SRORET.m

SRORET ;B'HAM ISC/MAM - RETURN TO SURGERY REPORT ; [ 09/22/98  11:36 AM ]

 ;;3.0; Surgery ;**77,50**;24 Jun 93

 W @IOF,!,"Report of Returns to Surgery",! S SRSOUT=0

DATE D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END

 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,IO("Q"),POP W !!,"This report will list cases completed during the date range entered that",!,"have had return cases associated with them.  It is designed to use a 132",!,"column format.",!!

 S %ZIS="QM",%ZIS("A")="Print the Report on which Device: " D ^%ZIS I POP S SRSOUT=1 G END

 I $D(IO("Q")) K IO("Q") S ZTDESC="RETURNS TO SURGERY",ZTRTN="BEG^SRORET",(ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRED"),ZTSAVE("SRSD"))="" D ^%ZTLOAD S SRSOUT=1 G END

BEG ; entry when queued

 N SRFRTO S SRSD1=SRSD-.0001,SRED1=SRED+.9999,SRSOUT=0,Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_"  TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y

 U IO D HDR Q:SRSOUT

 F  S SRSD1=$O(^SRF("AC",SRSD1)) Q:SRSD1>SRED1!'SRSD1!SRSOUT  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSD1,SRTN)) Q:'SRTN!SRSOUT  I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN),$O(^SRF(SRTN,29,0)) K RETURN D CHECK I $D(RETURN) D PRINT

 W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q

END S:$E(IOST)="P" SRSOUT=1 I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 D ^%ZISC W @IOF K SRTN D ^SRSKILL

 Q

HDR ; print heading

 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q

 W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?57,"SURGICAL SERVICE",?100,"REVIEWED BY: ",!,?52,"REPORT OF RETURNS TO SURGERY",?100,"DATE REVIEWED: "

 W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT

 W !!!,"OPERATION DATE",?17,"PATIENT (ID#)",?65,"PRINCIPAL OPERATIVE PROCEDURE",! F LINE=1:1:IOM W "="

 Q

PRET ; print procedures

 K SROPS,M S:$L(SROPER)<66 SROPS(1)=SROPER I $L(SROPER)>65 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MM=""

 W !,?20,SRETDT,?35,SROPS(1) I $D(SROPS(2)) W !,?35,SROPS(2) I $D(SROPS(3)) W !,?35,SROPS(3) I $D(SROPS(4)) W !,?35,SROPS(4)

 Q

PRINT ; print returns

 I $Y+9>IOSL D PAGE Q:SRSOUT

 S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNAME=VADM(1),SSN=VA("PID"),Y=SRSD1 D D^DIQ S SRSDT=$E(Y,1,12)

 S SROPER=$P(^SRF(SRTN,"OP"),"^") K SROPS,MM,MMM S:$L(SROPER)<66 SROPS(1)=SROPER I $L(SROPER)>65 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""

 W !!!,SRSDT,?17,SRNAME_" ("_VA("PID")_")",?65,SROPS(1) I $D(SROPS(2)) W !,?65,SROPS(2) I $D(SROPS(3)) W !,?65,SROPS(3) I $D(SROPS(4)) W !,?65,SROPS(4)

 W !!,"    RETURNS TO SURGERY: "

 S CNT=0 F  S CNT=$O(RETURN(CNT)) Q:'CNT  S RET=RETURN(CNT),Y=$P(^SRF(RET,0),"^",9) D D^DIQ S SRETDT=$E(Y,1,12),SROPER=$P(^SRF(RET,"OP"),"^") D PRET

 Q

PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit:  " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q

 D HDR

 Q

LOOP ; break procedure if greater than 65 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)'<65  S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM

 Q

CHECK ; check for related returns

 S (RET,CNT)=0 F  S RET=$O(^SRF(SRTN,29,RET)) Q:'RET  I '$P($G(^SRF(RET,30)),"^"),$P(^SRF(SRTN,29,RET,0),"^",3)="R" S CNT=CNT+1,RETURN(CNT)=RET

 Q

SRORET    ;B'HAM ISC/MAM - RETURN TO SURGERY REPORT ; [ 09/22/98  11:36 AM ]

 +1       ;;3.0; Surgery ;**77,50**;24 Jun 93

 +2        WRITE @IOF,!,"Report of Returns to Surgery",!

           SET SRSOUT=0

