Routine: GMRCSTL8

GMRCSTL8 ;SLC/JFR/WAT - Totals format for CPM ;12/10/14  14:17

 ;;3.0;CONSULT/REQUEST TRACKING;**41,60,66,81**;DEC 27, 1997;Build 6

 ; This routine invokes ICRs

 ; 875 (file 100.01), 2638 (file 100.01),10104 (XLFSTR),10103 (XLFDT),3744 (VADPT)

 ; portions copied from GMRCSTL1 & GMRCSTL2

 ;patch 66 - CHKRNG updated location referenced for Clinically Indicated Date (formerly Earliest Appropriate Date) field; this was changed during v28 development.

 Q  ; can't start here

PRTTOT(GEN,INDEX,NAME,ARRN) ; totals for printed report

 N QUIT S QUIT=0 D NOACTVT Q:QUIT=1

 N GMRCPCT,LAYOUT,FRMT,ROWTEXT,CALC1,CALC2,CALC3,ROWTXT

 N COUNT,SVCUSG

 S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1)

 I GEN=2 D

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=""

 .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:"")

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="     GROUPER: "_NAME_" Totals:"

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("WITHIN     IFC     IFC",75)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("FACILITY   SENT    REC'D",77)

 I GEN=1 D

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=" "

 .I $P(^GMR(123.5,INDEX,0),U,2)=9 S NAME=NAME_"   <disabled>"

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="SERVICE: "_NAME

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("WITHIN     IFC      IFC",76)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("FACILITY   SENT     REC'D",78)

 .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)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 30 Days Before Start/End of Qtr:"_ROWTXT

 .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)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 60 Days Before Start/End of Qtr:"_ROWTXT

 I GEN=2 D

 .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)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 30 Days Before Start/End of Qtr:"_ROWTXT

 .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)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 60 Days Before Start/End of Qtr:"_ROWTXT

 I GEN=1!(GEN=2) D

 .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)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="Complete with Results in 30 Days of Request:"_ROWTXT

 .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)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="Complete with Results 31-60 Days of Request:"_ROWTXT

 .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)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests Created 60 Days Before Qtr Start:"_ROWTXT

 .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)

 .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests Pending 60 Days Before Qtr Start:"_ROWTXT

 .;% complete in 30 days of request

 .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)_"%"

 .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)

 .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)_"%"

 .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)

 .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)_"%"

 .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)

 .S COUNT=COUNT+1

 .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Complete w/Results in 30 Days of Request: "_ROWTXT

 .;% complete in 60 days of request

 .K CALC1,CALC2,CALC3

 .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)_"%"

 .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)

 .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)_"%"

 .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)

 .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)_"%"

 .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)

 .S COUNT=COUNT+1

 .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Complete w/Results 31-60 Days of Request: "_ROWTXT

 .;% pending before quarter start

 .K CALC1,CALC2,CALC3

 .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)_"%"

 .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)

 .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)_"%"

 .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)

 .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)_"%"

 .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)

 .S COUNT=COUNT+1

 .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Still Pending Created Before Qtr Start:   "_ROWTXT

DELTOT(GEN,INDEX,NAME,ARRN) ; format for delimited

 N QUIT S QUIT=0 D NOACTVT Q:QUIT=1

 N STRING,COUNT,PIECE,INCR,SVCUSG

 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:"")

 S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1),STRING=$S(GEN=2:"GROUPER: ",1:"")_NAME_";"

 F PIECE=1:1:18 D

 .S STRING=STRING_$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,PIECE)_";"

 .I PIECE=6!(PIECE=12)!(PIECE=18) D

 ..S INCR=$S(PIECE=6:0,PIECE=12:6,1:12)

 ..;percents

 ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(1+INCR))=0 S STRING=STRING_"N/A;"

 ..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)_";"

 ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(2+INCR))=0 S STRING=STRING_"N/A;"

 ..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)_";"

 ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(5+INCR))=0 S STRING=STRING_"N/A;"

 ..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)_";"

 S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=STRING

NOACTVT ;services with no activity for the reporting period

 N CONT,PIECE S CONT=1

 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...

 F PIECE=1:1:18 D  Q:CONT=0

 .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,PIECE)>0 S CONT=0 Q

 S:CONT=1 ^TMP("GMRCT",$J,0,NAME)="",QUIT=1

