Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTU.m

    r613 r623  
    1 GMRCSTU ;SLC/DCM,dee - Statistic Utilities for C/RT ;09/26/02 10:16
    2         ;;3.0;CONSULT/REQUEST TRACKING;**1,7,29,30,43,61**;DEC 27, 1997;Build 2
    3         Q
    4         ;
    5 GETDT(GMRCO)    ;get the date that the consult/request was accepted by service
    6         N ND,GMRCDA
    7         S COMPLDT=9999999
    8         S ND=0 F  S ND=$O(^GMR(123,GMRCO,40,ND)) Q:ND?1A.E!(ND="")  D
    9         .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=21 GMRCDA=$P(^(0),"^",1)
    10         .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=1 GMRCDA(1)=$P(^(0),"^",1)
    11         .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=15 GMRCDA(15)=$P(^(0),"^",3)
    12         .I $P(^GMR(123,GMRCO,40,ND,0),"^",2)=10,$P(^(0),"^",3)<COMPLDT S COMPLDT=$P(^(0),"^",3)
    13         S RCVDT=$S($D(GMRCDA)#2:GMRCDA,$D(GMRCDA(1)):GMRCDA(1),$D(GMRCDA(15)):GMRCDA(15),1:$P(^GMR(123,GMRCO,0),"^",1))
    14         Q
    15 EN      ;
    16         K ^TMP("GMRCSLIST",$J),GMRCQUT
    17         ;Get the service/grouper
    18         D ASRV^GMRCASV
    19         G:$D(GMRCQUT) KILL
    20         I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 G KILL
    21         ;Get the date range
    22         D ^GMRCSPD
    23         G:$D(GMRCQUT) KILL
    24         Q
    25         ;
    26 ENOR(RETURN,GMRCSRVC,GMRCDT1,GMRCDT2)   ;Entry point for GUI interface.
    27         ;.RETURN:   This is the root to the returned temp array.
    28         ;GMRCSRVC:  Service for which consults are to be displayed.
    29         ;GMRCDT1:  Starting date or "ALL"
    30         ;GMRCDT2:  Ending date if not GMRCDT1="ALL"
    31         ;
    32         ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
    33         ;  status is "" tracking and/or grouper
    34         ;            1  grouper only
    35         ;            2  tracking only
    36         ;            9  disabled
    37         ;
    38         N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCCT,GMRCGRP,VALMCNT,VALMBCK
    39         N GMRCWRIT
    40         S GMRCWRIT=0
    41         K ^TMP("GMRCR",$J,"PRL")
    42         S RETURN="^TMP(""GMRCR"",$J,""PRL"")"
    43         I '($D(GMRCSRVC)#2) S GMRCSRVC=1
    44         Q:'$D(^GMR(123.5,$G(GMRCSRVC),0))
    45         ;Build service array
    46         S GMRCDG=GMRCSRVC
    47         D SERV1^GMRCASV
    48         ;Get external form of date range
    49         I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
    50         S:GMRCDT1="ALL" GMRCDT2=0
    51         D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
    52         G ODTSTR
    53         ;
    54 ODT     ;List Manager entry point
    55         N GMRCWRIT
    56         S GMRCWRIT=1
    57         D WAIT^DICD
    58         ;
    59 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
    60         N RCVDT,COMPLDT,INDEX,TEMPTMP,GROUPER,TAB
    61         N GMRCDG,GMRCDGT,GMRCDT,GMRCDTP
    62         N GMRCGRP,GMRCND,GMRCO,ND,X,X1,X2,X3,X4
    63         S GMRCDTP=GMRCDT2
    64         S GMRCDT2=GMRCDT2+1
    65         I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 G KILL
    66         S INDEX=0
    67         F  S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX=""  D
    68         .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
    69         .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
    70         .S ^TMP("GMRCSVC",$J,1,ND,"T")="0^0^0^0^0^0"
    71         .S ^TMP("GMRCSVC",$J,1,ND,"I")="0^0^0^0^0"
    72         .S ^TMP("GMRCSVC",$J,1,ND,"O")="0^0^0^0^0"
    73         .S ^TMP("GMRCSVC",$J,1,ND,"U")="0^0^0^0^0"
    74         .S ^TMP("GMRCSVC",$J,2,ND,"T")="0^0^0^0^0^0"
    75         .S ^TMP("GMRCSVC",$J,2,ND,"I")="0^0^0^0^0"
    76         .S ^TMP("GMRCSVC",$J,2,ND,"O")="0^0^0^0^0"
    77         .S ^TMP("GMRCSVC",$J,2,ND,"U")="0^0^0^0^0"
    78         S GMRCND=0
    79         S INDEX=""
    80         F  S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX),-1) Q:INDEX=""  D
    81         .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
    82         .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
    83         .Q:$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)>0
    84         .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",5)'=1 D
    85         ..S GMRCDT=""
    86         ..F  S GMRCDT=$O(^GMR(123,"AE",ND,2,GMRCDT)) Q:GMRCDT=""  D
    87         ...S GMRCO=0
    88         ...F  S GMRCO=$O(^GMR(123,"AE",ND,2,GMRCDT,GMRCO)) Q:GMRCO=""  D  W:GMRCWRIT&'(GMRCND#25) "."
    89         ....D GETDT(GMRCO)
    90         ....I COMPLDT<9999999,$S(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0) D
    91         .....S X1=COMPLDT
    92         .....S X2=RCVDT
    93         .....D ^%DTC
    94         .....IF X=0 D
    95         ......S X=$$FMDIFF^XLFDT(COMPLDT,RCVDT,3)
    96         ......S X=+$P(X," ",2)/24
    97         ......S X3=$E(X,1,3)
    98         ......S X4=$E(X,4)
    99         ......S:X4>4 X3=X3+.01
    100         ......S X=X3
    101         .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),U)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),U)+X
    102         .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)+1
    103         .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",3)+(X*X)
    104         .....I $P(^GMR(123,GMRCO,0),"^",18)="I" D
    105         ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",1)+X
    106         ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",2)+1
    107         ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",3)+(X*X)
    108         .....E  I $P(^GMR(123,GMRCO,0),"^",18)="O" D
    109         ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",1)+X
    110         ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",2)+1
    111         ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",3)+(X*X)
    112         .....E  D
    113         ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",1)+X
    114         ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",2)+1
    115         ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",3)+(X*X)
    116         .....S GMRCND=GMRCND+1
    117         .D PARENTS^GMRCSTU1(ND,+$P(^TMP("GMRCSLIST",$J,INDEX),"^",3))
    118         S ND=0
    119 STAT    ;Do the statistics
    120         F  S ND=$O(^TMP("GMRCSVC",$J,2,ND)) Q:ND=""  D
    121         .I $P($G(^TMP("GMRCSVC",$J,1,ND,"T")),"^",1)>0 D DOSTAT^GMRCSTU1(1,ND)
    122         .I $P(^TMP("GMRCSVC",$J,2,ND,"T"),"^",1)>0 D DOSTAT^GMRCSTU1(2,ND)
    123         K ^TMP("GMRCR",$J,"PRL")
    124         S GMRCCT=0
    125         S GMRCDT2=GMRCDTP  ;reset date value to print report heading
    126         D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
    127         S TAB=""
    128         S $P(TAB," ",40)=""
    129         S GMRCCT=GMRCCT+1
    130         S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,19)_"Consult/Request Completion Time Statistics"
    131         S GMRCCT=GMRCCT+1
    132         S TEMPTMP="FROM: "_GMRCEDT1_"   TO: "_GMRCEDT2
    133         S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,40-($L(TEMPTMP)/2))_TEMPTMP
    134         S GMRCCT=GMRCCT+1
    135         S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=""
    136         S INDEX=0
    137         S GROUPER=0
    138         S GROUPER(0)=0
    139         F  S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX=""  D
    140         .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
    141         .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9&'$D(^TMP("GMRCSVC",$J,2,ND))
    142         .F  Q:GROUPER(GROUPER)=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)  D
    143         ..;End of a group so print the group totals
    144         ..D SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
    145         ..;pop grouper from stack
    146         ..S GROUPER=GROUPER-1
    147         .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
    148         ..;Start of a new group so print the group heading.
    149         ..S GMRCCT=GMRCCT+1
    150         ..S TEMPTMP="GROUPER: "_$P(^GMR(123.5,ND,0),"^",1)
    151         ..S:$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)>0 TEMPTMP=TEMPTMP_"  in Group: "_$P(^GMR(123.5,$P(^TMP("GMRCSLIST",$J,INDEX),"^",3),0),"^",1)
    152         ..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,40-(($L(TEMPTMP)/2)+.5))_TEMPTMP
    153         ..S GMRCCT=GMRCCT+1
    154         ..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=""
    155         ..;push new grouper on stack
    156         ..S GROUPER=GROUPER+1
    157         ..S GROUPER(GROUPER)=ND
    158         .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=1
    159         .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
    160         .D SERVSTAT^GMRCSTU1(.GMRCCT,1,ND,GROUPER(GROUPER))
    161         ;Now list the group totals for the current groups.
    162         F GROUPER=GROUPER:-1:1 D
    163         .;End of a group so print the group totals
    164         .D SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
    165         ;Done building list.
    166         S VALMCNT=GMRCCT,VALMBCK="R"
    167 KILL    ;kill variables and exit
    168         S:$D(GMRCQUT) VALMBCK="Q"
    169         K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
    170         Q
    171 PRNT    ;print statistics to a printer
    172         ;Called from a List Manager action
    173         Q:'$D(^TMP("GMRCR",$J,"PRL",2,0))
    174         I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
    175         D PRNTASK
    176         D PRNTIT("PRL","PRNTQ^GMRCSTU","CONSULT/REQUEST PACKAGE PRINT COMPLETION TIME STATISTICS FROM LIST MANAGER DISPLAY")
    177         Q
    178         ;
    179 PRNTASK ;Ask for device
    180         N POP,%ZIS
    181         K GMRCQUT
    182         S POP=0
    183         S %ZIS="MQ"
    184         D ^%ZIS
    185         I POP D  Q
    186         .S GMRCMSG="Printer Busy. Try Again Later."
    187         .D EXAC^GMRCADC(GMRCMSG)
    188         .K GMRCMSG
    189         .S GMRCQUT=1
    190         Q
    191         ;
    192 PRNTIT(TMPNAME,QUERTN,QUEDESC)  ;Send list to printer
    193         N ANSWER,INDEX,DOLLARH,ZTRTN,ZTDESC
    194         I $D(IO("Q")) D  Q
    195         .S DOLLARH=$H
    196         .M ^XTMP("GMRCR","$"_$J,DOLLARH,"PRINT")=^TMP("GMRCR",$J,TMPNAME)
    197         .S ZTRTN=QUERTN
    198         .S ZTDESC=QUEDESC
    199         .S ZTSAVE("J")="$"_$J
    200         .S ZTSAVE("DOLLARH")=""
    201         .S ZTSAVE("TMPNAME")=""
    202         .S ZTSAVE("GMRCDG")=""
    203         .S ZTSAVE("GMRCDT1")=""
    204         .S ZTSAVE("GMRCDT2")=""
    205         .D ^%ZTLOAD,^%ZISC
    206         .K ZTSAVE
    207         .S VALMBCK="R"
    208         U IO
    209         S ANSWER=""
    210         S INDEX=""
    211         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
    212         I ANSWER'["^",IOST["C-",$Y>1 R !,"Press <ENTER> To Continue: ",ANSWER:DTIME
    213         U IO(0)
    214         D ^%ZISC
    215         S VALMBCK="R"
    216         Q
    217         ;
    218 PRNTQ   ;Print Queued report from ^XTMP global then kill off ^XTMP
    219         N INDEX
    220         U IO
    221         S INDEX=""
    222         F  S INDEX=$O(^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX)) Q:INDEX=""  W ^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX,0),!
    223         K ^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
    224         D ^%ZISC
    225         Q
     1GMRCSTU ;SLC/DCM,dee - Statistic Utilities for C/RT ;09/26/02 10:16
     2 ;;3.0;CONSULT/REQUEST TRACKING;**1,7,29,30,43**;DEC 27, 1997
     3 Q
     4 ;
     5GETDT(GMRCO) ;get the date that the consult/request was accepted by service
     6 N ND,GMRCDA
     7 S COMPLDT=9999999
     8 S ND=0 F  S ND=$O(^GMR(123,GMRCO,40,ND)) Q:ND?1A.E!(ND="")  D
     9 .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=21 GMRCDA=$P(^(0),"^",1)
     10 .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=1 GMRCDA(1)=$P(^(0),"^",1)
     11 .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=15 GMRCDA(15)=$P(^(0),"^",3)
     12 .I $P(^GMR(123,GMRCO,40,ND,0),"^",2)=10,$P(^(0),"^",3)<COMPLDT S COMPLDT=$P(^(0),"^",3)
     13 S RCVDT=$S($D(GMRCDA)#2:GMRCDA,$D(GMRCDA(1)):GMRCDA(1),$D(GMRCDA(15)):GMRCDA(15),1:$P(^GMR(123,GMRCO,0),"^",1))
     14 Q
     15EN ;
     16 K ^TMP("GMRCSLIST",$J),GMRCQUT
     17 ;Get the service/grouper
     18 D ASRV^GMRCASV
     19 G:$D(GMRCQUT) KILL
     20 I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 G KILL
     21 ;Get the date range
     22 D ^GMRCSPD
     23 G:$D(GMRCQUT) KILL
     24 Q
     25 ;
     26ENOR(RETURN,GMRCSRVC,GMRCDT1,GMRCDT2) ;Entry point for GUI interface.
     27 ;.RETURN:   This is the root to the returned temp array.
     28 ;GMRCSRVC:  Service for which consults are to be displayed.
     29 ;GMRCDT1:  Starting date or "ALL"
     30 ;GMRCDT2:  Ending date if not GMRCDT1="ALL"
     31 ;
     32 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
     33 ;  status is "" tracking and/or grouper
     34 ;            1  grouper only
     35 ;            2  tracking only
     36 ;            9  disabled
     37 ;
     38 N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCCT,GMRCGRP,VALMCNT,VALMBCK
     39 N GMRCWRIT
     40 S GMRCWRIT=0
     41 K ^TMP("GMRCR",$J,"PRL")
     42 S RETURN="^TMP(""GMRCR"",$J,""PRL"")"
     43 I '($D(GMRCSRVC)#2) S GMRCSRVC=1
     44 Q:'$D(^GMR(123.5,$G(GMRCSRVC),0))
     45 ;Build service array
     46 S GMRCDG=GMRCSRVC
     47 D SERV1^GMRCASV
     48 ;Get external form of date range
     49 I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
     50 S:GMRCDT1="ALL" GMRCDT2=0
     51 D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
     52 G ODTSTR
     53 ;
     54ODT ;List Manager entry point
     55 N GMRCWRIT
     56 S GMRCWRIT=1
     57 D WAIT^DICD
     58 ;
     59ODTSTR ;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
     60 N RCVDT,COMPLDT,INDEX,TEMPTMP,GROUPER,TAB
     61 N GMRCDG,GMRCDGT,GMRCDT
     62 N GMRCGRP,GMRCND,GMRCO,ND,X,X1,X2,X3,X4
     63 I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 G KILL
     64 S INDEX=0
     65 F  S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX=""  D
     66 .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
     67 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
     68 .S ^TMP("GMRCSVC",$J,1,ND,"T")="0^0^0^0^0^0"
     69 .S ^TMP("GMRCSVC",$J,1,ND,"I")="0^0^0^0^0"
     70 .S ^TMP("GMRCSVC",$J,1,ND,"O")="0^0^0^0^0"
     71 .S ^TMP("GMRCSVC",$J,1,ND,"U")="0^0^0^0^0"
     72 .S ^TMP("GMRCSVC",$J,2,ND,"T")="0^0^0^0^0^0"
     73 .S ^TMP("GMRCSVC",$J,2,ND,"I")="0^0^0^0^0"
     74 .S ^TMP("GMRCSVC",$J,2,ND,"O")="0^0^0^0^0"
     75 .S ^TMP("GMRCSVC",$J,2,ND,"U")="0^0^0^0^0"
     76 S GMRCND=0
     77 S INDEX=""
     78 F  S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX),-1) Q:INDEX=""  D
     79 .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
     80 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
     81 .Q:$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)>0
     82 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",5)'=1 D
     83 ..S GMRCDT=""
     84 ..F  S GMRCDT=$O(^GMR(123,"AE",ND,2,GMRCDT)) Q:GMRCDT=""  D
     85 ...S GMRCO=0
     86 ...F  S GMRCO=$O(^GMR(123,"AE",ND,2,GMRCDT,GMRCO)) Q:GMRCO=""  D  W:GMRCWRIT&'(GMRCND#25) "."
     87 ....D GETDT(GMRCO)
     88 ....I COMPLDT<9999999,$S(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0) D
     89 .....S X1=COMPLDT
     90 .....S X2=RCVDT
     91 .....D ^%DTC
     92 .....IF X=0 D
     93 ......S X=$$FMDIFF^XLFDT(COMPLDT,RCVDT,3)
     94 ......S X=+$P(X," ",2)/24
     95 ......S X3=$E(X,1,3)
     96 ......S X4=$E(X,4)
     97 ......S:X4>4 X3=X3+.01
     98 ......S X=X3
     99 .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),U)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),U)+X
     100 .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)+1
     101 .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",3)+(X*X)
     102 .....I $P(^GMR(123,GMRCO,0),"^",18)="I" D
     103 ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",1)+X
     104 ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",2)+1
     105 ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",3)+(X*X)
     106 .....E  I $P(^GMR(123,GMRCO,0),"^",18)="O" D
     107 ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",1)+X
     108 ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",2)+1
     109 ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",3)+(X*X)
     110 .....E  D
     111 ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",1)+X
     112 ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",2)+1
     113 ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",3)+(X*X)
     114 .....S GMRCND=GMRCND+1
     115 .D PARENTS^GMRCSTU1(ND,+$P(^TMP("GMRCSLIST",$J,INDEX),"^",3))
     116 S ND=0
     117STAT ;Do the statistics
     118 F  S ND=$O(^TMP("GMRCSVC",$J,2,ND)) Q:ND=""  D
     119 .I $P($G(^TMP("GMRCSVC",$J,1,ND,"T")),"^",1)>0 D DOSTAT^GMRCSTU1(1,ND)
     120 .I $P(^TMP("GMRCSVC",$J,2,ND,"T"),"^",1)>0 D DOSTAT^GMRCSTU1(2,ND)
     121 K ^TMP("GMRCR",$J,"PRL")
     122 S GMRCCT=0
     123 D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
     124 S TAB=""
     125 S $P(TAB," ",40)=""
     126 S GMRCCT=GMRCCT+1
     127 S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,19)_"Consult/Request Completion Time Statistics"
     128 S GMRCCT=GMRCCT+1
     129 S TEMPTMP="FROM: "_GMRCEDT1_"   TO: "_GMRCEDT2
     130 S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,40-($L(TEMPTMP)/2))_TEMPTMP
     131 S GMRCCT=GMRCCT+1
     132 S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=""
     133 S INDEX=0
     134 S GROUPER=0
     135 S GROUPER(0)=0
     136 F  S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX=""  D
     137 .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
     138 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9&'$D(^TMP("GMRCSVC",$J,2,ND))
     139 .F  Q:GROUPER(GROUPER)=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)  D
     140 ..;End of a group so print the group totals
     141 ..D SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
     142 ..;pop grouper from stack
     143 ..S GROUPER=GROUPER-1
     144 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
     145 ..;Start of a new group so print the group heading.
     146 ..S GMRCCT=GMRCCT+1
     147 ..S TEMPTMP="GROUPER: "_$P(^GMR(123.5,ND,0),"^",1)
     148 ..S:$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)>0 TEMPTMP=TEMPTMP_"  in Group: "_$P(^GMR(123.5,$P(^TMP("GMRCSLIST",$J,INDEX),"^",3),0),"^",1)
     149 ..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,40-(($L(TEMPTMP)/2)+.5))_TEMPTMP
     150 ..S GMRCCT=GMRCCT+1
     151 ..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=""
     152 ..;push new grouper on stack
     153 ..S GROUPER=GROUPER+1
     154 ..S GROUPER(GROUPER)=ND
     155 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=1
     156 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
     157 .D SERVSTAT^GMRCSTU1(.GMRCCT,1,ND,GROUPER(GROUPER))
     158 ;Now list the group totals for the current groups.
     159 F GROUPER=GROUPER:-1:1 D
     160 .;End of a group so print the group totals
     161 .D SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
     162 ;Done building list.
     163 S VALMCNT=GMRCCT,VALMBCK="R"
     164KILL ;kill variables and exit
     165 S:$D(GMRCQUT) VALMBCK="Q"
     166 K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
     167 Q
     168PRNT ;print statistics to a printer
     169 ;Called from a List Manager action
     170 Q:'$D(^TMP("GMRCR",$J,"PRL",2,0))
     171 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
     172 D PRNTASK
     173 D PRNTIT("PRL","PRNTQ^GMRCSTU","CONSULT/REQUEST PACKAGE PRINT COMPLETION TIME STATISTICS FROM LIST MANAGER DISPLAY")
     174 Q
     175 ;
     176PRNTASK ;Ask for device
     177 N POP,%ZIS
     178 K GMRCQUT
     179 S POP=0
     180 S %ZIS="MQ"
     181 D ^%ZIS
     182 I POP D  Q
     183 .S GMRCMSG="Printer Busy. Try Again Later."
     184 .D EXAC^GMRCADC(GMRCMSG)
     185 .K GMRCMSG
     186 .S GMRCQUT=1
     187 Q
     188 ;
     189PRNTIT(TMPNAME,QUERTN,QUEDESC) ;Send list to printer
     190 N ANSWER,INDEX,DOLLARH,ZTRTN,ZTDESC
     191 I $D(IO("Q")) D  Q
     192 .S DOLLARH=$H
     193 .M ^XTMP("GMRCR","$"_$J,DOLLARH,"PRINT")=^TMP("GMRCR",$J,TMPNAME)
     194 .S ZTRTN=QUERTN
     195 .S ZTDESC=QUEDESC
     196 .S ZTSAVE("J")="$"_$J
     197 .S ZTSAVE("DOLLARH")=""
     198 .S ZTSAVE("TMPNAME")=""
     199 .S ZTSAVE("GMRCDG")=""
     200 .S ZTSAVE("GMRCDT1")=""
     201 .S ZTSAVE("GMRCDT2")=""
     202 .D ^%ZTLOAD,^%ZISC
     203 .K ZTSAVE
     204 .S VALMBCK="R"
     205 U IO
     206 S ANSWER=""
     207 S INDEX=""
     208 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
     209 I ANSWER'["^",IOST["C-",$Y>1 R !,"Press <ENTER> To Continue: ",ANSWER:DTIME
     210 U IO(0)
     211 D ^%ZISC
     212 S VALMBCK="R"
     213 Q
     214 ;
     215PRNTQ ;Print Queued report from ^XTMP global then kill off ^XTMP
     216 N INDEX
     217 U IO
     218 S INDEX=""
     219 F  S INDEX=$O(^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX)) Q:INDEX=""  W ^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX,0),!
     220 K ^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
     221 D ^%ZISC
     222 Q
Note: See TracChangeset for help on using the changeset viewer.