SDCWL1 ;ALB/MLI - CLINIC WORKLOAD REPORT PRINTOUT ; 27 APRIL 88
;;5.3;Scheduling;**140,1001,1013,1015**;Aug 13, 1993;Build 21
G:SDS="C" CLIN
;IHS/ITSC/WAR 5/5/2004 PATCH #1001 Alpha/Num SC causing endless loop
;F I=2:0 D SCT S I=$O(^TMP($J,"SC",I)) Q:'I!(I=" ") D ISC S J=0 F J1=0:0 D T:J'="{",AT:J="{" S J=$O(^TMP($J,"SC",I,J)) Q:J="" D:J="{" ADD I J'="{" F K=-1:0 S K=$O(^TMP($J,"SC",I,J,K)) Q:K="" I $D(^TMP($J,"SC",1,I)),^(I) D HD1,I,SORT
;S I=2 ;IHS/ITSC/WAR PATCH #1001 added next line 5/5/2004
S I=0 ;IHS/ITSC/WAR PATCH #1001 worked on this with Chinle 12/22/2004
;IHS/ITSC/WAR 1/7/2004 PATCH #1001 to long of a string for SAC checker
;F D SCT S I=$O(^TMP($J,"SC",I)) Q:I="" S I=$S('$D(I(1)):1,'$D(I(2)):2,1:I) D ISC S J=0 F J1=0:0 D T:J'="{",AT:J="{" S J=$O(^TMP($J,"SC",I,J)) Q:J=""
;D:J="{" ADD I J'="{" F K=-1:0 S K=$O(^TMP($J,"SC",I,J,K)) Q:K="" I $D(^TMP($J,"SC",1,I)),^(I) D HD1,I,SORT
F D SCT S I=$O(^TMP($J,"SC",I)) Q:I="" S I=$S('$D(I(1)):1,'$D(I(2)):2,1:I) D ISC S J=0 F J1=0:0 D T:J'="{",AT:J="{" S J=$O(^TMP($J,"SC",I,J)) Q:J="" D:J="{" ADD I J'="{" F K=-1:0 S K=$O(^TMP($J,"SC",I,J,K)) Q:K="" D
.I $D(^TMP($J,"SC",1,I)),^(I) D HD1,I,SORT
Q
CLIN S J=0 F J1=0:0 D T S J=$O(^TMP($J,1,J)) Q:J="" I $D(^TMP($J,"CL",1,J)),^(J) D HD1,I,SORT
Q
SORT W !,J W:SDS="S"&K ?24,"***",I," IS THE CREDIT STOP CODE FOR THIS CLINIC***" F R=0:0 S R=$O(^TMP($J,1,J,R)) Q:'R D NM:SDNAM,PRINT
Q
NM S M=0 F M1=0:0 S M=$O(^TMP($J,1,J,R,"NM",M)) Q:M="" S N=0 F N1=0:0 S N=$O(^TMP($J,1,J,R,"NM",M,N)) Q:N="" S P=0 F P1=0:0 S P=$O(^TMP($J,1,J,R,"NM",M,N,P)) Q:P="" S Q=0 F Q1=0:0 S Q=$O(^TMP($J,1,J,R,"NM",M,N,P,Q)) Q:Q="" D PN
Q
PN D:$Y>(IOSL-15) HD1
;ihs/cmi/maw 08/09/2011 PATCH 1013 RQMT 159
;W !?12,$S(SDHR'=R:$S(SDF="D":$TR($$FMTE^XLFDT(R,"5DF")," ","0"),1:$E(R,4,5)_"-"_$E(R,2,3)),1:"") S SDHR=R W ?24,$E(M,1,17),?43,$E(N,1,3),"-",$E(N,4,5),"-",$E(N,6,9)
;W ?56,$S(Q["C":"CANCELLED",Q="NT":"ACTION REQ'D",Q["N":"NO-SHOW",Q["I":"INPATIENT",Q="OB":"OVERBOOK",Q="U":"UNSCHEDULED",Q="S":"SCHEDULED",1:" "),?69,"TIME: ",P
W !,$S(SDHR'=R:$S(SDF="D":$TR($$FMTE^XLFDT(R,"5DF")," ","0"),1:$E(R,4,5)_"-"_$E(R,2,3)),1:"") S SDHR=R W ?12,$E(M,1,17),?31,N
W ?56,$S(Q["C":"CANCELLED",Q="NT":"ACTION REQ'D",Q["N":"NO-SHOW",Q["I":"INPATIENT",Q="OB":"OVERBOOK",Q="U":"UNSCHEDULED",Q="S":"SCHEDULED",1:" "),?69,"TIME: ",P
Q
PRINT I $Y>(IOSL-12)&$S('SDNAM&(R>-1):1,'SDNAM:0,SDNAM&(M>-1):1,1:0) D HD1
W ! W:'SDNAM ?14,$S(SDF="D":$TR($$FMTE^XLFDT(R,"5DF")," ","0"),1:$E(R,4,5)_"-"_$E(R,2,3)) I SDNAM K Y S $P(Y,"_",57)="" W ?24,Y,!
W ?30,$J(^TMP($J,1,J,R,"SD"),4),?36,$J(^("UN"),4),?42,$J(^("IN"),4),?48,$J(^("OB"),4),?55,"N/A",?60,$J(^("NS"),4),?66,$J(^("CA"),4),?76,$J(^("SD")+^("UN")+^("IN")+^("OB"),4) W:SDNAM !
S SDSCH=SDSCH+^TMP($J,1,J,R,"SD"),SDUN=SDUN+^("UN"),SDIN=SDIN+^("IN"),SDOB=SDOB+^("OB"),SDNS=SDNS+^("NS"),SDCA=SDCA+^("CA")
S:SDS="S" SDSCS=SDSCS+^("SD"),SDSCU=SDSCU+^("UN"),SDSCI=SDSCI+^("IN"),SDSCO=SDSCO+^TMP($J,1,J,R,"OB"),SDSCN=SDSCN+^("NS"),SDSCC=SDSCC+^("CA") Q ;NAKED REFERENCE - ^TMP($J,1,Clinic,Date,Appt.Type)
HD1 D LEG^SDCWL3 S SDPG=SDPG+1
W @IOF,!?29,"CLINIC WORKLOAD REPORT",?71,"PAGE: ",$J(SDPG,3),!?27,$S(SDF="D":"DETAILED BY DAY",1:"SUMMARY BY MONTH")," BY ",$S(SDS="C":"CLINIC",1:"STOP CODE"),!?21,"PERIOD COVERING: ",SDB1,"-",SDE1,!?25,"DATE RUN ON: ",SDNOW
W !!?72,"TOTAL",!?29,"SCHED",?35,"UNSCH",?41,"INPAT",?47,"OVER-",?53,"ADD/",?59,"NO-",?65,"CANCEL",?72,"PATIENTS"
W !,"CLINIC NAME",?14,"DATE",?29,"APPTS",?35,"APPTS",?41,"APPTS",?47,"BOOKS",?53,"EDITS",?59,"SHOWS",?65,"APPTS",?72,"SEEN",!! W:SDS="S" "STOP CODE:",?14,I Q
I S (SDT,SDSCH,SDUN,SDIN,SDOB,SDNS,SDCA)=0 Q
;IHS/ITSC/WAR 5/5/2004 PATCH #1001
ISC ;S (SDAED,SDSCS,SDSCU,SDSCI,SDSCO,SDSCN,SDSCC)=0 Q
S (SDAED,SDSCS,SDSCU,SDSCI,SDSCO,SDSCN,SDSCC)=0,I(I)="" Q
T Q:$S('$D(^TMP($J,"CL",1,J)):1,'^(J):1,1:0)
K Y S $P(Y,"_",67)="" W !!?14,Y,!?14,"Clinic Total",?30,$J(SDSCH,4),?36,$J(SDUN,4),?42,$J(SDIN,4),?48,$J(SDOB,4),?55,"N/A",?60,$J(SDNS,4),?66,$J(SDCA,4) S SDTOT=SDSCH+SDUN+SDIN+SDOB W ?76,$J(SDTOT,4) Q
SCT Q:$S(I=2:1,'$D(^TMP($J,"SC",1,I)):1,'^(I):1,1:0) S SDTOT=SDSCS+SDSCU+SDSCI+SDSCO+$S('SDADD:0,1:SDAED)
K Y S $P(Y,"_",81)="" W !!,Y,!,"Stop Code ",I," Total",?30,$J(SDSCS,4),?36,$J(SDSCU,4),?42,$J(SDSCI,4),?48,$J(SDSCO,4),?54,$J($S('SDADD:"N/A",1:SDAED),4),?60,$J(SDSCN,4),?66,$J(SDSCC,4),?76,$J(SDTOT,4) Q
ADD D HD1 W !,"ADD/EDIT" S K=3 F K1=0:0 S SDHK=0,K=$O(^TMP($J,"SC",I,J,K)) Q:K="" D ADD1:SDNAM,PRADD
Q
ADD1 S L=0 F L1=0:0 S L=$O(^TMP($J,"SC",I,J,K,L)) Q:L="" S M=0 F M1=0:0 S M=$O(^TMP($J,"SC",I,J,K,L,M)) Q:M="" F N=0:0 S N=$O(^TMP($J,"SC",I,J,K,L,M,N)) Q:'N F P=0:0 S P=$O(^TMP($J,"SC",I,J,K,L,M,N,P)) Q:'P D PA
Q
PA W !?14,$S(SDHK'=K:$S(SDF="D":$E(K,4,5)_"-"_$E(K,6,7)_"-"_$E(K,2,3),1:$E(K,4,5)_"-"_$E(K,2,3)),1:"") S SDHK=K W ?24,$E(L,1,17),?43,$E(M,1,3),"-",$E(M,4,5)
W "-",$E(M,6,9),?56,"ADD/EDIT",?69,"TIME: " S Y=N X ^DD("DD") W $P(Y,"@",2) Q
AT K Y S $P(Y,"_",67)="" W !?14,Y,!?14,"Add/Edit Total",?31,"N/A",?37,"N/A",?43,"N/A",?49,"N/A",?54,$J(SDAED,4),?61,"N/A",?67,"N/A",?76,$J(SDAED,4) Q
PRADD D:($Y>(IOSL-8))&($O(^TMP($J,"SC",I,"{",K))'="") HD1 W ! W:'SDNAM ?14,$S(SDF="D":$E(K,4,5)_"-"_$E(K,6,7)_"-"_$E(K,2,3),1:$E(K,4,5)_"-"_$E(K,2,3)) I SDNAM K Y S $P(Y,"_",57)="" W ?24,Y,!
S SDNUM=^TMP($J,"SC",I,"{",K) W ?31,"N/A",?37,"N/A",?43,"N/A",?49,"N/A",?54,$J(SDNUM,4),?61,"N/A",?67,"N/A",?76,$J(SDNUM,4) S SDAED=SDAED+SDNUM Q
SDCWL1 ;ALB/MLI - CLINIC WORKLOAD REPORT PRINTOUT ; 27 APRIL 88
+1 ;;5.3;Scheduling;**140,1001,1013,1015**;Aug 13, 1993;Build 21
+2 IF SDS="C"
GOTO CLIN
+3 ;IHS/ITSC/WAR 5/5/2004 PATCH #1001 Alpha/Num SC causing endless loop
+4 ;F I=2:0 D SCT S I=$O(^TMP($J,"SC",I)) Q:'I!(I=" ") D ISC S J=0 F J1=0:0 D T:J'="{",AT:J="{" S J=$O(^TMP($J,"SC",I,J)) Q:J="" D:J="{" ADD I J'="{" F K=-1:0 S K=$O(^TMP($J,"SC",I,J,K)) Q:K="" I $D(^TMP($J,"SC",1,I)),^(I) D HD1,I,SORT
+5 ;S I=2 ;IHS/ITSC/WAR PATCH #1001 added next line 5/5/2004
+6 ;IHS/ITSC/WAR PATCH #1001 worked on this with Chinle 12/22/2004
SET I=0
+7 ;IHS/ITSC/WAR 1/7/2004 PATCH #1001 to long of a string for SAC checker
+8 ;F D SCT S I=$O(^TMP($J,"SC",I)) Q:I="" S I=$S('$D(I(1)):1,'$D(I(2)):2,1:I) D ISC S J=0 F J1=0:0 D T:J'="{",AT:J="{" S J=$O(^TMP($J,"SC",I,J)) Q:J=""
+9 ;D:J="{" ADD I J'="{" F K=-1:0 S K=$O(^TMP($J,"SC",I,J,K)) Q:K="" I $D(^TMP($J,"SC",1,I)),^(I) D HD1,I,SORT
+10 FOR
DO SCT
SET I=$ORDER(^TMP($JOB,"SC",I))
IF I=""
QUIT
SET I=$SELECT('$DATA(I(1)):1,'$DATA(I(2)):2,1:I)
DO ISC
SET J=0
FOR J1=0:0
IF J'="{"
DO T
IF J="{"
DO AT
SET J=$ORDER(^TMP($JOB,"SC",I,J))
IF J=""
QUIT
IF J="{"
DO ADD
IF J'="{"
FOR K=-1:0
SET K=$ORDER(^TMP($JOB,"SC",I,J,K))
IF K=""
QUIT
Begin DoDot:1
+11 IF $DATA(^TMP($JOB,"SC",1,I))
IF ^(I)
DO HD1
DO I
DO SORT
End DoDot:1
+12 QUIT
CLIN SET J=0
FOR J1=0:0
DO T
SET J=$ORDER(^TMP($JOB,1,J))
IF J=""
QUIT
IF $DATA(^TMP($JOB,"CL",1,J))
IF ^(J)
DO HD1
DO I
DO SORT
+1 QUIT
SORT WRITE !,J
IF SDS="S"&K
WRITE ?24,"***",I," IS THE CREDIT STOP CODE FOR THIS CLINIC***"
FOR R=0:0
SET R=$ORDER(^TMP($JOB,1,J,R))
IF 'R
QUIT
IF SDNAM
DO NM
DO PRINT
+1 QUIT
NM SET M=0
FOR M1=0:0
SET M=$ORDER(^TMP($JOB,1,J,R,"NM",M))
IF M=""
QUIT
SET N=0
FOR N1=0:0
SET N=$ORDER(^TMP($JOB,1,J,R,"NM",M,N))
IF N=""
QUIT
SET P=0
FOR P1=0:0
SET P=$ORDER(^TMP($JOB,1,J,R,"NM",M,N,P))
IF P=""
QUIT
SET Q=0
FOR Q1=0:0
SET Q=$ORDER(^TMP($JOB,1,J,R,"NM",M,N,P,Q))
IF Q=""
QUIT
DO PN
+1 QUIT
PN IF $Y>(IOSL-15)
DO HD1
+1 ;ihs/cmi/maw 08/09/2011 PATCH 1013 RQMT 159
+2 ;W !?12,$S(SDHR'=R:$S(SDF="D":$TR($$FMTE^XLFDT(R,"5DF")," ","0"),1:$E(R,4,5)_"-"_$E(R,2,3)),1:"") S SDHR=R W ?24,$E(M,1,17),?43,$E(N,1,3),"-",$E(N,4,5),"-",$E(N,6,9)
+3 ;W ?56,$S(Q["C":"CANCELLED",Q="NT":"ACTION REQ'D",Q["N":"NO-SHOW",Q["I":"INPATIENT",Q="OB":"OVERBOOK",Q="U":"UNSCHEDULED",Q="S":"SCHEDULED",1:" "),?69,"TIME: ",P
+4 WRITE !,$SELECT(SDHR'=R:$SELECT(SDF="D":$TRANSLATE($$FMTE^XLFDT(R,"5DF")," ","0"),1:$EXTRACT(R,4,5)_"-"_$EXTRACT(R,2,3)),1:"")
SET SDHR=R
WRITE ?12,$EXTRACT(M,1,17),?31,N
+5 WRITE ?56,$SELECT(Q["C":"CANCELLED",Q="NT":"ACTION REQ'D",Q["N":"NO-SHOW",Q["I":"INPATIENT",Q="OB":"OVERBOOK",Q="U":"UNSCHEDULED",Q="S":"SCHEDULED",1:" "),?69,"TIME: ",P
+6 QUIT
PRINT IF $Y>(IOSL-12)&$SELECT('SDNAM&(R>-1):1,'SDNAM:0,SDNAM&(M>-1):1,1:0)
DO HD1
+1 WRITE !
IF 'SDNAM
WRITE ?14,$SELECT(SDF="D":$TRANSLATE($$FMTE^XLFDT(R,"5DF")," ","0"),1:$EXTRACT(R,4,5)_"-"_$EXTRACT(R,2,3))
IF SDNAM
KILL Y
SET $PIECE(Y,"_",57)=""
WRITE ?24,Y,!
+2 WRITE ?30,$JUSTIFY(^TMP($JOB,1,J,R,"SD"),4),?36,$JUSTIFY(^("UN"),4),?42,$JUSTIFY(^("IN"),4),?48,$JUSTIFY(^("OB"),4),?55,"N/A",?60,$JUSTIFY(^("NS"),4),?66,$JUSTIFY(^("CA"),4),?76,$JUSTIFY(^("SD")+^("UN")+^("IN")+^("OB"),4)
IF SDNAM
WRITE !
+3 SET SDSCH=SDSCH+^TMP($JOB,1,J,R,"SD")
SET SDUN=SDUN+^("UN")
SET SDIN=SDIN+^("IN")
SET SDOB=SDOB+^("OB")
SET SDNS=SDNS+^("NS")
SET SDCA=SDCA+^("CA")
+4 ;NAKED REFERENCE - ^TMP($J,1,Clinic,Date,Appt.Type)
IF SDS="S"
SET SDSCS=SDSCS+^("SD")
SET SDSCU=SDSCU+^("UN")
SET SDSCI=SDSCI+^("IN")
SET SDSCO=SDSCO+^TMP($JOB,1,J,R,"OB")
SET SDSCN=SDSCN+^("NS")
SET SDSCC=SDSCC+^("CA")
QUIT
HD1 DO LEG^SDCWL3
SET SDPG=SDPG+1
+1 WRITE @IOF,!?29,"CLINIC WORKLOAD REPORT",?71,"PAGE: ",$JUSTIFY(SDPG,3),!?27,$SELECT(SDF="D":"DETAILED BY DAY",1:"SUMMARY BY MONTH")," BY ",$SELECT(SDS="C":"CLINIC",1:"STOP CODE"),!?21,"PERIOD COVERING: ",SDB1,"-",SDE1,!?25,"DATE RUN ON: ",SDN
OW
+2 WRITE !!?72,"TOTAL",!?29,"SCHED",?35,"UNSCH",?41,"INPAT",?47,"OVER-",?53,"ADD/",?59,"NO-",?65,"CANCEL",?72,"PATIENTS"
+3 WRITE !,"CLINIC NAME",?14,"DATE",?29,"APPTS",?35,"APPTS",?41,"APPTS",?47,"BOOKS",?53,"EDITS",?59,"SHOWS",?65,"APPTS",?72,"SEEN",!!
IF SDS="S"
WRITE "STOP CODE:",?14,I
QUIT
I SET (SDT,SDSCH,SDUN,SDIN,SDOB,SDNS,SDCA)=0
QUIT
+1 ;IHS/ITSC/WAR 5/5/2004 PATCH #1001
ISC ;S (SDAED,SDSCS,SDSCU,SDSCI,SDSCO,SDSCN,SDSCC)=0 Q
+1 SET (SDAED,SDSCS,SDSCU,SDSCI,SDSCO,SDSCN,SDSCC)=0
SET I(I)=""
QUIT
T IF $SELECT('$DATA(^TMP($JOB,"CL",1,J))
QUIT
+1 KILL Y
SET $PIECE(Y,"_",67)=""
WRITE !!?14,Y,!?14,"Clinic Total",?30,$JUSTIFY(SDSCH,4),?36,$JUSTIFY(SDUN,4),?42,$JUSTIFY(SDIN,4),?48,$JUSTIFY(SDOB,4),?55,"N/A",?60,$JUSTIFY(SDNS,4),?66,$JUSTIFY(SDCA,4)
SET SDTOT=SDSCH+SDUN+SDIN+SDOB
WRITE ?76,$JUSTIFY(SDTOT,4)
QUIT
SCT IF $SELECT(I=2
QUIT
SET SDTOT=SDSCS+SDSCU+SDSCI+SDSCO+$SELECT('SDADD:0,1:SDAED)
+1 KILL Y
SET $PIECE(Y,"_",81)=""
WRITE !!,Y,!,"Stop Code ",I," Total",?30,$JUSTIFY(SDSCS,4),?36,$JUSTIFY(SDSCU,4),?42,$JUSTIFY(SDSCI,4),?48,$JUSTIFY(SDSCO,4),?54,$JUSTIFY($SELECT('SDADD:"N/A",1:SDAED),4),?60,$JUSTIFY(SDSCN,4),?66,$JUSTIFY(SDSCC,4),?76,$JUSTIFY(SDTOT,4)
QUIT
ADD DO HD1
WRITE !,"ADD/EDIT"
SET K=3
FOR K1=0:0
SET SDHK=0
SET K=$ORDER(^TMP($JOB,"SC",I,J,K))
IF K=""
QUIT
IF SDNAM
DO ADD1
DO PRADD
+1 QUIT
ADD1 SET L=0
FOR L1=0:0
SET L=$ORDER(^TMP($JOB,"SC",I,J,K,L))
IF L=""
QUIT
SET M=0
FOR M1=0:0
SET M=$ORDER(^TMP($JOB,"SC",I,J,K,L,M))
IF M=""
QUIT
FOR N=0:0
SET N=$ORDER(^TMP($JOB,"SC",I,J,K,L,M,N))
IF 'N
QUIT
FOR P=0:0
SET P=$ORDER(^TMP($JOB,"SC",I,J,K,L,M,N,P))
IF 'P
QUIT
DO PA
+1 QUIT
PA WRITE !?14,$SELECT(SDHK'=K:$SELECT(SDF="D":$EXTRACT(K,4,5)_"-"_$EXTRACT(K,6,7)_"-"_$EXTRACT(K,2,3),1:$EXTRACT(K,4,5)_"-"_$EXTRACT(K,2,3)),1:"")
SET SDHK=K
WRITE ?24,$EXTRACT(L,1,17),?43,$EXTRACT(M,1,3),"-",$EXTRACT(M,4,5)
+1 WRITE "-",$EXTRACT(M,6,9),?56,"ADD/EDIT",?69,"TIME: "
SET Y=N
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@",2)
QUIT
AT KILL Y
SET $PIECE(Y,"_",67)=""
WRITE !?14,Y,!?14,"Add/Edit Total",?31,"N/A",?37,"N/A",?43,"N/A",?49,"N/A",?54,$JUSTIFY(SDAED,4),?61,"N/A",?67,"N/A",?76,$JUSTIFY(SDAED,4)
QUIT
PRADD IF ($Y>(IOSL-8))&($ORDER(^TMP($JOB,"SC",I,"{",K))'="")
DO HD1
WRITE !
IF 'SDNAM
WRITE ?14,$SELECT(SDF="D":$EXTRACT(K,4,5)_"-"_$EXTRACT(K,6,7)_"-"_$EXTRACT(K,2,3),1:$EXTRACT(K,4,5)_"-"_$EXTRACT(K,2,3))
IF SDNAM
KILL Y
SET $PIECE(Y,"_",57)=""
WRITE ?24,Y,!
+1 SET SDNUM=^TMP($JOB,"SC",I,"{",K)
WRITE ?31,"N/A",?37,"N/A",?43,"N/A",?49,"N/A",?54,$JUSTIFY(SDNUM,4),?61,"N/A",?67,"N/A",?76,$JUSTIFY(SDNUM,4)
SET SDAED=SDAED+SDNUM
QUIT
