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

revised back to 6/30/08 version

Location:
WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5D.m

    r613 r623  
    1 GMRCP5D ;SLC/DCM,RJS,JFR - Print Consult form 513 (Gather Data - Addendums, Headers, Service reports and Comments) ;8/19/03 15:31
    2         ;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,22,29,35,38,61**;Dec 27, 1997;Build 2
    3         ;
    4 FORMAT(GMRCIFN,GMRCRD,PAGEWID)  ;
    5         ;
    6         I $L($P(GMRCRD,U,15)) D
    7         .I $O(^TMP("GMRCR",$J,"MCAR",0)) D
    8         ..N GMRCSVC
    9         ..S GMRCSVC=$P($G(^GMR(123.5,+$P(GMRCRD,U,5),0)),U,1)
    10         ..S:$L(GMRCSVC) GMRCSVC=GMRCSVC_" "
    11         ..;
    12         ..; Medicine Results?
    13         ..S GMRCR0=0 F  S GMRCR0=$O(^TMP("GMRCR",$J,"MCAR",GMRCR0)) Q:'GMRCR0  D
    14         ...D SUB("H","SREP",GMRCR0,$$CENTER(GMRCSVC_"Service Report #"_GMRCR0_" continued."))
    15         ...D SUB("H","SREP",GMRCR0," ")
    16         ...D BLD("SREP",GMRCR0,1,0,$$CENTER("Medicine Package Report"))
    17         ...D BLD("SREP",GMRCR0,1,0,"")
    18         ...N LN
    19         ...S LN=0 F  S LN=$O(^TMP("GMRCR",$J,"MCAR",GMRCR0,LN)) Q:'LN  D
    20         ....D BLD("SREP",GMRCR0,1,0,$G(^TMP("GMRCR",$J,"MCAR",GMRCR0,LN,0)))
    21         ;
    22         ; Build Processing Activities
    23         S GMRCR0=0 F  S GMRCR0=$O(^GMR(123,GMRCIFN,40,GMRCR0)) Q:'GMRCR0  D
    24         .N GMRCR1,GMRC400,CMT,USER,GMRCDT,RPRV,GMRC402,GMRCISIT
    25         .S GMRCR1=+$O(^GMR(123,GMRCIFN,40,GMRCR0,0)) Q:GMRCR1'=1
    26         .S GMRC400=$G(^GMR(123,GMRCIFN,40,GMRCR0,0))
    27         .S GMRC402=$G(^GMR(123,GMRCIFN,40,GMRCR0,2))
    28         .S CMT=$$PRCMT^GMRCP5B(+$P(GMRC400,U,2)) Q:'$L(CMT)
    29         .S GMRCDT=$P(GMRC400,U,3) S:'GMRCDT GMRCDT=$P(GMRC400,U,1)
    30         .S GMRCDT=$$EXDT(GMRCDT)_" "_$P(GMRC402,U,3)
    31         .;Following lines modified in patch *38
    32         .;I $P(^GMR(123,GMRCIFN,0),U,23) D  ;commented out
    33         .;.S GMRCISIT=$$GET1^DIQ(4,$P(^GMR(123,GMRCIFN,0),U,23),.01)  ;commented out
    34         .;.S GMRCISIT="Entered at: "_GMRCISIT  ;commented out
    35         .I $L(GMRC402) D  ;ADDED
    36         ..S GMRCISIT=$$GET1^DIQ(123,GMRCIFN,.07)  ;ADDED
    37         .I '$D(GMRCISIT) D  ;ADDED
    38         ..S GMRCISIT=$$KSP^XUPARAM("INST")  ;ADDED
    39         ..I GMRCISIT'="" S GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01)  ;ADDED
    40         ..I GMRCISIT="" S GMRCISIT=$$GET1^DIQ(123,GMRCIFN,.05)  ;ADDED
    41         .S GMRCISIT="Entered at: "_GMRCISIT  ;ADDED
    42         .;End of modifications for patch *38
    43         .S RPRV=$$GET1^DIQ(200,+$P(GMRC400,U,4),.01)
    44         .I '$L(RPRV) S RPRV=$P(GMRC402,U,2)
    45         .S:($L(RPRV)) RPRV="Responsible Person: "_RPRV
    46         .S USER=$$GET1^DIQ(200,+$P(GMRC400,U,5),.01)
    47         .I '$L(USER) S USER=$P(GMRC402,U)
    48         .S USER="Entered by: "_USER_" - "_GMRCDT
    49         .D SUB("H","COM",GMRCR0,CMT_" Comment ("_USER_") continued.")
    50         .D SUB("H","COM",GMRCR0," ")
    51         .D BLD("COM",GMRCR0,1,0,"")
    52         .D BLD("COM",GMRCR0,1,0,$$CENTER("("_CMT_" Comment)"))
    53         .I $P(GMRC400,U,2)=17!($P(GMRC400,U,2)=25) D
    54         .. N FWDLN,FWDRS
    55         .. S FWDLN="Forwarded from: "
    56         .. S FWDRS=$P($G(^GMR(123,GMRCIFN,40,GMRCR0,3)),U)
    57         .. I $L(FWDRS) S FWDLN=FWDLN_FWDRS
    58         .. I '$L(FWDRS) S FWDLN=FWDLN_$$GET1^DIQ(123.5,+$P(GMRC400,U,6),.01)
    59         .. D BLD("COM",GMRCR0,1,5,FWDLN)
    60         .D BLD("COM",GMRCR0,1,5,USER)
    61         .D:($L(RPRV)) BLD("COM",GMRCR0,1,5,RPRV)
    62         .D:($L($G(GMRCISIT))) BLD("COM",GMRCR0,1,5,GMRCISIT)
    63         .;
    64         .N GMRCR2 S GMRCR2=0
    65         .F  S GMRCR2=$O(^GMR(123,GMRCIFN,40,GMRCR0,GMRCR1,GMRCR2)) Q:'GMRCR2  D
    66         ..D BLD("COM",GMRCR0,1,0,$G(^GMR(123,GMRCIFN,40,GMRCR0,GMRCR1,GMRCR2,0)))
    67         ;
    68         Q
    69         ;
    70 ADDEND(GMRCIFN,GMRCR0,GMRCNDX,GMRCRD,PAGEWID)   ;
    71         ;
    72         N GMRCADD,GMRCNDX,GMRCR1,GMRCV,TEXT,GMRCX
    73         ;
    74         S GMRCADD=0 F  S GMRCADD=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD)) Q:'GMRCADD  D
    75         .N GMRCSGNM,GMRCNMDT,GMRCTIT,GMRCMODE,GMRCCSDT,GMRCCTIT,GMRCCSGM
    76         .;
    77         .F GMRCV="GMRCSGNM","GMRCNMDT","GMRCTIT","GMRCMODE" D
    78         ..S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCV))
    79         .;
    80         . F GMRCV="GMRCCSDT","GMRCCTIT","GMRCCSGM","GMRCCSIG" D
    81         .. S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCV))
    82         .S GMRCNDX=$O(^TMP("GMRC",$J,"OUTPUT","RES"," "),-1)+1
    83         .I $L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Addendum #"_GMRCADD_" To Consult Note #"_GMRCR0_" for "_GMRCRPT_" continued.")
    84         .I '$L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Addendum #"_GMRCADD_" To Consult Note #"_GMRCR0_" continued.")
    85         .D SUB("H","RES",GMRCNDX," ")
    86         .I $L($G(GMRCSGNM)) D
    87         ..D SUB("F","RES",GMRCNDX," ")
    88         ..I (GMRCMODE="electronic") S GMRCX=" Addendum Signature: "_GMRCSGNM_" /es/ "_$$EXDT($G(GMRCNMDT))
    89         ..I '(GMRCMODE="electronic") S GMRCX=" Addendum Author: "_GMRCSGNM S:$L($G(GMRCNMDT)) GMRCX=GMRCX_" Last edited: "_$$EXDT(GMRCNMDT)
    90         ..D SUB("F","RES",GMRCNDX,GMRCX)
    91         ..D:$L($G(GMRCTIT)) SUB("F","RES",GMRCNDX,"                     "_GMRCTIT)
    92         .I $L($G(GMRCCSDT)) D
    93         ..D SUB("F","RES",GMRCNDX," ")
    94         ..I (GMRCCSGM="electronic") S GMRCX=" Addendum CoSignature: "_GMRCCSIG_" /es/ "_$$EXDT(GMRCCSDT)
    95         ..I '(GMRCCSGM="electronic") S GMRCX=" Addendum CoSignature: "_GMRCCSIG_" /chart/ "_$$EXDT(GMRCCSDT)
    96         ..D SUB("F","RES",GMRCNDX,GMRCX)
    97         ..D:$L($G(GMRCCTIT)) SUB("F","RES",GMRCNDX,"                       "_GMRCCTIT)
    98         .D BLD("RES",GMRCNDX,1,0," ")
    99         .I $L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("ADDENDUM #"_GMRCADD_" TO CONSULT NOTE #"_GMRCR0_" FOR "_GMRCRPT))
    100         .I '$L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("ADDENDUM #"_GMRCADD_" TO CONSULT NOTE #"_GMRCR0))
    101         .D BLD("RES",GMRCNDX,1,0," ")
    102         .S GMRCR1=0 F  S GMRCR1=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCR1)) Q:'GMRCR1  D
    103         ..D BLD("RES",GMRCNDX,1,0,$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCR1,0)))
    104         Q
    105         ;
    106 HDR     ; Header code for form 513
    107         ;
    108         N PG,GMRCFROM
    109         ;
    110         F PG=0,1 D
    111         .D BLD("HDR",PG,1,0,GMRCDVL)
    112         .D BLD("HDR",PG,1,6,"MEDICAL RECORD")
    113         .D BLD("HDR",PG,0,29,"|")
    114         .D BLD("HDR",PG,0,36,"CONSULTATION SHEET")
    115         .I PG D BLD("HDR",PG,0,60,"Page ","GMRCPG,65") I 1
    116         .E  I '$G(GMRCGUI) D BLD("HDR",PG,0,60,"Page ","GMRCPG,65")
    117         .;
    118         .D BLD("HDR",PG,1,0,GMRCDVL)
    119         .D BLD("HDR",PG,1,0,"Consult Request: "_$$CONSRQ(GMRCIFN))
    120         .D BLD("HDR",PG,1,55,"|Consult No.: "_GMRCIFN)
    121         .;
    122         D BLD("HDR",1,1,0,GMRCEQL)
    123         D BLD("HDR",0,1,0,GMRCDVL)
    124         ;
    125         I $G(CMT) D BLD("HDR",0,1,27,"("_$$PRCMT^GMRCP5B(CMT)_")") Q
    126         ;
    127         S GMRCFROM=$P($G(^SC(+$P(GMRCRD,U,6),0)),U,1)
    128         ;
    129         I '$L(GMRCFROM) D
    130         .N VAIN
    131         .D INP^VADPT
    132         .S GMRCFROM=$P($G(VAIN(4)),U,2)
    133         .I $L($G(VAIN(5))) S GMRCFROM=GMRCFROM_" (Rm/Bd: "_$G(VAIN(5))_" )"
    134         ;No location, IFC - consulting site
    135         I '$L(GMRCFROM),$P(GMRCRD,U,23),$P($G(GMRCRD(12)),U,5)="F" D
    136         .I $P(GMRCRD,U,21) S GMRCFROM=$$GET1^DIQ(4,$P(GMRCRD,U,21),.01)
    137         .E  S GMRCFROM=$$GET1^DIQ(4,$P(GMRCRD,U,23),.01)
    138         ;
    139         D BLD("HDR",0,1,0,"To: "_$P($G(^GMR(123.5,+$P(GMRCRD,U,5),0)),U,1))
    140         D BLD("HDR",0,1,5,"From: "_GMRCFROM)
    141         D BLD("HDR",0,0,49,"|Requested: "_$$EXDT($P(GMRCRD,U,7)))
    142         ;
    143         D BLD("HDR",0,1,0,GMRCDVL)
    144         D BLD("HDR",0,1,0,"Requesting Facility: "_$E(GMRCFAC,1,22))
    145         I $P(GMRCRD,U,11) D BLD("HDR",0,0,45,"|ATTENTION: "_$E($P($G(^VA(200,+$P(GMRCRD,U,11),0)),U,1),1,21))
    146         I $P(GMRCRD,U,23) D
    147         . D BLD("HDR",0,1,0,"Remote Consult No.: "_GMRCINO)
    148         . D BLD("HDR",0,1,0,"Role: "_GMRCIRL)
    149         D BLD("HDR",0,1,0,GMRCEQL)
    150         ;
    151         Q
    152         ;
    153 CENTER(X)       ;
    154         ;
    155         N TEXT,COL
    156         S COL=35-($L(X)\2) Q:(COL<1) X
    157         S $E(TEXT,COL)=X
    158         Q TEXT
    159         ;
    160 BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME)      ;
    161         ;
    162         Q:'$L($G(SUB))
    163         N LINECNT
    164         ;
    165         F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
    166         ;
    167         S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
    168         I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
    169         ;
    170         S GMRCLAST=SUB
    171         Q
    172         ;
    173 SUB(ZONE,SUB,NDX,TEXT)  ;
    174         ;
    175         N NEXT
    176         S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
    177         S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
    178         Q
    179         ;
    180 LASTLN(SUB,NDX) ;
    181         Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
    182         ;
    183 CONSRQ(IFN)     ;
    184         ;
    185         N PTR,LINK,REF,GMRCRQ
    186         I +$P(^GMR(123,+IFN,0),U,8) D
    187         . S GMRCRQ=$P(^GMR(123,+IFN,0),U,8)
    188         . S GMRCRQ=$$GET1^DIQ(123.3,+GMRCRQ,.01)
    189         . I '$L(GMRCRQ) S GMRCRQ="Procedure"
    190         I $L($G(GMRCRQ)) Q GMRCRQ
    191         I $L($G(^GMR(123,IFN,1.11))) D
    192         . N SERV,TYPE
    193         . S SERV=$$UP^XLFSTR($$GET1^DIQ(123.5,$P(^GMR(123,IFN,0),U,5),.01))
    194         . S TYPE=$$UP^XLFSTR(^GMR(123,IFN,1.11)) I TYPE'=SERV D
    195         . I TYPE'=SERV S GMRCRQ=$E(^GMR(123,IFN,1.11),1,36)
    196         Q:$L($G(GMRCRQ)) GMRCRQ Q "Consult"
    197         ;
    198 EXDT(X) ;EXTERNAL DATE FORMAT
    199         ;
    200         N DATE,TIME,HR,MN,PD,Y,%DT
    201         Q:'$L(X) ""
    202         I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y
    203         Q $$FMTE^XLFDT(X,"5PMZ")
    204         ;
     1GMRCP5D ;SLC/DCM,RJS,JFR - Print Consult form 513 (Gather Data - Addendums, Headers, Service reports and Comments) ;8/19/03 15:31
     2 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,22,29,35,38**;Dec 27, 1997
     3 ;
     4FORMAT(GMRCIFN,GMRCRD,PAGEWID) ;
     5 ;
     6 I $L($P(GMRCRD,U,15)) D
     7 .I $O(^TMP("GMRCR",$J,"MCAR",0)) D
     8 ..N GMRCSVC
     9 ..S GMRCSVC=$P($G(^GMR(123.5,+$P(GMRCRD,U,5),0)),U,1)
     10 ..S:$L(GMRCSVC) GMRCSVC=GMRCSVC_" "
     11 ..;
     12 ..; Medicine Results?
     13 ..S GMRCR0=0 F  S GMRCR0=$O(^TMP("GMRCR",$J,"MCAR",GMRCR0)) Q:'GMRCR0  D
     14 ...D SUB("H","SREP",GMRCR0,$$CENTER(GMRCSVC_"Service Report #"_GMRCR0_" continued."))
     15 ...D SUB("H","SREP",GMRCR0," ")
     16 ...D BLD("SREP",GMRCR0,1,0,$$CENTER("Medicine Package Report"))
     17 ...D BLD("SREP",GMRCR0,1,0,"")
     18 ...N LN
     19 ...S LN=0 F  S LN=$O(^TMP("GMRCR",$J,"MCAR",GMRCR0,LN)) Q:'LN  D
     20 ....D BLD("SREP",GMRCR0,1,0,$G(^TMP("GMRCR",$J,"MCAR",GMRCR0,LN,0)))
     21 ;
     22 ; Build Processing Activities
     23 S GMRCR0=0 F  S GMRCR0=$O(^GMR(123,GMRCIFN,40,GMRCR0)) Q:'GMRCR0  D
     24 .N GMRCR1,GMRC400,CMT,USER,GMRCDT,RPRV,GMRC402,GMRCISIT
     25 .S GMRCR1=+$O(^GMR(123,GMRCIFN,40,GMRCR0,0)) Q:GMRCR1'=1
     26 .S GMRC400=$G(^GMR(123,GMRCIFN,40,GMRCR0,0))
     27 .S GMRC402=$G(^GMR(123,GMRCIFN,40,GMRCR0,2))
     28 .S CMT=$$PRCMT^GMRCP5B(+$P(GMRC400,U,2)) Q:'$L(CMT)
     29 .S GMRCDT=$P(GMRC400,U,3) S:'GMRCDT GMRCDT=$P(GMRC400,U,1)
     30 .S GMRCDT=$$EXDT(GMRCDT)_" "_$P(GMRC402,U,3)
     31 .;Following lines modified in patch *38
     32 .;I $P(^GMR(123,GMRCIFN,0),U,23) D  ;commented out
     33 .;.S GMRCISIT=$$GET1^DIQ(4,$P(^GMR(123,GMRCIFN,0),U,23),.01)  ;commented out
     34 .;.S GMRCISIT="Entered at: "_GMRCISIT  ;commented out
     35 .I $L(GMRC402) D  ;ADDED
     36 ..S GMRCISIT=$$GET1^DIQ(123,GMRCIFN,.07)  ;ADDED
     37 .I '$D(GMRCISIT) D  ;ADDED
     38 ..S GMRCISIT=$$KSP^XUPARAM("INST")  ;ADDED
     39 ..I GMRCISIT'="" S GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01)  ;ADDED
     40 ..I GMRCISIT="" S GMRCISIT=$$GET1^DIQ(123,GMRCIFN,.05)  ;ADDED
     41 .S GMRCISIT="Entered at: "_GMRCISIT  ;ADDED
     42 .;End of modifications for patch *38
     43 .S RPRV=$$GET1^DIQ(200,+$P(GMRC400,U,4),.01)
     44 .I '$L(RPRV) S RPRV=$P(GMRC402,U,2)
     45 .S:($L(RPRV)) RPRV="Responsible Person: "_RPRV
     46 .S USER=$$GET1^DIQ(200,+$P(GMRC400,U,5),.01)
     47 .I '$L(USER) S USER=$P(GMRC402,U)
     48 .S USER="Entered by: "_USER_" - "_GMRCDT
     49 .D SUB("H","COM",GMRCR0,CMT_" Comment ("_USER_") continued.")
     50 .D SUB("H","COM",GMRCR0," ")
     51 .D BLD("COM",GMRCR0,1,0,"")
     52 .D BLD("COM",GMRCR0,1,0,$$CENTER("("_CMT_" Comment)"))
     53 .I $P(GMRC400,U,2)=17!($P(GMRC400,U,2)=25) D
     54 .. N FWDLN,FWDRS
     55 .. S FWDLN="Forwarded from: "
     56 .. S FWDRS=$P($G(^GMR(123,GMRCIFN,40,GMRCR0,3)),U)
     57 .. I $L(FWDRS) S FWDLN=FWDLN_FWDRS
     58 .. I '$L(FWDRS) S FWDLN=FWDLN_$$GET1^DIQ(123.5,+$P(GMRC400,U,6),.01)
     59 .. D BLD("COM",GMRCR0,1,5,FWDLN)
     60 .D BLD("COM",GMRCR0,1,5,USER)
     61 .D:($L(RPRV)) BLD("COM",GMRCR0,1,5,RPRV)
     62 .D:($L($G(GMRCISIT))) BLD("COM",GMRCR0,1,5,GMRCISIT)
     63 .;
     64 .N GMRCR2 S GMRCR2=0
     65 .F  S GMRCR2=$O(^GMR(123,GMRCIFN,40,GMRCR0,GMRCR1,GMRCR2)) Q:'GMRCR2  D
     66 ..D BLD("COM",GMRCR0,1,0,$G(^GMR(123,GMRCIFN,40,GMRCR0,GMRCR1,GMRCR2,0)))
     67 ;
     68 Q
     69 ;
     70ADDEND(GMRCIFN,GMRCR0,GMRCNDX,GMRCRD,PAGEWID) ;
     71 ;
     72 N GMRCADD,GMRCNDX,GMRCR1,GMRCV,TEXT,GMRCX
     73 ;
     74 S GMRCADD=0 F  S GMRCADD=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD)) Q:'GMRCADD  D
     75 .N GMRCSGNM,GMRCNMDT,GMRCTIT,GMRCMODE,GMRCCSDT,GMRCCTIT,GMRCCSGM
     76 .;
     77 .F GMRCV="GMRCSGNM","GMRCNMDT","GMRCTIT","GMRCMODE" D
     78 ..S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCV))
     79 .;
     80 . F GMRCV="GMRCCSDT","GMRCCTIT","GMRCCSGM","GMRCCSIG" D
     81 .. S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCV))
     82 .S GMRCNDX=$O(^TMP("GMRC",$J,"OUTPUT","RES"," "),-1)+1
     83 .I $L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Addendum #"_GMRCADD_" To Consult Note #"_GMRCR0_" for "_GMRCRPT_" continued.")
     84 .I '$L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Addendum #"_GMRCADD_" To Consult Note #"_GMRCR0_" continued.")
     85 .D SUB("H","RES",GMRCNDX," ")
     86 .I $L($G(GMRCSGNM)) D
     87 ..D SUB("F","RES",GMRCNDX," ")
     88 ..I (GMRCMODE="electronic") S GMRCX=" Addendum Signature: "_GMRCSGNM_" /es/ "_$$EXDT($G(GMRCNMDT))
     89 ..I '(GMRCMODE="electronic") S GMRCX=" Addendum Author: "_GMRCSGNM S:$L($G(GMRCNMDT)) GMRCX=GMRCX_" Last edited: "_$$EXDT(GMRCNMDT)
     90 ..D SUB("F","RES",GMRCNDX,GMRCX)
     91 ..D:$L($G(GMRCTIT)) SUB("F","RES",GMRCNDX,"                     "_GMRCTIT)
     92 .I $L($G(GMRCCSDT)) D
     93 ..D SUB("F","RES",GMRCNDX," ")
     94 ..I (GMRCCSGM="electronic") S GMRCX=" Addendum CoSignature: "_GMRCCSIG_" /es/ "_$$EXDT(GMRCCSDT)
     95 ..I '(GMRCCSGM="electronic") S GMRCX=" Addendum CoSignature: "_GMRCCSIG_" /chart/ "_$$EXDT(GMRCCSDT)
     96 ..D SUB("F","RES",GMRCNDX,GMRCX)
     97 ..D:$L($G(GMRCCTIT)) SUB("F","RES",GMRCNDX,"                       "_GMRCCTIT)
     98 .D BLD("RES",GMRCNDX,1,0," ")
     99 .I $L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("ADDENDUM #"_GMRCADD_" TO CONSULT NOTE #"_GMRCR0_" FOR "_GMRCRPT))
     100 .I '$L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("ADDENDUM #"_GMRCADD_" TO CONSULT NOTE #"_GMRCR0))
     101 .D BLD("RES",GMRCNDX,1,0," ")
     102 .S GMRCR1=0 F  S GMRCR1=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCR1)) Q:'GMRCR1  D
     103 ..D BLD("RES",GMRCNDX,1,0,$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCR1,0)))
     104 Q
     105 ;
     106HDR ; Header code for form 513
     107 ;
     108 N PG,GMRCFROM
     109 ;
     110 F PG=0,1 D
     111 .D BLD("HDR",PG,1,0,GMRCDVL)
     112 .D BLD("HDR",PG,1,6,"MEDICAL RECORD")
     113 .D BLD("HDR",PG,0,29,"|")
     114 .D BLD("HDR",PG,0,36,"CONSULTATION SHEET")
     115 .I PG D BLD("HDR",PG,0,60,"Page ","GMRCPG,65") I 1
     116 .E  I '$G(GMRCGUI) D BLD("HDR",PG,0,60,"Page ","GMRCPG,65")
     117 .;
     118 .D BLD("HDR",PG,1,0,GMRCDVL)
     119 .D BLD("HDR",PG,1,0,"Consult Request: "_$$CONSRQ(GMRCIFN))
     120 .D BLD("HDR",PG,0,55,"|Consult No.: "_GMRCIFN)
     121 .;
     122 D BLD("HDR",1,1,0,GMRCEQL)
     123 D BLD("HDR",0,1,0,GMRCDVL)
     124 ;
     125 I $G(CMT) D BLD("HDR",0,1,27,"("_$$PRCMT^GMRCP5B(CMT)_")") Q
     126 ;
     127 S GMRCFROM=$P($G(^SC(+$P(GMRCRD,U,6),0)),U,1)
     128 ;
     129 I '$L(GMRCFROM) D
     130 .N VAIN
     131 .D INP^VADPT
     132 .S GMRCFROM=$P($G(VAIN(4)),U,2)
     133 .I $L($G(VAIN(5))) S GMRCFROM=GMRCFROM_" (Rm/Bd: "_$G(VAIN(5))_" )"
     134 ;No location, IFC - consulting site
     135 I '$L(GMRCFROM),$P(GMRCRD,U,23),$P($G(GMRCRD(12)),U,5)="F" D
     136 .I $P(GMRCRD,U,21) S GMRCFROM=$$GET1^DIQ(4,$P(GMRCRD,U,21),.01)
     137 .E  S GMRCFROM=$$GET1^DIQ(4,$P(GMRCRD,U,23),.01)
     138 ;
     139 D BLD("HDR",0,1,0,"To: "_$P($G(^GMR(123.5,+$P(GMRCRD,U,5),0)),U,1))
     140 D BLD("HDR",0,1,5,"From: "_GMRCFROM)
     141 D BLD("HDR",0,0,49,"|Requested: "_$$EXDT($P(GMRCRD,U,7)))
     142 ;
     143 D BLD("HDR",0,1,0,GMRCDVL)
     144 D BLD("HDR",0,1,0,"Requesting Facility: "_$E(GMRCFAC,1,22))
     145 I $P(GMRCRD,U,11) D BLD("HDR",0,0,45,"|ATTENTION: "_$E($P($G(^VA(200,+$P(GMRCRD,U,11),0)),U,1),1,21))
     146 I $P(GMRCRD,U,23) D
     147 . D BLD("HDR",0,1,0,"Remote Consult No.: "_GMRCINO)
     148 . D BLD("HDR",0,1,0,"Role: "_GMRCIRL)
     149 D BLD("HDR",0,1,0,GMRCEQL)
     150 ;
     151 Q
     152 ;
     153CENTER(X) ;
     154 ;
     155 N TEXT,COL
     156 S COL=35-($L(X)\2) Q:(COL<1) X
     157 S $E(TEXT,COL)=X
     158 Q TEXT
     159 ;
     160BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ;
     161 ;
     162 Q:'$L($G(SUB))
     163 N LINECNT
     164 ;
     165 F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
     166 ;
     167 S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
     168 I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
     169 ;
     170 S GMRCLAST=SUB
     171 Q
     172 ;
     173SUB(ZONE,SUB,NDX,TEXT) ;
     174 ;
     175 N NEXT
     176 S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
     177 S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
     178 Q
     179 ;
     180LASTLN(SUB,NDX) ;
     181 Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
     182 ;
     183CONSRQ(IFN) ;
     184 ;
     185 N PTR,LINK,REF,GMRCRQ
     186 I +$P(^GMR(123,+IFN,0),U,8) D
     187 . S GMRCRQ=$P(^GMR(123,+IFN,0),U,8)
     188 . S GMRCRQ=$$GET1^DIQ(123.3,+GMRCRQ,.01)
     189 . I '$L(GMRCRQ) S GMRCRQ="Procedure"
     190 I $L($G(GMRCRQ)) Q GMRCRQ
     191 I $L($G(^GMR(123,IFN,1.11))) D
     192 . N SERV,TYPE
     193 . S SERV=$$UP^XLFSTR($$GET1^DIQ(123.5,$P(^GMR(123,IFN,0),U,5),.01))
     194 . S TYPE=$$UP^XLFSTR(^GMR(123,IFN,1.11)) I TYPE'=SERV D
     195 . I TYPE'=SERV S GMRCRQ=$E(^GMR(123,IFN,1.11),1,36)
     196 Q:$L($G(GMRCRQ)) GMRCRQ Q "Consult"
     197 ;
     198EXDT(X) ;EXTERNAL DATE FORMAT
     199 ;
     200 N DATE,TIME,HR,MN,PD,Y,%DT
     201 Q:'$L(X) ""
     202 I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y
     203 Q $$FMTE^XLFDT(X,"5PMZ")
     204 ;
  • WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL7.m

    r613 r623  
    1 GMRCSTL7        ;SLC/JFR/WAT - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28
    2         ;;3.0;CONSULT/REQUEST TRACKING;**41,60**;DEC 27, 1997;Build 9
    3         ;
    4         ;This routine invokes ICRs
    5         ;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),3744(VADPT),10089(%ZISC),10026(DIR)
    6         Q
    7         ;
    8 EN      ; start here
    9         K GMRCQUT
    10         N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
    11         N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
    12         N GMRC30ST,GMRC30SP
    13         D CAVEATS
    14         ;Ask for service
    15         S DIR(0)="P^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
    16         S DIR("A")="Select Service/Specialty"
    17         D ^DIR
    18         I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
    19         S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
    20          ;Ask for current FY
    21         N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCFY
    22         S DIR(0)="F^4:4^K:(X-1700)>($E(DT,1,3)+1) X"
    23         S DIR("A")="Current Fiscal Year (i.e. 2008)"
    24         S DIR("A",1)="Ensure you are providing fiscal year, NOT calendar year."
    25         D ^DIR
    26         I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
    27         S GMRCFY=X
    28         N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCQTR,GMRCYR
    29         S DIR(0)="N^1:4"
    30         S DIR("A")="Enter a number 1 - 4"
    31         S DIR("A",1)="For which quarter are you running the report: first, second, third or fourth?"
    32         D ^DIR
    33         I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
    34         S GMRCQTR=X
    35         ;if first quarter
    36         I $G(GMRCQTR)=1 D
    37         .;use FY-1 to set year part of date range to the previous calendar year
    38         .S GMRCYR=$G(GMRCFY)-1700 S GMRCYR=$G(GMRCYR)-1,GMRCDT1=$E($G(GMRCYR),1,3)_"1001" S GMRCDT2=$G(GMRCYR)_"1231"
    39         I $G(GMRCQTR)=2 D
    40         .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0101" S GMRCDT2=$G(GMRCYR)_"0331"
    41         I $G(GMRCQTR)=3 D
    42         .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0401" S GMRCDT2=$G(GMRCYR)_"0630"
    43         I $G(GMRCQTR)=4 D
    44         .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0701" S GMRCDT2=$G(GMRCYR)_"0930"
    45         S GMRC30ST=$$FMADD^XLFDT(GMRCDT1,-30),GMRC30SP=$$FMADD^XLFDT(GMRCDT2,-30)
    46         ; what type of report
    47         N DIROUT,DTOUT,DUOUT,DIR,Y,X
    48         S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
    49         D ^DIR
    50         I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
    51         S GMRCFMT=$S(Y="S":"CP",1:"DEL")
    52         ;
    53         W @IOF
    54         S GMRCSAVE("GMRCFMT")=""
    55         S GMRCSAVE("GMRCDG")=""
    56         S GMRCSAVE("GMRCDT1")=""
    57         S GMRCSAVE("GMRCDT2")=""
    58         S GMRCSAVE("GMRC30ST")=""
    59         S GMRCSAVE("GMRC30SP")=""
    60         S GMRCSAVE("GMRCSVNM")=""
    61         S GMRCSAVE("GMRCFY")=""
    62         S GMRCSAVE("GMRCQTR")=""
    63         ;
    64         N DIROUT,DTOUT,DUOUT,DIR,Y,X S DIR(0)="FO",DIR("A")="ENTER ""?"" FOR MORE HELP OR RETURN TO CONTINUE"
    65         S DIR("A",1)="MARGIN WIDTH IS BEST AT 256"
    66         S DIR("?")="^D MARGHLP^GMRCSTL7"
    67         D:GMRCFMT="DEL" ^DIR
    68         I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D EXIT Q
    69         D EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE)
    70         ;
    71         D EXIT
    72         ;
    73         Q
    74 MARGHLP ;help text to set margins
    75         W !,"Specify a device with optional parameters in the format"
    76         W !,?8,"Device Name;Right Margin;Page Length"
    77         W !,?21,"or"
    78         W !,?5,"Device Name;Subtype;Right Margin;Page Length"
    79         W !!,"Or in the new format"
    80         W !,?14,"Device Name;/settings"
    81         W !,?21,"or"
    82         W !,?10,"Device Name;Subtype;/settings"
    83         W !,"For example"
    84         W !,?17,"HOME;80;999"
    85         W !,?21,"or"
    86         W !,?13,"HOME;C-VT320;/M80L999"
    87         Q
    88         ;
    89 ENOR(RETURN,GMRCSVC,GMRC30ST,GMRC30SP,GMRCSTAT,GMRCST2,GMRCARRN)        ;Entry point
    90         ;.RETURN:   This is the root to the returned temp array.
    91         ;GMRCSVC:  Service for which consults are to be displayed.
    92         ;GMRC30ST:  30 days prior to quarter start date
    93         ;GMRC30SP:  30 days prior to quarter end date
    94         ;GMRCSTAT: The list of status to include separated by commas
    95         ;GMRCARRN: Format of report becomes ^TMP array element
    96         ;          "CP": Summary Report; "DEL": Delimited Report
    97         ;
    98         ;This temp array is used internally by the report:
    99         ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
    100         ;  status is "" tracking and/or grouper
    101         ;            1  grouper only
    102         ;            2  tracking only
    103         ;            9  disabled
    104         ;
    105         N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK
    106         K ^TMP("GMRCR",$J,GMRCARRN)
    107         S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
    108         I '($D(GMRCSVC)#2) S GMRCSVC=1
    109         Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
    110         ;Build service array
    111         S GMRCDG=GMRCSVC
    112         D SERV1^GMRCASV
    113         ;Get external form of date range
    114         D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
    115         ;
    116         N GMRCDA,INDEX,STATUS,STATUS2,LOOP,GROUPER
    117         N GMRCSVCG,GMRCPT,GMRCSVCP,GRP,PIECE,TYPE
    118         ;
    119         K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCT",$J)
    120         ;
    121         S GROUPER=0
    122         S GROUPER(0)=0
    123         I GMRCARRN="DEL" D
    124         . N STR
    125         . S STR="Svc;30DayRng;60DayRng;CmpIn30;Cmp31-60;B4Qtr;PndB4Qtr;%Cmp30;%Cmp60;%UnRsB4Qtr;IS30Rng;IS60Rng;ISCmp30;ISCmp31-60;ISB4Qtr;ISPndB4Qtr;%ISCmp30;%ISCmp60;%ISUnRsB4Qtr;"
    126         . S STR=STR_"IR30Rng;IR60Rng;IRCmp30;IRCmp31-60;IRB4Qtr;IRPndB4Qtr;%IRCmp30;%IRCmp60;%IRUnRsB4Qtr"
    127         . S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR
    128         S INDEX=""
    129         ;Loop on Service
    130         F  S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX=""  D
    131         .S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
    132         .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
    133         .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
    134         .N SUBIDX
    135         .;pieces for tmp arrays, 1 to 6 are local, 7 to 12 are IFC placer, 13 to 18 are IFC filler
    136         .;;total for 30 day start/end^total for 60 day start/end^results n 30 days^results n 60 days^total before quarter^total pending before quarter
    137         .S ^TMP("GMRCT",$J,1,GMRCSVC,"DATA")="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
    138         .S ^TMP("GMRCT",$J,2,GMRCSVC,"DATA")="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
    139         .;Check if starting a new Grouper
    140         .F  Q:GROUPER(GROUPER)=GMRCSVCG  D
    141         ..;End of a group so print the group totals
    142         ..I GROUPER(GROUPER)=GMRCSVCG D
    143         ... I GMRCARRN="CP" D
    144         ....D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
    145         ...I GMRCARRN="DEL" D
    146         ....D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
    147         ..;pop grouper from stack
    148         ..S GROUPER=GROUPER-1
    149         .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
    150         ..;push new grouper on stack
    151         ..S GROUPER=GROUPER+1
    152         ..S GROUPER(GROUPER)=GMRCSVC
    153         .;Loop for one status at a time
    154         .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
    155         ..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRC30ST,GMRC30SP,"30")
    156         .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
    157         ..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,$$FMADD^XLFDT(GMRC30ST,-30),$$FMADD^XLFDT(GMRC30SP,-30),"60")
    158         .S GMRCDT1=$$FMADD^XLFDT(GMRC30ST,30) ;add 30 days back to set date back to start of FY quarter.
    159         .F LOOP=1:1:$L(GMRCST2,",") S STATUS2=$P(GMRCST2,",",LOOP) D
    160         ..D ONESTAT2^GMRCSTL8(GMRCARRN,INDEX,STATUS2,$$FMADD^XLFDT(GMRCDT1,-60))
    161         .F GRP=GROUPER:-1:1 D
    162         ..F PIECE=1:1:18 D
    163         ...S $P(^TMP("GMRCT",$J,2,GROUPER(GRP),"DATA"),U,PIECE)=$P(^TMP("GMRCT",$J,2,GROUPER(GRP),"DATA"),U,PIECE)+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,PIECE)
    164         .;
    165         .;Print the totals for this service that are >0
    166         .I GMRCARRN="CP" D
    167         ..D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
    168         .I GMRCARRN="DEL" D
    169         ..D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
    170         .Q
    171         ;
    172         ;Done, so now list the group totals for the top group
    173         ;F GROUPER=GROUPER:-1:1 D  ; left for looking at all totals in future
    174         I $G(GROUPER) S GROUPER=1 D
    175         .I GMRCARRN="CP" D
    176         ..D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
    177         .I GMRCARRN="DEL" D
    178         ..D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
    179         Q
    180 PRNTQ     ;Build report and print it
    181         ;
    182         N GMRCPG,GMRCTMP,IDX,GMRCQUT,TEMP
    183         S GMRCPG=1
    184         D SERV1^GMRCASV
    185         D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
    186         S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
    187         S TEMP="Consult/Request Performance Monitor - "_TEMP
    188         W $J("",40-($L(TEMP)/2)+.5)_TEMP
    189         S TEMP="Fiscal Quarter Dates: "_$$FMTE^XLFDT(GMRCDT1)_" - "_$$FMTE^XLFDT(GMRCDT2)
    190         W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
    191         S TEMP="30 Days Before Start/End: "_$$FMTE^XLFDT(GMRC30ST)_" - "_$$FMTE^XLFDT(GMRC30SP)
    192         W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
    193         S TEMP="60 Days Before Start/End: "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30ST,-30))_" - "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30SP,-30))
    194         W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
    195         I '$D(IO("Q")) D WAIT^DICD W !!
    196         I '$O(^TMP("GMRCSLIST",$J,0)) D  G EXIT
    197         .W !!,"No records to print"
    198         D ENOR^GMRCSTL7(.GMRCTMP,GMRCDG,GMRC30ST,GMRC30SP,"2,5,6,8,9","1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99",GMRCFMT)
    199         I '$D(^TMP("GMRCR",$J,GMRCFMT)) D
    200         .W !!,"No records to print",!
    201         S IDX=""
    202         F  S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT))  D
    203         .I IOSL-$Y<3 D
    204         ..I $E(IOST,1,2)["C-" D
    205         ...N DIR S DIR(0)="E" D ^DIR
    206         ...I 'Y S GMRCQUT=1
    207         ..Q:$G(GMRCQUT)
    208         ..D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
    209         .Q:$G(GMRCQUT)
    210         .W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
    211         D:$D(^TMP("GMRCR",$J,GMRCFMT)) CAVEATS
    212         I GMRCFMT="CP",'$G(GMRCQUT) D
    213         .Q:$O(^TMP("GMRCT",$J,0,""))=""
    214         .I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
    215         .W !!!,$$REPEAT^XLFSTR("-",IOM-5)
    216         .W !,"Consult services not meeting the criteria of this report for",!,"the specified date range:",!
    217         .S IDX=""
    218         .F  S IDX=$O(^TMP("GMRCT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT))  D
    219         ..I IOSL-$Y<3 D
    220         ...I $E(IOST,1,2)["C-" D
    221         ....N DIR S DIR(0)="E" D ^DIR
    222         ....I 'Y S GMRCQUT=1
    223         ...Q:$G(GMRCQUT)
    224         ...D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
    225         ..Q:$G(GMRCQUT)
    226         ..W ?4,IDX,!
    227         D ^%ZISC
    228         D EXIT
    229         Q
    230         ;
    231 HEAD(PAGE)      ; print header for CPM
    232         W @IOF
    233         I PAGE>1 D
    234         .S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
    235         .S TEMP="Consult/Request Performance Monitor - "_TEMP
    236         .W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
    237         W !,$J("Run Date: "_$$HTE^XLFDT($H),0),$J("Page: "_PAGE,48)
    238         W !,$$REPEAT^XLFSTR("-",IOM-2),!!
    239         Q
    240         ;
    241 CAVEATS ; brief explanatory text
    242         W !!,"Resubmitted requests are evaluated based on the original Date of Request."
    243         W !!,"The following are excluded from this report:"
    244         W !," -Requests sent to test patients."
    245         W !," -Requests not marked as Outpatient in the REQUEST/CONSULTATION file."
    246         W !," -Services flagged as part of the interface between Consults/Request Tracking"
    247         W !,?2,"and Prosthetics."
    248         W !," -Administrative requests flagged via the Administrative fields in the"
    249         W !,?2,"REQUEST SERVICES and REQUEST/CONSULTATION files. This is not retroactive"
    250         W !,?2,"and only applies to services/requests leveraging the Administrative-flagging"
    251         W !,?2,"capability included in GMRC*3.0*60, available on or about June 2008.",!!
    252         Q
    253         ;
    254 EXIT    F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCT" K ^TMP(ARR,$J)
    255         K ARR
    256         Q
    257         ;
     1GMRCSTL7 ;SLC/JFR - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28
     2 ;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997
     3 ;
     4 Q
     5 ;
     6EN ; start here
     7 K GMRCQUT
     8 N DIROUT,DTOUT,DUOUT,DIR,DIRUT,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
     9 N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
     10 ;
     11 ;Ask for service
     12 N Y
     13 S DIR(0)="PO^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
     14 S DIR("A")="Select Service/Specialty"
     15 D ^DIR
     16 I Y<1 Q
     17 S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
     18 ;
     19 ;Ask for date range
     20 D ^GMRCSPD
     21 I $D(GMRCQUT) G EXIT
     22 ;
     23 ; what type of report
     24 K DIR,X,Y
     25 S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
     26 D ^DIR
     27 I Y="" G EXIT
     28 S GMRCFMT=$S(Y="S":"CP",1:"DEL")
     29 ;
     30 W @IOF
     31 S GMRCSAVE("GMRCFMT")=""
     32 S GMRCSAVE("GMRCDG")=""
     33 S GMRCSAVE("GMRCDT1")=""
     34 S GMRCSAVE("GMRCDT2")=""
     35 S GMRCSAVE("GMRCSVNM")=""
     36 ;
     37 D EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE)
     38 ;
     39 D EXIT
     40 ;
     41 Q
     42 ;
     43ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN) ;Entry point
     44 ;.RETURN:   This is the root to the returned temp array.
     45 ;GMRCSVC:  Service for which consults are to be displayed.
     46 ;GMRCDT1:  Starting date or "ALL"
     47 ;GMRCDT2:  Ending date if not GMRCDT1="ALL"
     48 ;GMRCSTAT: The list of status to include separated by commas
     49 ;GMRCARRN: Format of report becomes ^TMP array element
     50 ;          "CP": Summary Report; "DEL": Delimited Report
     51 ;
     52 ;This temp array is used internally by the report:
     53 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
     54 ;  status is "" tracking and/or grouper
     55 ;            1  grouper only
     56 ;            2  tracking only
     57 ;            9  disabled
     58 ;
     59 N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK
     60 K ^TMP("GMRCR",$J,GMRCARRN)
     61 S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
     62 I '($D(GMRCSVC)#2) S GMRCSVC=1
     63 Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
     64 ;Build service array
     65 S GMRCDG=GMRCSVC
     66 D SERV1^GMRCASV
     67 ;Get external form of date range
     68 I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
     69 S:GMRCDT1="ALL" GMRCDT2=0
     70 D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
     71 ;
     72 N GMRCDA,INDEX,STATUS,LOOP,GROUPER
     73 N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP
     74 N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
     75 N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
     76 ;
     77 K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
     78 ;
     79 S GROUPER=0
     80 S GROUPER(0)=0
     81 I GMRCARRN="DEL" D
     82 . N STR
     83 . S STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;"
     84 . S STR=STR_"%Comp w/Results"
     85 . S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR
     86 S INDEX=""
     87 ;Loop on Service
     88 F  S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX=""  D
     89 .S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
     90 .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
     91 .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
     92 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0
     93 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0
     94 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=0
     95 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=0
     96 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0
     97 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0
     98 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"R")=0
     99 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"C")=0
     100 . ;Check if starting a new Grouper
     101 . F  Q:GROUPER(GROUPER)=GMRCSVCG  D
     102 ..;End of a group so print the group totals
     103 ..I GROUPER(GROUPER)=GMRCSVCG D
     104 ... I GMRCARRN="CP" D
     105 .... D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
     106 ... I GMRCARRN="DEL" D
     107 .... D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
     108 ..;pop grouper from stack
     109 ..S GROUPER=GROUPER-1
     110 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
     111 ..;push new grouper on stack
     112 ..S GROUPER=GROUPER+1
     113 ..S GROUPER(GROUPER)=GMRCSVC
     114 .;Loop for one status at a time
     115 .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
     116 .. D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2)
     117 .F GRP=GROUPER:-1:1 D
     118 ..;  pending for this service to all of its groupers
     119 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P")
     120 .. ; completed w/results for all groupers
     121 .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"R")
     122 ..;  for all status for this service to all of its groupers
     123 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T")
     124 .. ; add all completed for all groupers
     125 .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"C")
     126 .;
     127 .;Print the totals for this service that are >0
     128 . I GMRCARRN="CP" D
     129 .. D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
     130 . I GMRCARRN="DEL" D
     131 .. D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
     132 . Q
     133 ;
     134 ;Done, so now list the group totals for the top group
     135 ;F GROUPER=GROUPER:-1:1 D  ; left for looking at all totals in future
     136 I $G(GROUPER) S GROUPER=1 D
     137 . I GMRCARRN="CP" D
     138 .. D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
     139 . I GMRCARRN="DEL" D
     140 .. D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
     141 Q
     142 ;
     143PRNTQ   ;Build report and print it
     144 ;
     145 N GMRCPG,GMRCTMP,IDX,GMRCQUT,TEMP
     146 S GMRCPG=1
     147 D SERV1^GMRCASV
     148 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
     149 W !,$J("",23)_"Consult/Request Performance Monitor"
     150 S TEMP="FROM: "_$$FMTE^XLFDT(GMRCDT1)_"  TO: "_$$FMTE^XLFDT(GMRCDT2)
     151 I GMRCDT1="ALL" S TEMP="ALL DATES"
     152 W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
     153 I '$O(^TMP("GMRCSLIST",$J,0)) D  G EXIT
     154 . W !!,"No records to print"
     155 D ENOR^GMRCSTL7(.GMRCTMP,GMRCDG,GMRCDT1,GMRCDT2,"5,6,8,2,9",GMRCFMT)
     156 I '$D(^TMP("GMRCR",$J,GMRCFMT)) D
     157 . W !!,"No records to print",!
     158 S IDX=""
     159 F  S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT))  D
     160 . I IOSL-$Y<3 D
     161 .. I $E(IOST,1,2)["C-" D
     162 ... N DIR S DIR(0)="E" D ^DIR
     163 ... I 'Y S GMRCQUT=1
     164 .. Q:$G(GMRCQUT)
     165 .. D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
     166 . Q:$G(GMRCQUT)
     167 . W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
     168 I GMRCFMT="CP",'$G(GMRCQUT) D
     169 . Q:$O(^TMP("GMRCTOT",$J,0,""))=""
     170 . I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
     171 . W !!!,$$REPEAT^XLFSTR("-",IOM-5)
     172 . W !,"Consult services with no activity meeting the criteria of this report in",!,"the specified date range:",!
     173 . S IDX=""
     174 . F  S IDX=$O(^TMP("GMRCTOT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT))  D
     175 .. I IOSL-$Y<3 D
     176 ... I $E(IOST,1,2)["C-" D
     177 .... N DIR S DIR(0)="E" D ^DIR
     178 .... I 'Y S GMRCQUT=1
     179 ... Q:$G(GMRCQUT)
     180 ... D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
     181 .. Q:$G(GMRCQUT)
     182 .. W ?4,IDX,!
     183 D ^%ZISC
     184 D EXIT
     185 Q
     186 ;
     187HEAD(PAGE) ; print header for CPM
     188 W @IOF
     189 W "Consult Performance Monitor",?40,$$HTE^XLFDT($H)
     190 W ?73,"Page: ",PAGE,!
     191 W $$REPEAT^XLFSTR("-",IOM-2),!
     192 Q
     193 ;
     194EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCTOT" K ^TMP(ARR,$J)
     195 K ARR
     196 Q
     197 ;
  • WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL8.m

    r613 r623  
    1 GMRCSTL8        ;SLC/JFR/WAT - Totals format for CPM ; 4/05/05 10:39
    2         ;;3.0;CONSULT/REQUEST TRACKING;**41,60**;DEC 27, 1997;Build 9
    3         ; This routine invokes ICRs
    4         ; 875 (file 100.01), 2638 (file 100.01),10104 (XLFSTR),10103 (XLFDT),3744 (VADPT)
    5         ;
    6         ; portions copied from GMRCSTL1 & GMRCSTL2
    7         Q  ; can't start here
    8 PRTTOT(GEN,INDEX,NAME,ARRN)     ; totals for printed report
    9         N QUIT S QUIT=0 D NOACTVT Q:QUIT=1
    10         N GMRCPCT,LAYOUT,FRMT,ROWTEXT,CALC1,CALC2,CALC3,ROWTXT
    11         N COUNT,SVCUSG
    12         S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1)
    13         I GEN=2 D
    14         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=""
    15         .S SVCUSG=$P(^GMR(123.5,INDEX,0),U,2) I $G(SVCUSG) S NAME=NAME_$S(SVCUSG=1:" <grouper only>",SVCUSG=2:"   <disabled>",1:"")
    16         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="     GROUPER: "_NAME_" Totals:"
    17         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("WITHIN     IFC     IFC",75)
    18         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("FACILITY   SENT    REC'D",77)
    19         I GEN=1 D
    20         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=" "
    21         .I $P(^GMR(123.5,INDEX,0),U,2)=9 S NAME=NAME_"   <disabled>"
    22         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="SERVICE: "_NAME
    23         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("WITHIN     IFC      IFC",76)
    24         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("FACILITY   SENT     REC'D",78)
    25         .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U),8)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,7),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,13),9)
    26         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 30 Days Before Start/End of Qtr:"_ROWTXT
    27         .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,2),8)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,8),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,14),9)
    28         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 60 Days Before Start/End of Qtr:"_ROWTXT
    29         I GEN=2 D
    30         .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U),8)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,7),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,13),9)
    31         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 30 Days Before Start/End of Qtr:"_ROWTXT
    32         .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,2),8)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,8),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,14),9)
    33         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 60 Days Before Start/End of Qtr:"_ROWTXT
    34         I GEN=1!(GEN=2) D
    35         .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,3),12)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,9),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,15),9)
    36         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="Complete with Results in 30 Days of Request:"_ROWTXT
    37         .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,4),12)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,10),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,16),9)
    38         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="Complete with Results 31-60 Days of Request:"_ROWTXT
    39         .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,5),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,11),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,17),9)
    40         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests Created 60 Days Before Qtr Start:"_ROWTXT
    41         .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,6),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,12),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,18),9)
    42         .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests Pending 60 Days Before Qtr Start:"_ROWTXT
    43         .;% complete in 30 days of request
    44         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U)>0 S CALC1=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,3)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U))*100,2,2)_"%"
    45         .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)
    46         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,7)>0 S CALC2=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,9)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,7))*100,2,2)_"%"
    47         .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)
    48         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,13)>0 S CALC3=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,15)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,13))*100,2,2)_"%"
    49         .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)
    50         .S COUNT=COUNT+1
    51         .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Complete w/Results in 30 Days of Request: "_ROWTXT
    52         .;% complete in 60 days of request
    53         .K CALC1,CALC2,CALC3
    54         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,2)>0 S CALC1=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,4)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,2))*100,2,2)_"%"
    55         .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)
    56         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,8)>0 S CALC2=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,10)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,8))*100,2,2)_"%"
    57         .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)
    58         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,14)>0 S CALC3=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,16)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,14))*100,2,2)_"%"
    59         .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)
    60         .S COUNT=COUNT+1
    61         .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Complete w/Results 31-60 Days of Request: "_ROWTXT
    62         .;% pending before quarter start
    63         .K CALC1,CALC2,CALC3
    64         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,5)>0 S CALC1=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,6)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,5))*100,2,2)_"%"
    65         .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)
    66         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,11)>0 S CALC2=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,12)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,11))*100,2,2)_"%"
    67         .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)
    68         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,17)>0 S CALC3=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,18)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,17))*100,2,2)_"%"
    69         .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)
    70         .S COUNT=COUNT+1
    71         .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Still Pending Created Before Qtr Start:   "_ROWTXT
    72         Q
    73 DELTOT(GEN,INDEX,NAME,ARRN)     ; format for delimited
    74         N QUIT S QUIT=0 D NOACTVT Q:QUIT=1
    75         N STRING,COUNT,PIECE,INCR,SVCUSG
    76         S SVCUSG=$P(^GMR(123.5,INDEX,0),U,2) I $G(SVCUSG) S NAME=NAME_$S(SVCUSG=1:" <grouper only>",SVCUSG=2:" <disabled>",1:"")
    77         S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1),STRING=$S(GEN=2:"GROUPER: ",1:"")_NAME_";"
    78         F PIECE=1:1:18 D
    79         .S STRING=STRING_$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,PIECE)_";"
    80         .I PIECE=6!(PIECE=12)!(PIECE=18) D
    81         ..S INCR=$S(PIECE=6:0,PIECE=12:6,1:12)
    82         ..;percents
    83         ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(1+INCR))=0 S STRING=STRING_"N/A;"
    84         ..E  S GMRCPCT=($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(3+INCR))/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(1+INCR)))*100,STRING=STRING_$J(GMRCPCT,0,2)_";"
    85         ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(2+INCR))=0 S STRING=STRING_"N/A;"
    86         ..E  S GMRCPCT=($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(4+INCR))/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(2+INCR)))*100,STRING=STRING_$J(GMRCPCT,0,2)_";"
    87         ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(5+INCR))=0 S STRING=STRING_"N/A;"
    88         ..E  S GMRCPCT=($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(6+INCR))/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(5+INCR)))*100,STRING=STRING_$J(GMRCPCT,0,2)_";"
    89         S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=STRING
    90         Q
    91 NOACTVT ;services with no activity for the reporting period
    92         N CONT,PIECE S CONT=1
    93         I GEN=1&($P(^GMR(123.5,INDEX,0),U,2)=1) S QUIT=1 Q  ;;don't add to list if service is a grouper only...
    94         F PIECE=1:1:18 D  Q:CONT=0
    95         .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,PIECE)>0 S CONT=0 Q
    96         S:CONT=1 ^TMP("GMRCT",$J,0,NAME)="",QUIT=1
    97         Q
    98 ONESTAT(ARRN,SVCN,STAT,DT1,DT2,STR)     ;Process one status
    99         ;Input -- ARRN  "CP"  - to be printed  or "DEL" - in delimited format
    100         ;SVCN = node in ^TMP("GMRCLIST,$J..STAT = status being worked on..DT1 = starting date..DT2 = ending date
    101         ;STR = string value used to store 30/60 day results in correct piece of ^tmp arrays
    102         ;Output - None
    103         N GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP,GMRCQT,FLG,TYPE
    104         S GMRCSVC=$P(^TMP("GMRCSLIST",$J,SVCN),"^",1)
    105         S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,SVCN),"^",2)
    106         S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,SVCN),"^",3)
    107         S GMRCXDT=9999999-DT2-.6  ;start searching the global at a date a fraction newer than DT2 (the end date for this search)
    108         F  S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT)) Q:GMRCXDT=""!(GMRCXDT>(9999999-DT1))  D
    109         .S GMRCPT=0
    110         .;Loop for one consult at a time
    111         .F  S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)) Q:GMRCPT=""  D
    112         ..S FLG=0 D EXCLUDE Q:$G(FLG)=1
    113         ..S TYPE="" D REQTYPE
    114         ..I TYPE="LOCAL" D  ;set totals for 30 and 60 day range
    115         ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U)+1
    116         ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,2)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,2)+1
    117         ...I STAT=2 D
    118         ....Q:'$O(^GMR(123,+$G(GMRCPT),50,0))  ;Q if no results
    119         ....D CHKRNG
    120         ..I TYPE="IFCP" D
    121         ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,7)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,7)+1
    122         ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,8)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,8)+1
    123         ...D:STAT=2 CHKRNG
    124         ..I TYPE="IFCF" D
    125         ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,13)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,13)+1
    126         ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,14)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,14)+1
    127         ...D:STAT=2 CHKRNG
    128         Q
    129         ;
    130 ONESTAT2(ARRN,SVCN,STAT,DT1)    ;all statuses, all requests, before quarter start
    131         ;Input -- ARRN  "CP"  - to be printed or "DEL" - in delimited format
    132         ;SVCN = node in ^TMP("GMRCLIST,$J..STAT = status being worked on..DT1 = 60 days before starting date of current quarter
    133         ;Output -- None
    134         N GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP,FLG,TYPE
    135         S GMRCSVC=$P(^TMP("GMRCSLIST",$J,SVCN),"^",1)
    136         S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,SVCN),"^",2)
    137         S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,SVCN),"^",3)
    138         S GMRCXDT=""
    139         F  S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT)) Q:GMRCXDT=""  D
    140         .S GMRCPT=0
    141         .;Loop for one consult at a time
    142         .F  S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)) Q:GMRCPT=""  D
    143         ..Q:GMRCXDT<(9999999-DT1-.6)  ;
    144         ..S FLG=0 D EXCLUDE Q:$G(FLG)=1
    145         ..S TYPE="" D REQTYPE
    146         ..I TYPE="LOCAL" D
    147         ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,5)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,5)+1
    148         ...; get unresolved requests for the period
    149         ...S:",3,4,5,6,8,9,11,99,"[(","_STAT_",") $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,6)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,6)+1
    150         ..I TYPE="IFCP" D
    151         ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,11)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,11)+1
    152         ...S:",3,4,5,6,8,9,11,99,"[(","_STAT_",") $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,12)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,12)+1
    153         ..I TYPE="IFCF" D
    154         ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,17)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,17)+1
    155         ...S:",3,4,5,6,8,9,11,99,"[(","_STAT_",") $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,18)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,18)+1
    156         Q
    157 REQTYPE  ;If the request is being requested and performed locally, this field will be blank; Placer done elsewhere, Filler done locally
    158         I $P(^GMR(123,$G(GMRCPT),0),U,23)="" S TYPE="LOCAL" Q
    159         I $P(^GMR(123,$G(GMRCPT),0),U,23)'=""&($P($G(^GMR(123,GMRCPT,12)),U,5)="P") S TYPE="IFCP" Q
    160         I $P(^GMR(123,$G(GMRCPT),0),U,23)'=""&($P($G(^GMR(123,GMRCPT,12)),U,5)="F") S TYPE="IFCF" Q
    161         Q
    162 EXCLUDE ;exclude these request types from the count
    163         N PROS
    164         ; Check for bad "AE" x-ref
    165         I '$D(^GMR(123,GMRCPT,0)) D  S FLG=1 Q
    166         .K ^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)
    167         I $$TESTPAT^VADPT(+$P(^GMR(123,GMRCPT,0),U,2)) S FLG=1 Q  ; exclude test pats
    168         D  I $G(PROS) S FLG=1 Q
    169         .N SVC S SVC=$P(^GMR(123,GMRCPT,0),U,5)
    170         .I +$G(^GMR(123.5,SVC,"INT")) S PROS=1 ; exclude PROS consults
    171         I $P($G(^GMR(123,GMRCPT,0)),U,18)'="O" S FLG=1 Q  ; only getting outpat
    172         I $G(^GMR(123,GMRCPT,70))["Y" S FLG=1 Q  ; exclude admin requests
    173         Q
    174 CHKRNG  ;check if request is complete within 30/60 days of Desired Date or Date of Request
    175         N DTOR,DTCMPL S DTOR="",DTCMPL=""
    176         Q:'$O(^GMR(123,+$G(GMRCPT),50,0))&('$O(^GMR(123,+$G(GMRCPT),51,0)))
    177         I $D(^GMR(123,+$G(GMRCPT),60))=1 S DTOR=$P(^GMR(123,+$G(GMRCPT),60),U,1) ;check for desired date CPRS GUI v28
    178         S:$G(DTOR)="" DTOR=$P(^GMR(123,+$G(GMRCPT),0),U,7)
    179         ; if request is completed and has results, was it completed within 30 or 60 days of the Date of Request, field 3 in 123 [0;7]
    180         ;order through activity multiple (40) and find the entry for completed 40, [0:2] - value of 10 is complete/update
    181         N CHK S CHK=0
    182         F  S CHK=$O(^GMR(123,+$G(GMRCPT),40,CHK)) Q:CHK="B"  D
    183         .;get the date/time of completion 40, [0;3]
    184         .I $D(^GMR(123,+$G(GMRCPT),40,CHK,0)) S:($P(^GMR(123,GMRCPT,40,CHK,0),U,2)=10) DTCMPL=$P(^GMR(123,GMRCPT,40,CHK,0),U,3)
    185         I $G(DTCMPL) D
    186         .I (STR="30")&(DTCMPL<=$$FMADD^XLFDT(DTOR,30)) D
    187         ..S:TYPE="LOCAL" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,3)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,3)+1
    188         ..S:TYPE="IFCP" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,9)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,9)+1
    189         ..S:TYPE="IFCF" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,15)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,15)+1
    190         .I STR'="30"&(DTCMPL<=$$FMADD^XLFDT(DTOR,60))&(DTCMPL>$$FMADD^XLFDT(DTOR,30)) D
    191         ..S:TYPE="LOCAL" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,4)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,4)+1
    192         ..S:TYPE="IFCP" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,10)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,10)+1
    193         ..S:TYPE="IFCF" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,16)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,16)+1
    194         Q
     1GMRCSTL8 ;SLC/JFR - Totals format for CPM ; 4/05/05 10:39
     2 ;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997
     3 ; This routine invokes IA #875, #2638
     4 ; This routine invokes IA #10035,#44, #10040
     5 ;
     6 ; portions copied from GMRCSTL1 & GMRCSTL2
     7 ;
     8 Q  ; can't start here
     9 ;
     10PRTTOT(GEN,INDEX,NAME,ARRN) ; totals for printed report
     11 N COUNT
     12 S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1)
     13 I GEN=2 D
     14 . S COUNT=COUNT+1
     15 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)=""
     16 . S COUNT=COUNT+1
     17 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="     GROUPER: "_NAME_" Totals:"
     18 I GEN=1 D
     19 . I ^TMP("GMRCTOT",$J,1,INDEX,"T")=0 D  Q  ;collect zero servs for summ
     20 .. Q:$P(^GMR(123.5,INDEX,0),U,2)=1
     21 .. S ^TMP("GMRCTOT",$J,0,NAME)=""
     22 . S COUNT=COUNT+1
     23 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)=" "
     24 . S COUNT=COUNT+1
     25 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="SERVICE: "_NAME
     26 . S COUNT=COUNT+1
     27 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests To Service:"_$J(^TMP("GMRCTOT",$J,1,INDEX,"T"),30,0)
     28 I GEN=2,^TMP("GMRCTOT",$J,2,INDEX,"T")>0 D
     29 . S COUNT=COUNT+1
     30 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests To Grouper:"_$J(^TMP("GMRCTOT",$J,2,INDEX,"T"),30,0)
     31 I $G(^TMP("GMRCTOT",$J,GEN,INDEX,"T"))>0 D
     32 . S COUNT=COUNT+1
     33 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests Pending Resolution: "_$J(^TMP("GMRCTOT",$J,GEN,INDEX,"P"),21,0)
     34 . S COUNT=COUNT+1
     35 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests completed: "_$J(^TMP("GMRCTOT",$J,GEN,INDEX,"C"),30,0)
     36 . S COUNT=COUNT+1
     37 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests completed with Results: "_$J(^TMP("GMRCTOT",$J,GEN,INDEX,"R"),17,0)
     38 . N GMRCPCT
     39 . I ^TMP("GMRCTOT",$J,GEN,INDEX,"T")=0 S GMRCPCT="N/A"
     40 . I '$D(GMRCPCT) S GMRCPCT=(^TMP("GMRCTOT",$J,GEN,INDEX,"C")/^TMP("GMRCTOT",$J,GEN,INDEX,"T"))*100
     41 . S COUNT=COUNT+1
     42 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percentage of total requests completed: "_$S(+GMRCPCT'=GMRCPCT:$J(GMRCPCT,16),1:($J(GMRCPCT,19,2)_"%"))
     43 . K GMRCPCT
     44 . I ^TMP("GMRCTOT",$J,GEN,INDEX,"C")=0 S GMRCPCT="N/A"
     45 . I '$D(GMRCPCT) S GMRCPCT=(^TMP("GMRCTOT",$J,GEN,INDEX,"R")/^TMP("GMRCTOT",$J,GEN,INDEX,"C"))*100
     46 . S COUNT=COUNT+1
     47 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percentage of total completed requests with results: "_$S(+GMRCPCT'=GMRCPCT:GMRCPCT,1:($J(GMRCPCT,6,2)_"%"))
     48 Q
     49 ;
     50DELTOT(GEN,INDEX,NAME,ARRN) ; format for delimited
     51 ;
     52 I ^TMP("GMRCTOT",$J,GEN,INDEX,"T")=0 Q
     53 N STRING,COUNT
     54 S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1)
     55 S STRING=$S(GEN=2:"GROUPER: ",1:"")_NAME_";"
     56 S STRING=STRING_^TMP("GMRCTOT",$J,GEN,INDEX,"T")_";"
     57 S STRING=STRING_^TMP("GMRCTOT",$J,GEN,INDEX,"P")_";"
     58 S STRING=STRING_^TMP("GMRCTOT",$J,GEN,INDEX,"C")_";"
     59 S STRING=STRING_^TMP("GMRCTOT",$J,GEN,INDEX,"R")_";"
     60 D  ;get % completed
     61 . N GMRCPCT
     62 . S GMRCPCT=(^TMP("GMRCTOT",$J,GEN,INDEX,"C")/^TMP("GMRCTOT",$J,GEN,INDEX,"T"))*100
     63 . S STRING=STRING_$J(GMRCPCT,0,2)_";"
     64 . Q
     65 D  ; get % completed w/results
     66 . I ^TMP("GMRCTOT",$J,GEN,INDEX,"C")=0 S STRING=STRING_"N/A;" Q
     67 . N GMRCPCT
     68 . S GMRCPCT=(^TMP("GMRCTOT",$J,GEN,INDEX,"R")/^TMP("GMRCTOT",$J,GEN,INDEX,"C"))*100
     69 . S STRING=STRING_$J(GMRCPCT,0,2)
     70 . Q
     71 S COUNT=COUNT+1
     72 S ^TMP("GMRCR",$J,ARRN,COUNT,0)=STRING
     73 Q
     74 ;
     75ONESTAT(ARRN,SVCN,STAT,DT1,DT2) ;Process one status
     76 ; Input -- ARRN  "CP"  - to be printed
     77 ;                "DEL" - in delimited format
     78 ;          SVCN = node in ^TMP("GMRCLIST,$J
     79 ;          STAT = status being worked on
     80 ;          DT1 = starting date
     81 ;          DT2 = ending date
     82 ;
     83 ; Output - None
     84 ;
     85 N GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP
     86 S GMRCSVC=$P(^TMP("GMRCSLIST",$J,SVCN),"^",1)
     87 S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,SVCN),"^",2)
     88 S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,SVCN),"^",3)
     89 S GMRCXDT=$S(DT1="ALL":0,1:9999999-DT2-.6)
     90 F  S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT)) Q:GMRCXDT=""!(GMRCXDT>(9999999-DT1))  D
     91 .S GMRCPT=0
     92 .;Loop for one consult at a time
     93 .F  S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)) Q:GMRCPT=""  D
     94 .. N PROS
     95 ..; Check for bad "AE" x-ref
     96 ..I '$D(^GMR(123,GMRCPT,0)) D  Q
     97 ...K ^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)
     98 .. I $$TESTPAT^VADPT(+$P(^GMR(123,GMRCPT,0),U,2)) Q  ; exclude test pats
     99 .. D  I $G(PROS) Q
     100 ... N SVC S SVC=$P(^GMR(123,GMRCPT,0),U,5)
     101 ... I +$G(^GMR(123.5,SVC,"INT")) S PROS=1 ; exclude PROS consults
     102 .. I $P($G(^GMR(123,GMRCPT,12)),U,5)="P" Q  ; exclude IFC placer
     103 ..; Add to totals
     104 ..; for all status for this service
     105 ..S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=^TMP("GMRCTOT",$J,1,GMRCSVC,"T")+1
     106 ..;  pending for this service
     107 ..S:",3,4,5,6,8,9,11,99,"[(","_STAT_",") ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=^TMP("GMRCTOT",$J,1,GMRCSVC,"P")+1
     108 .. I STAT=2 D
     109 ... S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=+$G(^TMP("GMRCTOT",$J,1,GMRCSVC,"C"))+1
     110 ... Q:'$O(^GMR(123,+$G(GMRCPT),50,0))  ; Q if no results
     111 ... S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=+$G(^TMP("GMRCTOT",$J,1,GMRCSVC,"R"))+1
     112 Q
     113 ;
  • 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.