GMRCQCST ;SLC/DCM - Gather all consults for QC that do not have status of discontinued,complete, or expired ;5/21/98 10:53
;;3.0;CONSULT/REQUEST TRACKING;**1,22**;DEC 27, 1997
STS(SRV) ;;Set partial statistics into the ^TMP global for printing
;;SRV=Service being worked on
;;STS=OERR status of order (3=hold, 4=flagged, 5=pending, etc.)
S GMRCTOTS=0
I GMRCSVCP'="ALL SERVICES" S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="",GMRCCT=GMRCCT+1
F K=3,4,5,6,7,8,9,11,99 I $G(GMRCTOT(SRV,K))>0 D
.S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="Consults "_$S(K=3:"On Hold: ",K=4:"Flagged: ",K=5:"Pending: ",K=6:"Active: ",K=7:"Expired: ",K=8:"Scheduled: ",K=9:"Incomplete: ",K=11:"Unreleased: ",1:"No Status: ")
.S ^TMP("GMRCR",$J,"CP",GMRCCT,0)=^TMP("GMRCR",$J,"CP",GMRCCT,0)_$J(GMRCTOT(SRV,K),4,0),GMRCCT=GMRCCT+1,GMRCTOTS=GMRCTOTS+GMRCTOT(SRV,K)
.Q
S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="Totals for Service: "_$J(GMRCTOTS,4,0),GMRCCT=GMRCCT+1,^TMP("GMRCR",$J,"CP",GMRCCT,0)="",GMRCCT=GMRCCT+1
Q
EN ;Use fileman to get service
K GMRCQUT
S DIC="^GMR(123.5,",DIC(0)="AEMQ",DIC("A")="Select Service/Specialty: "
S DIC("S")="I $P(^(0),U,2)'=9",D="B^D"
D MIX^DIC1 K DIC I Y<1!($D(DUOUT)) S GMRCQUT=1 K DIROUT,DUOUT,DTOUT Q
S (GMRCSVCP,GMRCSVC)=$P(Y,"^",2),GMRCSVCN=+Y
EN1 ;Collect all consults for service chosen, excluding status discontinued
K ^TMP("GMRCR",$J,"CP")
S TAB="",$P(TAB," ",30)="",GMRCCT=1,GMRCSND=GMRCSVC,GMRCTOT=0,GMRCTOT(3)=0,GMRCTOT(4)=0,GMRCTOT(5)=0,GMRCTOT(6)=0,GMRCTOT(7)=0,GMRCTOT(8)=0,GMRCTOT(9)=0,GMRCTOT(11)=0,GMRCTOT(99)=0
S GMRCSVTT=0
I "ALL SERVICES"[GMRCSVC F S GMRCSVC=$O(^GMR(123.5,"B",GMRCSVC)) Q:GMRCSVC="" S GMRCSVCN=0,GMRCSVCN=$O(^GMR(123.5,"B",GMRCSVC,GMRCSVCN)) I $P(^GMR(123.5,GMRCSVCN,0),"^",2)'=9 D D STS(GMRCSVCN)
.S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="SERVICE: "_$P(^GMR(123.5,GMRCSVCN,0),"^",1),GMRCCT=GMRCCT+1 D PROC(GMRCSVCN) S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="",GMRCCT=GMRCCT+1
.Q
I "ALL SERVICES"'[GMRCSVC S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="SERVICE: "_GMRCSVC,GMRCCT=GMRCCT+1 D PROC(GMRCSVCN),STS(GMRCSVCN) D KILL S GMRCCT=GMRCCT-1 Q
S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="",GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="SUMMARY STATISTICS (ALL SERVICES)",GMRCCT=GMRCCT+1 D
.F I=3,4,5,6,7,8,9,11,99 I GMRCTOT(I)>0 S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="Total Consults/Requests " D
..S ^TMP("GMRCR",$J,"CP",GMRCCT,0)=^TMP("GMRCR",$J,"CP",GMRCCT,0)_$S(I=3:"On Hold: ",I=4:"Flagged: ",I=5:"Pending: ",I=6:"Active: ",I=7:"Expired: ",I=8:"Scheduled: ",I=9:"Incomplete: ",I=11:"Unreleased: ",1:"No Status: ")
..S ^TMP("GMRCR",$J,"CP",GMRCCT,0)=^TMP("GMRCR",$J,"CP",GMRCCT,0)_$J(GMRCTOT(I),4,0),GMRCCT=GMRCCT+1
..Q
.Q
S ^TMP("GMRCR",$J,"CP",GMRCCT,0)="Total Pending Resolution For All Services: "_GMRCTOT,GMRCCT=GMRCCT+1,^TMP("GMRCR",$J,"CP",GMRCCT,0)=""
S GMRCCT=GMRCCT-1
D KILL
Q
PROC(GMRCSRV) ;Set status' info into the ^TMP global
F I=3,4,5,6,7,8,9,11,99 S GMRCXDT=0,GMRCTOT(GMRCSRV,I)=0 F S GMRCXDT=$O(^GMR(123,"AE",GMRCSRV,I,GMRCXDT)) Q:GMRCXDT="" D
.S GMRCPT=0 F S GMRCPT=$O(^GMR(123,"AE",GMRCSRV,I,GMRCXDT,GMRCPT)) Q:GMRCPT="" D S GMRCTOT=GMRCTOT+1,GMRCTOT(I)=GMRCTOT(I)+1,GMRCTOT(GMRCSRV,I)=GMRCTOT(GMRCSRV,I)+1
..S X=9999999-GMRCXDT D REGDTM^GMRCU S GMRCDT=$P(X," ",1)
..S GMRCDLA=$P(X," ",1),GMRCD(0)=^GMR(123,GMRCPT,0) S GMRCPTN=$P(^DPT($P(GMRCD(0),"^",2),0),"^",1),GMRCPTN=$P(GMRCPTN,",",1)_","_$E($P(GMRCPTN,",",2),1)_".",GMRCPTSN="("_$E($P(^(0),"^",9),6,9)_")"
..S GMRCD=0,GMRCD=$O(^GMR(123,GMRCPT,40,"B",GMRCD)) I GMRCD]"" S GMRCDA="",GMRCDA=$O(^GMR(123,+GMRCPT,40,"B",GMRCD,GMRCDA)) I GMRCDA]"" S GMRCDA(0)=^GMR(123,GMRCPT,40,GMRCDA,0) D
...S GMRCDLA=$E($P($G(^GMR(123.1,$P(GMRCDA(0),"^",2),0)),"^"),1,20)
...Q
..S GMRCLOC=$P(GMRCD(0),"^",4) S:+GMRCLOC GMRCLOC=$P(^SC(GMRCLOC,0),"^",1)
..S STS=$S(I=1:"Discontinued",I=3:"Hold",I=4:"Flagged",I=5:"Pending",I=6:"Active",I=7:"Expired",I=11:"Unreleased",1:"No Status")
..S ^TMP("GMRCR",$J,"CP",GMRCCT,0)=STS_$E(TAB,1,10-$L(STS)+1)_GMRCDLA_$E(TAB,1,18-$L(GMRCDLA))_GMRCDT_" "_GMRCPTN_" "_GMRCPTSN_$E(TAB,1,10-$L(GMRCPTN)+5)_GMRCLOC,GMRCCT=GMRCCT+1
..Q
.Q
Q
KILL ;Kill all variables
K I,K,Y,STS,TAB,GMRCT,GMRCD,GMRCDA,GMRCDT,GMRCPT,GMRCND,GMRCDLA,GMRCTM,GMRCBM,GMRCPTN,GMRCTOT,GMRCTOTS,GMRCPTSN,GMRCSND,GMRCSVC,GMRCSRV,GMRCSVCN,GMRCLOC,GMRCSVCN,GMRCXDT Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCQCST 4358 printed Nov 22, 2024@16:57:12 Page 2
GMRCQCST ;SLC/DCM - Gather all consults for QC that do not have status of discontinued,complete, or expired ;5/21/98 10:53
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,22**;DEC 27, 1997
STS(SRV) ;;Set partial statistics into the ^TMP global for printing
+1 ;;SRV=Service being worked on
+2 ;;STS=OERR status of order (3=hold, 4=flagged, 5=pending, etc.)
+3 SET GMRCTOTS=0
+4 IF GMRCSVCP'="ALL SERVICES"
SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+5 FOR K=3,4,5,6,7,8,9,11,99
IF $GET(GMRCTOT(SRV,K))>0
Begin DoDot:1
+6 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)="Consults "_$SELECT(K=3:"On Hold: ",K=4:"Flagged: ",K=5:"Pending: ",K=6:"Active: ",K=7:"Expired: ",K=8:"Scheduled: ",K=9:"Incomplete: ",K=11:"Unreleased: ",1:"No Status: ")
+7 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=^TMP("GMRCR",$JOB,"CP",GMRCCT,0)_$JUSTIFY(GMRCTOT(SRV,K),4,0)
SET GMRCCT=GMRCCT+1
SET GMRCTOTS=GMRCTOTS+GMRCTOT(SRV,K)
+8 QUIT
End DoDot:1
+9 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)="Totals for Service: "_$JUSTIFY(GMRCTOTS,4,0)
SET GMRCCT=GMRCCT+1
SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+10 QUIT
EN ;Use fileman to get service
+1 KILL GMRCQUT
+2 SET DIC="^GMR(123.5,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select Service/Specialty: "
+3 SET DIC("S")="I $P(^(0),U,2)'=9"
SET D="B^D"
+4 DO MIX^DIC1
KILL DIC
IF Y<1!($DATA(DUOUT))
SET GMRCQUT=1
KILL DIROUT,DUOUT,DTOUT
QUIT
+5 SET (GMRCSVCP,GMRCSVC)=$PIECE(Y,"^",2)
SET GMRCSVCN=+Y
EN1 ;Collect all consults for service chosen, excluding status discontinued
+1 KILL ^TMP("GMRCR",$JOB,"CP")
+2 SET TAB=""
SET $PIECE(TAB," ",30)=""
SET GMRCCT=1
SET GMRCSND=GMRCSVC
SET GMRCTOT=0
SET GMRCTOT(3)=0
SET GMRCTOT(4)=0
SET GMRCTOT(5)=0
SET GMRCTOT(6)=0
SET GMRCTOT(7)=0
SET GMRCTOT(8)=0
SET GMRCTOT(9)=0
SET GMRCTOT(11)=0
SET GMRCTOT(99)=0
+3 SET GMRCSVTT=0
+4 IF "ALL SERVICES"[GMRCSVC
FOR
SET GMRCSVC=$ORDER(^GMR(123.5,"B",GMRCSVC))
if GMRCSVC=""
QUIT
SET GMRCSVCN=0
SET GMRCSVCN=$ORDER(^GMR(123.5,"B",GMRCSVC,GMRCSVCN))
IF $PIECE(^GMR(123.5,GMRCSVCN,0),"^",2)'=9
Begin DoDot:1
+5 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)="SERVICE: "_$PIECE(^GMR(123.5,GMRCSVCN,0),"^",1)
SET GMRCCT=GMRCCT+1
DO PROC(GMRCSVCN)
SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+6 QUIT
End DoDot:1
DO STS(GMRCSVCN)
+7 IF "ALL SERVICES"'[GMRCSVC
SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)="SERVICE: "_GMRCSVC
SET GMRCCT=GMRCCT+1
DO PROC(GMRCSVCN)
DO STS(GMRCSVCN)
DO KILL
SET GMRCCT=GMRCCT-1
QUIT
+8 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+9 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)="SUMMARY STATISTICS (ALL SERVICES)"
SET GMRCCT=GMRCCT+1
Begin DoDot:1
+10 FOR I=3,4,5,6,7,8,9,11,99
IF GMRCTOT(I)>0
SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)="Total Consults/Requests "
Begin DoDot:2
+11 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=^TMP("GMRCR",$JOB,"CP",GMRCCT,0)_$SELECT(I=3:"On Hold: ",I=4:"Flagged: ",I=5:"Pending: ",I=6:"Active: ",I=7:"Expired: ",I=8:"Scheduled: ",I=9:"Incomplete: ",I=11:"Unreleased
: ",1:"No Status: ")
+12 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=^TMP("GMRCR",$JOB,"CP",GMRCCT,0)_$JUSTIFY(GMRCTOT(I),4,0)
SET GMRCCT=GMRCCT+1
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)="Total Pending Resolution For All Services: "_GMRCTOT
SET GMRCCT=GMRCCT+1
SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=""
+16 SET GMRCCT=GMRCCT-1
+17 DO KILL
+18 QUIT
PROC(GMRCSRV) ;Set status' info into the ^TMP global
+1 FOR I=3,4,5,6,7,8,9,11,99
SET GMRCXDT=0
SET GMRCTOT(GMRCSRV,I)=0
FOR
SET GMRCXDT=$ORDER(^GMR(123,"AE",GMRCSRV,I,GMRCXDT))
if GMRCXDT=""
QUIT
Begin DoDot:1
+2 SET GMRCPT=0
FOR
SET GMRCPT=$ORDER(^GMR(123,"AE",GMRCSRV,I,GMRCXDT,GMRCPT))
if GMRCPT=""
QUIT
Begin DoDot:2
+3 SET X=9999999-GMRCXDT
DO REGDTM^GMRCU
SET GMRCDT=$PIECE(X," ",1)
+4 SET GMRCDLA=$PIECE(X," ",1)
SET GMRCD(0)=^GMR(123,GMRCPT,0)
SET GMRCPTN=$PIECE(^DPT($PIECE(GMRCD(0),"^",2),0),"^",1)
SET GMRCPTN=$PIECE(GMRCPTN,",",1)_","_$EXTRACT($PIECE(GMRCPTN,",",2),1)_"."
SET GMRCPTSN="("_$EXTRACT($PIECE(^(0),"^",9),6,9)_")"
+5 SET GMRCD=0
SET GMRCD=$ORDER(^GMR(123,GMRCPT,40,"B",GMRCD))
IF GMRCD]""
SET GMRCDA=""
SET GMRCDA=$ORDER(^GMR(123,+GMRCPT,40,"B",GMRCD,GMRCDA))
IF GMRCDA]""
SET GMRCDA(0)=^GMR(123,GMRCPT,40,GMRCDA,0)
Begin DoDot:3
+6 SET GMRCDLA=$EXTRACT($PIECE($GET(^GMR(123.1,$PIECE(GMRCDA(0),"^",2),0)),"^"),1,20)
+7 QUIT
End DoDot:3
+8 SET GMRCLOC=$PIECE(GMRCD(0),"^",4)
if +GMRCLOC
SET GMRCLOC=$PIECE(^SC(GMRCLOC,0),"^",1)
+9 SET STS=$SELECT(I=1:"Discontinued",I=3:"Hold",I=4:"Flagged",I=5:"Pending",I=6:"Active",I=7:"Expired",I=11:"Unreleased",1:"No Status")
+10 SET ^TMP("GMRCR",$JOB,"CP",GMRCCT,0)=STS_$EXTRACT(TAB,1,10-$LENGTH(STS)+1)_GMRCDLA_$EXTRACT(TAB,1,18-$LENGTH(GMRCDLA))_GMRCDT_" "_GMRCPTN_" "_GMRCPTSN_$EXTRACT(TAB,1,10-$LENGTH(GMRCPTN)+5)_GMRCLOC
SET GMRCCT=GMRCCT+1
+11 QUIT
End DoDot:2
SET GMRCTOT=GMRCTOT+1
SET GMRCTOT(I)=GMRCTOT(I)+1
SET GMRCTOT(GMRCSRV,I)=GMRCTOT(GMRCSRV,I)+1
+12 QUIT
End DoDot:1
+13 QUIT
KILL ;Kill all variables
+1 KILL I,K,Y,STS,TAB,GMRCT,GMRCD,GMRCDA,GMRCDT,GMRCPT,GMRCND,GMRCDLA,GMRCTM,GMRCBM,GMRCPTN,GMRCTOT,GMRCTOTS,GMRCPTSN,GMRCSND,GMRCSVC,GMRCSRV,GMRCSVCN,GMRCLOC,GMRCSVCN,GMRCXDT
QUIT
+2 QUIT
