Return to DDS01.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDS01	;SFISC/MLH,MKO-PROCESS BLOCK ;09:44 AM  21 Dec 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	F  D IN,CHK Q:"^Q^NB^NP^"[(U_DDACT_U)
	Q
	;
IN	K DDSBR,DDSFLD,DDSO,DDSU,DIR
	S:$D(@DDSREFS@(DDSPG,$S(DDO:DDSBK,1:0),DDO,"N"))#2 DDSU("N")=^("N")
	;
	I DDM,'$G(DDSKM) D CLRMSG^DDS
	G:'DDO COM^DDSCOM
	;
	S DDSOSV=0
	F DDSI=0,1,2,4,7,10:1:14,20 D
	. S:$D(^DIST(.404,DDSBK,40,DDO,DDSI))#2 DDSO(DDSI)=^(DDSI)
	K DDSI
	;
	S DDSFLD=$G(DDSO(1)) K DDSO(1)
	I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0,DDSFLD=DDO_","_DDSBK
	;
	I DDSFLD]"",DDSDA]"" F DDSI="A","D","F","M","O","X" D
	. S:$D(@DDSREFT@("F"_DDP,DDSDA,DDSFLD,DDSI))#2 DDSU(DDSI)=^(DDSI)
	K DDSI
	;
	I '$D(DDSREP)!DDSDA,$$UNED($G(DDSU("A")),$G(DDSO(4)),$G(DDSU("N"))) D CURSOR Q:$D(DDSBR)#2  S DDSCHKQ=1 Q
	;
	S (X,DDSOLD)=$G(DDSU("D")),DDSEXT=$G(DDSU("X"),X)
	;
	X:$G(DDSO(11))'?."^" DDSO(11)
	I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
	;
	S DIR0N=1 Q:DDSFLD=""
	;
	S:$G(^DD(DDP,DDSFLD,0))'?."^" DDSU("DD")=^(0)
	I $D(DDSU("N"))[0 S DDACT="N" Q
	Q:$D(DDSO(2))[0
	;
	D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
	K DDSKM,DDQ
	;
	S DIR0=$P(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,1,3)
	S:$P(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,10) $P(DIR0,U,6)=1
	S:$P($G(DDSREP),U,3)>1 $P(DIR0,U)=$P(DIR0,U)+$P(DDSREP,U,3)-1
	;
	I $D(DDSREP),'DDSDA,$P(DDSO(0),U,3)'=2 K DDSU("DD") G SEL^DDSM
	I $D(DDSU("M"))#2 S DDSGL=U_$P(DDSU("M"),U,2) G:'DDSU("M") WP^DDSWP
	S DIR("B")=$G(DDSU("X"),DDSOLD)
	;
	I $D(DDSU("M"))#2 D SEL^DDS5 G:X'=DDSOLD&(DDACT="N") EXT
	I $P($G(DDSO(0)),U,3)'=2 S DIR(0)=DDP_","_DDSFLD_"O"
	E  D DIR^DDSFO
	D ^DIR K DIR,DUOUT,DIRUT,DIROUT
	I DIR0N S (X,Y)=DDSOLD Q
	;
EXT	I $E(X)=U!$D(DTOUT) S DIR0N=1 Q
	G EXT^DDS02
	;
CHK	Q:$D(DDSBR)#2
	I $G(DDSCHKQ)=1 K DDSCHKQ Q
	G:$D(DTOUT) TO^DDS3
	G:$E(X)=U UPA^DDS2
	I $G(DDSFLD)=.01,X="",$G(DA) G ^DDS6
	;
	I 'DIR0N,$G(DDSFLD),$D(DDSU("M"))[0,$G(DDSCHKQ)'=2,$P($G(DDSU("DD")),U,5,99)["DINUM"!($P($G(DDSU("DD")),U,2)["I")!$S($P($G(DDSU("A")),U,4)="":$P($G(DDSO(4)),U,4),1:$P($G(DDSU("A")),U,4)) G UNED^DDS02
	K DDSCHKQ
	;
	I $G(DDSFLD)=.01,$G(DDSPTB)]"",$G(DDSREP)<2,'DIR0N D RPF^DDS7(DDP,DDSPTB,DDSDA,.DA)
	X:$G(DDSO(12))'?."^" DDSO(12)
	;
	I 'DIR0N,DDO,$G(DDSFLD)]"" D
	. I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0
	. S DDSCHG=1
	. S:+$G(DDSU("F"))'=1 $P(@DDSREFT@("F"_DDP,DDSDA,DDSFLD,"F"),U)=1
	. X:$G(DDSO(13))'?."^" DDSO(13)
	. D:$D(@DDSREFS@("PT",DDP,DDSFLD)) RPB^DDS7(DDP,DDSFLD,DDSPG)
	. D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF^DDSCOMP(DDSPG)
	;
	I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
	I $T(@DDACT)]"" G @DDACT
	I 'DDO G:X]"" ^DDS3 S DDSO(0)=0
	;
	G:"^U^D^R^L^"[(U_DDACT_U) CURSOR
	G:$D(DDSU("M"))[0 NF
	G:DDSU("M") ^DDS5
	D EDIT^DDSWP,R^DDSR
	;
NF	I 'DDO,DDSOSV S DDO=DDSOSV Q
	;
	I DDO,$S($D(DDSREP):DDSDA,1:1) D
	. D:'$D(DDSU("M"))
	.. I $G(@DDSREFS@("ASUB",DDSPG,DDSBK,DDO))]"" S DDSSTACK="`"_^(DDO)
	.. E  I $P($G(DDSO(7)),U,2)]"" S DDSSTACK=$P(DDSO(7),U,2)
	. X:$G(DDSO(10))'?."^" DDSO(10)
	;
	I $D(DDSSTACK) D ^DDSSTK,R^DDS3 K DDSU
	I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
	S DDACT="N"
	;
CURSOR	N ACT,B,BLK,BLK0,FND,N,REP
	S:$D(DDSU("N"))[0 DDSU("N")=$G(@DDSREFS@(DDSPG,DDSBK,DDO,"N"))
	S FND=0
	I $D(DDSREP),DDO D MNAV^DDSM(.FND) Q:FND
	;
	S B=U,(BLK,BLK0)=DDSBK,N=DDSU("N"),ACT=$S(DDO&$G(DDSDN):"N",1:DDACT)
	F  D  Q:FND!$D(REP)
	. S DDO=$P(N,U,$L($P("U^D^R^L^N",ACT),U))
	. I 'DDO S (DDO,DDSBK)=0,FND=1 Q
	. ;
	. S DDSBK=$P(DDO,",",2),DDO=+DDO
	. I DDSBK D  Q:$D(REP)
	.. I $P(@DDSREFS@(DDSPG,DDSBK),U,7)>1 S REP=1,DDACT="NB",DDSBR="" Q
	.. I $P($G(@DDSREFS@(DDSPG,DDSBK)),U,4) D
	... S DDO=$P($G(@DDSREFS@(DDSPG,DDSBK)),U,9),ACT="N"
	.. E  S ACT=DDACT
	.. S:$P($G(@DDSREFT@(DDSPG,DDSBK)),U)="" B=B_DDSBK_U
	. E  S DDSBK=BLK
	. ;
	. I B'[(U_DDSBK_U) S FND=1 S:DDSBK'=BLK0 DDACT="NB",DDSBR=""
	. ;
	. S:'FND N=$G(@DDSREFS@(DDSPG,DDSBK,+DDO,"N")),BLK=DDSBK
	Q
	;
NP	;;
	G:$D(DDSREP)&DDO PGDN^DDSM
	S:DDSNP]"" DDSPG=DDSNP
	S:DDSNP="" DDACT="N"
	Q
PP	;;
	G:$D(DDSREP)&DDO PGUP^DDSM
	S DDSPG=$$PP^DDS5(.Y)
	S DDACT=$S(Y=1:"NP",1:"N")
	Q
NB	;;
	S DDSBK=$$NB^DDS5(.Y),DDACT=$S(Y=1:"NB",1:"N")
	Q
SEL	;;
	S DDACT="N" G PG^DDSRSEL
SV	;;
	G SV^DDS02
QT	;;
	G QT^DDS3
EX	;;
	G EX^DDS3
CL	;;
	G CL^DDS3
RF	;;
	G R^DDSR
	;
UNED(ATT,DEF,N)	;
	Q $S(N="":1,$P(ATT,U,4)="":$P(DEF,U,4)=1,1:$P(ATT,U,4)=1)&'$P(N,U,11)