ONESTAT(ARRN,SVCN,STAT,DT1,DT2,STR) ;Process one status

 ;Input -- ARRN  "CP"  - to be printed  or "DEL" - in delimited format

 ;SVCN = node in ^TMP("GMRCLIST,$J..STAT = status being worked on..DT1 = starting date..DT2 = ending date

 ;STR = string value used to store 30/60 day results in correct piece of ^tmp arrays

 ;Output - None

 N GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP,GMRCQT,FLG,TYPE

 S GMRCSVC=$P(^TMP("GMRCSLIST",$J,SVCN),"^",1)

 S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,SVCN),"^",2)

 S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,SVCN),"^",3)

 S GMRCXDT=9999999-DT2-.6  ;start searching the global at a date a fraction newer than DT2 (the end date for this search)

 F  S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT)) Q:GMRCXDT=""!(GMRCXDT>(9999999-DT1))  D

 .S GMRCPT=0

 .;Loop for one consult at a time

 .F  S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)) Q:GMRCPT=""  D

 ..S FLG=0 D EXCLUDE Q:$G(FLG)=1

 ..S TYPE="" D REQTYPE

 ..I TYPE="LOCAL" D  ;set totals for 30 and 60 day range

 ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U)+1

 ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,2)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,2)+1

 ...I STAT=2 D

 ....Q:'$O(^GMR(123,+$G(GMRCPT),50,0))  ;Q if no results

 ....D CHKRNG

 ..I TYPE="IFCP" D

 ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,7)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,7)+1

 ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,8)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,8)+1

 ...D:STAT=2 CHKRNG

 ..I TYPE="IFCF" D

 ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,13)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,13)+1

 ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,14)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,14)+1

 ...D:STAT=2 CHKRNG

ONESTAT2(ARRN,SVCN,STAT,DT1) ;all statuses, all requests, before quarter start

 ;Input -- ARRN  "CP"  - to be printed or "DEL" - in delimited format

 ;SVCN = node in ^TMP("GMRCLIST,$J..STAT = status being worked on..DT1 = 60 days before starting date of current quarter

 ;Output -- None

 N GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP,FLG,TYPE

 S GMRCSVC=$P(^TMP("GMRCSLIST",$J,SVCN),"^",1)

 S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,SVCN),"^",2)

 S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,SVCN),"^",3)

 S GMRCXDT=""

 F  S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT)) Q:GMRCXDT=""  D

 .S GMRCPT=0

 .;Loop for one consult at a time

 .F  S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)) Q:GMRCPT=""  D

 ..Q:GMRCXDT<(9999999-DT1-.6)  ;

 ..S FLG=0 D EXCLUDE Q:$G(FLG)=1

 ..S TYPE="" D REQTYPE

 ..I TYPE="LOCAL" D

 ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,5)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,5)+1

 ...; get unresolved requests for the period

 ...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

 ..I TYPE="IFCP" D

 ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,11)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,11)+1

 ...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

 ..I TYPE="IFCF" D

 ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,17)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,17)+1

 ...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

REQTYPE  ;If the request is being requested and performed locally, this field will be blank; Placer done elsewhere, Filler done locally

 I $P(^GMR(123,$G(GMRCPT),0),U,23)="" S TYPE="LOCAL" Q

 I $P(^GMR(123,$G(GMRCPT),0),U,23)'=""&($P($G(^GMR(123,GMRCPT,12)),U,5)="P") S TYPE="IFCP" Q

 I $P(^GMR(123,$G(GMRCPT),0),U,23)'=""&($P($G(^GMR(123,GMRCPT,12)),U,5)="F") S TYPE="IFCF" Q

