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
