Return to DDS01.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDS01	;SFISC/MLH,MKO-PROCESS BLOCK ;09:44 AM  21 Dec 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	F  D IN,CHK Q:"^Q^NB^NP^"[(U_DDACT_U)
    5: 	Q
    6: 	;
    7: IN	K DDSBR,DDSFLD,DDSO,DDSU,DIR
    8: 	S:$D(@DDSREFS@(DDSPG,$S(DDO:DDSBK,1:0),DDO,"N"))#2 DDSU("N")=^("N")
    9: 	;
   10: 	I DDM,'$G(DDSKM) D CLRMSG^DDS
   11: 	G:'DDO COM^DDSCOM
   12: 	;
   13: 	S DDSOSV=0
   14: 	F DDSI=0,1,2,4,7,10:1:14,20 D
   15: 	. S:$D(^DIST(.404,DDSBK,40,DDO,DDSI))#2 DDSO(DDSI)=^(DDSI)
   16: 	K DDSI
   17: 	;
   18: 	S DDSFLD=$G(DDSO(1)) K DDSO(1)
   19: 	I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0,DDSFLD=DDO_","_DDSBK
   20: 	;
   21: 	I DDSFLD]"",DDSDA]"" F DDSI="A","D","F","M","O","X" D
   22: 	. S:$D(@DDSREFT@("F"_DDP,DDSDA,DDSFLD,DDSI))#2 DDSU(DDSI)=^(DDSI)
   23: 	K DDSI
   24: 	;
   25: 	I '$D(DDSREP)!DDSDA,$$UNED($G(DDSU("A")),$G(DDSO(4)),$G(DDSU("N"))) D CURSOR Q:$D(DDSBR)#2  S DDSCHKQ=1 Q
   26: 	;
   27: 	S (X,DDSOLD)=$G(DDSU("D")),DDSEXT=$G(DDSU("X"),X)
   28: 	;
   29: 	X:$G(DDSO(11))'?."^" DDSO(11)
   30: 	I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
   31: 	;
   32: 	S DIR0N=1 Q:DDSFLD=""
   33: 	;
   34: 	S:$G(^DD(DDP,DDSFLD,0))'?."^" DDSU("DD")=^(0)
   35: 	I $D(DDSU("N"))[0 S DDACT="N" Q
   36: 	Q:$D(DDSO(2))[0
   37: 	;
   38: 	D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
   39: 	K DDSKM,DDQ
   40: 	;
   41: 	S DIR0=$P(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,1,3)
   42: 	S:$P(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,10) $P(DIR0,U,6)=1
   43: 	S:$P($G(DDSREP),U,3)>1 $P(DIR0,U)=$P(DIR0,U)+$P(DDSREP,U,3)-1
   44: 	;
   45: 	I $D(DDSREP),'DDSDA,$P(DDSO(0),U,3)'=2 K DDSU("DD") G SEL^DDSM
   46: 	I $D(DDSU("M"))#2 S DDSGL=U_$P(DDSU("M"),U,2) G:'DDSU("M") WP^DDSWP
   47: 	S DIR("B")=$G(DDSU("X"),DDSOLD)
   48: 	;
   49: 	I $D(DDSU("M"))#2 D SEL^DDS5 G:X'=DDSOLD&(DDACT="N") EXT
   50: 	I $P($G(DDSO(0)),U,3)'=2 S DIR(0)=DDP_","_DDSFLD_"O"
   51: 	E  D DIR^DDSFO
   52: 	D ^DIR K DIR,DUOUT,DIRUT,DIROUT
   53: 	I DIR0N S (X,Y)=DDSOLD Q
   54: 	;
   55: EXT	I $E(X)=U!$D(DTOUT) S DIR0N=1 Q
   56: 	G EXT^DDS02
   57: 	;
   58: CHK	Q:$D(DDSBR)#2
   59: 	I $G(DDSCHKQ)=1 K DDSCHKQ Q
   60: 	G:$D(DTOUT) TO^DDS3
   61: 	G:$E(X)=U UPA^DDS2
   62: 	I $G(DDSFLD)=.01,X="",$G(DA) G ^DDS6
   63: 	;
   64: 	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
   65: 	K DDSCHKQ
   66: 	;
   67: 	I $G(DDSFLD)=.01,$G(DDSPTB)]"",$G(DDSREP)<2,'DIR0N D RPF^DDS7(DDP,DDSPTB,DDSDA,.DA)
   68: 	X:$G(DDSO(12))'?."^" DDSO(12)
   69: 	;
   70: 	I 'DIR0N,DDO,$G(DDSFLD)]"" D
   71: 	. I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0
   72: 	. S DDSCHG=1
   73: 	. S:+$G(DDSU("F"))'=1 $P(@DDSREFT@("F"_DDP,DDSDA,DDSFLD,"F"),U)=1
   74: 	. X:$G(DDSO(13))'?."^" DDSO(13)
   75: 	. D:$D(@DDSREFS@("PT",DDP,DDSFLD)) RPB^DDS7(DDP,DDSFLD,DDSPG)
   76: 	. D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF^DDSCOMP(DDSPG)
   77: 	;
   78: 	I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
   79: 	I $T(@DDACT)]"" G @DDACT
   80: 	I 'DDO G:X]"" ^DDS3 S DDSO(0)=0
   81: 	;
   82: 	G:"^U^D^R^L^"[(U_DDACT_U) CURSOR
   83: 	G:$D(DDSU("M"))[0 NF
   84: 	G:DDSU("M") ^DDS5
   85: 	D EDIT^DDSWP,R^DDSR
   86: 	;
   87: NF	I 'DDO,DDSOSV S DDO=DDSOSV Q
   88: 	;
   89: 	I DDO,$S($D(DDSREP):DDSDA,1:1) D
   90: 	. D:'$D(DDSU("M"))
   91: 	.. I $G(@DDSREFS@("ASUB",DDSPG,DDSBK,DDO))]"" S DDSSTACK="`"_^(DDO)
   92: 	.. E  I $P($G(DDSO(7)),U,2)]"" S DDSSTACK=$P(DDSO(7),U,2)
   93: 	. X:$G(DDSO(10))'?."^" DDSO(10)
   94: 	;
   95: 	I $D(DDSSTACK) D ^DDSSTK,R^DDS3 K DDSU
   96: 	I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
   97: 	S DDACT="N"
   98: 	;
   99: CURSOR	N ACT,B,BLK,BLK0,FND,N,REP
  100: 	S:$D(DDSU("N"))[0 DDSU("N")=$G(@DDSREFS@(DDSPG,DDSBK,DDO,"N"))
  101: 	S FND=0
  102: 	I $D(DDSREP),DDO D MNAV^DDSM(.FND) Q:FND
  103: 	;
  104: 	S B=U,(BLK,BLK0)=DDSBK,N=DDSU("N"),ACT=$S(DDO&$G(DDSDN):"N",1:DDACT)
  105: 	F  D  Q:FND!$D(REP)
  106: 	. S DDO=$P(N,U,$L($P("U^D^R^L^N",ACT),U))
  107: 	. I 'DDO S (DDO,DDSBK)=0,FND=1 Q
  108: 	. ;
  109: 	. S DDSBK=$P(DDO,",",2),DDO=+DDO
  110: 	. I DDSBK D  Q:$D(REP)
  111: 	.. I $P(@DDSREFS@(DDSPG,DDSBK),U,7)>1 S REP=1,DDACT="NB",DDSBR="" Q
  112: 	.. I $P($G(@DDSREFS@(DDSPG,DDSBK)),U,4) D
  113: 	... S DDO=$P($G(@DDSREFS@(DDSPG,DDSBK)),U,9),ACT="N"
  114: 	.. E  S ACT=DDACT
  115: 	.. S:$P($G(@DDSREFT@(DDSPG,DDSBK)),U)="" B=B_DDSBK_U
  116: 	. E  S DDSBK=BLK
  117: 	. ;
  118: 	. I B'[(U_DDSBK_U) S FND=1 S:DDSBK'=BLK0 DDACT="NB",DDSBR=""
  119: 	. ;
  120: 	. S:'FND N=$G(@DDSREFS@(DDSPG,DDSBK,+DDO,"N")),BLK=DDSBK
  121: 	Q
  122: 	;
  123: NP	;;
  124: 	G:$D(DDSREP)&DDO PGDN^DDSM
  125: 	S:DDSNP]"" DDSPG=DDSNP
  126: 	S:DDSNP="" DDACT="N"
  127: 	Q
  128: PP	;;
  129: 	G:$D(DDSREP)&DDO PGUP^DDSM
  130: 	S DDSPG=$$PP^DDS5(.Y)
  131: 	S DDACT=$S(Y=1:"NP",1:"N")
  132: 	Q
  133: NB	;;
  134: 	S DDSBK=$$NB^DDS5(.Y),DDACT=$S(Y=1:"NB",1:"N")
  135: 	Q
  136: SEL	;;
  137: 	S DDACT="N" G PG^DDSRSEL
  138: SV	;;
  139: 	G SV^DDS02
  140: QT	;;
  141: 	G QT^DDS3
  142: EX	;;
  143: 	G EX^DDS3
  144: CL	;;
  145: 	G CL^DDS3
  146: RF	;;
  147: 	G R^DDSR
  148: 	;
  149: UNED(ATT,DEF,N)	;
  150: 	Q $S(N="":1,$P(ATT,U,4)="":$P(DEF,U,4)=1,1:$P(ATT,U,4)=1)&'$P(N,U,11)