source: FOIAVistA/tag/r/SURGERY-SR/SRODELA.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1SRODELA ;B'HAM ISC/MAM - REPORT OF DELAYED OPERATIONS; 5 Apr 1989 3:44 PM
2 ;;3.0; Surgery ;;24 Jun 93
3SET ; set up variables and print
4 Q:'$D(^SRF(SRTN,.2)) I $P(^(.2),"^",12)="" Q
5 S S(0)=^SRF(SRTN,0),DFN=$P(S(0),"^") D DEM^VADPT S PAT=VADM(1),SSN=VA("PID"),SERVICE=$P(S(0),"^",4)
6 K SRDEL S (SDELAY,CNT)=0 F S SDELAY=$O(^SRF(SRTN,17,SDELAY)) Q:'SDELAY S CNT=CNT+1,SRDEL(CNT)=$P(^SRF(SRTN,17,SDELAY,0),"^"),X=$P(^SRO(132.4,SRDEL(CNT),0),"^"),SRDEL(CNT)=X_"^" D TIME
7 S:SERVICE'="" SERVICE=$P(^SRO(137.45,SERVICE,0),"^") S:$L(SERVICE)>17 SERVICE=$P(SERVICE,"(")
8OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
9 K SROPS,MM,MMM S:$L(SROPER)<50 SROPS(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
10 I $Y+5>IOSL D ASK Q:ANS="^"!SRSOUT
11PRINT ;
12 W !!,$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),?12,$E(PAT,1,18),?30,SROPS(1),?82,$P(SRDEL(1),"^",2),?99,$P(SRDEL(1),"^"),!,SRTN,?12,SERVICE,?30 W:$D(SROPS(2)) SROPS(2)
13 W:$D(SRDEL(2)) ?82,$P(SRDEL(2),"^",2),?99,$P(SRDEL(2),"^") I $D(SROPS(3)) W !,?30,SROPS(3)
14 I $D(SROPS(4)) W !,?30,SROPS(4) I $D(SROPS(5)) W !,?30,SROPS(5) I $D(SROPS(6)) W !,?30,SROPS(6)
15 Q
16HDR ; print heading
17 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
18 W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?58,"SURGICAL SERVICE",?99,"REVIEWED BY: ",!,?52,"REPORT OF DELAYED OPERATIONS",?99,"DATE REVIEWED: "
19 W !,?53,"FROM "_$E(SRSD,4,5)_"/"_$E(SRSD,6,7)_"/"_$E(SRSD,2,3)_" TO "_$E(SRED,4,5)_"/"_$E(SRED,6,7)_"/"_$E(SRED,2,3)
20 W !!,?1,"DATE",?12,"PATIENT",?30,"OPERATION(S)",?82,"DELAY TIME",?99,"DELAY CAUSE",!,?1,"CASE #",?12,"SURGICAL SPECIALTY",! F LINE=1:1:132 W "="
21 Q
22END W:$E(IOST)="P" @IOF D ^SRSKILL K SRTN D ^%ZISC W @IOF
23 Q
24OTHER ; other operations
25 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
26 I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
27 S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
28 Q
29LOOP ; break procedure if greater than 50 characters
30 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<50 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
31 Q
32TIME ; set delay time
33 S SRDELT=$P(^SRF(SRTN,17,SDELAY,0),"^",2) S SRDELT=$S(SRDELT:SRDELT_" MINS.",1:"") S SRDEL(CNT)=SRDEL(CNT)_SRDELT
34 Q
35ASK I $E(IOST)'="P" W !!,"Press RETURN to continue, '^' to quit " R ANS:DTIME I '$T!(ANS["^") Q
36 D HDR Q
37 Q
38EN ;
39 S %DT="AEX",%DT("A")="Start with Date: " D ^%DT G:Y<1 END S SRSD=Y,%DT("A")="End with Date: " D ^%DT G:Y<1 END G:Y<SRSD EN S SRED=Y,SRD=SRSD-.0001,SRINST="VAMC - "_$P($$SITE^SROVAR,"^",2)
40 K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS G:POP END
41 I $D(IO("Q")) K IO("Q") S ZTRTN="1^SRODELA",ZTDESC="REPORT OF DELAYED OPERATIONS",ZTSAVE("SRED")=SRED,ZTSAVE("SRSD")=SRSD,ZTSAVE("SRINST")=SRINST,ZTSAVE("SRD")=SRD D ^%ZTLOAD G END
421 ; entry when queued
43 U IO S DATE=SRD,SRED1=SRED+.9999,(ANS,SRSOUT)=0 D HDR
44 F S DATE=$O(^SRF("AC",DATE)) Q:DATE>SRED1!(DATE="")!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",DATE,SRTN)) Q:SRTN=""!SRSOUT I $O(^SRF(SRTN,17,0)) D SET
45 I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
46 I $D(ANS),ANS="^" G END
47 I $E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
48 G END
Note: See TracBrowser for help on using the repository browser.