Return to DDS4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDS4	;SFISC/MKO-FILE AND RELOAD ;08:31 AM  24 Oct 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	D ^DDS41 Q:Y'=1
	N DA,DDO,DIE,DDP,DDSDA
	;
	S DX=0,DY=IOSL-1 X IOXY W "Filing form"_$P(DDGLCLR,DDGLDEL)
	;
	;File data
	S DDS4FI="F"
	F  S DDS4FI=$O(@DDSREFT@(DDS4FI)) Q:DDS4FI'?1"F".E  D
	. S DDP=$E(DDS4FI,2,999)
	. S DDS4DA=" "
	. F  S DDS4DA=$O(@DDSREFT@(DDS4FI,DDS4DA)) Q:DDS4DA=""  D REC
	;
	;Reload all pages on form
	S DDS4P=0
	F  S DDS4P=$O(@DDSREFT@(DDS4P)) Q:'DDS4P  D
	. S DDS4B=0
	. F  S DDS4B=$O(@DDSREFT@(DDS4P,DDS4B)) Q:'DDS4B  D
	.. S DDP=$P(@DDSREFS@(DDS4P,DDS4B),U,3),DDSDA=" "
	.. F  S DDSDA=$O(@DDSREFT@(DDS4P,DDS4B,DDSDA)) Q:'DDSDA  D
	... S $P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U)=1,DIE=^(DDSDA,"GL")
	... Q:$P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U,6)>1
	... D GDA(DDSDA)
	... D ^DDS11(DDS4B,1)
	;
	X:$G(^DIST(.403,+DDS,14))'?."^" ^(14)
	I '$G(DDSSAVE),$G(DDSPARM)["S" S DDSSAVE=1
	S (Y,DDSH)=1,(DDSCHG,DX)=0,DY=IOSL-1 X IOXY W $P(DDGLCLR,DDGLDEL)
	K @DDSREFT@("ADD")
	K DIC,DDS1B,DDS1DA,DDS4B,DDS4DA,DDS4FI,DDS4FLD,DDS4FO,DDS4P
	K DDSEXT,DDSI,DDSINT,DDSLC,DDSLN,DDSND,DDSOND,DDSOLD,DDSP,DDSPC
	K DDSW,DDSX,DV
	Q
REC	;
	G:DDS4FI="F0" FORMONLY
	;
	S DIE=@DDSREFT@(DDS4FI,DDS4DA,"GL")
	D GDA(DDS4DA)
	S DDSOND=-1 K DDSLN
	S DDS4FLD=""
	F  S DDS4FLD=$O(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD)) Q:DDS4FLD=""  D FLD
	S:$D(DDSLN)#2 @(DIE_"DA,DDSND)")=DDSLN
	Q
FLD	;
	Q:'$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F"))  S ^("F")=""
	I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
	S DDSINT=$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
	;
	;Word processing fields (quit if multiple)
	I $D(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"))#2 D:'$P(^("M"),U)  Q
	. N FR,TO
	. S FR=$NA(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
	. S TO=U_$$CREF^DILF($P(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"),U,2))
	. K @TO
	. M @TO=@FR
	. K @FR,@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F")
	;
	Q:$G(^DD(DDP,DDS4FLD,0))?."^"  S DDSND=$P(^(0),U,4)
	S DDSPC=$P(DDSND,";",2) Q:"0 "[DDSPC
	S DDSND=$P(DDSND,";")
	;
	I DDSOND'=DDSND D
	. S:$D(DDSLN)#2 @(DIE_"DA,DDSOND)")=DDSLN
	. S DDSLN=$G(@(DIE_"DA,DDSND)"))
	. S DDSOND=DDSND
	;
	I DDSPC D
	. S DDSOLD=$P(DDSLN,U,DDSPC)
	. S $P(DDSLN,U,DDSPC)=DDSINT
	E  D
	. S DDSW=$E(DDSPC,2,999),DDSP=$P(DDSW,",",2)+1
	. S DDSOLD=$E(DDSLN,+DDSW,DDSP-1)
	. S DDSX=$E(DDSLN,DDSP,999)
	. S DDSLN=$E(DDSLN,1,DDSW-1)_$J("",DDSW-1-$L(DDSLN))_DDSINT
	. S:DDSX'?." " DDSLN=DDSLN_$J("",DDSP-DDSW-$L(DDSINT))_DDSX
	;
	I $D(^DD(DDP,DDS4FLD,1))!($P(^(0),U,2)["a") D XR
	;
	Q
XR	;
	N DG,DP,DDS4AUD1,DDS4AUD2,DIIX
	S DP=DDP,DDSOND=-1
	I $D(DDSLN)#2 S @(DIE_"DA,DDSND)")=DDSLN K DDSLN
	;
	I $P(^DD(DDP,DDS4FLD,0),U,2)["a" D
	. S (DDS4AUD1,DDS4AUD2)=1
	. I $G(^DD(DDP,DDS4FLD,"AUDIT"))["e",DDSOLD="" S DDS4AUD1=0
	;
	I DDSOLD]"" D
	. S DG=0 F  S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1  D
	.. S DIC=DIE,X=DDSOLD
	.. X:$D(^DD(DDP,DDS4FLD,1,DG,2))#2 ^(2)
	. I $G(DDS4AUD2) S DG=1,X=DDSOLD,DIIX="2^"_DDS4FLD D AUDIT^DIET
	;
	I DDSINT]"" D
	. S DG=0 F  S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1  D
	.. S DIC=DIE,X=DDSINT
	.. X:$D(^DD(DDP,DDS4FLD,1,DG,1))#2 ^(1)
	. I $G(DDS4AUD1) S DG=1,X=DDSINT,DIIX="3^"_DDS4FLD D AUDIT^DIET
	Q
GDA(DDSDA)	;
	N I
	K DA S DA=$P(DDSDA,",")
	F I=2:1:$L(DDSDA,",")-1 S DA(I-1)=$P(DDSDA,",",I)
	Q
	;
FORMONLY	;
	N X
	D GDA(DDS4DA)
	S DDS4FLD=""
	F  S DDS4FLD=$O(@DDSREFT@("F0",DDS4DA,DDS4FLD)) Q:DDS4FLD=""  D
	. Q:'$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"F"))
	. S DDS4FO=$P(DDS4FLD,","),DDS4B=$P(DDS4FLD,",",2)
	. S DDSOLD=$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"O")),X=$G(^("D")),DDSEXT=$G(^("X"),X)
	. X:$G(^DIST(.404,DDS4B,40,DDS4FO,23))'?."^" ^(23)
	. S ^("O")=@DDSREFT@("F0",DDS4DA,DDS4FLD,"D"),^("F")=""
	Q