ECTDSUR ;B'ham ISC/DMA-Surgery Workload ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
I '$D(^SRF) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Surgery' File - #130 is not loaded on your system.",!! S XQUIT="" Q
I '$O(^SRF(0)) W *7,!!,"'Surgery' File - #130 has not been populated on your system.",!! S XQUIT="" Q
;
BDAT K %DT S %DT="AEX",%DT("A")="Beginning date : " D ^%DT G:Y<0 END S ECBD=Y
EDAT S %DT("A")="Ending date : " D ^%DT G:Y<0 END S ECED=Y I Y<ECBD W !,"Ending date must be later than beginning date",! G BDAT
S %ZIS="Q" D ^%ZIS I POP G END
I $D(IO("Q")) G QUE
;
DEQ ;gather and print data
U IO K ^TMP($J)
S ECED=ECED+.3
F ECD=ECBD-.1:0 S ECD=$O(^SRF("AC",ECD)) Q:'ECD Q:ECD>ECED F ECD0=0:0 S ECD0=$O(^SRF("AC",ECD,ECD0)) Q:'ECD0 I $D(^SRF(ECD0,0)) S DATA=^(0) D GET
;
PRINT ;
W:$Y @IOF
S (COT,CAT)=0,PGCT=1,$P(LN,"-",81)=""
W !,?15,"SURGERY CASES FOR THE PERIOD ",$E(ECBD,4,5),"/",$E(ECBD,6,7),"/",$E(ECBD,2,3)," TO ",$E(ECED,4,5),"/",$E(ECED,6,7),"/",$E(ECED,2,3) D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W !!?45,Y,?70,"PAGE ",PGCT S PGCT=PGCT+1
W !!,?35,"COMPLETED",?47,"CANCELLED",?61,"TOTAL",?71,"PERCENT",!,"SPECIALTY",?37,"CASES",?49,"CASES",?61,"CASES",?70,"CANCELLED",!,LN
I $O(^TMP($J,0))="" W !?19,"NO DATA AVAILABLE FOR SELECTED DATE RANGE.",!! G DONE
S SC="" F J=0:0 S SC=$O(^TMP($J,SC)) Q:SC="" S DATA=^(SC),CO=$P(DATA,"^"),CA=$P(DATA,"^",2),TOT=CO+CA,CAT=CAT+CA,COT=COT+CO W !,?3,$S(SC="zz":"NOT SPECIFIED",1:SC),?35,$J(CO,5,0),?47,$J(CA,5,0) W:TOT ?61,$J(TOT,5,0),?71,$J((100*CA/TOT),5,1)
W !?35 F J=1:1:45 W "-"
W !?10,"TOTAL",?35,$J(COT,5,0),?47,$J(CAT,5,0) S TOT=COT+CAT W:TOT ?61,$J(TOT,5,0),?71,$J(100*CAT/TOT,5,1)
DONE W:$E(IOST)="P" @IOF D ^%ZISC
END K %,%H,%I,%DT,%ZIS,CA,CAT,CO,COT,DATA,ECBD,ECD,ECD0,ECED,J,LN,PGCT,POP,SC,SPP,TOT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP($J) I IO="" S IOP="HOME" D ^%ZIS
Q
;
GET ;
S SC="zz",SPP=+$P(DATA,"^",4) I $D(^DIC(45.3,SPP,0)),$P(^(0),"^",2)]"" S SC=$P(^(0),"^",2) I $E(SC,2,200)["(" S SC=$P(SC,"(")
S X=0
I $D(^SRF(ECD0,.2)),$P(^(.2),"^",12) S X=1
I $D(^SRF(ECD0,30)),^(30)]"" S X=2
Q:'X
;X=1 FOR COMPLETED, 2 FOR CANCELLED
I '$D(^TMP($J,SC)) S ^(SC)=""
S $P(^TMP($J,SC),"^",X)=$P(^TMP($J,SC),"^",X)+1
Q
;
QUE S ZTRTN="DEQ^ECTDSUR",(ZTSAVE("ECBD"),ZTSAVE("ECED"))="",ZTDESC="Surgery Workload",ZTIO=ION D ^%ZTLOAD G END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTDSUR 2374 printed Sep 23, 2025@19:38:21 Page 2
ECTDSUR ;B'ham ISC/DMA-Surgery Workload ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
+1 IF '$DATA(^SRF)
WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Surgery' File - #130 is not loaded on your system.",!!
SET XQUIT=""
QUIT
+2 IF '$ORDER(^SRF(0))
WRITE *7,!!,"'Surgery' File - #130 has not been populated on your system.",!!
SET XQUIT=""
QUIT
+3 ;
BDAT KILL %DT
SET %DT="AEX"
SET %DT("A")="Beginning date : "
DO ^%DT
if Y<0
GOTO END
SET ECBD=Y
EDAT SET %DT("A")="Ending date : "
DO ^%DT
if Y<0
GOTO END
SET ECED=Y
IF Y<ECBD
WRITE !,"Ending date must be later than beginning date",!
GOTO BDAT
+1 SET %ZIS="Q"
DO ^%ZIS
IF POP
GOTO END
+2 IF $DATA(IO("Q"))
GOTO QUE
+3 ;
DEQ ;gather and print data
+1 USE IO
KILL ^TMP($JOB)
+2 SET ECED=ECED+.3
+3 FOR ECD=ECBD-.1:0
SET ECD=$ORDER(^SRF("AC",ECD))
if 'ECD
QUIT
if ECD>ECED
QUIT
FOR ECD0=0:0
SET ECD0=$ORDER(^SRF("AC",ECD,ECD0))
if 'ECD0
QUIT
IF $DATA(^SRF(ECD0,0))
SET DATA=^(0)
DO GET
+4 ;
PRINT ;
+1 if $Y
WRITE @IOF
+2 SET (COT,CAT)=0
SET PGCT=1
SET $PIECE(LN,"-",81)=""
+3 WRITE !,?15,"SURGERY CASES FOR THE PERIOD ",$EXTRACT(ECBD,4,5),"/",$EXTRACT(ECBD,6,7),"/",$EXTRACT(ECBD,2,3)," TO ",$EXTRACT(ECED,4,5),"/",$EXTRACT(ECED,6,7),"/",$EXTRACT(ECED,2,3)
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
WRITE !!?45,Y,?70,"PAGE ",PGCT
SET PGCT=PGCT+1
+4 WRITE !!,?35,"COMPLETED",?47,"CANCELLED",?61,"TOTAL",?71,"PERCENT",!,"SPECIALTY",?37,"CASES",?49,"CASES",?61,"CASES",?70,"CANCELLED",!,LN
+5 IF $ORDER(^TMP($JOB,0))=""
WRITE !?19,"NO DATA AVAILABLE FOR SELECTED DATE RANGE.",!!
GOTO DONE
+6 SET SC=""
FOR J=0:0
SET SC=$ORDER(^TMP($JOB,SC))
if SC=""
QUIT
SET DATA=^(SC)
SET CO=$PIECE(DATA,"^")
SET CA=$PIECE(DATA,"^",2)
SET TOT=CO+CA
SET CAT=CAT+CA
SET COT=COT+CO
WRITE !,?3,$SELECT(SC="zz":"NOT SPECIFIED",1:SC),?35,$JUSTIFY(CO,5,0),?47,$JUSTIFY(CA,5,0)
if TOT
WRITE ?61,$JUSTIFY(TOT,5,0),?71,$JUSTIFY((100*CA/TOT),5,1)
+7 WRITE !?35
FOR J=1:1:45
WRITE "-"
+8 WRITE !?10,"TOTAL",?35,$JUSTIFY(COT,5,0),?47,$JUSTIFY(CAT,5,0)
SET TOT=COT+CAT
if TOT
WRITE ?61,$JUSTIFY(TOT,5,0),?71,$JUSTIFY(100*CAT/TOT,5,1)
DONE if $EXTRACT(IOST)="P"
WRITE @IOF
DO ^%ZISC
END KILL %,%H,%I,%DT,%ZIS,CA,CAT,CO,COT,DATA,ECBD,ECD,ECD0,ECED,J,LN,PGCT,POP,SC,SPP,TOT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP($JOB)
IF IO=""
SET IOP="HOME"
DO ^%ZIS
+1 QUIT
+2 ;
GET ;
+1 SET SC="zz"
SET SPP=+$PIECE(DATA,"^",4)
IF $DATA(^DIC(45.3,SPP,0))
IF $PIECE(^(0),"^",2)]""
SET SC=$PIECE(^(0),"^",2)
IF $EXTRACT(SC,2,200)["("
SET SC=$PIECE(SC,"(")
+2 SET X=0
+3 IF $DATA(^SRF(ECD0,.2))
IF $PIECE(^(.2),"^",12)
SET X=1
+4 IF $DATA(^SRF(ECD0,30))
IF ^(30)]""
SET X=2
+5 if 'X
QUIT
+6 ;X=1 FOR COMPLETED, 2 FOR CANCELLED
+7 IF '$DATA(^TMP($JOB,SC))
SET ^(SC)=""
+8 SET $PIECE(^TMP($JOB,SC),"^",X)=$PIECE(^TMP($JOB,SC),"^",X)+1
+9 QUIT
+10 ;
QUE SET ZTRTN="DEQ^ECTDSUR"
SET (ZTSAVE("ECBD"),ZTSAVE("ECED"))=""
SET ZTDESC="Surgery Workload"
SET ZTIO=ION
DO ^%ZTLOAD
GOTO END