EXCLUDE ;exclude these request types from the count

 N PROS

 ; Check for bad "AE" x-ref

 I '$D(^GMR(123,GMRCPT,0)) D  S FLG=1 Q

 .K ^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)

 I $$TESTPAT^VADPT(+$P(^GMR(123,GMRCPT,0),U,2)) S FLG=1 Q  ; exclude test pats

 D  I $G(PROS) S FLG=1 Q

 .N SVC S SVC=$P(^GMR(123,GMRCPT,0),U,5)

 .I +$G(^GMR(123.5,SVC,"INT")) S PROS=1 ; exclude PROS consults

 I $P($G(^GMR(123,GMRCPT,0)),U,18)'="O" S FLG=1 Q  ; only getting outpat

 I $G(^GMR(123,GMRCPT,70))["Y" S FLG=1 Q  ; exclude admin requests

CHKRNG ;check if request is complete within 30/60 days of Desired Date or Date of Request

 N DTOR,DTCMPL S DTOR="",DTCMPL=""

 Q:'$O(^GMR(123,+$G(GMRCPT),50,0))&('$O(^GMR(123,+$G(GMRCPT),51,0)))

 I $P(^GMR(123,+$G(GMRCPT),0),U,24)>0 S DTOR=$P(^GMR(123,+$G(GMRCPT),0),U,24) ;check for desired date CPRS GUI v28

 S:$G(DTOR)="" DTOR=$P(^GMR(123,+$G(GMRCPT),0),U,7)

 ; 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]

 ;order through activity multiple (40) and find the entry for completed 40, [0:2] - value of 10 is complete/update

 N CHK S CHK=0

 F  S CHK=$O(^GMR(123,+$G(GMRCPT),40,CHK)) Q:CHK="B"  D

 .;get the date/time of completion 40, [0;3]

 .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)

 I $G(DTCMPL) D

 .I (STR="30")&(DTCMPL<=$$FMADD^XLFDT(DTOR,30)) D

 ..S:TYPE="LOCAL" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,3)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,3)+1

 ..S:TYPE="IFCP" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,9)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,9)+1

 ..S:TYPE="IFCF" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,15)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,15)+1

 .I STR'="30"&(DTCMPL<=$$FMADD^XLFDT(DTOR,60))&(DTCMPL>$$FMADD^XLFDT(DTOR,30)) D

 ..S:TYPE="LOCAL" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,4)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,4)+1

 ..S:TYPE="IFCP" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,10)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,10)+1

 ..S:TYPE="IFCF" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,16)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,16)+1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSTL8   14208     printed  Feb 18, 2025@23:13:46                                                                                                                                                                                                   Page 2

GMRCSTL8  ;SLC/JFR/WAT - Totals format for CPM ;12/10/14  14:17

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**41,60,66,81**;DEC 27, 1997;Build 6

 +2       ; This routine invokes ICRs

 +3       ; 875 (file 100.01), 2638 (file 100.01),10104 (XLFSTR),10103 (XLFDT),3744 (VADPT)

 +4       ;

 +5       ; portions copied from GMRCSTL1 & GMRCSTL2

 +6       ;patch 66 - CHKRNG updated location referenced for Clinically Indicated Date (formerly Earliest Appropriate Date) field; this was changed during v28 development.

 +7       ; can't start here

           QUIT

