Return to DDS.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDS	;SFISC/MLH,MKO-MAIN ROUTINE ;02:33 PM  15 Nov 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	N DIE,DX,DY,X,Y
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	;
	D EN^DDS0(.DDSFILE,DR,.DA)
	I $G(DIERR) D:$G(DDSPARM)'["E"  G END^DDS0
	. W !,$C(7)_$$EZBLD^DIALOG(3000)
	. D MSG^DIALOG("BW")
	. S DIMSG=""
	;
	N DR
	X:$G(^DIST(.403,+DDS,11))'?."^" ^(11)
	F  D PG Q:DDACT="Q"
	X:$G(^DIST(.403,+DDS,12))'?."^" ^(12)
	;
	D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
	G END^DDS0
	;
PROC	;Main loop
	F  D PG Q:DDACT="Q"
	Q
	;
PG	;Get DDSPOP and update DDSSC array
	;If we're going to another page
	S DDACT="N"
	I '$D(DDSPGUP) D
	. S DDSLN=^DIST(.403,+DDS,40,DDSPG,0),DDSPOP=$P(DDSLN,U,6)
	. K:'DDSPOP DDSSC
	. I '$D(DDSSC("B",DDSPG)) D
	.. S DDSSC=$G(DDSSC)+1,DDSSC(DDSSC)=DDSPG,DDSSC("B",DDSPG,DDSSC)=""
	.. S:DDSPOP $P(DDSSC(DDSSC),U,2,3)=$P(DDSLN,U,3)_U_$P(DDSLN,U,7)
	.. I $G(DDSSTK) S $P(DDSSC(DDSSC),U,4)=1 K DDSSTK
	.. K DDSPOP
	. E  D
	.. Q:$P($G(DDSSC(+$G(DDSSC))),U)=DDSPG
	.. N I,J,S
	.. S I=$O(DDSSC("B",DDSPG,"")),S=DDSSC(I) K DDSSC("B",DDSPG,I)
	.. F J=I:1:DDSSC-1 D
	... K DDSSC("B",$P(DDSSC(J+1),U),J)
	... S DDSSC(J)=DDSSC(J+1),DDSSC("B",$P(DDSSC(J),U),J)=""
	.. S DDSSC(DDSSC)=S,DDSSC("B",DDSPG,DDSSC)=""
	;
	;If we've moving up from a pop-up page
	E  K DDSPGUP
	;
	;Pre-action, save old and get next page
	S DDSOPB=DDSPG
	I $G(^DIST(.403,+DDS,40,DDSPG,11))'?."^" D PA(^(11)) Q:DDACT="NP"
	S DDSNP=$$NP^DDS5(.Y) S:'Y DDSNP=""
	;
	;Load page
	D ^DDS1(DDSPG)
	I $G(DIERR) D  Q
	. N P S P(1)=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U),P(2)=$P($G(^(1)),U)
	. S:P(2)="" P(2)="unnamed"
	. D BLD^DIALOG(3041,.P),ERR^DDSMSG
	. S DDACT="Q"
	;
	;Get DDO and DDSBK
	I $S($D(DDSBR)[0:1,1:$D(@DDSREFS@(DDSPG,$S(DDO:+DDSBK,1:0),DDO,"N"))[0) D
	. S DDO=+@DDSREFS@(DDSPG,"FIRST"),DDSBK=$P(^("FIRST"),",",2)
	I 'DDSBK D  Q
	. D BLD^DIALOG(3055,"number "_$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U)_$S($G(^(1))]"":" ("_$P($G(^(1)),U)_")",1:""))
	. S DDACT="Q"
	;
	;Paint the page
	D RP^DDSR(DDSSC(DDSSC),DDSSC=1)
	;
