Annotation of freem_fileman/DDS01.m, revision 1.1
1.1 ! snw 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)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDS01.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman