SROPACT ;B'HAM ISC/MAM - DAILY ACTIVITY LOG ; [ 09/22/98 11:36 AM ]
;;3.0; Surgery ;**77,50**;24 Jun 93
W @IOF,! S SRSOUT=0 K %DT
S %DT="AEPX",%DT("A")="Print the Report of Daily Activity for which Date ? " D ^%DT I Y<0 S SRSOUT=1 G END
S SRSD=+Y,SRINST=SRSITE("SITE")
D D^DIQ S SRDT1=Y S X1=SRSD,X2=1 D C^%DTC S SRET=X_".0559",Y=X,SRED=X_".9999" D D^DIQ S SRDT2=Y
W !!,"This report will include all cases started between "_SRDT1_" at 6:00 AM",!,"and "_SRDT2_" at 5:59 AM."
I $D(^XUSEC("SROCHIEF",+DUZ)) N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))
K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report to which Device ? ",%ZIS="QM"
W !!,"It is designed to use a 132 column format.",! D ^%ZIS I POP S SRSOUT=1 G END
I $D(IO("Q")) K IO("Q") S ZTDESC="Report of Daily OR Activities",ZTRTN="EN^SROPACT",(ZTSAVE("SRET"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRINST"),ZTSAVE("SRSITE*"),ZTSAVE("SRINSTP"))="" D ^%ZTLOAD G END
EN ; entry when queued
S Y=SRSD D D^DIQ S SRSDT=Y
U IO S SRSDATE=SRSD-.0001,SRST=SRSD_".06" K ^TMP("SRACT",$J)
F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:SRSDATE>SRED!('SRSDATE) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN D:$D(^SRF(SRTN,0))
.I $D(^XUSEC("SROCHIEF",+DUZ)) I $$MANDIV^SROUTL0(SRINSTP,SRTN) D UTIL
.I '$D(^XUSEC("SROCHIEF",+DUZ)) I $$DIV^SROUTL0(SRTN) D UTIL
D ^SROPAC0
END I $E(IOST)'="P",'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
W:$E(IOST)="P" @IOF K ^TMP("SRACT",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
K SRTN D ^SRSKILL D ^%ZISC W @IOF
Q
UTIL ; set ^TMP("SRACT",$J)
I '$D(^SRF(SRTN,.2)) Q
I $P(^SRF(SRTN,.2),"^",10)="" Q
S SRTIMEIN=$P(^SRF(SRTN,.2),"^",10) Q:SRTIMEIN<SRST I SRTIMEIN>SRET Q
S SROR=$P(^SRF(SRTN,0),"^",2) S:'SROR SROR="OTHER"
I SROR S SROR=$P(^SRS(SROR,0),"^"),SROR=$P(^SC(SROR,0),"^")
S ^TMP("SRACT",$J,SROR,SRSDATE,SRTN)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPACT 1956 printed Nov 22, 2024@17:54:47 Page 2
SROPACT ;B'HAM ISC/MAM - DAILY ACTIVITY LOG ; [ 09/22/98 11:36 AM ]
+1 ;;3.0; Surgery ;**77,50**;24 Jun 93
+2 WRITE @IOF,!
SET SRSOUT=0
KILL %DT
+3 SET %DT="AEPX"
SET %DT("A")="Print the Report of Daily Activity for which Date ? "
DO ^%DT
IF Y<0
SET SRSOUT=1
GOTO END
+4 SET SRSD=+Y
SET SRINST=SRSITE("SITE")
+5 DO D^DIQ
SET SRDT1=Y
SET X1=SRSD
SET X2=1
DO C^%DTC
SET SRET=X_".0559"
SET Y=X
SET SRED=X_".9999"
DO D^DIQ
SET SRDT2=Y
+6 WRITE !!,"This report will include all cases started between "_SRDT1_" at 6:00 AM",!,"and "_SRDT2_" at 5:59 AM."
+7 IF $DATA(^XUSEC("SROCHIEF",+DUZ))
NEW SRINSTP
SET SRINST=$$INST^SROUTL0()
if SRINST="^"
GOTO END
SET SRINSTP=$PIECE(SRINST,U)
SET SRINST=$SELECT(SRINST["ALL DIVISIONS":SRINST,1:$PIECE(SRINST,U,2))
+8 KILL IOP,%ZIS,POP,IO("Q")
SET %ZIS("A")="Print the Report to which Device ? "
SET %ZIS="QM"
+9 WRITE !!,"It is designed to use a 132 column format.",!
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO END
+10 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="Report of Daily OR Activities"
SET ZTRTN="EN^SROPACT"
SET (ZTSAVE("SRET"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRINST"),ZTSAVE("SRSITE*"),ZTSAVE("SRINSTP"))=""
DO ^%ZTLOAD
GOTO END
EN ; entry when queued
+1 SET Y=SRSD
DO D^DIQ
SET SRSDT=Y
+2 USE IO
SET SRSDATE=SRSD-.0001
SET SRST=SRSD_".06"
KILL ^TMP("SRACT",$JOB)
+3 FOR
SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
if SRSDATE>SRED!('SRSDATE)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
if 'SRTN
QUIT
if $DATA(^SRF(SRTN,0))
Begin DoDot:1
+4 IF $DATA(^XUSEC("SROCHIEF",+DUZ))
IF $$MANDIV^SROUTL0(SRINSTP,SRTN)
DO UTIL
+5 IF '$DATA(^XUSEC("SROCHIEF",+DUZ))
IF $$DIV^SROUTL0(SRTN)
DO UTIL
End DoDot:1
+6 DO ^SROPAC0
END IF $EXTRACT(IOST)'="P"
IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+1 if $EXTRACT(IOST)="P"
WRITE @IOF
KILL ^TMP("SRACT",$JOB)
IF $DATA(ZTQUEUED)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+2 KILL SRTN
DO ^SRSKILL
DO ^%ZISC
WRITE @IOF
+3 QUIT
UTIL ; set ^TMP("SRACT",$J)
+1 IF '$DATA(^SRF(SRTN,.2))
QUIT
+2 IF $PIECE(^SRF(SRTN,.2),"^",10)=""
QUIT
+3 SET SRTIMEIN=$PIECE(^SRF(SRTN,.2),"^",10)
if SRTIMEIN<SRST
QUIT
IF SRTIMEIN>SRET
QUIT
+4 SET SROR=$PIECE(^SRF(SRTN,0),"^",2)
if 'SROR
SET SROR="OTHER"
+5 IF SROR
SET SROR=$PIECE(^SRS(SROR,0),"^")
SET SROR=$PIECE(^SC(SROR,0),"^")
+6 SET ^TMP("SRACT",$JOB,SROR,SRSDATE,SRTN)=""
+7 QUIT