PRTTOT(GEN,INDEX,NAME,ARRN) ; totals for printed report

 +1        NEW QUIT

           SET QUIT=0

           DO NOACTVT

           if QUIT=1

               QUIT

 +2        NEW GMRCPCT,LAYOUT,FRMT,ROWTEXT,CALC1,CALC2,CALC3,ROWTXT

 +3        NEW COUNT,SVCUSG

 +4        SET COUNT=$ORDER(^TMP("GMRCR",$JOB,ARRN," "),-1)

 +5        IF GEN=2

               Begin DoDot:1

 +6                SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)=""

 +7                SET SVCUSG=$PIECE(^GMR(123.5,INDEX,0),U,2)

                   IF $GET(SVCUSG)

                       SET NAME=NAME_$SELECT(SVCUSG=1:" <grouper only>",SVCUSG=2:"   <disabled>",1:"")

 +8                SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="     GROUPER: "_NAME_" Totals:"

 +9                SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)=$JUSTIFY("WITHIN     IFC     IFC",75)

 +10               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)=$JUSTIFY("FACILITY   SENT    REC'D",77)

               End DoDot:1

 +11       IF GEN=1

               Begin DoDot:1

 +12               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)=" "

 +13               IF $PIECE(^GMR(123.5,INDEX,0),U,2)=9

                       SET NAME=NAME_"   <disabled>"

 +14               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="SERVICE: "_NAME

 +15               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)=$JUSTIFY("WITHIN     IFC      IFC",76)

 +16               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)=$JUSTIFY("FACILITY   SENT     REC'D",78)

 +17               SET ROWTXT=$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U),8)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,7),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,13),9)

 +18               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="All Requests in 30 Days Before Start/End of Qtr:"_ROWTXT

 +19               SET ROWTXT=$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,2),8)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,8),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,14),9)

 +20               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="All Requests in 60 Days Before Start/End of Qtr:"_ROWTXT

               End DoDot:1

 +21       IF GEN=2

               Begin DoDot:1

 +22               SET ROWTXT=$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U),8)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,7),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,13),9)

 +23               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="All Requests in 30 Days Before Start/End of Qtr:"_ROWTXT

 +24               SET ROWTXT=$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,2),8)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,8),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,14),9)

 +25               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="All Requests in 60 Days Before Start/End of Qtr:"_ROWTXT

               End DoDot:1

 +26       IF GEN=1!(GEN=2)

               Begin DoDot:1

 +27               SET ROWTXT=$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,3),12)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,9),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,15),9)

 +28               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="Complete with Results in 30 Days of Request:"_ROWTXT

 +29               SET ROWTXT=$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,4),12)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,10),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,16),9)

 +30               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="Complete with Results 31-60 Days of Request:"_ROWTXT

 +31               SET ROWTXT=$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,5),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,11),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,17),9)

 +32               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="All Requests Created 60 Days Before Qtr Start:"_ROWTXT

 +33               SET ROWTXT=$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,6),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,12),10)_$JUSTIFY($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,18),9)

 +34               SET COUNT=COUNT+1

                   SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="All Requests Pending 60 Days Before Qtr Start:"_ROWTXT

 +35      ;% complete in 30 days of request

 +36               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U)>0

                       SET CALC1=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,3)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U))*100,2,2)_"%"

 +37               SET ROWTXT=$SELECT($GET(CALC1)="":$$REPEAT^XLFSTR(" ",10-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$LENGTH(CALC1))_CALC1)

 +38               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,7)>0

                       SET CALC2=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,9)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,7))*100,2,2)_"%"

 +39               SET ROWTXT=ROWTXT_$SELECT('$DATA(CALC2):$$REPEAT^XLFSTR(" ",10-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$LENGTH(CALC2))_CALC2)

 +40               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,13)>0

                       SET CALC3=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,15)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,13))*100,2,2)_"%"

 +41               SET ROWTXT=ROWTXT_$SELECT($GET(CALC3)="":$$REPEAT^XLFSTR(" ",9-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$LENGTH(CALC3))_CALC3)

 +42               SET COUNT=COUNT+1

 +43               SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="Percent Complete w/Results in 30 Days of Request: "_ROWTXT

 +44      ;% complete in 60 days of request

 +45               KILL CALC1,CALC2,CALC3

 +46               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,2)>0

                       SET CALC1=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,4)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,2))*100,2,2)_"%"

 +47               SET ROWTXT=$SELECT($GET(CALC1)="":$$REPEAT^XLFSTR(" ",10-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$LENGTH(CALC1))_CALC1)

 +48               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,8)>0

                       SET CALC2=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,10)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,8))*100,2,2)_"%"

 +49               SET ROWTXT=ROWTXT_$SELECT('$DATA(CALC2):$$REPEAT^XLFSTR(" ",10-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$LENGTH(CALC2))_CALC2)

 +50               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,14)>0

                       SET CALC3=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,16)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,14))*100,2,2)_"%"

 +51               SET ROWTXT=ROWTXT_$SELECT($GET(CALC3)="":$$REPEAT^XLFSTR(" ",9-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$LENGTH(CALC3))_CALC3)

 +52               SET COUNT=COUNT+1

 +53               SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="Percent Complete w/Results 31-60 Days of Request: "_ROWTXT

 +54      ;% pending before quarter start

 +55               KILL CALC1,CALC2,CALC3

 +56               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,5)>0

                       SET CALC1=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,6)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,5))*100,2,2)_"%"

 +57               SET ROWTXT=$SELECT($GET(CALC1)="":$$REPEAT^XLFSTR(" ",10-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$LENGTH(CALC1))_CALC1)

 +58               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,11)>0

                       SET CALC2=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,12)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,11))*100,2,2)_"%"

 +59               SET ROWTXT=ROWTXT_$SELECT('$DATA(CALC2):$$REPEAT^XLFSTR(" ",10-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$LENGTH(CALC2))_CALC2)

 +60               IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,17)>0

                       SET CALC3=$JUSTIFY(($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,18)/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,17))*100,2,2)_"%"

 +61               SET ROWTXT=ROWTXT_$SELECT($GET(CALC3)="":$$REPEAT^XLFSTR(" ",9-$LENGTH("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$LENGTH(CALC3))_CALC3)

 +62               SET COUNT=COUNT+1

 +63               SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)="Percent Still Pending Created Before Qtr Start:   "_ROWTXT

               End DoDot:1

 +64       QUIT

DELTOT(GEN,INDEX,NAME,ARRN) ; format for delimited

 +1        NEW QUIT

           SET QUIT=0

           DO NOACTVT

           if QUIT=1

               QUIT

 +2        NEW STRING,COUNT,PIECE,INCR,SVCUSG

 +3        SET SVCUSG=$PIECE(^GMR(123.5,INDEX,0),U,2)

           IF $GET(SVCUSG)

               SET NAME=NAME_$SELECT(SVCUSG=1:" <grouper only>",SVCUSG=2:" <disabled>",1:"")

 +4        SET COUNT=$ORDER(^TMP("GMRCR",$JOB,ARRN," "),-1)

           SET STRING=$SELECT(GEN=2:"GROUPER: ",1:"")_NAME_";"

 +5        FOR PIECE=1:1:18

               Begin DoDot:1

 +6                SET STRING=STRING_$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,PIECE)_";"

 +7                IF PIECE=6!(PIECE=12)!(PIECE=18)

                       Begin DoDot:2

 +8                        SET INCR=$SELECT(PIECE=6:0,PIECE=12:6,1:12)

 +9       ;percents

 +10                       IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(1+INCR))=0

                               SET STRING=STRING_"N/A;"

 +11                      IF '$TEST

                               SET GMRCPCT=($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(3+INCR))/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(1+INCR)))*100

                               SET STRING=STRING_$JUSTIFY(GMRCPCT,0,2)_";"

 +12                       IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(2+INCR))=0

                               SET STRING=STRING_"N/A;"

 +13                      IF '$TEST

                               SET GMRCPCT=($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(4+INCR))/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(2+INCR)))*100

                               SET STRING=STRING_$JUSTIFY(GMRCPCT,0,2)_";"

 +14                       IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(5+INCR))=0

                               SET STRING=STRING_"N/A;"

 +15                      IF '$TEST

                               SET GMRCPCT=($PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(6+INCR))/$PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,(5+INCR)))*100

                               SET STRING=STRING_$JUSTIFY(GMRCPCT,0,2)_";"

                       End DoDot:2

               End DoDot:1

 +16       SET COUNT=COUNT+1

           SET ^TMP("GMRCR",$JOB,ARRN,COUNT,0)=STRING

 +17       QUIT

NOACTVT   ;services with no activity for the reporting period

 +1        NEW CONT,PIECE

           SET CONT=1

 +2       ;;don't add to list if service is a grouper only...

           IF GEN=1&($PIECE(^GMR(123.5,INDEX,0),U,2)=1)

               SET QUIT=1

               QUIT

 +3        FOR PIECE=1:1:18

               Begin DoDot:1

 +4                IF $PIECE(^TMP("GMRCT",$JOB,GEN,INDEX,"DATA"),U,PIECE)>0

                       SET CONT=0

                       QUIT

               End DoDot:1

               if CONT=0

                   QUIT

 +5        if CONT=1

               SET ^TMP("GMRCT",$JOB,0,NAME)=""

               SET QUIT=1

 +6        QUIT

ONESTAT(ARRN,SVCN,STAT,DT1,DT2,STR) ;Process one status

 +1       ;Input -- ARRN  "CP"  - to be printed  or "DEL" - in delimited format

 +2       ;SVCN = node in ^TMP("GMRCLIST,$J..STAT = status being worked on..DT1 = starting date..DT2 = ending date

 +3       ;STR = string value used to store 30/60 day results in correct piece of ^tmp arrays

 +4       ;Output - None

 +5        NEW GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP,GMRCQT,FLG,TYPE

 +6        SET GMRCSVC=$PIECE(^TMP("GMRCSLIST",$JOB,SVCN),"^",1)

 +7        SET GMRCSVCP=$PIECE(^TMP("GMRCSLIST",$JOB,SVCN),"^",2)

 +8        SET GMRCSVCG=$PIECE(^TMP("GMRCSLIST",$JOB,SVCN),"^",3)

 +9       ;start searching the global at a date a fraction newer than DT2 (the end date for this search)

           SET GMRCXDT=9999999-DT2-.6

 +10       FOR

               SET GMRCXDT=$ORDER(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT))

               if GMRCXDT=""!(GMRCXDT>(9999999-DT1))

                   QUIT

               Begin DoDot:1

 +11               SET GMRCPT=0

 +12      ;Loop for one consult at a time

 +13               FOR

                       SET GMRCPT=$ORDER(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT))

                       if GMRCPT=""

                           QUIT

                       Begin DoDot:2

 +14                       SET FLG=0

                           DO EXCLUDE

                           if $GET(FLG)=1

                               QUIT

 +15                       SET TYPE=""

                           DO REQTYPE

 +16      ;set totals for 30 and 60 day range

                           IF TYPE="LOCAL"

                               Begin DoDot:3

 +17                               if STR="30"

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U)+1

 +18                               if STR="60"

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,2)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,2)+1

 +19                               IF STAT=2

                                       Begin DoDot:4

 +20      ;Q if no results

                                           if '$ORDER(^GMR(123,+$GET(GMRCPT),50,0))

                                               QUIT

 +21                                       DO CHKRNG

                                       End DoDot:4

                               End DoDot:3

 +22                       IF TYPE="IFCP"

                               Begin DoDot:3

 +23                               if STR="30"

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,7)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,7)+1

 +24                               if STR="60"

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,8)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,8)+1

 +25                               if STAT=2

                                       DO CHKRNG

                               End DoDot:3

 +26                       IF TYPE="IFCF"

                               Begin DoDot:3

 +27                               if STR="30"

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,13)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,13)+1

 +28                               if STR="60"

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,14)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,14)+1

 +29                               if STAT=2

                                       DO CHKRNG

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +30       QUIT

 +31      ;

