[628] | 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 | ;
|
---|