SDCWL3 ;ALB/MLI - CLINIC WORKLOAD REPORT CONTINUATION ; 25 MAY 88
;;5.3;Scheduling;**540,1001,1015,1016**;Aug 13, 1993;Build 20
SET Q:'$D(^SC(I,"S"))!'$D(^(0))!($O(^("S",SDBD))="")!($O(^(SDBD))>SDED) S SDST=^SC(I,0),SDN=$P(SDST,U),SDSC=$P(SDST,U,7),SDDIV=$S(+$P(SDST,U,15):$P(SDST,U,15),1:$O(^DG(40.8,0))) I SDSC']"" S ^TMP($J,"ERR",1,SDN)="" Q
I 'VAUTD,'$D(VAUTD(SDDIV)) Q
;IHS/ITSC/WAR 4/20/04 Correction to handle free text stop code field
;S SDSC=$S($D(^DIC(40.7,SDSC,0)):$P(^(0),U,2),1:0) I 'SDSC S ^TMP($J,"ERR",2,SDN)="" Q
;IHS/ITSC/WAR 5/4/04 P #1001 Correct earlier change of free text stop code field
;S NULL="",SDSC=$S($D(^DIC(40.7,SDSC,0)):$P(^(0),U,2),1:0) I SDSC=NULL S ^UTILITY($J,"ERR",2,SDN)="" Q
S SDSC=$P($G(^DIC(40.7,SDSC,0)),U,2) ;IHS/ITSC/WAR 5/4/2004 added
I +$G(SDSC)'>0,$L(SDSC)'>1 S ^UTILITY($J,"ERR",2,SDN)="" Q ;IHS/ITSC/WAR 5/4/2004 added
I +$G(SDSC)>0 S SDSC=+SDSC ;IHS/ITSC/WAR 5/4/2004 added
I SDSC=900 S ^TMP($J,"ERR",3,SDN)="" Q
S SDCR=$S($D(^DIC(40.7,+$P(^SC(I,0),"^",18),0)):$P(^(0),"^",2),1:0) I SDCR>899,(SDCR<908) S ^TMP($J,"ERR",4,SDN)=""
;IHS/ITSC/WAR 12/21/04 P #1001 Correcting for exact matching of SDSC variable, which is used in the $D of array SDCL
;I SDS="S" S (SDF1,SDF2)=0 S:SDALL!$D(SDCL(SDSC)) ^TMP($J,"SC",SDSC,SDN,0)="",SDF1=1 I SDCR,SDCR'=SDSC I (SDALL!$D(SDCL(SDCR))) S SDF2=1,^TMP($J,"SC",SDCR,SDN,1)=""
I SDS="S" S (SDF1,SDF2)=0 S:SDALL!$D(SDCL($P(^DIC(40.7,$P(SDST,U,7),0),U,2))) ^TMP($J,"SC",SDSC,SDN,0)="",SDF1=1 I SDCR,SDCR'=SDSC I (SDALL!$D(SDCL(SDCR))) S SDF2=1,^TMP($J,"SC",SDCR,SDN,1)=""
S:SDS="C" SDF1=1 I SDS="S",'SDF1,'SDF2 Q
;SD*5.3*540 - added Q:'DFN in 2nd FOR loop
F J=SDBD:0 S J=$O(^SC(I,"S",J)) Q:'J!(J>SDED) F K=0:0 S K=$O(^SC(I,"S",J,1,K)) Q:'K I $D(^(K,0)) S DFN=$P(^(0),U) Q:'DFN S SDOB=$S('$D(^("OB")):0,^("OB")]"":1,1:0) I $D(^DPT(DFN,0)),$D(^("S",J,0)) D PRO^SDCWL2
S SDOB=0 F J=SDBD:0 S J=$O(^DPT("ASDCN",I,J)) Q:'J!(J>SDED) F K=0:0 S K=$O(^DPT("ASDCN",I,J,K)) Q:'K I $D(^DPT(K,"S",J,0)),$S($P(^(0),U,2)["C":1,+^(0)'=I:1,1:0) S DFN=K,SDAS="C" D
.S Y=0 F S Y=$O(^SC(I,"S",J,1,Y)) Q:'Y I $D(^(Y,0)),DFN=+^(0) Q
.D:'Y PRO1^SDCWL2
Q
ERR ;IHS/ITSC/WAR 4/20/04 1 Mod to handle StopCode,2nd Mod Name field
;W @IOF S SDPG=SDPG+1,SDFL=0 W !?37,"***ERRORS***",?70,"PAGE: ",$J(SDPG,4) I $D(^TMP($J,"ERR",1)) W !!,"No stop code assigned to the following clinics:" S I=0 F I1=0:0 S I=$O(^TMP($J,"ERR",1,I)) Q:I="" W !?3,I S SDFL=1
W @IOF S SDPG=SDPG+1,SDFL=0 W !?37,"***ERRORS***",?70,"PAGE: ",$J(SDPG,4) I $D(^UTILITY($J,"ERR",1)) W !!,"No stop code assigned to the following clinics:" S I=0,NULL="" F I1=0:0 S I=$O(^UTILITY($J,"ERR",1,I)) Q:I=NULL W !?3,I S SDFL=1
;I $D(^TMP($J,"ERR",2)) W !!,"Invalid pointer to stop code file for the following clinics:" S I=0 F I1=0:0 S I=$O(^TMP($J,"ERR",2,I)) Q:I="" W !?3,I S SDFL=1
I $D(^UTILITY($J,"ERR",2)) W !!,"Invalid pointer to stop code file for the following clinics:" S I=0 F I1=0:0 S I=$O(^UTILITY($J,"ERR",2,I)) Q:I=NULL W !?3,I S SDFL=1
;IHS/ITSC/WAR 4/20/04 end of Mods
I SDFL W !!,"***APPTS MADE TO CLINICS ABOVE WERE NOT INCLUDED IN WORKLOAD COMPUTATIONS***"
S SDFL=0 I $D(^TMP($J,"ERR",3)) W !!,"Stop code between 900 and 907 assigned to the following clinics:" S I=0 F I1=0:0 S I=$O(^TMP($J,"ERR",3,I)) Q:I="" W !?3,I S SDFL=1
I $D(^TMP($J,"ERR",4)) W !!,"Credit stop code between 900 and 907 assigned to the following clinics:" S I=0 F I1=0:0 S I=$O(^TMP($J,"ERR",4,I)) Q:I="" W !?3,I S SDFL=1
I SDFL W !,"***THESE STOP CODES MUST BE CHANGED TO ACTIVE STOP CODES***",!,"***THEY WERE INCLUDED IN WORKLOAD***"
Q
LEG I SD1 F S=$Y:1:(IOSL-10) W !
I SD1 W ! F S=3:1:6 W !?11,$P($T(LEG+S),";;",2)
S SD1=1 Q
;;TOTAL PATIENTS SEEN = SCHED + UNSCHED + INPAT + OVERBOOKS + ADD/EDITS
;;
;;CANCELLED APPTS AND NO-SHOWS ARE NOT INCLUDED IN THE ABOVE TOTALS AND
;; ARE GIVEN FOR STATISTICAL PURPOSES ONLY.
NONE W @IOF,"***CLINIC WORKLOAD REPORTS HAVE RUN -- NO MATCHES FOUND***",!!!,"DATE RANGE: ",SDB,"-",SDE,!," DATE RUN: ",SDNOW,!,"SORTED BY ",$S(SDS="C":"CLINIC",1:"STOP CODE"),"(S): ",$S(SDALL!VAUTC:"ALL",1:"") Q:(SDALL!VAUTC)
;I SDS="S" F I=0:0 S I=$O(SDCL(I)) Q:'I W I,", " ;IHS/ITSC/WAR 5/4/04P #1001
I SDS="S" S I="" F S I=$O(SDCL(I)) Q:I="" W I,", "
I SDS="C" F I=0:0 S I=$O(VAUTC(I)) Q:'I W VAUTC(I),", "
W !,"FOR DIVISION(S): " W:VAUTD "ALL" I 'VAUTD F I=0:0 S I=$O(VAUTD(I)) Q:'I W VAUTD(I),", "
Q
SDCWL3 ;ALB/MLI - CLINIC WORKLOAD REPORT CONTINUATION ; 25 MAY 88
+1 ;;5.3;Scheduling;**540,1001,1015,1016**;Aug 13, 1993;Build 20
SET IF '$DATA(^SC(I,"S"))!'$DATA(^(0))!($ORDER(^("S",SDBD))="")!($ORDER(^(SDBD))>SDED)
QUIT
SET SDST=^SC(I,0)
SET SDN=$PIECE(SDST,U)
SET SDSC=$PIECE(SDST,U,7)
SET SDDIV=$SELECT(+$PIECE(SDST,U,15):$PIECE(SDST,U,15),1:$ORDER(^DG(40.8,0)))
IF SDSC']""
SET ^TMP($JOB,"ERR",1,SDN)=""
QUIT
+1 IF 'VAUTD
IF '$DATA(VAUTD(SDDIV))
QUIT
+2 ;IHS/ITSC/WAR 4/20/04 Correction to handle free text stop code field
+3 ;S SDSC=$S($D(^DIC(40.7,SDSC,0)):$P(^(0),U,2),1:0) I 'SDSC S ^TMP($J,"ERR",2,SDN)="" Q
+4 ;IHS/ITSC/WAR 5/4/04 P #1001 Correct earlier change of free text stop code field
+5 ;S NULL="",SDSC=$S($D(^DIC(40.7,SDSC,0)):$P(^(0),U,2),1:0) I SDSC=NULL S ^UTILITY($J,"ERR",2,SDN)="" Q
+6 ;IHS/ITSC/WAR 5/4/2004 added
SET SDSC=$PIECE($GET(^DIC(40.7,SDSC,0)),U,2)
+7 ;IHS/ITSC/WAR 5/4/2004 added
IF +$GET(SDSC)'>0
IF $LENGTH(SDSC)'>1
SET ^UTILITY($JOB,"ERR",2,SDN)=""
QUIT
+8 ;IHS/ITSC/WAR 5/4/2004 added
IF +$GET(SDSC)>0
SET SDSC=+SDSC
+9 IF SDSC=900
SET ^TMP($JOB,"ERR",3,SDN)=""
QUIT
+10 SET SDCR=$SELECT($DATA(^DIC(40.7,+$PIECE(^SC(I,0),"^",18),0)):$PIECE(^(0),"^",2),1:0)
IF SDCR>899
IF (SDCR<908)
SET ^TMP($JOB,"ERR",4,SDN)=""
+11 ;IHS/ITSC/WAR 12/21/04 P #1001 Correcting for exact matching of SDSC variable, which is used in the $D of array SDCL
+12 ;I SDS="S" S (SDF1,SDF2)=0 S:SDALL!$D(SDCL(SDSC)) ^TMP($J,"SC",SDSC,SDN,0)="",SDF1=1 I SDCR,SDCR'=SDSC I (SDALL!$D(SDCL(SDCR))) S SDF2=1,^TMP($J,"SC",SDCR,SDN,1)=""
+13 IF SDS="S"
SET (SDF1,SDF2)=0
IF SDALL!$DATA(SDCL($PIECE(^DIC(40.7,$PIECE(SDST,U,7),0),U,2)))
SET ^TMP($JOB,"SC",SDSC,SDN,0)=""
SET SDF1=1
IF SDCR
IF SDCR'=SDSC
IF (SDALL!$DATA(SDCL(SDCR)))
SET SDF2=1
SET ^TMP($JOB,"SC",SDCR,SDN,1)=""
+14 IF SDS="C"
SET SDF1=1
IF SDS="S"
IF 'SDF1
IF 'SDF2
QUIT
+15 ;SD*5.3*540 - added Q:'DFN in 2nd FOR loop
+16 FOR J=SDBD:0
SET J=$ORDER(^SC(I,"S",J))
IF 'J!(J>SDED)
QUIT
FOR K=0:0
SET K=$ORDER(^SC(I,"S",J,1,K))
IF 'K
QUIT
IF $DATA(^(K,0))
SET DFN=$PIECE(^(0),U)
IF 'DFN
QUIT
SET SDOB=$SELECT('$DATA(^("OB")):0,^("OB")]"":1,1:0)
IF $DATA(^DPT(DFN,0))
IF $DATA(^("S",J,0))
DO PRO^SDCWL2
+17 SET SDOB=0
FOR J=SDBD:0
SET J=$ORDER(^DPT("ASDCN",I,J))
IF 'J!(J>SDED)
QUIT
FOR K=0:0
SET K=$ORDER(^DPT("ASDCN",I,J,K))
IF 'K
QUIT
IF $DATA(^DPT(K,"S",J,0))
IF $SELECT($PIECE(^(0),U,2)["C":1,+^(0)'=I:1,1:0)
SET DFN=K
SET SDAS="C"
Begin DoDot:1
+18 SET Y=0
FOR
SET Y=$ORDER(^SC(I,"S",J,1,Y))
IF 'Y
QUIT
IF $DATA(^(Y,0))
IF DFN=+^(0)
QUIT
+19 IF 'Y
DO PRO1^SDCWL2
End DoDot:1
+20 QUIT
ERR ;IHS/ITSC/WAR 4/20/04 1 Mod to handle StopCode,2nd Mod Name field
+1 ;W @IOF S SDPG=SDPG+1,SDFL=0 W !?37,"***ERRORS***",?70,"PAGE: ",$J(SDPG,4) I $D(^TMP($J,"ERR",1)) W !!,"No stop code assigned to the following clinics:" S I=0 F I1=0:0 S I=$O(^TMP($J,"ERR",1,I)) Q:I="" W !?3,I S SDFL=1
+2 WRITE @IOF
SET SDPG=SDPG+1
SET SDFL=0
WRITE !?37,"***ERRORS***",?70,"PAGE: ",$JUSTIFY(SDPG,4)
IF $DATA(^UTILITY($JOB,"ERR",1))
WRITE !!,"No stop code assigned to the following clinics:"
SET I=0
SET NULL=""
FOR I1=0:0
SET I=$ORDER(^UTILITY($JOB,"ERR",1,I))
IF I=NULL
QUIT
WRITE !?3,I
SET SDFL=1
+3 ;I $D(^TMP($J,"ERR",2)) W !!,"Invalid pointer to stop code file for the following clinics:" S I=0 F I1=0:0 S I=$O(^TMP($J,"ERR",2,I)) Q:I="" W !?3,I S SDFL=1
+4 IF $DATA(^UTILITY($JOB,"ERR",2))
WRITE !!,"Invalid pointer to stop code file for the following clinics:"
SET I=0
FOR I1=0:0
SET I=$ORDER(^UTILITY($JOB,"ERR",2,I))
IF I=NULL
QUIT
WRITE !?3,I
SET SDFL=1
+5 ;IHS/ITSC/WAR 4/20/04 end of Mods
+6 IF SDFL
WRITE !!,"***APPTS MADE TO CLINICS ABOVE WERE NOT INCLUDED IN WORKLOAD COMPUTATIONS***"
+7 SET SDFL=0
IF $DATA(^TMP($JOB,"ERR",3))
WRITE !!,"Stop code between 900 and 907 assigned to the following clinics:"
SET I=0
FOR I1=0:0
SET I=$ORDER(^TMP($JOB,"ERR",3,I))
IF I=""
QUIT
WRITE !?3,I
SET SDFL=1
+8 IF $DATA(^TMP($JOB,"ERR",4))
WRITE !!,"Credit stop code between 900 and 907 assigned to the following clinics:"
SET I=0
FOR I1=0:0
SET I=$ORDER(^TMP($JOB,"ERR",4,I))
IF I=""
QUIT
WRITE !?3,I
SET SDFL=1
+9 IF SDFL
WRITE !,"***THESE STOP CODES MUST BE CHANGED TO ACTIVE STOP CODES***",!,"***THEY WERE INCLUDED IN WORKLOAD***"
+10 QUIT
LEG IF SD1
FOR S=$Y:1:(IOSL-10)
WRITE !
+1 IF SD1
WRITE !
FOR S=3:1:6
WRITE !?11,$PIECE($TEXT(LEG+S),";;",2)
+2 SET SD1=1
QUIT
+3 ;;TOTAL PATIENTS SEEN = SCHED + UNSCHED + INPAT + OVERBOOKS + ADD/EDITS
+4 ;;
+5 ;;CANCELLED APPTS AND NO-SHOWS ARE NOT INCLUDED IN THE ABOVE TOTALS AND
+6 ;; ARE GIVEN FOR STATISTICAL PURPOSES ONLY.
NONE WRITE @IOF,"***CLINIC WORKLOAD REPORTS HAVE RUN -- NO MATCHES FOUND***",!!!,"DATE RANGE: ",SDB,"-",SDE,!," DATE RUN: ",SDNOW,!,"SORTED BY ",$SELECT(SDS="C":"CLINIC",1:"STOP CODE"),"(S): ",$SELECT(SDALL!VAUTC:"ALL",1:"")
IF (SDALL!VAUTC)
QUIT
+1 ;I SDS="S" F I=0:0 S I=$O(SDCL(I)) Q:'I W I,", " ;IHS/ITSC/WAR 5/4/04P #1001
+2 IF SDS="S"
SET I=""
FOR
SET I=$ORDER(SDCL(I))
IF I=""
QUIT
WRITE I,", "
+3 IF SDS="C"
FOR I=0:0
SET I=$ORDER(VAUTC(I))
IF 'I
QUIT
WRITE VAUTC(I),", "
+4 WRITE !,"FOR DIVISION(S): "
IF VAUTD
WRITE "ALL"
IF 'VAUTD
FOR I=0:0
SET I=$ORDER(VAUTD(I))
IF 'I
QUIT
WRITE VAUTD(I),", "
+5 QUIT