DATE       DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)

           IF SRSOUT

               GOTO END

 +1        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))

 +2        KILL IOP,%ZIS,IO("Q"),POP

           WRITE !!,"This report will list cases completed during the date range entered that",!,"have had return cases associated with them.  It is designed to use a 132",!,"column format.",!!

 +3        SET %ZIS="QM"

           SET %ZIS("A")="Print the Report on which Device: "

           DO ^%ZIS

           IF POP

               SET SRSOUT=1

               GOTO END

 +4        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTDESC="RETURNS TO SURGERY"

               SET ZTRTN="BEG^SRORET"

               SET (ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRED"),ZTSAVE("SRSD"))=""

               DO ^%ZTLOAD

               SET SRSOUT=1

               GOTO END

BEG       ; entry when queued

 +1        NEW SRFRTO

           SET SRSD1=SRSD-.0001

           SET SRED1=SRED+.9999

           SET SRSOUT=0

           SET Y=SRSD

           XECUTE ^DD("DD")

           SET SRFRTO="FROM: "_Y_"  TO: "

           SET Y=SRED

           XECUTE ^DD("DD")

           SET SRFRTO=SRFRTO_Y

           SET Y=DT

           XECUTE ^DD("DD")

           SET SRPRINT="DATE PRINTED: "_Y

 +2        USE IO

           DO HDR

           IF SRSOUT

               QUIT 

 +3        FOR 

               SET SRSD1=$ORDER(^SRF("AC",SRSD1))

               IF SRSD1>SRED1!'SRSD1!SRSOUT

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^SRF("AC",SRSD1,SRTN))

                   IF 'SRTN!SRSOUT

                       QUIT 

                   IF $DATA(^SRF(SRTN,0))

                       IF $$MANDIV^SROUTL0(SRINSTP,SRTN)

                           IF $ORDER(^SRF(SRTN,29,0))

                               KILL RETURN

                               DO CHECK

                               IF $DATA(RETURN)

                                   DO PRINT

 +4        IF $EXTRACT(IOST)="P"

               WRITE @IOF

           IF $DATA(ZTQUEUED)

               IF $GET(ZTSTOP)

                   QUIT 

               SET ZTREQ="@"

               QUIT 

END        IF $EXTRACT(IOST)="P"

               SET SRSOUT=1

           IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

 +1        DO ^%ZISC

           WRITE @IOF

           KILL SRTN

           DO ^SRSKILL

 +2        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,!,?57,"SURGICAL SERVICE",?100,"REVIEWED BY: ",!,?52,"REPORT OF RETURNS TO SURGERY",?100,"DATE REVIEWED: "

 +3        WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO,?100,SRPRINT

 +4        WRITE !!!,"OPERATION DATE",?17,"PATIENT (ID#)",?65,"PRINCIPAL OPERATIVE PROCEDURE",!

           FOR LINE=1:1:IOM

               WRITE "="

 +5        QUIT 

PRET      ; print procedures

 +1        KILL SROPS,M

           IF $LENGTH(SROPER)<66

               SET SROPS(1)=SROPER

           IF $LENGTH(SROPER)>65

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MM=""

                       QUIT 

 +2        WRITE !,?20,SRETDT,?35,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?35,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?35,SROPS(3)

                   IF $DATA(SROPS(4))

                       WRITE !,?35,SROPS(4)

 +3        QUIT 

PRINT     ; print returns

 +1        IF $Y+9>IOSL

               DO PAGE

               IF SRSOUT

                   QUIT 

 +2        SET DFN=$PIECE(^SRF(SRTN,0),"^")

           DO DEM^VADPT

           SET SRNAME=VADM(1)

           SET SSN=VA("PID")

           SET Y=SRSD1

           DO D^DIQ

           SET SRSDT=$EXTRACT(Y,1,12)

 +3        SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")

           KILL SROPS,MM,MMM

           IF $LENGTH(SROPER)<66

               SET SROPS(1)=SROPER

           IF $LENGTH(SROPER)>65

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MMM=""

                       QUIT 

 +4        WRITE !!!,SRSDT,?17,SRNAME_" ("_VA("PID")_")",?65,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?65,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?65,SROPS(3)

                   IF $DATA(SROPS(4))

                       WRITE !,?65,SROPS(4)

 +5        WRITE !!,"    RETURNS TO SURGERY: "

 +6        SET CNT=0

           FOR 

               SET CNT=$ORDER(RETURN(CNT))

               IF 'CNT

                   QUIT 

               SET RET=RETURN(CNT)

               SET Y=$PIECE(^SRF(RET,0),"^",9)

               DO D^DIQ

               SET SRETDT=$EXTRACT(Y,1,12)

               SET SROPER=$PIECE(^SRF(RET,"OP"),"^")

               DO PRET

 +7        QUIT 

PAGE       IF $EXTRACT(IOST)'="P"

               WRITE !!,"Press RETURN to continue, or '^' to quit:  "

               READ X:DTIME

               IF '$TEST!(X["^")

                   SET SRSOUT=1

                   QUIT 

 +1        DO HDR

 +2        QUIT 

LOOP      ; break procedure if greater than 65 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)'<65

                   QUIT 

               SET SROPS(M)=SROPS(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT 

CHECK     ; check for related returns

 +1        SET (RET,CNT)=0

           FOR 

               SET RET=$ORDER(^SRF(SRTN,29,RET))

               IF 'RET

                   QUIT 

               IF '$PIECE($GET(^SRF(RET,30)),"^")

                   IF $PIECE(^SRF(SRTN,29,RET,0),"^",3)="R"

                       SET CNT=CNT+1

                       SET RETURN(CNT)=RET

 +2        QUIT