- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- Location:
- WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT
- Files:
-
- 4 edited
-
GMRCP5D.m (modified) (1 diff)
-
GMRCSTL7.m (modified) (1 diff)
-
GMRCSTL8.m (modified) (1 diff)
-
GMRCSTU.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5D.m
r613 r623 1 GMRCP5D 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 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 ADDEND(GMRCIFN,GMRCR0,GMRCNDX,GMRCRD,PAGEWID) 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 HDR 107 108 109 110 111 112 113 114 115 116 117 118 119 120 .D BLD("HDR",PG,1,55,"|Consult No.: "_GMRCIFN)121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 CENTER(X) 154 155 156 157 158 159 160 BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) 161 162 163 164 165 166 167 168 169 170 171 172 173 SUB(ZONE,SUB,NDX,TEXT) 174 175 176 177 178 179 180 LASTLN(SUB,NDX) 181 182 183 CONSRQ(IFN) 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 EXDT(X) 199 200 201 202 203 204 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**;Dec 27, 1997 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,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 ; 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 ; -
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 ; 1 GMRCSTL7 ;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 ; 6 EN ; 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 ; 43 ENOR(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 ; 143 PRNTQ ;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 ; 187 HEAD(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 ; 194 EXIT 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 1 GMRCSTL8 ;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 ; 10 PRTTOT(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 ; 50 DELTOT(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 ; 75 ONESTAT(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 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**;DEC 27, 1997 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 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 117 STAT ;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" 164 KILL ;kill variables and exit 165 S:$D(GMRCQUT) VALMBCK="Q" 166 K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J) 167 Q 168 PRNT ;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 ; 176 PRNTASK ;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 ; 189 PRNTIT(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 ; 215 PRNTQ ;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.
