SDCWL3 ;ALB/MLI - CLINIC WORKLOAD REPORT CONTINUATION ; 25 MAY 88
;;5.3;Scheduling;**540**;Aug 13, 1993;Build 2
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
S SDSC=$S($D(^DIC(40.7,SDSC,0)):$P(^(0),U,2),1:0) I 'SDSC S ^TMP($J,"ERR",2,SDN)="" Q
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)=""
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)=""
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 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
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 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,", "
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCWL3 3045 printed Nov 22, 2024@17:59:42 Page 2
SDCWL3 ;ALB/MLI - CLINIC WORKLOAD REPORT CONTINUATION ; 25 MAY 88
+1 ;;5.3;Scheduling;**540**;Aug 13, 1993;Build 2
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 SET SDSC=$SELECT($DATA(^DIC(40.7,SDSC,0)):$PIECE(^(0),U,2),1:0)
IF 'SDSC
SET ^TMP($JOB,"ERR",2,SDN)=""
QUIT
+3 IF SDSC=900
SET ^TMP($JOB,"ERR",3,SDN)=""
QUIT
+4 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)=""
+5 IF SDS="S"
SET (SDF1,SDF2)=0
if SDALL!$DATA(SDCL(SDSC))
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)=""
+6 if SDS="C"
SET SDF1=1
IF SDS="S"
IF 'SDF1
IF 'SDF2
QUIT
+7 ;SD*5.3*540 - added Q:'DFN in 2nd FOR loop
+8 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
+9 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
+10 SET Y=0
FOR
SET Y=$ORDER(^SC(I,"S",J,1,Y))
if 'Y
QUIT
IF $DATA(^(Y,0))
IF DFN=+^(0)
QUIT
+11 if 'Y
DO PRO1^SDCWL2
End DoDot:1
+12 QUIT
ERR WRITE @IOF
SET SDPG=SDPG+1
SET SDFL=0
WRITE !?37,"***ERRORS***",?70,"PAGE: ",$JUSTIFY(SDPG,4)
IF $DATA(^TMP($JOB,"ERR",1))
WRITE !!,"No stop code assigned to the following clinics:"
SET I=0
FOR I1=0:0
SET I=$ORDER(^TMP($JOB,"ERR",1,I))
if I=""
QUIT
WRITE !?3,I
SET SDFL=1
+1 IF $DATA(^TMP($JOB,"ERR",2))
WRITE !!,"Invalid pointer to stop code file for the following clinics:"
SET I=0
FOR I1=0:0
SET I=$ORDER(^TMP($JOB,"ERR",2,I))
if I=""
QUIT
WRITE !?3,I
SET SDFL=1
+2 IF SDFL
WRITE !!,"***APPTS MADE TO CLINICS ABOVE WERE NOT INCLUDED IN WORKLOAD COMPUTATIONS***"
+3 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
+4 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
+5 IF SDFL
WRITE !,"***THESE STOP CODES MUST BE CHANGED TO ACTIVE STOP CODES***",!,"***THEY WERE INCLUDED IN WORKLOAD***"
+6 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 IF SDS="S"
FOR I=0:0
SET I=$ORDER(SDCL(I))
if 'I
QUIT
WRITE I,", "
+2 IF SDS="C"
FOR I=0:0
SET I=$ORDER(VAUTC(I))
if 'I
QUIT
WRITE VAUTC(I),", "
+3 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),", "
+4 QUIT