ONESTAT2(ARRN,SVCN,STAT,DT1) ;all statuses, all requests, before quarter start

 +1       ;Input -- ARRN  "CP"  - to be printed or "DEL" - in delimited format

 +2       ;SVCN = node in ^TMP("GMRCLIST,$J..STAT = status being worked on..DT1 = 60 days before starting date of current quarter

 +3       ;Output -- None

 +4        NEW GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP,FLG,TYPE

 +5        SET GMRCSVC=$PIECE(^TMP("GMRCSLIST",$JOB,SVCN),"^",1)

 +6        SET GMRCSVCP=$PIECE(^TMP("GMRCSLIST",$JOB,SVCN),"^",2)

 +7        SET GMRCSVCG=$PIECE(^TMP("GMRCSLIST",$JOB,SVCN),"^",3)

 +8        SET GMRCXDT=""

 +9        FOR

               SET GMRCXDT=$ORDER(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT))

               if GMRCXDT=""

                   QUIT

               Begin DoDot:1

 +10               SET GMRCPT=0

 +11      ;Loop for one consult at a time

 +12               FOR

                       SET GMRCPT=$ORDER(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT))

                       if GMRCPT=""

                           QUIT

                       Begin DoDot:2

 +13      ;

                           if GMRCXDT<(9999999-DT1-.6)

                               QUIT

 +14                       SET FLG=0

                           DO EXCLUDE

                           if $GET(FLG)=1

                               QUIT

 +15                       SET TYPE=""

                           DO REQTYPE

 +16                       IF TYPE="LOCAL"

                               Begin DoDot:3

 +17                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,5)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,5)+1

 +18      ; get unresolved requests for the period

 +19                               if ",3,4,5,6,8,9,11,99,"[(","_STAT_",")

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,6)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,6)+1

                               End DoDot:3

 +20                       IF TYPE="IFCP"

                               Begin DoDot:3

 +21                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,11)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,11)+1

 +22                               if ",3,4,5,6,8,9,11,99,"[(","_STAT_",")

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,12)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,12)+1

                               End DoDot:3

 +23                       IF TYPE="IFCF"

                               Begin DoDot:3

 +24                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,17)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,17)+1

 +25                               if ",3,4,5,6,8,9,11,99,"[(","_STAT_",")

                                       SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,18)=$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,18)+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +26       QUIT