P1	F  D BLK Q:"^Q^NP^"[(U_DDACT_U)
	;
	;Post action, print any help
	D:$G(^DIST(.403,+DDS,40,+DDSOPB,12))'?."^" PA(^(12))
	D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
	G:"^NB^N^"[(U_DDACT_U) P1
	;
	I DDACT="Q" D
	. I '$P(DDSSC(DDSSC),U,4) D
	.. D:$G(DDSSEL) GDA^DDSRSEL
	.. D:$G(DDSSC)>1 CLEAR^DDSBOX($P(DDSSC(DDSSC),U,2),$P(DDSSC(DDSSC),U,3))
	.. S:DDSSC>1 DDSPG=$P(DDSSC(DDSSC-1),U),DDACT="N",DDSPGUP=1
	. K DDSSC("B",$P(DDSSC(DDSSC),U),DDSSC),DDSSC(DDSSC) S DDSSC=DDSSC-1
	Q
	;
BLK	S DDACT="N",DDSOSV=0
	;
	I $D(@DDSREFS@(DDSPG,DDSBK))[0 S DDACT="Q" Q
	S DDSLN=@DDSREFS@(DDSPG,DDSBK)
	;
	S DDSDN=$P(DDSLN,U,4),DDSTP=$P(DDSLN,U,5)
	S DDSREP=$P(DDSLN,U,7),DDSPTB=$P(DDSLN,U,8)
	K:'DDSDN DDSDN K:DDSTP="e" DDSTP K:'DDSPTB DDSPTB K:DDSREP'>1 DDSREP
	;
	I $D(DDSPTB)!$D(DDSREP) N DDP,DDSDA,DIE D
	. S DDP=$P(DDSLN,U,3)
	. S DDSDA=$P(@DDSREFT@(DDSPG,DDSBK),U) Q:DDSDA=""
	. S DIE=@DDSREFT@(DDSPG,DDSBK,DDSDA,"GL")
	;
	I $D(DDSPTB) N DA,@$$D0(DDSDL),DDSDL D
	. S DDSPTB=@DDSREFS@(DDSPG,DDSBK,"PTB")
	. S DDSDL=$L(DDSDA,",")-2
	. S (D0,DA)=+DDSDA
	;
	I $D(DDSREP) N DDSDL,DA D
	. S DDSREP=$P(@DDSREFT@(DDSPG,DDSBK,DDSDA),U,2,999)
	. S DDSDL=$L(DDSDA,",")-1
	. S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),$P(DDSREP,U,4)),"0,"_DDSDA)
	I  N @$$D0(DDSDL) D
	. D BLDDA(DDSDA)
	. S:'DA DDO=+$P(DDSREP,U,8)
	;
	I $D(DDSPTB),DDSDA=""  D  Q
	. S DDSBK=$$NB^DDS5(.Y) Q:Y
	. I DDSNP]"" S DDSPG=DDSNP,DDACT="NP" Q
	. S DDSPG=$$PP^DDS5(.Y) I Y S DDACT="NP" Q
	;
	S $P(DDSOPB,U,2)=DDSBK
	I $G(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,11))'?."^" D PA(^(11)) Q:DDACT="NP"
	I $G(^DIST(.404,DDSBK,11))'?."^" D PA(^(11)) Q:DDACT="NP"
	I $S($D(DDSBR)[0:1,1:$D(@DDSREFS@(DDSPG,$S(DDO:+DDSBK,1:0),DDO,"N"))[0) D
	. S DDO=$P(@DDSREFS@(DDSPG,DDSBK),U,9)
	K DDSLN
	;
B1	D ^DDS01
	;
	I $G(^DIST(.403,+DDS,40,DDSPG,40,$P(DDSOPB,U,2),12))'?."^" D PA(^(12)) G:DDACT="N" B1
	I $G(^DIST(.404,$P(DDSOPB,U,2),12))'?."^" D PA(^(12)) G:DDACT="N" B1
	Q
	;
BLDDA(DDSDA)	;
	N I
	S (DA,@("D"_DDSDL))=$P(DDSDA,",")
	F I=1:1:DDSDL S (DA(I),@("D"_(DDSDL-I)))=$P(DDSDA,",",I+1)
	Q
	;
D0(DL)	;Given DL, return string D0,D1,...,Dn
	N I,S
	S S="" F I=0:1:DL S S=S_"D"_I_","
	S:S?.E1"," S=$E(S,1,$L(S)-1)
	Q S
	;
CLRMSG	;
	K DDQ S DDSH=1,(DDM,DX)=0,DY=DDSHBX+1 X DDXY W $P(DDGLCLR,DDGLDEL,3)
	Q
	;
PA(DDSPA)	;
	N DDSBRORG S:$D(DDSBR)#2 DDSBRORG=DDSBR
	K DDSBR X DDSPA
	I $D(DDSBR)[0 S:$D(DDSBRORG)#2 DDSBR=DDSBRORG Q
	D BR^DDS2
	Q
RESET	;Programmer entry point to reset terminal and cleanup
	D INIT^DDGLIB0() D:$G(DIERR) MSG^DIALOG("BW")
	W $P($G(DDGLVID),DDGLDEL,10)
	K DDSPARM
	S DDSREFT="^TMP(""DDS"",$J)"
	D END^DDS0
	G RESET^DDGF
	;
RUN	;Run a form
	G ^DDSRUN
CLONE	;Clone a form
	G ^DDSCLONE
PRINT	;Print a form
	G ^DDSPRNT
DFRM	;Delete a form
	G ^DDSDFRM
DBLK	;Delete unused blocks
	G ^DDSDBLK