source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETH.m@ 1361

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

revised back to 6/30/08 version

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