Annotation of freem_fileman/DDSM.m, revision 1.1.1.1
1.1 snw 1: DDSM ;SFISC/MKO-MULTILINE ;01:34 PM 6 Oct 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: MNAV(FND) ;Navigate within repeating blocks
5: ;Returns FND if navigating to another field within the repeating
6: ;block
7: N DDSCL,DDSDDO,DDSNR,DDSPDA,DDSSN,DDSSTL
8: S DDSDDO=$P(DDSU("N"),U,$L($P("U^D^R^L^N",DDACT),U)+5)
9: ;
10: S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2),DDSCL=$P(DDSREP,U,3)
11: S DDSSN=$P(DDSREP,U,4),DDSNR=$P(DDSREP,U,5)
12: ;
13: I $P(DDSDDO,",",2)="-1" D MUP Q
14: I $P(DDSDDO,",",2)="+1" D MDN Q
15: I DA S DDO=+DDSDDO,FND=1 Q
16: Q
17: ;
18: MUP ;Move up a line
19: Q:DDSSN'>1
20: S DDSSN=DDSSN-1
21: I DDSCL>1 D
22: . S DDSCL=DDSCL-1 D MDA
23: E D
24: . S DDSSTL=DDSSTL-1
25: . D MDA,DB^DDSR(DDSPG,DDSBK)
26: Q
27: ;
28: MDN ;Move down a line
29: Q:'DA
30: S DDSSN=DDSSN+1
31: I DDSCL<DDSNR D
32: . S DDSCL=DDSCL+1 D MDA
33: E D
34: . S DDSSTL=DDSSTL+1
35: . D MDA,DB^DDSR(DDSPG,DDSBK)
36: Q
37: ;
38: MDA ;Update DDO, DA and Dn, set FND=1
39: N DDSDASV
40: S $P(DDSREP,U,2,4)=DDSSTL_U_DDSCL_U_DDSSN
41: S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
42: S DDSDASV=DDSDA
43: S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
44: S DA=+DDSDA,@("D"_DDSDL)=DA
45: S DDO=$S(DA:+DDSDDO,1:$P(DDSREP,U,8))
46: S FND=1
47: Q
48: ;
49: SEL ;Issue read
50: N DIRUT
51: S DIR(0)="PO"_DIE_":QEMZ"_$E("L",'$D(DDSTP)&'$P(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,2),U,4))
52: I $P(DDSREP,U,7) D
53: . S:$D(@(DIE_"0)"))[0 @(DIE_"0)")=U_$P(^DD($P(DDSREP,U,6),$P(DDSREP,U,7),0),U,2)_U_U
54: E D
55: . S DIR("S")="I $D("_DIE_""""_$P(DDSREP,U,9)_""","_+$P(DDSREP,U)_",Y))"
56: D ^DIR K DIR,DUOUT,DIROUT Q:DIR0N!$D(DIRUT)
57: ;
58: S DA=+Y,$P(DDSDA,",")=DA
59: I $P(Y,U,3)=1 D
60: . N DDSFN,DDSLN,DDSPDA,DDSSN
61: . S DDSPDA=$P(DDSREP,U),DDSLN=$P(DDSREP,U,3),DDSSN=$P(DDSREP,U,4)
62: . D ADD(DDSDA,DDSPDA,DDSSN)
63: . S DDSFN="F"_$P(@DDSREFS@(DDSPG,DDSBK),U,3)
64: . D DMULT1^DDSR(DDSPG,DDSBK,DDSFN,DDSDA,DDSLN,DDSSN)
65: . S DDSCHKQ=2
66: E D
67: . S DDSCHKQ=1
68: . D POSDA(DDSDA)
69: ;
70: S Y=$P(Y,U)
71: S:X="" Y=""
72: Q
73: ;
74: END ;
75: S DDACT="N"
76: Q:'DA
77: D POSSN(999999999999)
78: Q
79: ;
80: PGDN ;Page down
81: S DDACT="N"
82: Q:'DA
83: D POSSN($P(DDSREP,U,2)+$P(DDSREP,U,5))
84: Q
85: ;
86: PGUP ;Page up
87: S DDACT="N"
88: Q:$P(DDSREP,U,4)=1
89: D POSSN($P(DDSREP,U,2)-$P(DDSREP,U,5))
90: Q
91: ;
92: POSSN(DDSSN) ;Make line with given DDSSN current
93: N DDSLSN,DDSPDA,DDSSTL
94: S DDSPDA=$P(DDSREP,U)
95: S DDSLSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA," "),-1)+1
96: S DDSSN=$$MIN(DDSLSN,DDSSN)
97: S:DDSSN<1 DDSSN=1
98: S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
99: S DA=+DDSDA
100: S DDSSTL=$P(DDSREP,U,2)
101: ;
102: S:'DA DDO=$P(DDSREP,U,8)
103: I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
104: . S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
105: . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
106: E D
107: . S DDSSTL=$$MIN(DDSLSN-$P(DDSREP,U,5)+1,DDSSN)
108: . S:DDSSTL<1 DDSSTL=1
109: . S $P(DDSREP,U,2,4)=DDSSTL_U_(DDSSN-DDSSTL+1)_U_DDSSN
110: . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
111: . D DB^DDSR(DDSPG,DDSBK)
112: Q
113: ;
114: POSDA(DDSDA) ;Make line with given DDSDA current
115: N DDSPDA,DDSSN,DDSSTL
116: S DDSSN=@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),"B",DDSDA)
117: S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2)
118: ;
119: I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
120: . N DY,DX
121: . S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
122: . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
123: . S DY=$P(DIR0,U),DX=$P(DIR0,U,2) X IOXY W $J("",$P(DIR0,U,3))
124: E D
125: . S $P(DDSREP,U,2,4)=DDSSN_"^1^"_DDSSN
126: . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
127: . D DB^DDSR(DDSPG,DDSBK)
128: Q
129: ;
130: ADD(DDSDA,DDSPDA,DDSSN) ;Add entry
131: S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIE
132: S @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSDA
133: S @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)=DDSSN
134: D ^DDS11(DDSBK)
135: S DDSCHG=1
136: Q
137: ;
138: MIN(X,Y) ;
139: Q $S(X<Y:X,1:Y)
140: MAX(X,Y) ;
141: Q $S(X>Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSM.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman