source: WorldVistAEHR/trunk/r/SURGERY-SR/SRORET.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1SRORET ;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
4DATE 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
9BEG ; 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
14END 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
17HDR ; 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
23PRET ; 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
27PRINT ; 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
35PAGE 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
38LOOP ; 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
41CHECK ; 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
Note: See TracBrowser for help on using the repository browser.