GMRCSTLA ;SLC/JFR,WAT - DRIVER FOR LOCAL CSLT COMPL RATE ;
;;3.0;CONSULT/REQUEST TRACKING;**67,1003**;DEC 27, 1997;Build 14
;
;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,GMRTST
;
;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
;
;Patch 1003 Check for test patients
S GMRTST=$$TESTPT^GMRCPC1()
I $D(GMRCQUT) S VALMBCK="Q" 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")=""
S GMRCSAVE("GMRTST")=""
;
D EN^XUTMDEVQ("PRNTQ^GMRCSTLA","LOCAL CONSULT COMPLETION RATES",.GMRCSAVE)
;
D EXIT
;
Q
;
ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN,GMRTST) ;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
;GMRTST: Whether to include test pts or not
;
;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,GMRTST)
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
;
GMRCSTLA ;SLC/JFR,WAT - DRIVER FOR LOCAL CSLT COMPL RATE ;
+1 ;;3.0;CONSULT/REQUEST TRACKING;**67,1003**;DEC 27, 1997;Build 14
+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,GMRTST
+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 ;Patch 1003 Check for test patients
+18 SET GMRTST=$$TESTPT^GMRCPC1()
+19 IF $DATA(GMRCQUT)
SET VALMBCK="Q"
GOTO EXIT
+20 ; what type of report
+21 KILL DIR,X,Y
+22 SET DIR(0)="S:O^S:Summary;D:Delimited"
SET DIR("A")="What type of report"
+23 DO ^DIR
+24 IF Y=""
GOTO EXIT
+25 SET GMRCFMT=$SELECT(Y="S":"CP",1:"DEL")
+26 ;
+27 WRITE @IOF
+28 SET GMRCSAVE("GMRCFMT")=""
+29 SET GMRCSAVE("GMRCDG")=""
+30 SET GMRCSAVE("GMRCDT1")=""
+31 SET GMRCSAVE("GMRCDT2")=""
+32 SET GMRCSAVE("GMRCSVNM")=""
+33 SET GMRCSAVE("GMRTST")=""
+34 ;
+35 DO EN^XUTMDEVQ("PRNTQ^GMRCSTLA","LOCAL CONSULT COMPLETION RATES",.GMRCSAVE)
+36 ;
+37 DO EXIT
+38 ;
+39 QUIT
+40 ;
ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN,GMRTST) ;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 ;GMRTST: Whether to include test pts or not
+9 ;
+10 ;This temp array is used internally by the report:
+11 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
+12 ; status is "" tracking and/or grouper
+13 ; 1 grouper only
+14 ; 2 tracking only
+15 ; 9 disabled
+16 ;
+17 NEW GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK
+18 KILL ^TMP("GMRCR",$JOB,GMRCARRN)
+19 SET RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
+20 IF '($DATA(GMRCSVC)#2)
SET GMRCSVC=1
+21 IF '$DATA(^GMR(123.5,$GET(GMRCSVC),0))
QUIT
+22 ;Build service array
+23 SET GMRCDG=GMRCSVC
+24 DO SERV1^GMRCASV
+25 ;Get external form of date range
+26 IF '($DATA(GMRCDT1)#2)
SET GMRCDT1="ALL"
+27 IF GMRCDT1="ALL"
SET GMRCDT2=0
+28 DO LISTDATE^GMRCSTU1(GMRCDT1,$GET(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
+29 ;
+30 NEW GMRCDA,INDEX,STATUS,LOOP,GROUPER
+31 NEW STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP
+32 NEW GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
+33 NEW GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
+34 ;
+35 KILL ^TMP("GMRCR",$JOB,GMRCARRN),^TMP("GMRCRINDEX",$JOB),^TMP("GMRCTOT",$JOB)
+36 ;
+37 SET GROUPER=0
+38 SET GROUPER(0)=0
+39 IF GMRCARRN="DEL"
Begin DoDot:1
+40 NEW STR
+41 SET STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;"
+42 SET STR=STR_"%Comp w/Results"
+43 SET ^TMP("GMRCR",$JOB,GMRCARRN,1,0)=STR
End DoDot:1
+44 SET INDEX=""
+45 ;Loop on Service
+46 FOR
SET INDEX=$ORDER(^TMP("GMRCSLIST",$JOB,INDEX))
IF INDEX=""
QUIT
Begin DoDot:1
+47 SET GMRCSVC=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",1)
+48 SET GMRCSVCP=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",2)
+49 SET GMRCSVCG=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",3)
+50 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"T")=0
+51 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"P")=0
+52 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"R")=0
+53 SET ^TMP("GMRCTOT",$JOB,1,GMRCSVC,"C")=0
+54 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,"T")=0
+55 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,"P")=0
+56 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,"R")=0
+57 SET ^TMP("GMRCTOT",$JOB,2,GMRCSVC,"C")=0
+58 ;Check if starting a new Grouper
+59 FOR
IF GROUPER(GROUPER)=GMRCSVCG
QUIT
Begin DoDot:2
+60 ;End of a group so print the group totals
+61 IF GROUPER(GROUPER)=GMRCSVCG
Begin DoDot:3
+62 IF GMRCARRN="CP"
Begin DoDot:4
+63 DO PRTTOT^GMRCSTLB(2,GROUPER(GROUPER),GMRCARRN)
End DoDot:4
+64 IF GMRCARRN="DEL"
Begin DoDot:4
+65 DO DELTOT^GMRCSTLB(2,GROUPER(GROUPER),GMRCARRN)
End DoDot:4
End DoDot:3
+66 ;pop grouper from stack
+67 SET GROUPER=GROUPER-1
End DoDot:2
+68 IF $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",4)="+"
Begin DoDot:2
+69 ;push new grouper on stack
+70 SET GROUPER=GROUPER+1
+71 SET GROUPER(GROUPER)=GMRCSVC
End DoDot:2
+72 ;Loop for one status at a time
+73 FOR LOOP=1:1:$LENGTH(GMRCSTAT,",")
SET STATUS=$PIECE(GMRCSTAT,",",LOOP)
Begin DoDot:2
+74 DO ONESTAT^GMRCSTLB(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2)
End DoDot:2
+75 FOR GRP=GROUPER:-1:1
Begin DoDot:2
+76 ; pending for this service to all of its groupers
+77 SET ^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"P")=$GET(^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$JOB,1,GMRCSVC,"P")
+78 ; completed w/results for all groupers
+79 SET ^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"R")=$GET(^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$JOB,1,GMRCSVC,"R")
+80 ; for all status for this service to all of its groupers
+81 SET ^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"T")=$GET(^TMP("GMRCTOT",$JOB,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$JOB,1,GMRCSVC,"T")
+82 ; add all completed for all groupers
+83 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
+84 ;
+85 ;Print the totals for this service that are >0
+86 IF GMRCARRN="CP"
Begin DoDot:2
+87 DO PRTTOT^GMRCSTLB(1,GMRCSVC,GMRCSVCP,GMRCARRN)
End DoDot:2
+88 IF GMRCARRN="DEL"
Begin DoDot:2
+89 DO DELTOT^GMRCSTLB(1,GMRCSVC,GMRCSVCP,GMRCARRN)
End DoDot:2
+90 QUIT
End DoDot:1
+91 ;
+92 ;Done, so now list the group totals for the top group
+93 ;F GROUPER=GROUPER:-1:1 D ; left for looking at all totals in future
+94 IF $GET(GROUPER)
SET GROUPER=1
Begin DoDot:1
+95 IF GMRCARRN="CP"
Begin DoDot:2
+96 DO PRTTOT^GMRCSTLB(2,GROUPER(GROUPER),$PIECE(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
End DoDot:2
+97 IF GMRCARRN="DEL"
Begin DoDot:2
+98 DO DELTOT^GMRCSTLB(2,GROUPER(GROUPER),$PIECE(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
End DoDot:2
End DoDot:1
+99 QUIT
+100 ;
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,GMRTST)
+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 ;
