GMRCSTLA ;SLC/JFR,WAT - DRIVER FOR LOCAL CSLT COMPL RATE ;
;;3.0;CONSULT/REQUEST TRACKING;**67**;DEC 27, 1997;Build 1
;
;This routine invokes the following ICRs:
;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),10089(%ZISC),10026(DIR)
Q
;
EN ; start here
K GMRCQUT
N DIROUT,DTOUT,DUOUT,DIR,DIRUT,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
;
;Ask for service
N Y
S DIR(0)="PO^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
S DIR("A")="Select Service/Specialty"
D ^DIR
I Y<1 Q
S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
;
;Ask for date range
D ^GMRCSPD
I $D(GMRCQUT) G EXIT
;
; what type of report
K DIR,X,Y
S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
D ^DIR
I Y="" G EXIT
S GMRCFMT=$S(Y="S":"CP",1:"DEL")
;
W @IOF
S GMRCSAVE("GMRCFMT")=""
S GMRCSAVE("GMRCDG")=""
S GMRCSAVE("GMRCDT1")=""
S GMRCSAVE("GMRCDT2")=""
S GMRCSAVE("GMRCSVNM")=""
;
D EN^XUTMDEVQ("PRNTQ^GMRCSTLA","LOCAL CONSULT COMPLETION RATES",.GMRCSAVE)
;
D EXIT
;
Q
;
ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN) ;Entry point
;.RETURN: This is the root to the returned temp array.
;GMRCSVC: Service for which consults are to be displayed.
;GMRCDT1: Starting date or "ALL"
;GMRCDT2: Ending date if not GMRCDT1="ALL"
;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
I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
S:GMRCDT1="ALL" GMRCDT2=0
D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
;
N GMRCDA,INDEX,STATUS,LOOP,GROUPER
N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP
N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
;
K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
;
S GROUPER=0
S GROUPER(0)=0
I GMRCARRN="DEL" D
. N STR
. S STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;"
. S STR=STR_"%Comp w/Results"
. 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)
.S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0
.S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0
.S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=0
.S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=0
.S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0
.S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0
.S ^TMP("GMRCTOT",$J,2,GMRCSVC,"R")=0
.S ^TMP("GMRCTOT",$J,2,GMRCSVC,"C")=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^GMRCSTLB(2,GROUPER(GROUPER),GMRCARRN)
... I GMRCARRN="DEL" D
.... D DELTOT^GMRCSTLB(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^GMRCSTLB(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2)
.F GRP=GROUPER:-1:1 D
..; pending for this service to all of its groupers
..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P")
.. ; completed w/results for all groupers
.. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"R")
..; for all status for this service to all of its groupers
..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T")
.. ; add all completed for all groupers
.. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"C")
.;
.;Print the totals for this service that are >0
. I GMRCARRN="CP" D
.. D PRTTOT^GMRCSTLB(1,GMRCSVC,GMRCSVCP,GMRCARRN)
. I GMRCARRN="DEL" D
.. D DELTOT^GMRCSTLB(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^GMRCSTLB(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
. I GMRCARRN="DEL" D
.. D DELTOT^GMRCSTLB(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
W !,$J("",23)_"Local Consult Completion Rates"
S TEMP="FROM: "_$$FMTE^XLFDT(GMRCDT1)_" TO: "_$$FMTE^XLFDT(GMRCDT2)
I GMRCDT1="ALL" S TEMP="ALL DATES"
W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
I '$O(^TMP("GMRCSLIST",$J,0)) D G EXIT
. W !!,"No records to print"
D ENOR^GMRCSTLA(.GMRCTMP,GMRCDG,GMRCDT1,GMRCDT2,"5,6,8,2,9",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),!
I GMRCFMT="CP",'$G(GMRCQUT) D
. Q:$O(^TMP("GMRCTOT",$J,0,""))=""
. I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
. W !!!,$$REPEAT^XLFSTR("-",IOM-5)
. W !,"Consult services with no activity meeting the criteria of this report in",!,"the specified date range:",!
. S IDX=""
. F S IDX=$O(^TMP("GMRCTOT",$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
W @IOF
W "Local Consult Completion Rates",?40,$$HTE^XLFDT($H)
W ?73,"Page: ",PAGE,!
W $$REPEAT^XLFSTR("-",IOM-2),!
Q
;
EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCTOT" K ^TMP(ARR,$J)
K ARR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSTLA 6901 printed Dec 13, 2024@01:47:25 Page 2
GMRCSTLA ;SLC/JFR,WAT - DRIVER FOR LOCAL CSLT COMPL RATE ;
+1 ;;3.0;CONSULT/REQUEST TRACKING;**67**;DEC 27, 1997;Build 1
+2 ;
+3 ;This routine invokes the following ICRs:
+4 ;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),10089(%ZISC),10026(DIR)
+5 QUIT
+6 ;
EN ; start here
+1 KILL GMRCQUT
+2 NEW DIROUT,DTOUT,DUOUT,DIR,DIRUT,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
+3 NEW GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
+4 ;
+5 ;Ask for service
+6 NEW Y
+7 SET DIR(0)="PO^123.5:EMQ"
SET DIR("??")="^D LISTALL^GMRCASV"
+8 SET DIR("A")="Select Service/Specialty"
+9 DO ^DIR
+10 IF Y<1
QUIT
+11 SET GMRCDG=+Y
SET GMRCSVNM=$PIECE(Y,U,2)
+12 ;
+13 ;Ask for date range
+14 DO ^GMRCSPD
+15 IF $DATA(GMRCQUT)
GOTO EXIT
+16 ;
+17 ; what type of report
+18 KILL DIR,X,Y
+19 SET DIR(0)="S:O^S:Summary;D:Delimited"
SET DIR("A")="What type of report"
+20 DO ^DIR
+21 IF Y=""
GOTO EXIT
+22 SET GMRCFMT=$SELECT(Y="S":"CP",1:"DEL")
+23 ;
+24 WRITE @IOF
+25 SET GMRCSAVE("GMRCFMT")=""
+26 SET GMRCSAVE("GMRCDG")=""
+27 SET GMRCSAVE("GMRCDT1")=""
+28 SET GMRCSAVE("GMRCDT2")=""
+29 SET GMRCSAVE("GMRCSVNM")=""
+30 ;
+31 DO EN^XUTMDEVQ("PRNTQ^GMRCSTLA","LOCAL CONSULT COMPLETION RATES",.GMRCSAVE)
+32 ;
+33 DO EXIT
+34 ;
+35 QUIT
+36 ;
ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,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 ;GMRCDT1: Starting date or "ALL"
+4 ;GMRCDT2: Ending date if not GMRCDT1="ALL"
+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 IF '($DATA(GMRCDT1)#2)
SET GMRCDT1="ALL"
+26 if GMRCDT1="ALL"
SET GMRCDT2=0
+27 DO LISTDATE^GMRCSTU1(GMRCDT1,$GET(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
+28 ;
+29 NEW GMRCDA,INDEX,STATUS,LOOP,GROUPER
+30 NEW STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP
+31 NEW GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
+32 NEW GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
+33 ;
+34 KILL ^TMP("GMRCR",$JOB,GMRCARRN),^TMP("GMRCRINDEX",$JOB),^TMP("GMRCTOT",$JOB)
+35 ;
+36 SET GROUPER=0
+37 SET GROUPER(0)=0
+38 IF GMRCARRN="DEL"
Begin DoDot:1
+39 NEW STR
+40 SET STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;"
+41 SET STR=STR_"%Comp w/Results"
+42 SET ^TMP("GMRCR",$JOB,GMRCARRN,1,0)=STR
End DoDot:1
+43 SET INDEX=""
+44 ;Loop on Service
+45 FOR
SET INDEX=$ORDER(^TMP("GMRCSLIST",$JOB,INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+46 SET GMRCSVC=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",1)
+47 SET GMRCSVCP=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",2)
+48 SET GMRCSVCG=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",3)
+49 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"T")=0
+50 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"P")=0
+51 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"R")=0
+52 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"C")=0
+53 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,"T")=0
+54 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,"P")=0
+55 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,"R")=0
+56 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,"C")=0
+57 ;Check if starting a new Grouper
+58 FOR
if GROUPER(GROUPER)=GMRCSVCG
QUIT
Begin DoDot:2
+59 ;End of a group so print the group totals
+60 IF GROUPER(GROUPER)=GMRCSVCG
Begin DoDot:3
+61 IF GMRCARRN="CP"
Begin DoDot:4
+62 DO PRTTOT^GMRCSTLB(2,GROUPER(GROUPER),GMRCARRN)
End DoDot:4
+63 IF GMRCARRN="DEL"
Begin DoDot:4
+64 DO DELTOT^GMRCSTLB(2,GROUPER(GROUPER),GMRCARRN)
End DoDot:4
End DoDot:3
+65 ;pop grouper from stack
+66 SET GROUPER=GROUPER-1
End DoDot:2
+67 IF $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",4)="+"
Begin DoDot:2
+68 ;push new grouper on stack
+69 SET GROUPER=GROUPER+1
+70 SET GROUPER(GROUPER)=GMRCSVC
End DoDot:2
+71 ;Loop for one status at a time
+72 FOR LOOP=1:1:$LENGTH(GMRCSTAT,",")
SET STATUS=$PIECE(GMRCSTAT,",",LOOP)
Begin DoDot:2
+73 DO ONESTAT^GMRCSTLB(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2)
End DoDot:2
+74 FOR GRP=GROUPER:-1:1
Begin DoDot:2
+75 ; pending for this service to all of its groupers
+76 SET ^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"P")=$GET(^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$JOB,1,GMRCSVC,"P")
+77 ; completed w/results for all groupers
+78 SET ^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"R")=$GET(^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$JOB,1,GMRCSVC,"R")
+79 ; for all status for this service to all of its groupers
+80 SET ^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"T")=$GET(^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$JOB,1,GMRCSVC,"T")
+81 ; add all completed for all groupers
+82 SET ^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"C")=$GET(^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"C"))+^TMP("GMRCTOT",$JOB,1,GMRCSVC,"C")
End DoDot:2
+83 ;
+84 ;Print the totals for this service that are >0
+85 IF GMRCARRN="CP"
Begin DoDot:2
+86 DO PRTTOT^GMRCSTLB(1,GMRCSVC,GMRCSVCP,GMRCARRN)
End DoDot:2
+87 IF GMRCARRN="DEL"
Begin DoDot:2
+88 DO DELTOT^GMRCSTLB(1,GMRCSVC,GMRCSVCP,GMRCARRN)
End DoDot:2
+89 QUIT
End DoDot:1
+90 ;
+91 ;Done, so now list the group totals for the top group
+92 ;F GROUPER=GROUPER:-1:1 D ; left for looking at all totals in future
+93 IF $GET(GROUPER)
SET GROUPER=1
Begin DoDot:1
+94 IF GMRCARRN="CP"
Begin DoDot:2
+95 DO PRTTOT^GMRCSTLB(2,GROUPER(GROUPER),$PIECE(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
End DoDot:2
+96 IF GMRCARRN="DEL"
Begin DoDot:2
+97 DO DELTOT^GMRCSTLB(2,GROUPER(GROUPER),$PIECE(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
End DoDot:2
End DoDot:1
+98 QUIT
+99 ;
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 WRITE !,$JUSTIFY("",23)_"Local Consult Completion Rates"
+7 SET TEMP="FROM: "_$$FMTE^XLFDT(GMRCDT1)_" TO: "_$$FMTE^XLFDT(GMRCDT2)
+8 IF GMRCDT1="ALL"
SET TEMP="ALL DATES"
+9 WRITE !,$JUSTIFY("",40-($LENGTH(TEMP)/2)+.5)_TEMP,!
+10 IF '$ORDER(^TMP("GMRCSLIST",$JOB,0))
Begin DoDot:1
+11 WRITE !!,"No records to print"
End DoDot:1
GOTO EXIT
+12 DO ENOR^GMRCSTLA(.GMRCTMP,GMRCDG,GMRCDT1,GMRCDT2,"5,6,8,2,9",GMRCFMT)
+13 IF '$DATA(^TMP("GMRCR",$JOB,GMRCFMT))
Begin DoDot:1
+14 WRITE !!,"No records to print",!
End DoDot:1
+15 SET IDX=""
+16 FOR
SET IDX=$ORDER(^TMP("GMRCR",$JOB,GMRCFMT,IDX))
if 'IDX!($GET(GMRCQUT))
QUIT
Begin DoDot:1
+17 IF IOSL-$Y<3
Begin DoDot:2
+18 IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:3
+19 NEW DIR
SET DIR(0)="E"
DO ^DIR
+20 IF 'Y
SET GMRCQUT=1
End DoDot:3
+21 if $GET(GMRCQUT)
QUIT
+22 DO HEAD(GMRCPG)
SET GMRCPG=GMRCPG+1
End DoDot:2
+23 if $GET(GMRCQUT)
QUIT
+24 WRITE ^TMP("GMRCR",$JOB,GMRCFMT,IDX,0),!
End DoDot:1
+25 IF GMRCFMT="CP"
IF '$GET(GMRCQUT)
Begin DoDot:1
+26 if $ORDER(^TMP("GMRCTOT",$JOB,0,""))=""
QUIT
+27 IF IOSL-$Y<6
DO HEAD(GMRCPG)
SET GMRCPG=GMRCPG+1
+28 WRITE !!!,$$REPEAT^XLFSTR("-",IOM-5)
+29 WRITE !,"Consult services with no activity meeting the criteria of this report in",!,"the specified date range:",!
+30 SET IDX=""
+31 FOR
SET IDX=$ORDER(^TMP("GMRCTOT",$JOB,0,IDX))
if IDX=""!($GET(GMRCQUT))
QUIT
Begin DoDot:2
+32 IF IOSL-$Y<3
Begin DoDot:3
+33 IF $EXTRACT(IOST,1,2)["C-"
Begin DoDot:4
+34 NEW DIR
SET DIR(0)="E"
DO ^DIR
+35 IF 'Y
SET GMRCQUT=1
End DoDot:4
+36 if $GET(GMRCQUT)
QUIT
+37 DO HEAD(GMRCPG)
SET GMRCPG=GMRCPG+1
End DoDot:3
+38 if $GET(GMRCQUT)
QUIT
+39 WRITE ?4,IDX,!
End DoDot:2
End DoDot:1
+40 DO ^%ZISC
+41 DO EXIT
+42 QUIT
+43 ;
HEAD(PAGE) ; print header
+1 WRITE @IOF
+2 WRITE "Local Consult Completion Rates",?40,$$HTE^XLFDT($HOROLOG)
+3 WRITE ?73,"Page: ",PAGE,!
+4 WRITE $$REPEAT^XLFSTR("-",IOM-2),!
+5 QUIT
+6 ;
EXIT FOR ARR="GMRCR","GMRCS","GMRCSLIST","GMRCTOT"
KILL ^TMP(ARR,$JOB)
+1 KILL ARR
+2 QUIT
+3 ;
