source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAREQ1.m@ 1154

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1DVBAREQ1 ;ALB/GTS-557/THM-AMIE NEW REQUESTS; 21 JUL 89@0128
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4 D INIT
5 S DVBSEL=$$SELECT^DVBAUTL5("Date Range","7131 Request")
6 I DVBSEL="D" D BYDATE
7 I DVBSEL="N" D BYNAME
8 D KILL^DVBAREQS
9 Q
10 ;
11BYDATE ;Selection by the date like old way
12 F DO Q:DVBOUT
13 .S DVBSTOP=0,DVBOUT=0
14 .D KILL1^DVBAREQS
15 .D LINE
16 .D REMOTE
17 .I DVBOUT Q
18 .D DATE
19 .I DVBOUT Q
20 .S DVBVER=$$VERSION^DVBAREQS()
21 .I DVBVER=0 S DVBOUT=1 Q
22 .I DVBVER="S" D ^DVBAREQS Q
23 .D DEVICE
24 .I DVBOUT!(DVBSTOP) Q
25 .I DVBVER="L" DO
26 ..D GO
27 ..D EXIT
28 ..Q
29 .Q
30 Q
31 ;
32BYNAME ;Selection by patient name
33 F DO Q:DVBOUT
34 .S DVBSTOP=0,DVBOUT=0
35 .D KILL1^DVBAREQS
36 .D LINE
37 .S DVBDA=$$PAT^DVBAUTL5(7131)
38 .S XDIV="ALL"
39 .I DVBDA<0!('DVBDA) S DVBOUT=1 Q
40 .S DVBVER=$$VERSION^DVBAREQS()
41 .I DVBVER=0 S DVBOUT=1 Q
42 .I DVBVER="S" DO
43 ..S DA=DVBDA
44 ..D NAME^DVBAREQS
45 ..Q
46 .I DVBVER="L" DO
47 ..S DVBDA=+DVBDA
48 ..S (BDT,EDT)=""
49 ..D DEVICE
50 ..I DVBOUT!(DVBSTOP) Q
51 ..S QQ=1,NODTA=0,DA=+DVBDA U IO
52 ..D PRINT^DVBAREQ3
53 ..D EXIT
54 ..Q
55 .Q
56 Q
57 ;
58LINE ;LINE FEED
59 S VAR(1,0)="0,0,0,3,0^"
60 D WR^DVBAUTL4("VAR")
61 K VAR
62 Q
63 ;
64REMOTE ;Get remote site name from user
65 S XDIV=""
66 S VAR(1,0)="0,0,0,2,0^"
67 D WR^DVBAUTL4("VAR")
68 K VAR
69 S DIC("A")="For REMOTE SITE (Press RETURN for all sites) : ",DIC(0)="AEQM",DIC="^DG(40.8,"
70 D ^DIC
71 I $D(DTOUT)!(X=U) S DVBOUT=1 Q
72 I +Y>0 S XDIV=+Y
73ASK I +Y<0 DO
74 .S DIR(0)="YA"
75 .S DIR("A")="Are you sure you want ALL REMOTE SITES: "
76 .S DIR("B")="NO"
77 .S DIR("?")="Enter Y to get all remote sites N for just one"
78 .D ^DIR
79 .I $D(DTOUT)!($D(DUOUT)) S DVBOUT=1 Q
80 .I Y=1 S XDIV="ALL"
81 .I Y=0 S VAR=1
82 .Q
83 I $D(VAR) G REMOTE
84 K VAR,DIR
85 Q
86 ;
87DATE ;Gets beginning and ending dates from user
88 S VAR(1,0)="0,0,0,1,0^"
89 D WR^DVBAUTL4("VAR")
90 K VAR
91 S %DT(0)=-DT,%DT("A")="BEGINNING date: ",%DT="AE"
92 D ^%DT
93 I X="^"!(Y=-1) S DVBOUT=1 Q
94 S BDT=Y
95 S %DT("A")=" ENDING date: "
96 D ^%DT
97 I X="^"!(Y=-1) S DVBOUT=1 Q
98 S EDT=Y_".2359"
99 I EDT<BDT DO G DATE
100 .S VAR(1,0)="1,0,0,2:2,0^Invalid dates! Ending must not be before beginning."
101 .D WR^DVBAUTL4("VAR")
102 .K VAR
103 .D PAUSE^DVBCUTL4
104 .Q
105 K %DT
106 Q
107 ;
108GO D STM^DVBCUTL4
109 S QQ=1,NODTA=0 U IO
110 ;
111DATA S MA=BDT-.5 F J=0:0 S MA=$O(^DVB(396,"AE",MA)) Q:MA>EDT!(MA="") S:XDIV'="ALL" LPDIV=+XDIV-1 S:XDIV="ALL" LPDIV="" DO LOOPDIV
112 D EXIT
113 Q
114 ;
115LOOPDIV ;** Loop through Division - 'AE' X-ref
116 F LPVAR=0:0 S LPDIV=$O(^DVB(396,"AE",MA,LPDIV)) Q:(LPDIV=""!(XDIV'="ALL"&(XDIV'=LPDIV))) D LOOPDA
117 K LPVAR
118 Q
119 ;
120LOOPDA ;** Loop through DA - 'AE' X-ref
121 F DA=0:0 S DA=$O(^DVB(396,"AE",MA,LPDIV,DA)) Q:DA="" DO
122 .I $D(DVBATASK) D:'$D(^TMP($J,LPDIV,DA)) PRINT^DVBAREQ3 S QQ=1
123 .I '$D(DVBATASK) D:'$D(^TMP($J,DA)) PRINT^DVBAREQ3 S QQ=1
124 Q
125 ;
126EXIT I NODTA=0 DO
127 .U IO
128 .I IOST?1"C-".E S VAR(1,0)="0,0,0,0,1^" D WR^DVBAUTL4("VAR") K VAR
129 .S VAR(1,0)="0,0,0,3,0^Notice to MAS on "_FDT(0)
130 .S VAR(2,0)="0,0,0,1,0^There were no new 7131 requests"
131 .S VAR(3,0)="0,0,0,1:3,0^"_$S(XDIV'="ALL":"for "_$P(^DG(40.8,XDIV,0),U,1)_" ",1:"")
132 .I BDT]"" DO
133 ..S Y=$P(BDT,".",1)
134 ..X ^DD("DD")
135 ..S VAR(3,0)=VAR(3,0)_"from "_Y_" to "
136 ..S Y=$P(EDT,".",1)
137 ..X ^DD("DD")
138 ..S VAR(3,0)=VAR(3,0)_Y
139 ..Q
140 .D WR^DVBAUTL4("VAR")
141 .K VAR
142 .Q
143 D ^%ZISC
144 Q
145 ;
146TASK S X="T-1" D ^%DT S BDT=Y
147 S X="T-1" D ^%DT S EDT=Y_".2359"
148 S Y=DT X ^DD("DD") S FDT(0)=Y
149 D NOPARM^DVBAUTL2
150 I $D(DVBAQUIT) D KILL^DVBAREQS Q
151 S DVBSEL="D",DVBATASK=""
152 S HOSP=$$SITE^DVBCUTL4
153 F ZI=0:0 S ZI=$O(^DVB(396.1,1,2,"B",ZI)) Q:ZI="" F ZJ=0:0 S ZJ=$O(^DVB(396.1,1,2,"B",ZI,ZJ)) Q:ZJ="" D CLIN
154 D KILL^DVBAREQS
155 Q
156 ;
157DEQUE Q:'$D(XDIV)
158 I DVBSEL="D" D GO
159 I DVBSEL="N" DO
160 .S DA=DVBDA,QQ=1,NODTA=0
161 .D PRINT^DVBAREQ3
162 .D EXIT
163 .Q
164 D KILL^DVBAREQS
165 Q
166 ;
167CLIN ;Logic not changed, it is the original - needs to be
168 ;looked at for efficiency
169 S XDIV=ZI,ZTRTN="GO^DVBAREQ1",ZTIO=$P(^DVB(396.1,1,2,ZJ,0),U,2),ZTDESC="AMIE New Req for "_$S($D(^DG(40.8,XDIV,0)):$P(^(0),U,1),1:"Unknown")
170 F I="DVBATASK","DVBSEL","FDT(0)","XDIV","BDT","EDT","HOSP" S ZTSAVE(I)=""
171 S ZTDTH=$H D ^%ZTLOAD
172 Q
173 ;
174INIT ;Initialize variables
175 S DVBOUT=0
176 D NOPARM^DVBAUTL2
177 I $D(DVBAQUIT) S DVBOUT=1
178 D HOME^%ZIS
179 D HDR
180 S DVBAMAN=""
181 S HOSP=$$SITE^DVBCUTL4
182 S Y=DT X ^DD("DD") S FDT(0)=Y
183 K NOASK
184 Q
185 ;
186HDR ;Writes header info
187 S VAR(1,0)="0,0,0,1:3,1^AMIE New Request Report"
188 D WR^DVBAUTL4("VAR")
189 K VAR
190 Q
191 ;
192DEVICE ;Get device to print to
193 S VAR(1,0)="0,0,0,1,0^"
194 D WR^DVBAUTL4("VAR")
195 K VAR
196 S %ZIS="Q"
197 D ^%ZIS
198 K %ZIS
199 I POP S DVBOUT=1 Q
200 I $D(IO("Q")) DO
201 .S NOASK=1,DVBSTOP=1
202 .S ZTRTN="DEQUE^DVBAREQ1"
203 .S ZTIO=ION,ZTDESC="Amie new request rpt"
204 .F I="DVBSEL","DVBDA","FDT(0)","XDIV","BDT","EDT","VER","NOASK","HOSP","DVBAMAN" S ZTSAVE(I)=""
205 .D ^%ZTLOAD
206 .D ^%ZISC
207 .I $D(ZTSK) DO
208 ..S VAR(1,0)="0,0,0,2:2,0^Request queued."
209 ..D WR^DVBAUTL4("VAR")
210 ..K VAR
211 ..Q
212 .Q
Note: See TracBrowser for help on using the repository browser.