- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
