- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL7.m
r613 r623 1 GMRCSTL7 ;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 ; 8 EN ; 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 74 MARGHLP ;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 ; 89 ENOR(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 180 PRNTQ ;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 ; 231 HEAD(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 ; 241 CAVEATS ; 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 ; 254 EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCT" K ^TMP(ARR,$J) 255 K ARR 256 Q 257 ; 1 GMRCSTL7 ;SLC/JFR - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28 2 ;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997 3 ; 4 Q 5 ; 6 EN ; start here 7 K GMRCQUT 8 N DIROUT,DTOUT,DUOUT,DIR,DIRUT,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1 9 N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE 10 ; 11 ;Ask for service 12 N Y 13 S DIR(0)="PO^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV" 14 S DIR("A")="Select Service/Specialty" 15 D ^DIR 16 I Y<1 Q 17 S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2) 18 ; 19 ;Ask for date range 20 D ^GMRCSPD 21 I $D(GMRCQUT) G EXIT 22 ; 23 ; what type of report 24 K DIR,X,Y 25 S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report" 26 D ^DIR 27 I Y="" G EXIT 28 S GMRCFMT=$S(Y="S":"CP",1:"DEL") 29 ; 30 W @IOF 31 S GMRCSAVE("GMRCFMT")="" 32 S GMRCSAVE("GMRCDG")="" 33 S GMRCSAVE("GMRCDT1")="" 34 S GMRCSAVE("GMRCDT2")="" 35 S GMRCSAVE("GMRCSVNM")="" 36 ; 37 D EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE) 38 ; 39 D EXIT 40 ; 41 Q 42 ; 43 ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN) ;Entry point 44 ;.RETURN: This is the root to the returned temp array. 45 ;GMRCSVC: Service for which consults are to be displayed. 46 ;GMRCDT1: Starting date or "ALL" 47 ;GMRCDT2: Ending date if not GMRCDT1="ALL" 48 ;GMRCSTAT: The list of status to include separated by commas 49 ;GMRCARRN: Format of report becomes ^TMP array element 50 ; "CP": Summary Report; "DEL": Delimited Report 51 ; 52 ;This temp array is used internally by the report: 53 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status 54 ; status is "" tracking and/or grouper 55 ; 1 grouper only 56 ; 2 tracking only 57 ; 9 disabled 58 ; 59 N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK 60 K ^TMP("GMRCR",$J,GMRCARRN) 61 S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)" 62 I '($D(GMRCSVC)#2) S GMRCSVC=1 63 Q:'$D(^GMR(123.5,$G(GMRCSVC),0)) 64 ;Build service array 65 S GMRCDG=GMRCSVC 66 D SERV1^GMRCASV 67 ;Get external form of date range 68 I '($D(GMRCDT1)#2) S GMRCDT1="ALL" 69 S:GMRCDT1="ALL" GMRCDT2=0 70 D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2) 71 ; 72 N GMRCDA,INDEX,STATUS,LOOP,GROUPER 73 N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP 74 N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP 75 N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT 76 ; 77 K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J) 78 ; 79 S GROUPER=0 80 S GROUPER(0)=0 81 I GMRCARRN="DEL" D 82 . N STR 83 . S STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;" 84 . S STR=STR_"%Comp w/Results" 85 . S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR 86 S INDEX="" 87 ;Loop on Service 88 F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D 89 .S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1) 90 .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2) 91 .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3) 92 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0 93 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0 94 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=0 95 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=0 96 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0 97 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0 98 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"R")=0 99 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"C")=0 100 . ;Check if starting a new Grouper 101 . F Q:GROUPER(GROUPER)=GMRCSVCG D 102 ..;End of a group so print the group totals 103 ..I GROUPER(GROUPER)=GMRCSVCG D 104 ... I GMRCARRN="CP" D 105 .... D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN) 106 ... I GMRCARRN="DEL" D 107 .... D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN) 108 ..;pop grouper from stack 109 ..S GROUPER=GROUPER-1 110 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D 111 ..;push new grouper on stack 112 ..S GROUPER=GROUPER+1 113 ..S GROUPER(GROUPER)=GMRCSVC 114 .;Loop for one status at a time 115 .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D 116 .. D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2) 117 .F GRP=GROUPER:-1:1 D 118 ..; pending for this service to all of its groupers 119 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P") 120 .. ; completed w/results for all groupers 121 .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"R") 122 ..; for all status for this service to all of its groupers 123 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T") 124 .. ; add all completed for all groupers 125 .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"C") 126 .; 127 .;Print the totals for this service that are >0 128 . I GMRCARRN="CP" D 129 .. D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN) 130 . I GMRCARRN="DEL" D 131 .. D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN) 132 . Q 133 ; 134 ;Done, so now list the group totals for the top group 135 ;F GROUPER=GROUPER:-1:1 D ; left for looking at all totals in future 136 I $G(GROUPER) S GROUPER=1 D 137 . I GMRCARRN="CP" D 138 .. D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN) 139 . I GMRCARRN="DEL" D 140 .. D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN) 141 Q 142 ; 143 PRNTQ ;Build report and print it 144 ; 145 N GMRCPG,GMRCTMP,IDX,GMRCQUT,TEMP 146 S GMRCPG=1 147 D SERV1^GMRCASV 148 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1 149 W !,$J("",23)_"Consult/Request Performance Monitor" 150 S TEMP="FROM: "_$$FMTE^XLFDT(GMRCDT1)_" TO: "_$$FMTE^XLFDT(GMRCDT2) 151 I GMRCDT1="ALL" S TEMP="ALL DATES" 152 W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,! 153 I '$O(^TMP("GMRCSLIST",$J,0)) D G EXIT 154 . W !!,"No records to print" 155 D ENOR^GMRCSTL7(.GMRCTMP,GMRCDG,GMRCDT1,GMRCDT2,"5,6,8,2,9",GMRCFMT) 156 I '$D(^TMP("GMRCR",$J,GMRCFMT)) D 157 . W !!,"No records to print",! 158 S IDX="" 159 F S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT)) D 160 . I IOSL-$Y<3 D 161 .. I $E(IOST,1,2)["C-" D 162 ... N DIR S DIR(0)="E" D ^DIR 163 ... I 'Y S GMRCQUT=1 164 .. Q:$G(GMRCQUT) 165 .. D HEAD(GMRCPG) S GMRCPG=GMRCPG+1 166 . Q:$G(GMRCQUT) 167 . W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),! 168 I GMRCFMT="CP",'$G(GMRCQUT) D 169 . Q:$O(^TMP("GMRCTOT",$J,0,""))="" 170 . I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1 171 . W !!!,$$REPEAT^XLFSTR("-",IOM-5) 172 . W !,"Consult services with no activity meeting the criteria of this report in",!,"the specified date range:",! 173 . S IDX="" 174 . F S IDX=$O(^TMP("GMRCTOT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT)) D 175 .. I IOSL-$Y<3 D 176 ... I $E(IOST,1,2)["C-" D 177 .... N DIR S DIR(0)="E" D ^DIR 178 .... I 'Y S GMRCQUT=1 179 ... Q:$G(GMRCQUT) 180 ... D HEAD(GMRCPG) S GMRCPG=GMRCPG+1 181 .. Q:$G(GMRCQUT) 182 .. W ?4,IDX,! 183 D ^%ZISC 184 D EXIT 185 Q 186 ; 187 HEAD(PAGE) ; print header for CPM 188 W @IOF 189 W "Consult Performance Monitor",?40,$$HTE^XLFDT($H) 190 W ?73,"Page: ",PAGE,! 191 W $$REPEAT^XLFSTR("-",IOM-2),! 192 Q 193 ; 194 EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCTOT" K ^TMP(ARR,$J) 195 K ARR 196 Q 197 ;
Note:
See TracChangeset
for help on using the changeset viewer.
