SDCWL2 ;ALB/MLI - CONTINUATION OF CLINIC WORKLOAD REPORTS ; 07 Mar 99 6:41 PM
;;5.3;Scheduling;**140,132,171,184,529**;Aug 13, 1993;Build 3
PRO S SDAS=$S($P(^SC(I,"S",J,1,K,0),U,9)="C":"C",1:$P(^DPT(DFN,"S",J,0),U,2)) S SDP=$P(^DPT(DFN,"S",J,0),U,7)
PRO1 S SDP=$P(^DPT(DFN,"S",J,0),U,7) S:SDS="C" ^(SDN)=$S($D(^TMP($J,"CL",'$D(SDFL),SDN)):^(SDN),1:0)
I SDS="S" S:SDF1 ^(SDSC)=$S($D(^TMP($J,"SC",'$D(SDFL),SDSC)):^(SDSC),1:0) I SDF2 S ^(SDCR)=$S($D(^TMP($J,"SC",'$D(SDFL),SDCR)):^(SDCR),1:0)
S $P(^TMP($J,"CL",'$D(SDFL),SDN),"^")=1 I SDS="S" S:SDF1 $P(^TMP($J,"SC",'$D(SDFL),SDSC),"^")=1 I SDF2 S $P(^TMP($J,"SC",'$D(SDFL),SDCR),"^")=1
I SDAS'["C",SDAS'="N",SDAS'="NA" S:SDS="C" $P(^(SDN),U,2)=$P(^TMP($J,"CL",'$D(SDFL),SDN),U,2)+1 I SDS="S" S:SDF1 $P(^(SDSC),U,2)=$P(^TMP($J,"SC",'$D(SDFL),SDSC),U,2)+1 I SDF2 S $P(^(SDCR),U,2)=$P(^TMP($J,"SC",'$D(SDFL),SDCR),U,2)+1
I $D(SDFL) S:SDS="C" ^(SDN)=$S($D(^TMP($J,"CL",1,SDN)):^(SDN),1:0) I SDS="S" S:SDF1 ^(SDSC)=$S($D(^TMP($J,"SC",1,SDSC)):^(SDSC),1:0) S:SDF2 ^(SDCR)=$S($D(^TMP($J,"SC",1,SDCR)):^(SDCR),1:0)
Q:$D(SDFL)!(SDRT="B") S SDAPT=$S(SDF="D":J\1,1:J\100) S:'$D(^TMP($J,1,SDN,SDAPT)) (^(SDAPT,"CA"),^("NS"),^("IN"),^("OB"),^("UN"),^("SD"))=0
S TIME=$E($P(J,".",2)_"0000",1,4),TIME=$E(TIME,1,2)_":"_$E(TIME,3,4)
S:SDNAM SDPN=$E($P(^DPT(DFN,0),U),1,20),SDSSN=$S($P(^(0),U,9)]"":$P(^(0),U,9),1:0),^TMP($J,1,SDN,SDAPT,"NM",SDPN,SDSSN,TIME,$S(SDAS]"":SDAS,SDOB:"OB",SDP=1:"S",SDP=3:"S",SDP=4:"U",1:" "))="" ;added SDP=1 SD*529
K TIME I SDAS["C" S ^("CA")=^TMP($J,1,SDN,SDAPT,"CA")+1 Q
I SDAS="N"!(SDAS="NA") S ^("NS")=^TMP($J,1,SDN,SDAPT,"NS")+1 Q
I SDAS["I" S ^("IN")=^TMP($J,1,SDN,SDAPT,"IN")+1 Q
I SDOB S ^("OB")=^TMP($J,1,SDN,SDAPT,"OB")+1 Q
I SDP=4 S ^("UN")=^TMP($J,1,SDN,SDAPT,"UN")+1 Q
S ^("SD")=^TMP($J,1,SDN,SDAPT,"SD")+1 Q
PREV S SDBD=SDBD+.1,SDED=SDED-.9,SDBO=$TR($$FMTE^XLFDT(SDBD,"2FD")," ","0"),SDEO=$TR($$FMTE^XLFDT(SDED,"2FD")," ","0"),I=0,SDSUB=$S(SDS="C":"CL",1:"SC") D COMPHEAD
F I1=0:0 S I=$O(^TMP($J,SDSUB,1,I)) Q:I="" S SDCUR=+$P(^(I),"^",2),SDOLD=+$S($D(^TMP($J,SDSUB,0,I)):$P(^(I),"^",2),1:0) D:($Y>(IOSL-8)) EOP,COMPHEAD D COMPARE
D EOP Q
COMPHEAD S SDPG=SDPG+1 W @IOF,!?29,"CLINIC WORKLOAD REPORT",?71,"PAGE: ",$J(SDPG,3),!?22,"COMPARISON OF VISITS TO PREVIOUS YEAR",!?20,"FOR PERIOD COVERING: ",SDB1,"-",SDE1,!?26,"REPORT RUN ON: ",SDNOW,!! K Y S $P(Y,"_",81)="" W Y D BLANK
W !,"|",?25,"|",?29,"# OF VISITS",?43,"|",?47,"# OF VISITS",?61,"|",?64,"NET",?70,"|",?74,"%",?79,"|",!,"|",?7,$S(SDS="C":"Clinic",1:"Stop Code")," Name",?25,"|",SDB,"-",SDE,"|",SDBO,"-",SDEO,"| CHANGE | CHANGE |" D EOP,EOP,BLANK Q
COMPARE W !,"|",$S(SDS="C":$E(I,1,24),1:$J(I,15)),?25,"|",?31,$J(SDCUR,7),?43,"|",?49,$J(SDOLD,7),?61,"|" S X=SDCUR-SDOLD W $J($S(X>0:"+"_X,2:X),7,2),?70,"|",$S(SDOLD=0:" N/A",1:$J(X*100/SDOLD,7,2))," |" Q
EOP W !,"|" K Y S $P(Y,"_",25)="" W Y,"|",$E(Y,1,17),"|",$E(Y,1,17),"|",$E(Y,1,8),"|",$E(Y,1,8),"|" Q
BLANK W !,"|",?25,"|",?43,"|",?61,"|",?70,"|",?79,"|" Q
ADDON I 'SDALL&'$D(SDCL(SDSC)) Q
S J=SDOE,I=+SDOE0
S DIV=$S($P(SDOE0,"^",11)]"":$P(SDOE0,"^",11),1:$O(^DG(40.8,0))),DFN=+$P(SDOE0,U,2) Q:'VAUTD&'$D(VAUTD(DIV))
S $P(^TMP($J,"SC",'$D(SDFL),SDSC),"^")=1,$P(^(SDSC),"^",2)=$P(^(SDSC),"^",2)+1 Q:(SDRT="B") S ^("{")=$S($D(^(SDSC,"{")):^("{")+1,1:1),SDAPT=$S(SDF="D":I\1,1:I\100)
Q:$D(SDFL) S ^(SDAPT)=$S($D(^TMP($J,"SC",SDSC,"{",SDAPT)):^(SDAPT)+1,1:1)
Q:'SDNAM S SDNM=$P(^DPT(DFN,0),U),SDSSN=$S($P(^(0),U,9)]"":$P(^(0),U,9),1:0),^TMP($J,"SC",SDSC,"{",SDAPT,SDNM,SDSSN,I,J)="" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCWL2 3537 printed Dec 13, 2024@02:49:41 Page 2
SDCWL2 ;ALB/MLI - CONTINUATION OF CLINIC WORKLOAD REPORTS ; 07 Mar 99 6:41 PM
+1 ;;5.3;Scheduling;**140,132,171,184,529**;Aug 13, 1993;Build 3
PRO SET SDAS=$SELECT($PIECE(^SC(I,"S",J,1,K,0),U,9)="C":"C",1:$PIECE(^DPT(DFN,"S",J,0),U,2))
SET SDP=$PIECE(^DPT(DFN,"S",J,0),U,7)
PRO1 SET SDP=$PIECE(^DPT(DFN,"S",J,0),U,7)
if SDS="C"
SET ^(SDN)=$SELECT($DATA(^TMP($JOB,"CL",'$DATA(SDFL),SDN)):^(SDN),1:0)
+1 IF SDS="S"
if SDF1
SET ^(SDSC)=$SELECT($DATA(^TMP($JOB,"SC",'$DATA(SDFL),SDSC)):^(SDSC),1:0)
IF SDF2
SET ^(SDCR)=$SELECT($DATA(^TMP($JOB,"SC",'$DATA(SDFL),SDCR)):^(SDCR),1:0)
+2 SET $PIECE(^TMP($JOB,"CL",'$DATA(SDFL),SDN),"^")=1
IF SDS="S"
if SDF1
SET $PIECE(^TMP($JOB,"SC",'$DATA(SDFL),SDSC),"^")=1
IF SDF2
SET $PIECE(^TMP($JOB,"SC",'$DATA(SDFL),SDCR),"^")=1
+3 IF SDAS'["C"
IF SDAS'="N"
IF SDAS'="NA"
if SDS="C"
SET $PIECE(^(SDN),U,2)=$PIECE(^TMP($JOB,"CL",'$DATA(SDFL),SDN),U,2)+1
IF SDS="S"
if SDF1
SET $PIECE(^(SDSC),U,2)=$PIECE(^TMP($JOB,"SC",'$DATA(SDFL),SDSC),U,2)+1
IF SDF2
SET $PIECE(^(SDCR),U,2)=$PIECE(^TMP($JOB,"SC",'$DATA(SDFL),SDCR),U,2)+1
+4 IF $DATA(SDFL)
if SDS="C"
SET ^(SDN)=$SELECT($DATA(^TMP($JOB,"CL",1,SDN)):^(SDN),1:0)
IF SDS="S"
if SDF1
SET ^(SDSC)=$SELECT($DATA(^TMP($JOB,"SC",1,SDSC)):^(SDSC),1:0)
if SDF2
SET ^(SDCR)=$SELECT($DATA(^TMP($JOB,"SC",1,SDCR)):^(SDCR),1:0)
+5 if $DATA(SDFL)!(SDRT="B")
QUIT
SET SDAPT=$SELECT(SDF="D":J\1,1:J\100)
if '$DATA(^TMP($JOB,1,SDN,SDAPT))
SET (^(SDAPT,"CA"),^("NS"),^("IN"),^("OB"),^("UN"),^("SD"))=0
+6 SET TIME=$EXTRACT($PIECE(J,".",2)_"0000",1,4)
SET TIME=$EXTRACT(TIME,1,2)_":"_$EXTRACT(TIME,3,4)
+7 ;added SDP=1 SD*529
if SDNAM
SET SDPN=$EXTRACT($PIECE(^DPT(DFN,0),U),1,20)
SET SDSSN=$SELECT($PIECE(^(0),U,9)]"":$PIECE(^(0),U,9),1:0)
SET ^TMP($JOB,1,SDN,SDAPT,"NM",SDPN,SDSSN,TIME,$SELECT(SDAS]"":SDAS,SDOB:"OB",SDP=1:"S",SDP=3:"S",SDP=4:"U",1:" "))=""
+8 KILL TIME
IF SDAS["C"
SET ^("CA")=^TMP($JOB,1,SDN,SDAPT,"CA")+1
QUIT
+9 IF SDAS="N"!(SDAS="NA")
SET ^("NS")=^TMP($JOB,1,SDN,SDAPT,"NS")+1
QUIT
+10 IF SDAS["I"
SET ^("IN")=^TMP($JOB,1,SDN,SDAPT,"IN")+1
QUIT
+11 IF SDOB
SET ^("OB")=^TMP($JOB,1,SDN,SDAPT,"OB")+1
QUIT
+12 IF SDP=4
SET ^("UN")=^TMP($JOB,1,SDN,SDAPT,"UN")+1
QUIT
+13 SET ^("SD")=^TMP($JOB,1,SDN,SDAPT,"SD")+1
QUIT
PREV SET SDBD=SDBD+.1
SET SDED=SDED-.9
SET SDBO=$TRANSLATE($$FMTE^XLFDT(SDBD,"2FD")," ","0")
SET SDEO=$TRANSLATE($$FMTE^XLFDT(SDED,"2FD")," ","0")
SET I=0
SET SDSUB=$SELECT(SDS="C":"CL",1:"SC")
DO COMPHEAD
+1 FOR I1=0:0
SET I=$ORDER(^TMP($JOB,SDSUB,1,I))
if I=""
QUIT
SET SDCUR=+$PIECE(^(I),"^",2)
SET SDOLD=+$SELECT($DATA(^TMP($JOB,SDSUB,0,I)):$PIECE(^(I),"^",2),1:0)
if ($Y>(IOSL-8))
DO EOP
DO COMPHEAD
DO COMPARE
+2 DO EOP
QUIT
COMPHEAD SET SDPG=SDPG+1
WRITE @IOF,!?29,"CLINIC WORKLOAD REPORT",?71,"PAGE: ",$JUSTIFY(SDPG,3),!?22,"COMPARISON OF VISITS TO PREVIOUS YEAR",!?20,"FOR PERIOD COVERING: ",SDB1,"-",SDE1,!?26,"REPORT RUN ON: ",SDNOW,!!
KILL Y
SET $PIECE(Y,"_",81)=""
WRITE Y
DO BLANK
+1 WRITE !,"|",?25,"|",?29,"# OF VISITS",?43,"|",?47,"# OF VISITS",?61,"|",?64,"NET",?70,"|",?74,"%",?79,"|",!,"|",?7,$SELECT(SDS="C":"Clinic",1:"Stop Code")," Name",?25,"|",SDB,"-",SDE,"|",SDBO,"-",SDEO,"| CHANGE | CHANGE |"
DO EOP
DO EOP
DO BLANK
QUIT
COMPARE WRITE !,"|",$SELECT(SDS="C":$EXTRACT(I,1,24),1:$JUSTIFY(I,15)),?25,"|",?31,$JUSTIFY(SDCUR,7),?43,"|",?49,$JUSTIFY(SDOLD,7),?61,"|"
SET X=SDCUR-SDOLD
WRITE $JUSTIFY($SELECT(X>0:"+"_X,2:X),7,2),?70,"|",$SELECT(SDOLD=0:" N/A",1:$JUSTIFY(X*100/SDOLD,7,2))," |"
QUIT
EOP WRITE !,"|"
KILL Y
SET $PIECE(Y,"_",25)=""
WRITE Y,"|",$EXTRACT(Y,1,17),"|",$EXTRACT(Y,1,17),"|",$EXTRACT(Y,1,8),"|",$EXTRACT(Y,1,8),"|"
QUIT
BLANK WRITE !,"|",?25,"|",?43,"|",?61,"|",?70,"|",?79,"|"
QUIT
ADDON IF 'SDALL&'$DATA(SDCL(SDSC))
QUIT
+1 SET J=SDOE
SET I=+SDOE0
+2 SET DIV=$SELECT($PIECE(SDOE0,"^",11)]"":$PIECE(SDOE0,"^",11),1:$ORDER(^DG(40.8,0)))
SET DFN=+$PIECE(SDOE0,U,2)
if 'VAUTD&'$DATA(VAUTD(DIV))
QUIT
+3 SET $PIECE(^TMP($JOB,"SC",'$DATA(SDFL),SDSC),"^")=1
SET $PIECE(^(SDSC),"^",2)=$PIECE(^(SDSC),"^",2)+1
if (SDRT="B")
QUIT
SET ^("{")=$SELECT($DATA(^(SDSC,"{")):^("{")+1,1:1)
SET SDAPT=$SELECT(SDF="D":I\1,1:I\100)
+4 if $DATA(SDFL)
QUIT
SET ^(SDAPT)=$SELECT($DATA(^TMP($JOB,"SC",SDSC,"{",SDAPT)):^(SDAPT)+1,1:1)
+5 if 'SDNAM
QUIT
SET SDNM=$PIECE(^DPT(DFN,0),U)
SET SDSSN=$SELECT($PIECE(^(0),U,9)]"":$PIECE(^(0),U,9),1:0)
SET ^TMP($JOB,"SC",SDSC,"{",SDAPT,SDNM,SDSSN,I,J)=""
QUIT
