GMRCSTU ;SLC/DCM,dee - Statistic Utilities for C/RT ;09/26/02 10:16
;;3.0;CONSULT/REQUEST TRACKING;**1,7,29,30,43,61**;DEC 27, 1997;Build 2
Q
;
GETDT(GMRCO) ;get the date that the consult/request was accepted by service
N ND,GMRCDA
S COMPLDT=9999999
S ND=0 F S ND=$O(^GMR(123,GMRCO,40,ND)) Q:ND?1A.E!(ND="") D
.S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=21 GMRCDA=$P(^(0),"^",1)
.S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=1 GMRCDA(1)=$P(^(0),"^",1)
.S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=15 GMRCDA(15)=$P(^(0),"^",3)
.I $P(^GMR(123,GMRCO,40,ND,0),"^",2)=10,$P(^(0),"^",3)<COMPLDT S COMPLDT=$P(^(0),"^",3)
S RCVDT=$S($D(GMRCDA)#2:GMRCDA,$D(GMRCDA(1)):GMRCDA(1),$D(GMRCDA(15)):GMRCDA(15),1:$P(^GMR(123,GMRCO,0),"^",1))
Q
EN ;
K ^TMP("GMRCSLIST",$J),GMRCQUT
;Get the service/grouper
D ASRV^GMRCASV
G:$D(GMRCQUT) KILL
I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 G KILL
;Get the date range
D ^GMRCSPD
G:$D(GMRCQUT) KILL
Q
;
ENOR(RETURN,GMRCSRVC,GMRCDT1,GMRCDT2) ;Entry point for GUI interface.
;.RETURN: This is the root to the returned temp array.
;GMRCSRVC: Service for which consults are to be displayed.
;GMRCDT1: Starting date or "ALL"
;GMRCDT2: Ending date if not GMRCDT1="ALL"
;
;^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,GMRCCT,GMRCGRP,VALMCNT,VALMBCK
N GMRCWRIT
S GMRCWRIT=0
K ^TMP("GMRCR",$J,"PRL")
S RETURN="^TMP(""GMRCR"",$J,""PRL"")"
I '($D(GMRCSRVC)#2) S GMRCSRVC=1
Q:'$D(^GMR(123.5,$G(GMRCSRVC),0))
;Build service array
S GMRCDG=GMRCSRVC
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)
G ODTSTR
;
ODT ;List Manager entry point
N GMRCWRIT
S GMRCWRIT=1
D WAIT^DICD
;
ODTSTR ;Find the mean, standard deviation of how long to complete a consult from when it is accepted in the service to when it is complete
N RCVDT,COMPLDT,INDEX,TEMPTMP,GROUPER,TAB
N GMRCDG,GMRCDGT,GMRCDT,GMRCDTP
N GMRCGRP,GMRCND,GMRCO,ND,X,X1,X2,X3,X4
S GMRCDTP=GMRCDT2
S GMRCDT2=GMRCDT2+1
I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 G KILL
S INDEX=0
F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
.S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
.Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
.S ^TMP("GMRCSVC",$J,1,ND,"T")="0^0^0^0^0^0"
.S ^TMP("GMRCSVC",$J,1,ND,"I")="0^0^0^0^0"
.S ^TMP("GMRCSVC",$J,1,ND,"O")="0^0^0^0^0"
.S ^TMP("GMRCSVC",$J,1,ND,"U")="0^0^0^0^0"
.S ^TMP("GMRCSVC",$J,2,ND,"T")="0^0^0^0^0^0"
.S ^TMP("GMRCSVC",$J,2,ND,"I")="0^0^0^0^0"
.S ^TMP("GMRCSVC",$J,2,ND,"O")="0^0^0^0^0"
.S ^TMP("GMRCSVC",$J,2,ND,"U")="0^0^0^0^0"
S GMRCND=0
S INDEX=""
F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX),-1) Q:INDEX="" D
.S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
.Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
.Q:$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)>0
.I $P(^TMP("GMRCSLIST",$J,INDEX),"^",5)'=1 D
..S GMRCDT=""
..F S GMRCDT=$O(^GMR(123,"AE",ND,2,GMRCDT)) Q:GMRCDT="" D
...S GMRCO=0
...F S GMRCO=$O(^GMR(123,"AE",ND,2,GMRCDT,GMRCO)) Q:GMRCO="" D W:GMRCWRIT&'(GMRCND#25) "."
....D GETDT(GMRCO)
....I COMPLDT<9999999,$S(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0) D
.....S X1=COMPLDT
.....S X2=RCVDT
.....D ^%DTC
.....IF X=0 D
......S X=$$FMDIFF^XLFDT(COMPLDT,RCVDT,3)
......S X=+$P(X," ",2)/24
......S X3=$E(X,1,3)
......S X4=$E(X,4)
......S:X4>4 X3=X3+.01
......S X=X3
.....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),U)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),U)+X
.....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)+1
.....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",3)+(X*X)
.....I $P(^GMR(123,GMRCO,0),"^",18)="I" D
......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",1)+X
......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",2)+1
......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",3)+(X*X)
.....E I $P(^GMR(123,GMRCO,0),"^",18)="O" D
......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",1)+X
......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",2)+1
......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",3)+(X*X)
.....E D
......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",1)+X
......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",2)+1
......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",3)+(X*X)
.....S GMRCND=GMRCND+1
.D PARENTS^GMRCSTU1(ND,+$P(^TMP("GMRCSLIST",$J,INDEX),"^",3))
S ND=0
STAT ;Do the statistics
F S ND=$O(^TMP("GMRCSVC",$J,2,ND)) Q:ND="" D
.I $P($G(^TMP("GMRCSVC",$J,1,ND,"T")),"^",1)>0 D DOSTAT^GMRCSTU1(1,ND)
.I $P(^TMP("GMRCSVC",$J,2,ND,"T"),"^",1)>0 D DOSTAT^GMRCSTU1(2,ND)
K ^TMP("GMRCR",$J,"PRL")
S GMRCCT=0
S GMRCDT2=GMRCDTP ;reset date value to print report heading
D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
S TAB=""
S $P(TAB," ",40)=""
S GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,19)_"Consult/Request Completion Time Statistics"
S GMRCCT=GMRCCT+1
S TEMPTMP="FROM: "_GMRCEDT1_" TO: "_GMRCEDT2
S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,40-($L(TEMPTMP)/2))_TEMPTMP
S GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=""
S INDEX=0
S GROUPER=0
S GROUPER(0)=0
F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
.S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
.Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9&'$D(^TMP("GMRCSVC",$J,2,ND))
.F Q:GROUPER(GROUPER)=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3) D
..;End of a group so print the group totals
..D SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
..;pop grouper from stack
..S GROUPER=GROUPER-1
.I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
..;Start of a new group so print the group heading.
..S GMRCCT=GMRCCT+1
..S TEMPTMP="GROUPER: "_$P(^GMR(123.5,ND,0),"^",1)
..S:$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)>0 TEMPTMP=TEMPTMP_" in Group: "_$P(^GMR(123.5,$P(^TMP("GMRCSLIST",$J,INDEX),"^",3),0),"^",1)
..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,40-(($L(TEMPTMP)/2)+.5))_TEMPTMP
..S GMRCCT=GMRCCT+1
..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=""
..;push new grouper on stack
..S GROUPER=GROUPER+1
..S GROUPER(GROUPER)=ND
.Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=1
.Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
.D SERVSTAT^GMRCSTU1(.GMRCCT,1,ND,GROUPER(GROUPER))
;Now list the group totals for the current groups.
F GROUPER=GROUPER:-1:1 D
.;End of a group so print the group totals
.D SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
;Done building list.
S VALMCNT=GMRCCT,VALMBCK="R"
KILL ;kill variables and exit
S:$D(GMRCQUT) VALMBCK="Q"
K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
Q
PRNT ;print statistics to a printer
;Called from a List Manager action
Q:'$D(^TMP("GMRCR",$J,"PRL",2,0))
I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
D PRNTASK
D PRNTIT("PRL","PRNTQ^GMRCSTU","CONSULT/REQUEST PACKAGE PRINT COMPLETION TIME STATISTICS FROM LIST MANAGER DISPLAY")
Q
;
PRNTASK ;Ask for device
N POP,%ZIS
K GMRCQUT
S POP=0
S %ZIS="MQ"
D ^%ZIS
I POP D Q
.S GMRCMSG="Printer Busy. Try Again Later."
.D EXAC^GMRCADC(GMRCMSG)
.K GMRCMSG
.S GMRCQUT=1
Q
;
PRNTIT(TMPNAME,QUERTN,QUEDESC) ;Send list to printer
N ANSWER,INDEX,DOLLARH,ZTRTN,ZTDESC
I $D(IO("Q")) D Q
.S DOLLARH=$H
.M ^XTMP("GMRCR","$"_$J,DOLLARH,"PRINT")=^TMP("GMRCR",$J,TMPNAME)
.S ZTRTN=QUERTN
.S ZTDESC=QUEDESC
.S ZTSAVE("J")="$"_$J
.S ZTSAVE("DOLLARH")=""
.S ZTSAVE("TMPNAME")=""
.S ZTSAVE("GMRCDG")=""
.S ZTSAVE("GMRCDT1")=""
.S ZTSAVE("GMRCDT2")=""
.D ^%ZTLOAD,^%ZISC
.K ZTSAVE
.S VALMBCK="R"
U IO
S ANSWER=""
S INDEX=""
F S INDEX=$O(^TMP("GMRCR",$J,TMPNAME,INDEX)) Q:INDEX="" W ^TMP("GMRCR",$J,TMPNAME,INDEX,0),! I IOST["C-",$S($D(IOSL)#2:$Y>(IOSL-2),1:$Y>22) R "Press <ENTER> To Continue, '^' To Quit: ",ANSWER:DTIME Q:'$T!(ANSWER["^") W @IOF
I ANSWER'["^",IOST["C-",$Y>1 R !,"Press <ENTER> To Continue: ",ANSWER:DTIME
U IO(0)
D ^%ZISC
S VALMBCK="R"
Q
;
PRNTQ ;Print Queued report from ^XTMP global then kill off ^XTMP
N INDEX
U IO
S INDEX=""
F S INDEX=$O(^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX)) Q:INDEX="" W ^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX,0),!
K ^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSTU 8715 printed Dec 13, 2024@01:47:30 Page 2
GMRCSTU ;SLC/DCM,dee - Statistic Utilities for C/RT ;09/26/02 10:16
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,7,29,30,43,61**;DEC 27, 1997;Build 2
+2 QUIT
+3 ;
GETDT(GMRCO) ;get the date that the consult/request was accepted by service
+1 NEW ND,GMRCDA
+2 SET COMPLDT=9999999
+3 SET ND=0
FOR
SET ND=$ORDER(^GMR(123,GMRCO,40,ND))
if ND?1A.E!(ND="")
QUIT
Begin DoDot:1
+4 if $PIECE(^GMR(123,GMRCO,40,ND,0),"^",2)=21
SET GMRCDA=$PIECE(^(0),"^",1)
+5 if $PIECE(^GMR(123,GMRCO,40,ND,0),"^",2)=1
SET GMRCDA(1)=$PIECE(^(0),"^",1)
+6 if $PIECE(^GMR(123,GMRCO,40,ND,0),"^",2)=15
SET GMRCDA(15)=$PIECE(^(0),"^",3)
+7 IF $PIECE(^GMR(123,GMRCO,40,ND,0),"^",2)=10
IF $PIECE(^(0),"^",3)<COMPLDT
SET COMPLDT=$PIECE(^(0),"^",3)
End DoDot:1
+8 SET RCVDT=$SELECT($DATA(GMRCDA)#2:GMRCDA,$DATA(GMRCDA(1)):GMRCDA(1),$DATA(GMRCDA(15)):GMRCDA(15),1:$PIECE(^GMR(123,GMRCO,0),"^",1))
+9 QUIT
EN ;
+1 KILL ^TMP("GMRCSLIST",$JOB),GMRCQUT
+2 ;Get the service/grouper
+3 DO ASRV^GMRCASV
+4 if $DATA(GMRCQUT)
GOTO KILL
+5 IF '$ORDER(^TMP("GMRCSLIST",$JOB,0))
SET GMRCQUT=1
GOTO KILL
+6 ;Get the date range
+7 DO ^GMRCSPD
+8 if $DATA(GMRCQUT)
GOTO KILL
+9 QUIT
+10 ;
ENOR(RETURN,GMRCSRVC,GMRCDT1,GMRCDT2) ;Entry point for GUI interface.
+1 ;.RETURN: This is the root to the returned temp array.
+2 ;GMRCSRVC: Service for which consults are to be displayed.
+3 ;GMRCDT1: Starting date or "ALL"
+4 ;GMRCDT2: Ending date if not GMRCDT1="ALL"
+5 ;
+6 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
+7 ; status is "" tracking and/or grouper
+8 ; 1 grouper only
+9 ; 2 tracking only
+10 ; 9 disabled
+11 ;
+12 NEW GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCCT,GMRCGRP,VALMCNT,VALMBCK
+13 NEW GMRCWRIT
+14 SET GMRCWRIT=0
+15 KILL ^TMP("GMRCR",$JOB,"PRL")
+16 SET RETURN="^TMP(""GMRCR"",$J,""PRL"")"
+17 IF '($DATA(GMRCSRVC)#2)
SET GMRCSRVC=1
+18 if '$DATA(^GMR(123.5,$GET(GMRCSRVC),0))
QUIT
+19 ;Build service array
+20 SET GMRCDG=GMRCSRVC
+21 DO SERV1^GMRCASV
+22 ;Get external form of date range
+23 IF '($DATA(GMRCDT1)#2)
SET GMRCDT1="ALL"
+24 if GMRCDT1="ALL"
SET GMRCDT2=0
+25 DO LISTDATE^GMRCSTU1(GMRCDT1,$GET(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
+26 GOTO ODTSTR
+27 ;
ODT ;List Manager entry point
+1 NEW GMRCWRIT
+2 SET GMRCWRIT=1
+3 DO WAIT^DICD
+4 ;
ODTSTR ;Find the mean, standard deviation of how long to complete a consult from when it is accepted in the service to when it is complete
+1 NEW RCVDT,COMPLDT,INDEX,TEMPTMP,GROUPER,TAB
+2 NEW GMRCDG,GMRCDGT,GMRCDT,GMRCDTP
+3 NEW GMRCGRP,GMRCND,GMRCO,ND,X,X1,X2,X3,X4
+4 SET GMRCDTP=GMRCDT2
+5 SET GMRCDT2=GMRCDT2+1
+6 IF '$ORDER(^TMP("GMRCSLIST",$JOB,0))
SET GMRCQUT=1
GOTO KILL
+7 SET INDEX=0
+8 FOR
SET INDEX=$ORDER(^TMP("GMRCSLIST",$JOB,INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+9 SET ND=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",1)
+10 if $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",5)=9
QUIT
+11 SET ^TMP("GMRCSVC",$JOB,1,ND,"T")="0^0^0^0^0^0"
+12 SET ^TMP("GMRCSVC",$JOB,1,ND,"I")="0^0^0^0^0"
+13 SET ^TMP("GMRCSVC",$JOB,1,ND,"O")="0^0^0^0^0"
+14 SET ^TMP("GMRCSVC",$JOB,1,ND,"U")="0^0^0^0^0"
+15 SET ^TMP("GMRCSVC",$JOB,2,ND,"T")="0^0^0^0^0^0"
+16 SET ^TMP("GMRCSVC",$JOB,2,ND,"I")="0^0^0^0^0"
+17 SET ^TMP("GMRCSVC",$JOB,2,ND,"O")="0^0^0^0^0"
+18 SET ^TMP("GMRCSVC",$JOB,2,ND,"U")="0^0^0^0^0"
End DoDot:1
+19 SET GMRCND=0
+20 SET INDEX=""
+21 FOR
SET INDEX=$ORDER(^TMP("GMRCSLIST",$JOB,INDEX),-1)
if INDEX=""
QUIT
Begin DoDot:1
+22 SET ND=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",1)
+23 if $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",5)=9
QUIT
+24 if $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"T"),"^",2)>0
QUIT
+25 IF $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",5)'=1
Begin DoDot:2
+26 SET GMRCDT=""
+27 FOR
SET GMRCDT=$ORDER(^GMR(123,"AE",ND,2,GMRCDT))
if GMRCDT=""
QUIT
Begin DoDot:3
+28 SET GMRCO=0
+29 FOR
SET GMRCO=$ORDER(^GMR(123,"AE",ND,2,GMRCDT,GMRCO))
if GMRCO=""
QUIT
Begin DoDot:4
+30 DO GETDT(GMRCO)
+31 IF COMPLDT<9999999
IF $SELECT(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0)
Begin DoDot:5
+32 SET X1=COMPLDT
+33 SET X2=RCVDT
+34 DO ^%DTC
+35 IF X=0
Begin DoDot:6
+36 SET X=$$FMDIFF^XLFDT(COMPLDT,RCVDT,3)
+37 SET X=+$PIECE(X," ",2)/24
+38 SET X3=$EXTRACT(X,1,3)
+39 SET X4=$EXTRACT(X,4)
+40 if X4>4
SET X3=X3+.01
+41 SET X=X3
End DoDot:6
+42 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"T"),U)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"T"),U)+X
+43 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"T"),"^",2)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"T"),"^",2)+1
+44 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"T"),"^",3)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"T"),"^",3)+(X*X)
+45 IF $PIECE(^GMR(123,GMRCO,0),"^",18)="I"
Begin DoDot:6
+46 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"I"),"^",1)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"I"),"^",1)+X
+47 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"I"),"^",2)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"I"),"^",2)+1
+48 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"I"),"^",3)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"I"),"^",3)+(X*X)
End DoDot:6
+49 IF '$TEST
IF $PIECE(^GMR(123,GMRCO,0),"^",18)="O"
Begin DoDot:6
+50 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"O"),"^",1)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"O"),"^",1)+X
+51 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"O"),"^",2)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"O"),"^",2)+1
+52 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"O"),"^",3)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"O"),"^",3)+(X*X)
End DoDot:6
+53 IF '$TEST
Begin DoDot:6
+54 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"U"),"^",1)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"U"),"^",1)+X
+55 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"U"),"^",2)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"U"),"^",2)+1
+56 SET $PIECE(^TMP("GMRCSVC",$JOB,1,ND,"U"),"^",3)=$PIECE(^TMP("GMRCSVC",$JOB,1,ND,"U"),"^",3)+(X*X)
End DoDot:6
+57 SET GMRCND=GMRCND+1
End DoDot:5
End DoDot:4
if GMRCWRIT&'(GMRCND#25)
WRITE "."
End DoDot:3
End DoDot:2
+58 DO PARENTS^GMRCSTU1(ND,+$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",3))
End DoDot:1
+59 SET ND=0
STAT ;Do the statistics
+1 FOR
SET ND=$ORDER(^TMP("GMRCSVC",$JOB,2,ND))
if ND=""
QUIT
Begin DoDot:1
+2 IF $PIECE($GET(^TMP("GMRCSVC",$JOB,1,ND,"T")),"^",1)>0
DO DOSTAT^GMRCSTU1(1,ND)
+3 IF $PIECE(^TMP("GMRCSVC",$JOB,2,ND,"T"),"^",1)>0
DO DOSTAT^GMRCSTU1(2,ND)
End DoDot:1
+4 KILL ^TMP("GMRCR",$JOB,"PRL")
+5 SET GMRCCT=0
+6 ;reset date value to print report heading
SET GMRCDT2=GMRCDTP
+7 DO LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
+8 SET TAB=""
+9 SET $PIECE(TAB," ",40)=""
+10 SET GMRCCT=GMRCCT+1
+11 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)=$EXTRACT(TAB,1,19)_"Consult/Request Completion Time Statistics"
+12 SET GMRCCT=GMRCCT+1
+13 SET TEMPTMP="FROM: "_GMRCEDT1_" TO: "_GMRCEDT2
+14 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)=$EXTRACT(TAB,1,40-($LENGTH(TEMPTMP)/2))_TEMPTMP
+15 SET GMRCCT=GMRCCT+1
+16 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)=""
+17 SET INDEX=0
+18 SET GROUPER=0
+19 SET GROUPER(0)=0
+20 FOR
SET INDEX=$ORDER(^TMP("GMRCSLIST",$JOB,INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+21 SET ND=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",1)
+22 if $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",5)=9&'$DATA(^TMP("GMRCSVC",$JOB,2,ND))
QUIT
+23 FOR
if GROUPER(GROUPER)=$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",3)
QUIT
Begin DoDot:2
+24 ;End of a group so print the group totals
+25 DO SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
+26 ;pop grouper from stack
+27 SET GROUPER=GROUPER-1
End DoDot:2
+28 IF $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",4)="+"
Begin DoDot:2
+29 ;Start of a new group so print the group heading.
+30 SET GMRCCT=GMRCCT+1
+31 SET TEMPTMP="GROUPER: "_$PIECE(^GMR(123.5,ND,0),"^",1)
+32 if $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",3)>0
SET TEMPTMP=TEMPTMP_" in Group: "_$PIECE(^GMR(123.5,$PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",3),0),"^",1)
+33 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)=$EXTRACT(TAB,1,40-(($LENGTH(TEMPTMP)/2)+.5))_TEMPTMP
+34 SET GMRCCT=GMRCCT+1
+35 SET ^TMP("GMRCR",$JOB,"PRL",GMRCCT,0)=""
+36 ;push new grouper on stack
+37 SET GROUPER=GROUPER+1
+38 SET GROUPER(GROUPER)=ND
End DoDot:2
+39 if $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",5)=1
QUIT
+40 if $PIECE(^TMP("GMRCSLIST",$JOB,INDEX),"^",5)=9
QUIT
+41 DO SERVSTAT^GMRCSTU1(.GMRCCT,1,ND,GROUPER(GROUPER))
End DoDot:1
+42 ;Now list the group totals for the current groups.
+43 FOR GROUPER=GROUPER:-1:1
Begin DoDot:1
+44 ;End of a group so print the group totals
+45 DO SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
End DoDot:1
+46 ;Done building list.
+47 SET VALMCNT=GMRCCT
SET VALMBCK="R"
KILL ;kill variables and exit
+1 if $DATA(GMRCQUT)
SET VALMBCK="Q"
+2 KILL ^TMP("GMRCS",$JOB),^TMP("GMRCSLIST",$JOB)
+3 QUIT
PRNT ;print statistics to a printer
+1 ;Called from a List Manager action
+2 if '$DATA(^TMP("GMRCR",$JOB,"PRL",2,0))
QUIT
+3 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+4 DO PRNTASK
+5 DO PRNTIT("PRL","PRNTQ^GMRCSTU","CONSULT/REQUEST PACKAGE PRINT COMPLETION TIME STATISTICS FROM LIST MANAGER DISPLAY")
+6 QUIT
+7 ;
PRNTASK ;Ask for device
+1 NEW POP,%ZIS
+2 KILL GMRCQUT
+3 SET POP=0
+4 SET %ZIS="MQ"
+5 DO ^%ZIS
+6 IF POP
Begin DoDot:1
+7 SET GMRCMSG="Printer Busy. Try Again Later."
+8 DO EXAC^GMRCADC(GMRCMSG)
+9 KILL GMRCMSG
+10 SET GMRCQUT=1
End DoDot:1
QUIT
+11 QUIT
+12 ;
PRNTIT(TMPNAME,QUERTN,QUEDESC) ;Send list to printer
+1 NEW ANSWER,INDEX,DOLLARH,ZTRTN,ZTDESC
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET DOLLARH=$HOROLOG
+4 MERGE ^XTMP("GMRCR","$"_$JOB,DOLLARH,"PRINT")=^TMP("GMRCR",$JOB,TMPNAME)
+5 SET ZTRTN=QUERTN
+6 SET ZTDESC=QUEDESC
+7 SET ZTSAVE("J")="$"_$JOB
+8 SET ZTSAVE("DOLLARH")=""
+9 SET ZTSAVE("TMPNAME")=""
+10 SET ZTSAVE("GMRCDG")=""
+11 SET ZTSAVE("GMRCDT1")=""
+12 SET ZTSAVE("GMRCDT2")=""
+13 DO ^%ZTLOAD
DO ^%ZISC
+14 KILL ZTSAVE
+15 SET VALMBCK="R"
End DoDot:1
QUIT
+16 USE IO
+17 SET ANSWER=""
+18 SET INDEX=""
+19 FOR
SET INDEX=$ORDER(^TMP("GMRCR",$JOB,TMPNAME,INDEX))
if INDEX=""
QUIT
WRITE ^TMP("GMRCR",$JOB,TMPNAME,INDEX,0),!
IF IOST["C-"
IF $SELECT($DATA(IOSL)#2:$Y>(IOSL-2),1:$Y>22)
READ "Press <ENTER> To Continue, '^' To Quit: ",ANSWER:DTIME
if '$TEST!(ANSWER["^")
QUIT
WRITE @IOF
+20 IF ANSWER'["^"
IF IOST["C-"
IF $Y>1
READ !,"Press <ENTER> To Continue: ",ANSWER:DTIME
+21 USE IO(0)
+22 DO ^%ZISC
+23 SET VALMBCK="R"
+24 QUIT
+25 ;
PRNTQ ;Print Queued report from ^XTMP global then kill off ^XTMP
+1 NEW INDEX
+2 USE IO
+3 SET INDEX=""
+4 FOR
SET INDEX=$ORDER(^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX))
if INDEX=""
QUIT
WRITE ^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX,0),!
+5 KILL ^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
+6 DO ^%ZISC
+7 QUIT
