SRODELA.m

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

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