- 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 Jan 18, 2025@02:48:15 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