GMRCSTL7 ;SLC/JFR/WAT - DRIVER FOR CSLT PER MONITOR ;12/10/14 14:25
;;3.0;CONSULT/REQUEST TRACKING;**41,60,76,81**;DEC 27, 1997;Build 6
;
;This routine invokes ICRs
;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),3744(VADPT),10089(%ZISC),10026(DIR)
Q
;
EN ; start here
K GMRCQUT
N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
N GMRC30ST,GMRC30SP
D CAVEATS
;Ask for service
S DIR(0)="P^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
S DIR("A")="Select Service/Specialty"
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
;Ask for current FY
N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCFY
S DIR(0)="F^4:4^K:(X-1700)>($E(DT,1,3)+1) X"
S DIR("A")="Current Fiscal Year (i.e. 2008)"
S DIR("A",1)="Ensure you are providing fiscal year, NOT calendar year."
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
S GMRCFY=X
N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCQTR,GMRCYR
S DIR(0)="N^1:4"
S DIR("A")="Enter a number 1 - 4"
S DIR("A",1)="For which quarter are you running the report: first, second, third or fourth?"
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
S GMRCQTR=X
;if first quarter
I $G(GMRCQTR)=1 D
.;use FY-1 to set year part of date range to the previous calendar year
.S GMRCYR=$G(GMRCFY)-1700 S GMRCYR=$G(GMRCYR)-1,GMRCDT1=$E($G(GMRCYR),1,3)_"1001" S GMRCDT2=$G(GMRCYR)_"1231"
I $G(GMRCQTR)=2 D
.S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0101" S GMRCDT2=$G(GMRCYR)_"0331"
I $G(GMRCQTR)=3 D
.S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0401" S GMRCDT2=$G(GMRCYR)_"0630"
I $G(GMRCQTR)=4 D
.S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0701" S GMRCDT2=$G(GMRCYR)_"0930"
S GMRC30ST=$$FMADD^XLFDT(GMRCDT1,-30),GMRC30SP=$$FMADD^XLFDT(GMRCDT2,-30)
; what type of report
N DIROUT,DTOUT,DUOUT,DIR,Y,X
S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
S GMRCFMT=$S(Y="S":"CP",1:"DEL")
;
W @IOF
S GMRCSAVE("GMRCFMT")=""
S GMRCSAVE("GMRCDG")=""
S GMRCSAVE("GMRCDT1")=""
S GMRCSAVE("GMRCDT2")=""
S GMRCSAVE("GMRC30ST")=""
S GMRCSAVE("GMRC30SP")=""
S GMRCSAVE("GMRCSVNM")=""
S GMRCSAVE("GMRCFY")=""
S GMRCSAVE("GMRCQTR")=""
;
N DIROUT,DTOUT,DUOUT,DIR,Y,X S DIR(0)="FO",DIR("A")="ENTER ""?"" FOR MORE HELP OR RETURN TO CONTINUE"
S DIR("A",1)="MARGIN WIDTH IS BEST AT 256"
S DIR("?")="^D MARGHLP^GMRCSTL7"
D:GMRCFMT="DEL" ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D EXIT Q
D EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE)
;
D EXIT
;
Q
MARGHLP ;help text to set margins
W !,"Specify a device with optional parameters in the format"
W !,?8,"Device Name;Right Margin;Page Length"
W !,?21,"or"
W !,?5,"Device Name;Subtype;Right Margin;Page Length"
W !!,"Or in the new format"
W !,?14,"Device Name;/settings"
W !,?21,"or"
W !,?10,"Device Name;Subtype;/settings"
W !,"For example"
W !,?17,"HOME;80;999"
W !,?21,"or"
W !,?13,"HOME;C-VT320;/M80L999"
Q
;
ENOR(RETURN,GMRCSVC,GMRC30ST,GMRC30SP,GMRCSTAT,GMRCST2,GMRCARRN) ;Entry point
;.RETURN: This is the root to the returned temp array.
;GMRCSVC: Service for which consults are to be displayed.
;GMRC30ST: 30 days prior to quarter start date
;GMRC30SP: 30 days prior to quarter end date
;GMRCSTAT: The list of status to include separated by commas
;GMRCARRN: Format of report becomes ^TMP array element
; "CP": Summary Report; "DEL": Delimited Report
;
;This temp array is used internally by the report:
;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
; status is "" tracking and/or grouper
; 1 grouper only
; 2 tracking only
; 9 disabled
;
N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK
K ^TMP("GMRCR",$J,GMRCARRN)
S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
I '($D(GMRCSVC)#2) S GMRCSVC=1
Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
;Build service array
S GMRCDG=GMRCSVC
D SERV1^GMRCASV
;Get external form of date range
D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
;
N GMRCDA,INDEX,STATUS,STATUS2,LOOP,GROUPER
N GMRCSVCG,GMRCPT,GMRCSVCP,GRP,PIECE,TYPE
;
K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCT",$J)
;
S GROUPER=0
S GROUPER(0)=0
I GMRCARRN="DEL" D
. N STR
. S STR="Svc;30DayRng;60DayRng;CmpIn30;Cmp31-60;B4Qtr;PndB4Qtr;%Cmp30;%Cmp60;%UnRsB4Qtr;IS30Rng;IS60Rng;ISCmp30;ISCmp31-60;ISB4Qtr;ISPndB4Qtr;%ISCmp30;%ISCmp60;%ISUnRsB4Qtr;"
. S STR=STR_"IR30Rng;IR60Rng;IRCmp30;IRCmp31-60;IRB4Qtr;IRPndB4Qtr;%IRCmp30;%IRCmp60;%IRUnRsB4Qtr"
. S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR
S INDEX=""
;Loop on Service
F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
.S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
.S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
.S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
.N SUBIDX
.;pieces for tmp arrays, 1 to 6 are local, 7 to 12 are IFC placer, 13 to 18 are IFC filler
.;;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
.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"
.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"
.;Check if starting a new Grouper
.F Q:GROUPER(GROUPER)=GMRCSVCG D
..;End of a group so print the group totals
..I GROUPER(GROUPER)=GMRCSVCG D
... I GMRCARRN="CP" D
....D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
...I GMRCARRN="DEL" D
....D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
..;pop grouper from stack
..S GROUPER=GROUPER-1
.I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
..;push new grouper on stack
..S GROUPER=GROUPER+1
..S GROUPER(GROUPER)=GMRCSVC
.;Loop for one status at a time
.F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRC30ST,GMRC30SP,"30")
.F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,$$FMADD^XLFDT(GMRC30ST,-30),$$FMADD^XLFDT(GMRC30SP,-30),"60")
.S GMRCDT1=$$FMADD^XLFDT(GMRC30ST,30) ;add 30 days back to set date back to start of FY quarter.
.F LOOP=1:1:$L(GMRCST2,",") S STATUS2=$P(GMRCST2,",",LOOP) D
..D ONESTAT2^GMRCSTL8(GMRCARRN,INDEX,STATUS2,$$FMADD^XLFDT(GMRCDT1,-60))
.F GRP=GROUPER:-1:1 D
..F PIECE=1:1:18 D
...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)
.;
.;Print the totals for this service that are >0
.I GMRCARRN="CP" D
..D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
.I GMRCARRN="DEL" D
..D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
.Q
;
;Done, so now list the group totals for the top group
;F GROUPER=GROUPER:-1:1 D ; left for looking at all totals in future
I $G(GROUPER) S GROUPER=1 D
.I GMRCARRN="CP" D
..D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
.I GMRCARRN="DEL" D
..D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
Q
PRNTQ ;Build report and print it
;
N GMRCPG,GMRCTMP,IDX,GMRCQUT,TEMP
S GMRCPG=1
D SERV1^GMRCASV
D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
S TEMP="Consult/Request Performance Monitor - "_TEMP
W $J("",40-($L(TEMP)/2)+.5)_TEMP
S TEMP="Fiscal Quarter Dates: "_$$FMTE^XLFDT(GMRCDT1)_" - "_$$FMTE^XLFDT(GMRCDT2)
W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
S TEMP="30 Days Before Start/End: "_$$FMTE^XLFDT(GMRC30ST)_" - "_$$FMTE^XLFDT(GMRC30SP)
W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
S TEMP="60 Days Before Start/End: "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30ST,-30))_" - "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30SP,-30))
W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
I '$D(IO("Q")) D WAIT^DICD W !!
I '$O(^TMP("GMRCSLIST",$J,0)) D G EXIT
.W !!,"No records to print"
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)
I '$D(^TMP("GMRCR",$J,GMRCFMT)) D
.W !!,"No records to print",!
S IDX=""
F S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT)) D
.I IOSL-$Y<3 D
..I $E(IOST,1,2)["C-" D
...N DIR S DIR(0)="E" D ^DIR
...I 'Y S GMRCQUT=1
..Q:$G(GMRCQUT)
..D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
.Q:$G(GMRCQUT)
.W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
D:$D(^TMP("GMRCR",$J,GMRCFMT)) CAVEATS
I GMRCFMT="CP",'$G(GMRCQUT) D
.Q:$O(^TMP("GMRCT",$J,0,""))=""
.I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
.W !!!,$$REPEAT^XLFSTR("-",IOM-5)
.W !,"Consult services not meeting the criteria of this report for",!,"the specified date range:",!
.S IDX=""
.F S IDX=$O(^TMP("GMRCT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT)) D
..I IOSL-$Y<3 D
...I $E(IOST,1,2)["C-" D
....N DIR S DIR(0)="E" D ^DIR
....I 'Y S GMRCQUT=1
...Q:$G(GMRCQUT)
...D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
..Q:$G(GMRCQUT)
..W ?4,IDX,!
D ^%ZISC
D EXIT
Q
;
HEAD(PAGE) ; print header for CPM
W @IOF
I PAGE>1 D
.S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
.S TEMP="Consult/Request Performance Monitor - "_TEMP
.W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
W !,$J("Run Date: "_$$HTE^XLFDT($H),0),$J("Page: "_PAGE,48)
W !,$$REPEAT^XLFSTR("-",IOM-2),!!
Q
;
CAVEATS ; brief explanatory text
W !!,"Resubmitted requests are evaluated based on the original Date of Request."
W !!,"The following are excluded from this report:"
W !," -Requests sent to test patients."
W !," -Requests not marked as Outpatient in the REQUEST/CONSULTATION file."
W !," -Services flagged as part of the interface between Consults/Request Tracking"
W !,?2,"and Prosthetics."
W !," -Administrative requests flagged via the Administrative fields in the"
W !,?2,"REQUEST SERVICES and REQUEST/CONSULTATION files. This is not retroactive"
W !,?2,"and only applies to services/requests leveraging the Administrative-flagging"
W !,?2,"capability included in GMRC*3.0*60."
W !," -The report utilizes the CLINICALLY INDICATED DATE field from the "
W !,?2,"REQUEST/CONSULTATION file to determine request totals for a given date"
W !,?2,"range. This is true even for requests that have been re-submitted using"
W !,?2,"the Edit/Resubmit functionality.",!!
Q
;
EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCT" K ^TMP(ARR,$J)
K ARR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSTL7 10653 printed Oct 16, 2024@17:48:13 Page 2
GMRCSTL7 ;SLC/JFR/WAT - DRIVER FOR CSLT PER MONITOR ;12/10/14 14:25
+1 ;;3.0;CONSULT/REQUEST TRACKING;**41,60,76,81**;DEC 27, 1997;Build 6
+2 ;
+3 ;This routine invokes ICRs
+4 ;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),3744(VADPT),10089(%ZISC),10026(DIR)
+5 QUIT
+6 ;
EN ; start here
+1 KILL GMRCQUT
+2 NEW DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
+3 NEW GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
+4 NEW GMRC30ST,GMRC30SP
+5 DO CAVEATS
+6 ;Ask for service
+7 SET DIR(0)="P^123.5:EMQ"
SET DIR("??")="^D LISTALL^GMRCASV"
+8 SET DIR("A")="Select Service/Specialty"
+9 DO ^DIR
+10 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))!(X="")
DO EXIT
QUIT
+11 SET GMRCDG=+Y
SET GMRCSVNM=$PIECE(Y,U,2)
+12 ;Ask for current FY
+13 NEW DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCFY
+14 SET DIR(0)="F^4:4^K:(X-1700)>($E(DT,1,3)+1) X"
+15 SET DIR("A")="Current Fiscal Year (i.e. 2008)"
+16 SET DIR("A",1)="Ensure you are providing fiscal year, NOT calendar year."
+17 DO ^DIR
+18 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))!(X="")
DO EXIT
QUIT
+19 SET GMRCFY=X
+20 NEW DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCQTR,GMRCYR
+21 SET DIR(0)="N^1:4"
+22 SET DIR("A")="Enter a number 1 - 4"
+23 SET DIR("A",1)="For which quarter are you running the report: first, second, third or fourth?"
+24 DO ^DIR
+25 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))!(X="")
DO EXIT
QUIT
+26 SET GMRCQTR=X
+27 ;if first quarter
+28 IF $GET(GMRCQTR)=1
Begin DoDot:1
+29 ;use FY-1 to set year part of date range to the previous calendar year
+30 SET GMRCYR=$GET(GMRCFY)-1700
SET GMRCYR=$GET(GMRCYR)-1
SET GMRCDT1=$EXTRACT($GET(GMRCYR),1,3)_"1001"
SET GMRCDT2=$GET(GMRCYR)_"1231"
End DoDot:1
+31 IF $GET(GMRCQTR)=2
Begin DoDot:1
+32 SET GMRCYR=$GET(GMRCFY)-1700
SET GMRCDT1=$EXTRACT($GET(GMRCYR),1,3)_"0101"
SET GMRCDT2=$GET(GMRCYR)_"0331"
End DoDot:1
+33 IF $GET(GMRCQTR)=3
Begin DoDot:1
+34 SET GMRCYR=$GET(GMRCFY)-1700
SET GMRCDT1=$EXTRACT($GET(GMRCYR),1,3)_"0401"
SET GMRCDT2=$GET(GMRCYR)_"0630"
End DoDot:1
+35 IF $GET(GMRCQTR)=4
Begin DoDot:1
+36 SET GMRCYR=$GET(GMRCFY)-1700
SET GMRCDT1=$EXTRACT($GET(GMRCYR),1,3)_"0701"
SET GMRCDT2=$GET(GMRCYR)_"0930"
End DoDot:1
+37 SET GMRC30ST=$$FMADD^XLFDT(GMRCDT1,-30)
SET GMRC30SP=$$FMADD^XLFDT(GMRCDT2,-30)
+38 ; what type of report
+39 NEW DIROUT,DTOUT,DUOUT,DIR,Y,X
+40 SET DIR(0)="S:O^S:Summary;D:Delimited"
SET DIR("A")="What type of report"
+41 DO ^DIR
+42 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))!(X="")
DO EXIT
QUIT
+43 SET GMRCFMT=$SELECT(Y="S":"CP",1:"DEL")
+44 ;
+45 WRITE @IOF
+46 SET GMRCSAVE("GMRCFMT")=""
+47 SET GMRCSAVE("GMRCDG")=""
+48 SET GMRCSAVE("GMRCDT1")=""
+49 SET GMRCSAVE("GMRCDT2")=""
+50 SET GMRCSAVE("GMRC30ST")=""
+51 SET GMRCSAVE("GMRC30SP")=""
+52 SET GMRCSAVE("GMRCSVNM")=""
+53 SET GMRCSAVE("GMRCFY")=""
+54 SET GMRCSAVE("GMRCQTR")=""
+55 ;
+56 NEW DIROUT,DTOUT,DUOUT,DIR,Y,X
SET DIR(0)="FO"
SET DIR("A")="ENTER ""?"" FOR MORE HELP OR RETURN TO CONTINUE"
+57 SET DIR("A",1)="MARGIN WIDTH IS BEST AT 256"
+58 SET DIR("?")="^D MARGHLP^GMRCSTL7"
+59 if GMRCFMT="DEL"
DO ^DIR
+60 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
DO EXIT
QUIT
+61 DO EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE)
+62 ;
+63 DO EXIT
+64 ;
+65 QUIT
MARGHLP ;help text to set margins
+1 WRITE !,"Specify a device with optional parameters in the format"
+2 WRITE !,?8,"Device Name;Right Margin;Page Length"
+3 WRITE !,?21,"or"
+4 WRITE !,?5,"Device Name;Subtype;Right Margin;Page Length"
+5 WRITE !!,"Or in the new format"
+6 WRITE !,?14,"Device Name;/settings"
+7 WRITE !,?21,"or"
+8 WRITE !,?10,"Device Name;Subtype;/settings"
+9 WRITE !,"For example"
+10 WRITE !,?17,"HOME;80;999"
+11 WRITE !,?21,"or"
+12 WRITE !,?13,"HOME;C-VT320;/M80L999"
+13 QUIT
+14 ;
ENOR(RETURN,GMRCSVC,GMRC30ST,GMRC30SP,GMRCSTAT,GMRCST2,GMRCARRN) ;Entry point
+1 ;.RETURN: This is the root to the returned temp array.
+2 ;GMRCSVC: Service for which consults are to be displayed.
+3 ;GMRC30ST: 30 days prior to quarter start date
+4 ;GMRC30SP: 30 days prior to quarter end date
+5 ;GMRCSTAT: The list of status to include separated by commas
+6 ;GMRCARRN: Format of report becomes ^TMP array element
+7 ; "CP": Summary Report; "DEL": Delimited Report
+8 ;
+9 ;This temp array is used internally by the report:
+10 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
+11 ; status is "" tracking and/or grouper
+12 ; 1 grouper only
+13 ; 2 tracking only
+14 ; 9 disabled
+15 ;
+16 NEW GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK
+17 KILL ^TMP("GMRCR",$JOB,GMRCARRN)
+18 SET RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
+19 IF '($DATA(GMRCSVC)#2)
SET GMRCSVC=1
+20 if '$DATA(^GMR(123.5,$GET(GMRCSVC),0))
QUIT
+21 ;Build service array
+22 SET GMRCDG=GMRCSVC
+23 DO SERV1^GMRCASV
+24 ;Get external form of date range
+25 DO LISTDATE^GMRCSTU1(GMRCDT1,$GET(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
+26 ;
+27 NEW GMRCDA,INDEX,STATUS,STATUS2,LOOP,GROUPER
+28 NEW GMRCSVCG,GMRCPT,GMRCSVCP,GRP,PIECE,TYPE
+29 ;
+30 KILL ^TMP("GMRCR",$JOB,GMRCARRN),^TMP("GMRCRINDEX",$JOB),^TMP("GMRCT",$JOB)
+31 ;
+32 SET GROUPER=0
+33 SET GROUPER(0)=0
+34 IF GMRCARRN="DEL"
Begin DoDot:1
+35 NEW STR
+36 SET STR="Svc;30DayRng;60DayRng;CmpIn30;Cmp31-60;B4Qtr;PndB4Qtr;%Cmp30;%Cmp60;%UnRsB4Qtr;IS30Rng;IS60Rng;ISCmp30;ISCmp31-60;ISB4Qtr;ISPndB4Qtr;%ISCmp30;%ISCmp60;%ISUnRsB4Qtr;"
+37 SET STR=STR_"IR30Rng;IR60Rng;IRCmp30;IRCmp31-60;IRB4Qtr;IRPndB4Qtr;%IRCmp30;%IRCmp60;%IRUnRsB4Qtr"
+38 SET ^TMP("GMRCR",$JOB,GMRCARRN,1,0)=STR
End DoDot:1
+39 SET INDEX=""
+40 ;Loop on Service
+41 FOR
SET INDEX=$ORDER(^TMP("GMRCSLIST",$JOB,INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+42 SET GMRCSVC=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",1)
+43 SET GMRCSVCP=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",2)
+44 SET GMRCSVCG=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",3)
+45 NEW SUBIDX
+46 ;pieces for tmp arrays, 1 to 6 are local, 7 to 12 are IFC placer, 13 to 18 are IFC filler
+47 ;;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
+48 SET ^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA")="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
+49 SET ^TMP("GMRCT",$JOB,2,GMRCSVC,"DATA")="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
+50 ;Check if starting a new Grouper
+51 FOR
if GROUPER(GROUPER)=GMRCSVCG
QUIT
Begin DoDot:2
+52 ;End of a group so print the group totals
+53 IF GROUPER(GROUPER)=GMRCSVCG
Begin DoDot:3
+54 IF GMRCARRN="CP"
Begin DoDot:4
+55 DO PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
End DoDot:4
+56 IF GMRCARRN="DEL"
Begin DoDot:4
+57 DO DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
End DoDot:4
End DoDot:3
+58 ;pop grouper from stack
+59 SET GROUPER=GROUPER-1
End DoDot:2
+60 IF $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",4)="+"
Begin DoDot:2
+61 ;push new grouper on stack
+62 SET GROUPER=GROUPER+1
+63 SET GROUPER(GROUPER)=GMRCSVC
End DoDot:2
+64 ;Loop for one status at a time
+65 FOR LOOP=1:1:$LENGTH(GMRCSTAT,",")
SET STATUS=$PIECE(GMRCSTAT,",",LOOP)
Begin DoDot:2
+66 DO ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRC30ST,GMRC30SP,"30")
End DoDot:2
+67 FOR LOOP=1:1:$LENGTH(GMRCSTAT,",")
SET STATUS=$PIECE(GMRCSTAT,",",LOOP)
Begin DoDot:2
+68 DO ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,$$FMADD^XLFDT(GMRC30ST,-30),$$FMADD^XLFDT(GMRC30SP,-30),"60")
End DoDot:2
+69 ;add 30 days back to set date back to start of FY quarter.
SET GMRCDT1=$$FMADD^XLFDT(GMRC30ST,30)
+70 FOR LOOP=1:1:$LENGTH(GMRCST2,",")
SET STATUS2=$PIECE(GMRCST2,",",LOOP)
Begin DoDot:2
+71 DO ONESTAT2^GMRCSTL8(GMRCARRN,INDEX,STATUS2,$$FMADD^XLFDT(GMRCDT1,-60))
End DoDot:2
+72 FOR GRP=GROUPER:-1:1
Begin DoDot:2
+73 FOR PIECE=1:1:18
Begin DoDot:3
+74 SET $PIECE(^TMP("GMRCT",$JOB,2,GROUPER(GRP),"DATA"),U,PIECE)=$PIECE(^TMP("GMRCT",$JOB,2,GROUPER(GRP),"DATA"),U,PIECE)+$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,PIECE)
End DoDot:3
End DoDot:2
+75 ;
+76 ;Print the totals for this service that are >0
+77 IF GMRCARRN="CP"
Begin DoDot:2
+78 DO PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
End DoDot:2
+79 IF GMRCARRN="DEL"
Begin DoDot:2
+80 DO DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
End DoDot:2
+81 QUIT
End DoDot:1
+82 ;
+83 ;Done, so now list the group totals for the top group
+84 ;F GROUPER=GROUPER:-1:1 D ; left for looking at all totals in future
+85 IF $GET(GROUPER)
SET GROUPER=1
Begin DoDot:1
+86 IF GMRCARRN="CP"
Begin DoDot:2
+87 DO PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$PIECE(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
End DoDot:2
+88 IF GMRCARRN="DEL"
Begin DoDot:2
+89 DO DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$PIECE(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
End DoDot:2
End DoDot:1
+90 QUIT
PRNTQ ;Build report and print it
+1 ;
+2 NEW GMRCPG,GMRCTMP,IDX,GMRCQUT,TEMP
+3 SET GMRCPG=1
+4 DO SERV1^GMRCASV
+5 DO HEAD(GMRCPG)
SET GMRCPG=GMRCPG+1
+6 SET TEMP=$SELECT($GET(GMRCQTR)=4:"4",$GET(GMRCQTR)=3:"3",$GET(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$EXTRACT($GET(GMRCFY),3,4)
+7 SET TEMP="Consult/Request Performance Monitor - "_TEMP
+8 WRITE $JUSTIFY("",40-($LENGTH(TEMP)/2)+.5)_TEMP
+9 SET TEMP="Fiscal Quarter Dates: "_$$FMTE^XLFDT(GMRCDT1)_" - "_$$FMTE^XLFDT(GMRCDT2)
+10 WRITE !,$JUSTIFY("",40-($LENGTH(TEMP)/2)+.5)_TEMP
+11 SET TEMP="30 Days Before Start/End: "_$$FMTE^XLFDT(GMRC30ST)_" - "_$$FMTE^XLFDT(GMRC30SP)
+12 WRITE !,$JUSTIFY("",40-($LENGTH(TEMP)/2)+.5)_TEMP
+13 SET TEMP="60 Days Before Start/End: "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30ST,-30))_" - "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30SP,-30))
+14 WRITE !,$JUSTIFY("",40-($LENGTH(TEMP)/2)+.5)_TEMP,!
+15 IF '$DATA(IO("Q"))
DO WAIT^DICD
WRITE !!
+16 IF '$ORDER(^TMP("GMRCSLIST",$JOB,0))
Begin DoDot:1
+17 WRITE !!,"No records to print"
End DoDot:1
GOTO EXIT
+18 DO 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)
+19 IF '$DATA(^TMP("GMRCR",$JOB,GMRCFMT))
Begin DoDot:1
+20 WRITE !!,"No records to print",!
End DoDot:1
+21 SET IDX=""
+22 FOR
SET IDX=$ORDER(^TMP("GMRCR",$JOB,GMRCFMT,IDX))
if 'IDX!($GET(GMRCQUT))
QUIT
Begin DoDot:1
+23 IF IOSL-$Y<3
Begin DoDot:2
+24 IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:3
+25 NEW DIR
SET DIR(0)="E"
DO ^DIR
+26 IF 'Y
SET GMRCQUT=1
End DoDot:3
+27 if $GET(GMRCQUT)
QUIT
+28 DO HEAD(GMRCPG)
SET GMRCPG=GMRCPG+1
End DoDot:2
+29 if $GET(GMRCQUT)
QUIT
+30 WRITE ^TMP("GMRCR",$JOB,GMRCFMT,IDX,0),!
End DoDot:1
+31 if $DATA(^TMP("GMRCR",$JOB,GMRCFMT))
DO CAVEATS
+32 IF GMRCFMT="CP"
IF '$GET(GMRCQUT)
Begin DoDot:1
+33 if $ORDER(^TMP("GMRCT",$JOB,0,""))=""
QUIT
+34 IF IOSL-$Y<6
DO HEAD(GMRCPG)
SET GMRCPG=GMRCPG+1
+35 WRITE !!!,$$REPEAT^XLFSTR("-",IOM-5)
+36 WRITE !,"Consult services not meeting the criteria of this report for",!,"the specified date range:",!
+37 SET IDX=""
+38 FOR
SET IDX=$ORDER(^TMP("GMRCT",$JOB,0,IDX))
if IDX=""!($GET(GMRCQUT))
QUIT
Begin DoDot:2
+39 IF IOSL-$Y<3
Begin DoDot:3
+40 IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:4
+41 NEW DIR
SET DIR(0)="E"
DO ^DIR
+42 IF 'Y
SET GMRCQUT=1
End DoDot:4
+43 if $GET(GMRCQUT)
QUIT
+44 DO HEAD(GMRCPG)
SET GMRCPG=GMRCPG+1
End DoDot:3
+45 if $GET(GMRCQUT)
QUIT
+46 WRITE ?4,IDX,!
End DoDot:2
End DoDot:1
+47 DO ^%ZISC
+48 DO EXIT
+49 QUIT
+50 ;
HEAD(PAGE) ; print header for CPM
+1 WRITE @IOF
+2 IF PAGE>1
Begin DoDot:1
+3 SET TEMP=$SELECT($GET(GMRCQTR)=4:"4",$GET(GMRCQTR)=3:"3",$GET(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$EXTRACT($GET(GMRCFY),3,4)
+4 SET TEMP="Consult/Request Performance Monitor - "_TEMP
+5 WRITE !,$JUSTIFY("",40-($LENGTH(TEMP)/2)+.5)_TEMP,!
End DoDot:1
+6 WRITE !,$JUSTIFY("Run Date: "_$$HTE^XLFDT($HOROLOG),0),$JUSTIFY("Page: "_PAGE,48)
+7 WRITE !,$$REPEAT^XLFSTR("-",IOM-2),!!
+8 QUIT
+9 ;
CAVEATS ; brief explanatory text
+1 WRITE !!,"Resubmitted requests are evaluated based on the original Date of Request."
+2 WRITE !!,"The following are excluded from this report:"
+3 WRITE !," -Requests sent to test patients."
+4 WRITE !," -Requests not marked as Outpatient in the REQUEST/CONSULTATION file."
+5 WRITE !," -Services flagged as part of the interface between Consults/Request Tracking"
+6 WRITE !,?2,"and Prosthetics."
+7 WRITE !," -Administrative requests flagged via the Administrative fields in the"
+8 WRITE !,?2,"REQUEST SERVICES and REQUEST/CONSULTATION files. This is not retroactive"
+9 WRITE !,?2,"and only applies to services/requests leveraging the Administrative-flagging"
+10 WRITE !,?2,"capability included in GMRC*3.0*60."
+11 WRITE !," -The report utilizes the CLINICALLY INDICATED DATE field from the "
+12 WRITE !,?2,"REQUEST/CONSULTATION file to determine request totals for a given date"
+13 WRITE !,?2,"range. This is true even for requests that have been re-submitted using"
+14 WRITE !,?2,"the Edit/Resubmit functionality.",!!
+15 QUIT
+16 ;
EXIT FOR ARR="GMRCR","GMRCS","GMRCSLIST","GMRCT"
KILL ^TMP(ARR,$JOB)
+1 KILL ARR
+2 QUIT
+3 ;
