source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSM.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1DDSM ;SFISC/MKO-MULTILINE ;10:12 AM 1 Oct 1999
2 ;;22.0;VA FileMan;**8**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4MNAV(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 ;
18MUP ;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 ;
28MDN ;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 ;
38MDA ;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 ;
49SEL ;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))_$E("V",$P(^(2),U,6))
52 I $P(DDSREP,U,7) D
53 . N DDSMSPEC S DDSMSPEC=$P(^DD($P(DDSREP,U,6),$P(DDSREP,U,7),0),U,2)
54 . I $D(@(DIE_"0)"))[0 S ^(0)=U_DDSMSPEC_U_U
55 . E I $P(@(DIE_"0)"),U,2)'=DDSMSPEC S $P(^(0),U,2)=DDSMSPEC
56 . I $P(DDSREP,U,9)]"" D
57 .. N DDSROOT,DDSSUB
58 .. S DDSROOT=$NA(@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),"B"))
59 .. S DDSSUB="Y_"",""_"""_$P(DDSREP,U)_""""
60 .. S DDSROOT=$E(DDSROOT,1,$L(DDSROOT)-1)_","_DDSSUB_")"
61 .. S DIR("S")="I $D("_DDSROOT_")"
62 E N DDSLASCN D
63 . S DDSLASCN=$NA(@(DIE_""""_$P(DDSREP,U,9)_""","_+$P(DDSREP,U)_")"))
64 . S DIR("S")="X ""I 0"" N R,S S (R,S)=DDSLASCN F S R=$Q(@R) Q:R=""""!($NA(@R,"_$QL(DDSLASCN)_")'=S) I $QS(R,$QL(R))=Y Q"
65 D ^DIR K DIR,DUOUT,DIROUT Q:DIR0N!$D(DIRUT)
66 ;
67 S DA=+Y,$P(DDSDA,",")=DA,@("D"_DDSDL)=DA
68 I $P(Y,U,3)=1 D
69 . N DDSFN,DDSLN,DDSPDA,DDSSN
70 . S DDSPDA=$P(DDSREP,U),DDSLN=$P(DDSREP,U,3),DDSSN=$P(DDSREP,U,4)
71 . S DDSFN=+$P(@DDSREFS@(DDSPG,DDSBK),U,3)
72 . ;
73 . I '$P(DDSREP,U,7) D
74 .. N DR,X,Y
75 .. S DR=$O(^DD(DDSFN,0,"IX",$P(DDSREP,U,9),DDSFN,""))_"////"_+DDSREP
76 .. D ^DIE
77 . ;
78 . D ADD(DDSDA,DDSPDA,DDSSN)
79 . S DDSFN="F"_DDSFN
80 . D DMULT1^DDSR(DDSPG,DDSBK,DDSFN,DDSDA,DDSLN,DDSSN)
81 . S DDSCHKQ=2
82 E D
83 . S DDSCHKQ=1
84 . D POSDA(DDSDA)
85 ;
86 S Y=$P(Y,U)
87 S:X="" Y=""
88 Q
89 ;
90END ;
91 S DDACT="N"
92 Q:'DA
93 D POSSN(999999999999)
94 Q
95 ;
96PGDN ;Page down
97 S DDACT="N"
98 I 'DA D
99 . I DDSNP]"" S DDSPG=DDSNP,DDACT="NP"
100 E D POSSN($P(DDSREP,U,2)+$P(DDSREP,U,5))
101 Q
102 ;
103PGUP ;Page up
104 S DDACT="N"
105 I $P(DDSREP,U,4)=1 D
106 . S DDSPG=$$PP^DDS5(.Y)
107 . S:Y=1 DDACT="NP"
108 E D POSSN($P(DDSREP,U,2)-$P(DDSREP,U,5))
109 Q
110 ;
111POSSN(DDSSN,DDSPAINT) ;Make line with given DDSSN current
112 N DDSLSN,DDSPDA,DDSSTL
113 S DDSPDA=$P(DDSREP,U)
114 S DDSSTL=$P(DDSREP,U,2)
115 ;
116 S DDSLSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA," "),-1)+1
117 S DDSSN=$$MIN(DDSLSN,DDSSN)
118 S:DDSSN<1 DDSSN=1
119 ;
120 S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
121 S DA=+DDSDA,@("D"_DDSDL)=DA
122 ;
123 S:'DA DDO=$P(DDSREP,U,8)
124 I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
125 . S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
126 . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
127 . D:$G(DDSPAINT) DB^DDSR(DDSPG,DDSBK)
128 E D
129 . S DDSSTL=$$MIN(DDSLSN-$P(DDSREP,U,5)+1,DDSSN)
130 . S:DDSSTL<1 DDSSTL=1
131 . S $P(DDSREP,U,2,4)=DDSSTL_U_(DDSSN-DDSSTL+1)_U_DDSSN
132 . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
133 . D DB^DDSR(DDSPG,DDSBK)
134 Q
135 ;
136POSDA(DDSDA) ;Make line with given DDSDA current
137 N DDSPDA,DDSSN,DDSSTL
138 S DDSSN=@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),"B",DDSDA)
139 S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2)
140 ;
141 I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
142 . N DY,DX
143 . S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
144 . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
145 . S DY=$P(DIR0,U),DX=$P(DIR0,U,2) X IOXY W $J("",$P(DIR0,U,3))
146 E D
147 . S $P(DDSREP,U,2,4)=DDSSN_"^1^"_DDSSN
148 . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
149 . D DB^DDSR(DDSPG,DDSBK)
150 Q
151 ;
152ADD(DDSDA,DDSPDA,DDSSN) ;Add entry
153 S @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)=DDSSN
154 S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIE
155 S @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSDA
156 D ^DDS11(DDSBK)
157 S DDSCHG=1
158 Q
159 ;
160MIN(X,Y) ;
161 Q $S(X<Y:X,1:Y)
162MAX(X,Y) ;
163 Q $S(X>Y:X,1:Y)
Note: See TracBrowser for help on using the repository browser.