| 1 | SRORET ;B'HAM ISC/MAM - RETURN TO SURGERY REPORT ; [ 09/22/98 11:36 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**77,50**;24 Jun 93
|
|---|
| 3 | W @IOF,!,"Report of Returns to Surgery",! S SRSOUT=0
|
|---|
| 4 | DATE D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END
|
|---|
| 5 | 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))
|
|---|
| 6 | 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.",!!
|
|---|
| 7 | S %ZIS="QM",%ZIS("A")="Print the Report on which Device: " D ^%ZIS I POP S SRSOUT=1 G END
|
|---|
| 8 | 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
|
|---|
| 9 | BEG ; entry when queued
|
|---|
| 10 | 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
|
|---|
| 11 | U IO D HDR Q:SRSOUT
|
|---|
| 12 | 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
|
|---|
| 13 | W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
|
|---|
| 14 | END S:$E(IOST)="P" SRSOUT=1 I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
|
|---|
| 15 | D ^%ZISC W @IOF K SRTN D ^SRSKILL
|
|---|
| 16 | Q
|
|---|
| 17 | HDR ; print heading
|
|---|
| 18 | I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
|
|---|
| 19 | W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?57,"SURGICAL SERVICE",?100,"REVIEWED BY: ",!,?52,"REPORT OF RETURNS TO SURGERY",?100,"DATE REVIEWED: "
|
|---|
| 20 | W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
|
|---|
| 21 | W !!!,"OPERATION DATE",?17,"PATIENT (ID#)",?65,"PRINCIPAL OPERATIVE PROCEDURE",! F LINE=1:1:IOM W "="
|
|---|
| 22 | Q
|
|---|
| 23 | PRET ; print procedures
|
|---|
| 24 | 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=""
|
|---|
| 25 | 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)
|
|---|
| 26 | Q
|
|---|
| 27 | PRINT ; print returns
|
|---|
| 28 | I $Y+9>IOSL D PAGE Q:SRSOUT
|
|---|
| 29 | 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)
|
|---|
| 30 | 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=""
|
|---|
| 31 | 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)
|
|---|
| 32 | W !!," RETURNS TO SURGERY: "
|
|---|
| 33 | 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
|
|---|
| 34 | Q
|
|---|
| 35 | PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
|
|---|
| 36 | D HDR
|
|---|
| 37 | Q
|
|---|
| 38 | LOOP ; break procedure if greater than 65 characters
|
|---|
| 39 | 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
|
|---|
| 40 | Q
|
|---|
| 41 | CHECK ; check for related returns
|
|---|
| 42 | 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
|
|---|
| 43 | Q
|
|---|
