SRODELA ;B'HAM ISC/MAM - REPORT OF DELAYED OPERATIONS; 5 Apr 1989 3:44 PM
;;3.0; Surgery ;;24 Jun 93
SET ; set up variables and print
Q:'$D(^SRF(SRTN,.2)) I $P(^(.2),"^",12)="" Q
S S(0)=^SRF(SRTN,0),DFN=$P(S(0),"^") D DEM^VADPT S PAT=VADM(1),SSN=VA("PID"),SERVICE=$P(S(0),"^",4)
K SRDEL S (SDELAY,CNT)=0 F S SDELAY=$O(^SRF(SRTN,17,SDELAY)) Q:'SDELAY S CNT=CNT+1,SRDEL(CNT)=$P(^SRF(SRTN,17,SDELAY,0),"^"),X=$P(^SRO(132.4,SRDEL(CNT),0),"^"),SRDEL(CNT)=X_"^" D TIME
S:SERVICE'="" SERVICE=$P(^SRO(137.45,SERVICE,0),"^") S:$L(SERVICE)>17 SERVICE=$P(SERVICE,"(")
OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
K SROPS,MM,MMM S:$L(SROPER)<50 SROPS(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
I $Y+5>IOSL D ASK Q:ANS="^"!SRSOUT
PRINT ;
W !!,$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),?12,$E(PAT,1,18),?30,SROPS(1),?82,$P(SRDEL(1),"^",2),?99,$P(SRDEL(1),"^"),!,SRTN,?12,SERVICE,?30 W:$D(SROPS(2)) SROPS(2)
W:$D(SRDEL(2)) ?82,$P(SRDEL(2),"^",2),?99,$P(SRDEL(2),"^") I $D(SROPS(3)) W !,?30,SROPS(3)
I $D(SROPS(4)) W !,?30,SROPS(4) I $D(SROPS(5)) W !,?30,SROPS(5) I $D(SROPS(6)) W !,?30,SROPS(6)
Q
HDR ; print heading
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?58,"SURGICAL SERVICE",?99,"REVIEWED BY: ",!,?52,"REPORT OF DELAYED OPERATIONS",?99,"DATE REVIEWED: "
W !,?53,"FROM "_$E(SRSD,4,5)_"/"_$E(SRSD,6,7)_"/"_$E(SRSD,2,3)_" TO "_$E(SRED,4,5)_"/"_$E(SRED,6,7)_"/"_$E(SRED,2,3)
W !!,?1,"DATE",?12,"PATIENT",?30,"OPERATION(S)",?82,"DELAY TIME",?99,"DELAY CAUSE",!,?1,"CASE #",?12,"SURGICAL SPECIALTY",! F LINE=1:1:132 W "="
Q
END W:$E(IOST)="P" @IOF D ^SRSKILL K SRTN D ^%ZISC W @IOF
Q
OTHER ; other operations
S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
Q
LOOP ; break procedure if greater than 50 characters
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<50 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
TIME ; set delay time
S SRDELT=$P(^SRF(SRTN,17,SDELAY,0),"^",2) S SRDELT=$S(SRDELT:SRDELT_" MINS.",1:"") S SRDEL(CNT)=SRDEL(CNT)_SRDELT
Q
ASK I $E(IOST)'="P" W !!,"Press RETURN to continue, '^' to quit " R ANS:DTIME I '$T!(ANS["^") Q
D HDR Q
Q
EN ;
S %DT="AEX",%DT("A")="Start with Date: " D ^%DT G:Y<1 END S SRSD=Y,%DT("A")="End with Date: " D ^%DT G:Y<1 END G:Y<SRSD EN S SRED=Y,SRD=SRSD-.0001,SRINST="VAMC - "_$P($$SITE^SROVAR,"^",2)
K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS G:POP END
I $D(IO("Q")) K IO("Q") S ZTRTN="1^SRODELA",ZTDESC="REPORT OF DELAYED OPERATIONS",ZTSAVE("SRED")=SRED,ZTSAVE("SRSD")=SRSD,ZTSAVE("SRINST")=SRINST,ZTSAVE("SRD")=SRD D ^%ZTLOAD G END
1 ; entry when queued
U IO S DATE=SRD,SRED1=SRED+.9999,(ANS,SRSOUT)=0 D HDR
F S DATE=$O(^SRF("AC",DATE)) Q:DATE>SRED1!(DATE="")!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",DATE,SRTN)) Q:SRTN=""!SRSOUT I $O(^SRF(SRTN,17,0)) D SET
I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
I $D(ANS),ANS="^" G END
I $E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
G END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRODELA 3362 printed Dec 13, 2024@02:43:05 Page 2
SRODELA ;B'HAM ISC/MAM - REPORT OF DELAYED OPERATIONS; 5 Apr 1989 3:44 PM
+1 ;;3.0; Surgery ;;24 Jun 93
SET ; set up variables and print
+1 if '$DATA(^SRF(SRTN,.2))
QUIT
IF $PIECE(^(.2),"^",12)=""
QUIT
+2 SET S(0)=^SRF(SRTN,0)
SET DFN=$PIECE(S(0),"^")
DO DEM^VADPT
SET PAT=VADM(1)
SET SSN=VA("PID")
SET SERVICE=$PIECE(S(0),"^",4)
+3 KILL SRDEL
SET (SDELAY,CNT)=0
FOR
SET SDELAY=$ORDER(^SRF(SRTN,17,SDELAY))
if 'SDELAY
QUIT
SET CNT=CNT+1
SET SRDEL(CNT)=$PIECE(^SRF(SRTN,17,SDELAY,0),"^")
SET X=$PIECE(^SRO(132.4,SRDEL(CNT),0),"^")
SET SRDEL(CNT)=X_"^"
DO TIME
+4 if SERVICE'=""
SET SERVICE=$PIECE(^SRO(137.45,SERVICE,0),"^")
if $LENGTH(SERVICE)>17
SET SERVICE=$PIECE(SERVICE,"(")
OPS SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
SET OPER=0
FOR
SET OPER=$ORDER(^SRF(SRTN,13,OPER))
if OPER=""
QUIT
DO OTHER
+1 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<50
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>49
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+2 IF $Y+5>IOSL
DO ASK
if ANS="^"!SRSOUT
QUIT
PRINT ;
+1 WRITE !!,$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3),?12,$EXTRACT(PAT,1,18),?30,SROPS(1),?82,$PIECE(SRDEL(1),"^",2),?99,$PIECE(SRDEL(1),"^"),!,SRTN,?12,SERVICE,?30
if $DATA(SROPS(2))
WRITE SROPS(2)
+2 if $DATA(SRDEL(2))
WRITE ?82,$PIECE(SRDEL(2),"^",2),?99,$PIECE(SRDEL(2),"^")
IF $DATA(SROPS(3))
WRITE !,?30,SROPS(3)
+3 IF $DATA(SROPS(4))
WRITE !,?30,SROPS(4)
IF $DATA(SROPS(5))
WRITE !,?30,SROPS(5)
IF $DATA(SROPS(6))
WRITE !,?30,SROPS(6)
+4 QUIT
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 if $Y
WRITE @IOF
WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,!,?58,"SURGICAL SERVICE",?99,"REVIEWED BY: ",!,?52,"REPORT OF DELAYED OPERATIONS",?99,"DATE REVIEWED: "
+3 WRITE !,?53,"FROM "_$EXTRACT(SRSD,4,5)_"/"_$EXTRACT(SRSD,6,7)_"/"_$EXTRACT(SRSD,2,3)_" TO "_$EXTRACT(SRED,4,5)_"/"_$EXTRACT(SRED,6,7)_"/"_$EXTRACT(SRED,2,3)
+4 WRITE !!,?1,"DATE",?12,"PATIENT",?30,"OPERATION(S)",?82,"DELAY TIME",?99,"DELAY CAUSE",!,?1,"CASE #",?12,"SURGICAL SPECIALTY",!
FOR LINE=1:1:132
WRITE "="
+5 QUIT
END if $EXTRACT(IOST)="P"
WRITE @IOF
DO ^SRSKILL
KILL SRTN
DO ^%ZISC
WRITE @IOF
+1 QUIT
OTHER ; other operations
+1 SET SRLONG=1
IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OPER,0),"^"))>250
SET SRLONG=0
SET OPER=999
SET SROPERS=" ..."
+2 IF SRLONG
SET SROPERS=$PIECE(^SRF(SRTN,13,OPER,0),"^")
+3 SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)
+4 QUIT
LOOP ; break procedure if greater than 50 characters
+1 SET SROPS(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROPS(M))+$LENGTH(MM)'<50
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
TIME ; set delay time
+1 SET SRDELT=$PIECE(^SRF(SRTN,17,SDELAY,0),"^",2)
SET SRDELT=$SELECT(SRDELT:SRDELT_" MINS.",1:"")
SET SRDEL(CNT)=SRDEL(CNT)_SRDELT
+2 QUIT
ASK IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue, '^' to quit "
READ ANS:DTIME
IF '$TEST!(ANS["^")
QUIT
+1 DO HDR
QUIT
+2 QUIT
EN ;
+1 SET %DT="AEX"
SET %DT("A")="Start with Date: "
DO ^%DT
if Y<1
GOTO END
SET SRSD=Y
SET %DT("A")="End with Date: "
DO ^%DT
if Y<1
GOTO END
if Y<SRSD
GOTO EN
SET SRED=Y
SET SRD=SRSD-.0001
SET SRINST="VAMC - "_$PIECE($$SITE^SROVAR,"^",2)
+2 KILL IOP,%ZIS,POP,IO("Q")
SET %ZIS("A")="Print the Report on which Device: "
SET %ZIS="QM"
WRITE !!,"This report is designed to use a 132 column format.",!
DO ^%ZIS
if POP
GOTO END
+3 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="1^SRODELA"
SET ZTDESC="REPORT OF DELAYED OPERATIONS"
SET ZTSAVE("SRED")=SRED
SET ZTSAVE("SRSD")=SRSD
SET ZTSAVE("SRINST")=SRINST
SET ZTSAVE("SRD")=SRD
DO ^%ZTLOAD
GOTO END
1 ; entry when queued
+1 USE IO
SET DATE=SRD
SET SRED1=SRED+.9999
SET (ANS,SRSOUT)=0
DO HDR
+2 FOR
SET DATE=$ORDER(^SRF("AC",DATE))
if DATE>SRED1!(DATE="")!SRSOUT
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",DATE,SRTN))
if SRTN=""!SRSOUT
QUIT
IF $ORDER(^SRF(SRTN,17,0))
DO SET
+3 IF $DATA(ZTQUEUED)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+4 IF $DATA(ANS)
IF ANS="^"
GOTO END
+5 IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+6 GOTO END
