Annotation of freem_fileman/DDS01.m, revision 1.1.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