44 lines
3.2 KiB
Mathematica
44 lines
3.2 KiB
Mathematica
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
|