- 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 ;