source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETH.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1PXRMETH ; SLC/PJH - Reminder Extract History ;10/11/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;Main entry point for PXRM EXTRACT HISTORY
5START(EDIEN) ;
6 ;EDIEN is the extract definition IEN.
7 N VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
8 ;Details of last run
9 N DATA,NPERIOD,NSDATE,NTAS,PXRMVIEW
10 S DATA=$G(^PXRM(810.2,EDIEN,0))
11 S NPERIOD=$P(DATA,U,6),NSDATE=$P(DATA,U,7)
12 ;Default view is in date created order
13 S PXRMVIEW="D"
14 S X="IORESET"
15 D ENDR^%ZISS
16 S VALMCNT=0
17 D EN^VALM("PXRM EXTRACT HISTORY")
18 Q
19 ;
20DELETE ;Delete an extract, called by protocol PXRM EXTRACT SUMMARY DELETE.
21 N CLASS,IEN,IENLIST,IND
22 S IENLIST=$$LMSEL
23 F IND=1:1:$L(IENLIST,U) D
24 .S IEN=$P(IENLIST,U,IND)
25 .D DELETE^PXRMETXU(IEN)
26 ;Rebuild workfile
27 D BLDLIST^PXRMETH1(EDIEN)
28 ;Refresh
29 S VALMBCK="R"
30 Q
31 ;
32ENTRY ;Entry code
33 D BLDLIST^PXRMETH1(EDIEN),XQORM
34 Q
35 ;
36EXIT ;Exit code
37 K ^TMP("PXRMETH",$J)
38 K ^TMP("PXRMETHH",$J)
39 D CLEAN^VALM10
40 D FULL^VALM1
41 S VALMBCK="Q"
42 Q
43 ;
44EXTRACT(EDIEN) ;Run Extract/Transmission
45 ;Reset screen mode
46 W IORESET
47 ;Refresh on exit
48 S VALMBCK="R"
49 ;
50 ;Get details from parameter file
51 N ANS,DATA,DUOUT,DTOUT,EDATE,EXSUMPUG,FREQ,MODE
52 N NAME,NAT,NEXT,PLISTPUG,RTN,REPL,STATUS,SNEXT,TEXT,XMIT
53 S DATA=$G(^PXRM(810.2,EDIEN,0))
54 S NAT=$P($G(^PXRM(810.2,EDIEN,100)),U)
55 ;Determine Extract Name and Frequency
56 S NAME=$P(DATA,U),FREQ=$P(DATA,U,3),NEXT=$P(DATA,U,6),RTN="PXRMETX"
57 ;Save next scheduled extract
58 S SNEXT=NEXT
59 ;Select extract period
60EXSEL D SELECT(FREQ,.NEXT) Q:$D(DUOUT)!$D(DTOUT)
61 ;Warn if period is still open
62 D WARN(NEXT,.STATUS)
63 ;Option to continue
64 S TEXT="Are you sure you want to run a "_NAME_" extract for "_$TR(NEXT,"/"," ")
65SURE ;
66 S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,1) Q:$D(DUOUT)!$D(DTOUT) Q:'ANS
67 ;Purge options
68PLIST ;
69 S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
70 G:$D(DUOUT) SURE Q:$D(DTOUT)
71 S EXSUMPUG="N" D ASK^PXRMXD(.EXSUMPUG,"Purge Extract Summary after 5 years?: ",5)
72 G:$D(DUOUT) PLIST Q:$D(DTOUT)
73 ;Option to transmit
74 S TEXT="Transmit extract results to AAC"
75 I NAT="N" S XMIT=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
76 E S XMIT=0
77 ;Option to replace scheduled run
78 S REPL=0
79 I XMIT,SNEXT=NEXT,STATUS="COMPLETE" D Q:$D(DUOUT)!$D(DTOUT)
80 .S TEXT="Does this extract replace the scheduled extract"
81 .S REPL=$$ASKYN^PXRMEUT("N",TEXT,RTN,4) Q:$D(DUOUT)!$D(DTOUT)
82 ;
83 ;Note that the manual extract does not update 810.2
84 ;exept if the selected period is the same as the scheduled
85 ;period AND this period is complete
86 ;
87 ;Default is to extract and transmit and not update 810.2
88 S MODE=2 I 'XMIT S MODE=3
89 ;Update 810.2 if this extract is for current completed period
90 I REPL S MODE=0 I 'XMIT S MODE=1
91 ;
92 ;Extract/transmission run
93 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
94 S ZTDESC="Reminder Extract "_NAME
95 S ZTRTN="RUN^PXRMETX(EDIEN,NEXT,MODE,EXSUMPUG)"
96 S ZTSAVE("EDIEN")=""
97 S ZTSAVE("MODE")=""
98 S ZTSAVE("NEXT")=""
99 S ZTSAVE("PLISTPUG")=""
100 S ZTSAVE("EXSUMPUG")=""
101 S ZTIO=""
102 ;
103 ;Select and verify start date/time for task
104 N DIR,DTOUT,DUOUT,MINDT,SDTIME,STIME,X,Y
105 S MINDT=$$NOW^XLFDT
106 W !,"Queue a "_ZTDESC_" for "_NEXT
107 S DIR("A",1)="Enter the date and time you want the job to start."
108 S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
109 S DIR("A")="Start the task at: "
110 S DIR(0)="DAU"_U_MINDT_"::RSX"
111 D ^DIR
112 I $D(DTOUT)!$D(DUOUT) Q
113 S SDTIME=Y
114 ;
115 ;Put the task into the queue.
116 S ZTDTH=SDTIME
117 D ^%ZTLOAD
118 W !,"Task number ",ZTSK," queued." H 2
119 S VALMBCK="Q"
120 Q
121 ;
122HDR ; Header code
123 N VIEW
124 S VIEW=$S(PXRMVIEW="D":"Creation Date Order",1:"Extract Period Order")
125 S VALMHDR(2)=" Extract Name: "_$P($G(^PXRM(810.2,EDIEN,0)),U)
126 S VALMHDR(3)=" Next Extract Period: "_NPERIOD
127 S VALMHDR(4)=" Scheduled to Run: "_$$FMTE^XLFDT(NSDATE,"5Z")
128 S VALMHDR(4)=$$LJ^XLFSTR(VALMHDR(4),45)_" View: "_VIEW
129 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
130 Q
131 ;
132HLP ;Help code
133 N ORU,ORUPRMT,SUB,XQORM
134 S SUB="PXRMETHH"
135 D EN^VALM("PXRM EXTRACT HELP")
136 Q
137 ;
138INIT ;Init
139 S VALMCNT=0
140 Q
141 ;
142LMSEL() ;Return selection list
143 N IENLIST,IND,VALMY,XIEN
144 D EN^VALM2(XQORNOD(0))
145 ;If there is no list quit.
146 I '$D(VALMY) Q ""
147 S PXRMDONE=0,IENLIST=""
148 S IND=""
149 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
150 .;Get the ien.
151 .S XIEN=^TMP("PXRMETH",$J,"SEL",IND)
152 .S IENLIST=$S(IENLIST'="":IENLIST_U_XIEN,1:XIEN)
153 Q IENLIST
154 ;
155PEXIT ;PXRM EXCH MENU protocol exit code
156 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
157 D XQORM
158 Q
159 ;
160SELECT(FREQ,SEL) ;Select extract period
161 N BDATE,EDATE,DA,DIE,DIK,DIR,DR,FDATE,VALID,X
162 ;Get the new name.
163 F D Q:$D(DTOUT)!$D(DUOUT) Q:SEL]""
164 .S DIR("A")="Select EXTRACT PERIOD "
165 .I FREQ="M" D
166 ..S DIR("A")=DIR("A")_"(Mnn/yyyy)"
167 ..S DIR(0)="F"_U_"7:8"_U_"K:'$$VALID^PXRMETH(FREQ,X) X"
168 .I FREQ="Q" D
169 ..S DIR("A")=DIR("A")_"(Qnn/yyyy)"
170 ..S DIR(0)="F"_U_"7:7"_U_"K:'$$VALID^PXRMETH(FREQ,X) X"
171 .I FREQ="Y" D
172 ..S DIR("A")=DIR("A")_"(yyyy)"
173 ..S DIR(0)="N"_U_"2000:2050"_U_"K:(X'?4N) X"
174 .;Default is next period
175 .S DIR("B")=NEXT
176 .W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT)
177 .;Calculate beginning and end dates for period
178 .S Y=$$UP^XLFSTR(Y) D CALC^PXRMEUT(Y,.BDATE,.EDATE)
179 .;Abort if period has not started
180 .I $$FMDIFF^XLFDT(BDATE,$$NOW^XLFDT)>0 D Q
181 ..S FDATE=$$FMTE^XLFDT(BDATE,5)
182 ..W !,"ERROR -This period does not start until "_FDATE,*7
183 .S SEL=Y
184 Q
185 ;
186TLIST ;Extract summary display
187 N IEN,IENLIST,IND
188 S IENLIST=$$LMSEL
189 F IND=1:1:$L(IENLIST,U) D
190 .S IEN=$P(IENLIST,U,IND)
191 .D START^PXRMETT(IEN)
192 .S VALMBCK="R"
193 S VALMBCK="R"
194 Q
195 ;
196TRANS ;Run Transmission
197 N IEN,IENLIST,IND
198 S IENLIST=$$LMSEL
199 F IND=1:1:$L(IENLIST,U) D
200 .S IEN=$P(IENLIST,U,IND)
201 .I $P($G(^PXRMXT(810.3,IEN,100)),U)'="N" D Q
202 ..W !,"Local extracts cannot be transmitted to AAC." H 2
203 .;Transmit extract summary
204 .N ANS,DUOUT,DTOUT,RTN,TEXT
205 .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
206 .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
207 .I ANS D TRANS^PXRMETX(IEN)
208 ;
209 ;Rebuild workfile
210 D BLDLIST^PXRMETH1(EDIEN)
211 ;Refresh
212 S VALMBCK="R"
213 Q
214 ;
215TRHIST ;Transmission History
216 N IEN,IENLIST,IND
217 S IENLIST=$$LMSEL
218 F IND=1:1:$L(IENLIST,U) D
219 .S IEN=$P(IENLIST,U,IND)
220 .D START^PXRMETHL(IEN)
221 S VALMBCK="R"
222 Q
223 ;
224VALID(FREQ,INP) ;Validate Period input
225 W !
226 N PERIOD,YEAR
227 ;Convert to upper case
228 S INP=$$UP^XLFSTR(INP)
229 ;General format
230 I $E(INP)'=FREQ D EN^DDIOL("Format should be "_FREQ_"nn/yyyy") Q 0
231 S PERIOD=$P(INP,"/"),YEAR=$P(INP,"/",2)
232 S PERIOD=$P(PERIOD,FREQ,2)
233 ;All runs
234 I (YEAR<2000)!(YEAR>2050) D EN^DDIOL("Year should be in range 2000-2050") Q 0
235 ;Quarterly run
236 I FREQ="Q",(PERIOD>4)!(PERIOD<1) D EN^DDIOL("Quarter should be in range 1-4") Q 0
237 ;Monthly run
238 I FREQ="M",(PERIOD>12)!(PERIOD<1) D EN^DDIOL("Month should be in range 1-12") Q 0
239 ;Otherwise
240 Q 1
241 ;
242VIEW ;Select view
243 W IORESET
244 S VALMBCK="R"
245 N X,Y,CODE,DIR
246 K DIROUT,DIRUT,DTOUT,DUOUT
247 S DIR(0)="S"_U_"D:Sort by Creation Date;"
248 S DIR(0)=DIR(0)_"P:Sort by Extract Period;"
249 S DIR("A")="TYPE OF VIEW"
250 S DIR("B")=$S(PXRMVIEW="P":"D",1:"P")
251 S DIR("?")="Select from the codes displayed. For detailed help type ??"
252 ;BOOKMARK - HELP NEEDS MOVING
253 S DIR("??")=U_"D HELP^PXRMSEL2(3)"
254 D ^DIR K DIR
255 I $D(DIROUT) S DTOUT=1
256 I $D(DTOUT)!($D(DUOUT)) Q
257 ;Change display type
258 S PXRMVIEW=Y
259 ;
260 ;Rebuild Workfile
261 D BLDLIST^PXRMETH1(EDIEN),HDR
262 Q
263 ;
264WARN(NEXT,STATUS) ;Warn if period is not completed
265 N BDATE,EDATE,FDATE
266 ;Calculate beginning and end dates for period
267 D CALC^PXRMEUT(NEXT,.BDATE,.EDATE)
268 ;No warning if period end date is a prior date
269 I $$FMDIFF^XLFDT($$NOW^XLFDT,EDATE)>0 S STATUS="COMPLETE" Q
270 ;Else Format date
271 S FDATE=$$FMTE^XLFDT(EDATE,5),STATUS="INCOMPLETE"
272 ;And Warn that period end date is a future date
273 W !!,"WARNING -This period is not complete until "_FDATE
274 Q
275XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT HISTORY SELECT ENTRY",0))_U_"1:"_VALMCNT
276 S XQORM("A")="Select Item: "
277 Q
278 ;
279XSEL ;PXRM EXTRACT HISTORY SELECT ENTRY validation
280 N SEL,PXRMSIEN
281 S SEL=$P(XQORNOD(0),"=",2)
282 ;Remove trailing ,
283 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
284 ;Invalid selection
285 I SEL["," D Q
286 .W $C(7),!,"Only one item number allowed." H 2
287 .S VALMBCK="R"
288 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
289 .W $C(7),!,SEL_" is not a valid item number." H 2
290 .S VALMBCK="R"
291 ;
292 ;Get the list ien.
293 ;S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",SEL,SEL)
294 S PXRMSIEN=^TMP("PXRMETH",$J,"SEL",SEL)
295 ;
296 ;Full screen mode
297 D FULL^VALM1
298 ;
299 ;Options
300 N X,Y,DIR,OPTION K DIROUT,DIRUT,DTOUT,DUOUT
301 S DIR(0)="SBM"_U_"DE:Delete Extract;"
302 S DIR(0)=DIR(0)_"ES:Extract Summary;"
303 S DIR(0)=DIR(0)_"MT:Manual Transmission;"
304 S DIR(0)=DIR(0)_"TH:Transmission History;"
305 S DIR("A")="Select Action"
306 S DIR("B")="ES"
307 S DIR("?")="Select from the codes displayed. For detailed help type ??"
308 S DIR("??")=U_"D HELP^PXRMETH1(1)"
309 D ^DIR K DIR
310 I $D(DIROUT) S DTOUT=1
311 I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
312 S OPTION=Y
313 ;
314 ;Delete an extract
315 I OPTION="DE" D
316 .D DELETE^PXRMETXU(PXRMSIEN)
317 .;Rebuild workfile
318 .D BLDLIST^PXRMETH1(PXRMSIEN)
319 .;Refresh
320 .S VALMBCK="R"
321 ;
322 ;Display Extract Summary
323 I OPTION="ES" D START^PXRMETT(PXRMSIEN)
324 ;
325 ;Transmission option
326 I OPTION="MT" D
327 .N ANS,DUOUT,DTOUT,RTN,TEXT
328 .I $P($G(^PXRMXT(810.3,PXRMSIEN,100)),U)'="N" D Q
329 ..W !,"Local extracts cannot be transmitted to AAC" H 2 Q
330 .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
331 .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
332 .I ANS D TRANS^PXRMETX(PXRMSIEN)
333 ;
334 ;Transmission History
335 I OPTION="TH" D START^PXRMETHL(PXRMSIEN)
336 ;
337 S VALMBCK="R"
338 Q
339 ;
Note: See TracBrowser for help on using the repository browser.