- 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 Feb 19, 2025@00:16:08 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