source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL7.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.9 KB
Line 
1GMRCSTL7 ;SLC/JFR/WAT - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28
2 ;;3.0;CONSULT/REQUEST TRACKING;**41,60**;DEC 27, 1997;Build 9
3 ;
4 ;This routine invokes ICRs
5 ;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),3744(VADPT),10089(%ZISC),10026(DIR)
6 Q
7 ;
8EN ; start here
9 K GMRCQUT
10 N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
11 N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
12 N GMRC30ST,GMRC30SP
13 D CAVEATS
14 ;Ask for service
15 S DIR(0)="P^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
16 S DIR("A")="Select Service/Specialty"
17 D ^DIR
18 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
19 S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
20 ;Ask for current FY
21 N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCFY
22 S DIR(0)="F^4:4^K:(X-1700)>($E(DT,1,3)+1) X"
23 S DIR("A")="Current Fiscal Year (i.e. 2008)"
24 S DIR("A",1)="Ensure you are providing fiscal year, NOT calendar year."
25 D ^DIR
26 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
27 S GMRCFY=X
28 N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCQTR,GMRCYR
29 S DIR(0)="N^1:4"
30 S DIR("A")="Enter a number 1 - 4"
31 S DIR("A",1)="For which quarter are you running the report: first, second, third or fourth?"
32 D ^DIR
33 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
34 S GMRCQTR=X
35 ;if first quarter
36 I $G(GMRCQTR)=1 D
37 .;use FY-1 to set year part of date range to the previous calendar year
38 .S GMRCYR=$G(GMRCFY)-1700 S GMRCYR=$G(GMRCYR)-1,GMRCDT1=$E($G(GMRCYR),1,3)_"1001" S GMRCDT2=$G(GMRCYR)_"1231"
39 I $G(GMRCQTR)=2 D
40 .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0101" S GMRCDT2=$G(GMRCYR)_"0331"
41 I $G(GMRCQTR)=3 D
42 .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0401" S GMRCDT2=$G(GMRCYR)_"0630"
43 I $G(GMRCQTR)=4 D
44 .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0701" S GMRCDT2=$G(GMRCYR)_"0930"
45 S GMRC30ST=$$FMADD^XLFDT(GMRCDT1,-30),GMRC30SP=$$FMADD^XLFDT(GMRCDT2,-30)
46 ; what type of report
47 N DIROUT,DTOUT,DUOUT,DIR,Y,X
48 S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
49 D ^DIR
50 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
51 S GMRCFMT=$S(Y="S":"CP",1:"DEL")
52 ;
53 W @IOF
54 S GMRCSAVE("GMRCFMT")=""
55 S GMRCSAVE("GMRCDG")=""
56 S GMRCSAVE("GMRCDT1")=""
57 S GMRCSAVE("GMRCDT2")=""
58 S GMRCSAVE("GMRC30ST")=""
59 S GMRCSAVE("GMRC30SP")=""
60 S GMRCSAVE("GMRCSVNM")=""
61 S GMRCSAVE("GMRCFY")=""
62 S GMRCSAVE("GMRCQTR")=""
63 ;
64 N DIROUT,DTOUT,DUOUT,DIR,Y,X S DIR(0)="FO",DIR("A")="ENTER ""?"" FOR MORE HELP OR RETURN TO CONTINUE"
65 S DIR("A",1)="MARGIN WIDTH IS BEST AT 256"
66 S DIR("?")="^D MARGHLP^GMRCSTL7"
67 D:GMRCFMT="DEL" ^DIR
68 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D EXIT Q
69 D EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE)
70 ;
71 D EXIT
72 ;
73 Q
74MARGHLP ;help text to set margins
75 W !,"Specify a device with optional parameters in the format"
76 W !,?8,"Device Name;Right Margin;Page Length"
77 W !,?21,"or"
78 W !,?5,"Device Name;Subtype;Right Margin;Page Length"
79 W !!,"Or in the new format"
80 W !,?14,"Device Name;/settings"
81 W !,?21,"or"
82 W !,?10,"Device Name;Subtype;/settings"
83 W !,"For example"
84 W !,?17,"HOME;80;999"
85 W !,?21,"or"
86 W !,?13,"HOME;C-VT320;/M80L999"
87 Q
88 ;
89ENOR(RETURN,GMRCSVC,GMRC30ST,GMRC30SP,GMRCSTAT,GMRCST2,GMRCARRN) ;Entry point
90 ;.RETURN: This is the root to the returned temp array.
91 ;GMRCSVC: Service for which consults are to be displayed.
92 ;GMRC30ST: 30 days prior to quarter start date
93 ;GMRC30SP: 30 days prior to quarter end date
94 ;GMRCSTAT: The list of status to include separated by commas
95 ;GMRCARRN: Format of report becomes ^TMP array element
96 ; "CP": Summary Report; "DEL": Delimited Report
97 ;
98 ;This temp array is used internally by the report:
99 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
100 ; status is "" tracking and/or grouper
101 ; 1 grouper only
102 ; 2 tracking only
103 ; 9 disabled
104 ;
105 N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK
106 K ^TMP("GMRCR",$J,GMRCARRN)
107 S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
108 I '($D(GMRCSVC)#2) S GMRCSVC=1
109 Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
110 ;Build service array
111 S GMRCDG=GMRCSVC
112 D SERV1^GMRCASV
113 ;Get external form of date range
114 D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
115 ;
116 N GMRCDA,INDEX,STATUS,STATUS2,LOOP,GROUPER
117 N GMRCSVCG,GMRCPT,GMRCSVCP,GRP,PIECE,TYPE
118 ;
119 K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCT",$J)
120 ;
121 S GROUPER=0
122 S GROUPER(0)=0
123 I GMRCARRN="DEL" D
124 . N STR
125 . S STR="Svc;30DayRng;60DayRng;CmpIn30;Cmp31-60;B4Qtr;PndB4Qtr;%Cmp30;%Cmp60;%UnRsB4Qtr;IS30Rng;IS60Rng;ISCmp30;ISCmp31-60;ISB4Qtr;ISPndB4Qtr;%ISCmp30;%ISCmp60;%ISUnRsB4Qtr;"
126 . S STR=STR_"IR30Rng;IR60Rng;IRCmp30;IRCmp31-60;IRB4Qtr;IRPndB4Qtr;%IRCmp30;%IRCmp60;%IRUnRsB4Qtr"
127 . S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR
128 S INDEX=""
129 ;Loop on Service
130 F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
131 .S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
132 .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
133 .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
134 .N SUBIDX
135 .;pieces for tmp arrays, 1 to 6 are local, 7 to 12 are IFC placer, 13 to 18 are IFC filler
136 .;;total for 30 day start/end^total for 60 day start/end^results n 30 days^results n 60 days^total before quarter^total pending before quarter
137 .S ^TMP("GMRCT",$J,1,GMRCSVC,"DATA")="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
138 .S ^TMP("GMRCT",$J,2,GMRCSVC,"DATA")="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
139 .;Check if starting a new Grouper
140 .F Q:GROUPER(GROUPER)=GMRCSVCG D
141 ..;End of a group so print the group totals
142 ..I GROUPER(GROUPER)=GMRCSVCG D
143 ... I GMRCARRN="CP" D
144 ....D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
145 ...I GMRCARRN="DEL" D
146 ....D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
147 ..;pop grouper from stack
148 ..S GROUPER=GROUPER-1
149 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
150 ..;push new grouper on stack
151 ..S GROUPER=GROUPER+1
152 ..S GROUPER(GROUPER)=GMRCSVC
153 .;Loop for one status at a time
154 .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
155 ..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRC30ST,GMRC30SP,"30")
156 .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
157 ..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,$$FMADD^XLFDT(GMRC30ST,-30),$$FMADD^XLFDT(GMRC30SP,-30),"60")
158 .S GMRCDT1=$$FMADD^XLFDT(GMRC30ST,30) ;add 30 days back to set date back to start of FY quarter.
159 .F LOOP=1:1:$L(GMRCST2,",") S STATUS2=$P(GMRCST2,",",LOOP) D
160 ..D ONESTAT2^GMRCSTL8(GMRCARRN,INDEX,STATUS2,$$FMADD^XLFDT(GMRCDT1,-60))
161 .F GRP=GROUPER:-1:1 D
162 ..F PIECE=1:1:18 D
163 ...S $P(^TMP("GMRCT",$J,2,GROUPER(GRP),"DATA"),U,PIECE)=$P(^TMP("GMRCT",$J,2,GROUPER(GRP),"DATA"),U,PIECE)+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,PIECE)
164 .;
165 .;Print the totals for this service that are >0
166 .I GMRCARRN="CP" D
167 ..D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
168 .I GMRCARRN="DEL" D
169 ..D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
170 .Q
171 ;
172 ;Done, so now list the group totals for the top group
173 ;F GROUPER=GROUPER:-1:1 D ; left for looking at all totals in future
174 I $G(GROUPER) S GROUPER=1 D
175 .I GMRCARRN="CP" D
176 ..D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
177 .I GMRCARRN="DEL" D
178 ..D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
179 Q
180PRNTQ ;Build report and print it
181 ;
182 N GMRCPG,GMRCTMP,IDX,GMRCQUT,TEMP
183 S GMRCPG=1
184 D SERV1^GMRCASV
185 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
186 S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
187 S TEMP="Consult/Request Performance Monitor - "_TEMP
188 W $J("",40-($L(TEMP)/2)+.5)_TEMP
189 S TEMP="Fiscal Quarter Dates: "_$$FMTE^XLFDT(GMRCDT1)_" - "_$$FMTE^XLFDT(GMRCDT2)
190 W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
191 S TEMP="30 Days Before Start/End: "_$$FMTE^XLFDT(GMRC30ST)_" - "_$$FMTE^XLFDT(GMRC30SP)
192 W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
193 S TEMP="60 Days Before Start/End: "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30ST,-30))_" - "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30SP,-30))
194 W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
195 I '$D(IO("Q")) D WAIT^DICD W !!
196 I '$O(^TMP("GMRCSLIST",$J,0)) D G EXIT
197 .W !!,"No records to print"
198 D ENOR^GMRCSTL7(.GMRCTMP,GMRCDG,GMRC30ST,GMRC30SP,"2,5,6,8,9","1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99",GMRCFMT)
199 I '$D(^TMP("GMRCR",$J,GMRCFMT)) D
200 .W !!,"No records to print",!
201 S IDX=""
202 F S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT)) D
203 .I IOSL-$Y<3 D
204 ..I $E(IOST,1,2)["C-" D
205 ...N DIR S DIR(0)="E" D ^DIR
206 ...I 'Y S GMRCQUT=1
207 ..Q:$G(GMRCQUT)
208 ..D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
209 .Q:$G(GMRCQUT)
210 .W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
211 D:$D(^TMP("GMRCR",$J,GMRCFMT)) CAVEATS
212 I GMRCFMT="CP",'$G(GMRCQUT) D
213 .Q:$O(^TMP("GMRCT",$J,0,""))=""
214 .I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
215 .W !!!,$$REPEAT^XLFSTR("-",IOM-5)
216 .W !,"Consult services not meeting the criteria of this report for",!,"the specified date range:",!
217 .S IDX=""
218 .F S IDX=$O(^TMP("GMRCT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT)) D
219 ..I IOSL-$Y<3 D
220 ...I $E(IOST,1,2)["C-" D
221 ....N DIR S DIR(0)="E" D ^DIR
222 ....I 'Y S GMRCQUT=1
223 ...Q:$G(GMRCQUT)
224 ...D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
225 ..Q:$G(GMRCQUT)
226 ..W ?4,IDX,!
227 D ^%ZISC
228 D EXIT
229 Q
230 ;
231HEAD(PAGE) ; print header for CPM
232 W @IOF
233 I PAGE>1 D
234 .S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
235 .S TEMP="Consult/Request Performance Monitor - "_TEMP
236 .W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
237 W !,$J("Run Date: "_$$HTE^XLFDT($H),0),$J("Page: "_PAGE,48)
238 W !,$$REPEAT^XLFSTR("-",IOM-2),!!
239 Q
240 ;
241CAVEATS ; brief explanatory text
242 W !!,"Resubmitted requests are evaluated based on the original Date of Request."
243 W !!,"The following are excluded from this report:"
244 W !," -Requests sent to test patients."
245 W !," -Requests not marked as Outpatient in the REQUEST/CONSULTATION file."
246 W !," -Services flagged as part of the interface between Consults/Request Tracking"
247 W !,?2,"and Prosthetics."
248 W !," -Administrative requests flagged via the Administrative fields in the"
249 W !,?2,"REQUEST SERVICES and REQUEST/CONSULTATION files. This is not retroactive"
250 W !,?2,"and only applies to services/requests leveraging the Administrative-flagging"
251 W !,?2,"capability included in GMRC*3.0*60, available on or about June 2008.",!!
252 Q
253 ;
254EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCT" K ^TMP(ARR,$J)
255 K ARR
256 Q
257 ;
Note: See TracBrowser for help on using the repository browser.