REQTYPE   ;If the request is being requested and performed locally, this field will be blank; Placer done elsewhere, Filler done locally

 +1        IF $PIECE(^GMR(123,$GET(GMRCPT),0),U,23)=""

               SET TYPE="LOCAL"

               QUIT

 +2        IF $PIECE(^GMR(123,$GET(GMRCPT),0),U,23)'=""&($PIECE($GET(^GMR(123,GMRCPT,12)),U,5)="P")

               SET TYPE="IFCP"

               QUIT

 +3        IF $PIECE(^GMR(123,$GET(GMRCPT),0),U,23)'=""&($PIECE($GET(^GMR(123,GMRCPT,12)),U,5)="F")

               SET TYPE="IFCF"

               QUIT

 +4        QUIT

EXCLUDE   ;exclude these request types from the count

 +1        NEW PROS

 +2       ; Check for bad "AE" x-ref

 +3        IF '$DATA(^GMR(123,GMRCPT,0))

               Begin DoDot:1

 +4                KILL ^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)

               End DoDot:1

               SET FLG=1

               QUIT

 +5       ; exclude test pats

           IF $$TESTPAT^VADPT(+$PIECE(^GMR(123,GMRCPT,0),U,2))

               SET FLG=1

               QUIT

 +6        Begin DoDot:1

 +7            NEW SVC

               SET SVC=$PIECE(^GMR(123,GMRCPT,0),U,5)

 +8       ; exclude PROS consults

               IF +$GET(^GMR(123.5,SVC,"INT"))

                   SET PROS=1

           End DoDot:1

           IF $GET(PROS)

               SET FLG=1

               QUIT

 +9       ; only getting outpat

           IF $PIECE($GET(^GMR(123,GMRCPT,0)),U,18)'="O"

               SET FLG=1

               QUIT

 +10      ; exclude admin requests

           IF $GET(^GMR(123,GMRCPT,70))["Y"

               SET FLG=1

               QUIT

 +11       QUIT

CHKRNG    ;check if request is complete within 30/60 days of Desired Date or Date of Request

 +1        NEW DTOR,DTCMPL

           SET DTOR=""

           SET DTCMPL=""

 +2        if '$ORDER(^GMR(123,+$GET(GMRCPT),50,0))&('$ORDER(^GMR(123,+$GET(GMRCPT),51,0)))

               QUIT

 +3       ;check for desired date CPRS GUI v28

           IF $PIECE(^GMR(123,+$GET(GMRCPT),0),U,24)>0

               SET DTOR=$PIECE(^GMR(123,+$GET(GMRCPT),0),U,24)

 +4        if $GET(DTOR)=""

               SET DTOR=$PIECE(^GMR(123,+$GET(GMRCPT),0),U,7)

 +5       ; 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]

 +6       ;order through activity multiple (40) and find the entry for completed 40, [0:2] - value of 10 is complete/update

 +7        NEW CHK

           SET CHK=0

 +8        FOR

               SET CHK=$ORDER(^GMR(123,+$GET(GMRCPT),40,CHK))

               if CHK="B"

                   QUIT

               Begin DoDot:1

 +9       ;get the date/time of completion 40, [0;3]

 +10               IF $DATA(^GMR(123,+$GET(GMRCPT),40,CHK,0))

                       if ($PIECE(^GMR(123,GMRCPT,40,CHK,0),U,2)=10)

                           SET DTCMPL=$PIECE(^GMR(123,GMRCPT,40,CHK,0),U,3)

               End DoDot:1

 +11       IF $GET(DTCMPL)

               Begin DoDot:1

 +12               IF (STR="30")&(DTCMPL<=$$FMADD^XLFDT(DTOR,30))

                       Begin DoDot:2

 +13                       if TYPE="LOCAL"

                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,3)=+$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,3)+1

 +14                       if TYPE="IFCP"

                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,9)=+$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,9)+1

 +15                       if TYPE="IFCF"

                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,15)=+$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,15)+1

                       End DoDot:2

 +16               IF STR'="30"&(DTCMPL<=$$FMADD^XLFDT(DTOR,60))&(DTCMPL>$$FMADD^XLFDT(DTOR,30))

                       Begin DoDot:2

 +17                       if TYPE="LOCAL"

                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,4)=+$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,4)+1

 +18                       if TYPE="IFCP"

                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,10)=+$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,10)+1

 +19                       if TYPE="IFCF"

                               SET $PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,16)=+$PIECE(^TMP("GMRCT",$JOB,1,GMRCSVC,"DATA"),U,16)+1

                       End DoDot:2

               End DoDot:1

 +20       QUIT

GMRCSTL8.m