- 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 Jan 18, 2025@02:48:44 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