source: FOIAVistA/trunk/r/SURGERY-SR/SRONPEN.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1SRONPEN ;B'HAM ISC/ADM - NON-O.R. PROCEDURE REPORT ; [ 07/26/04 9:50 AM ]
2 ;;3.0; Surgery ;**132**;24 Jun 93
3 I '$D(SRSITE) D ^SROVAR G:'$D(SRSITE) END S SRSITE("KILL")=1
4 S SRSOUT=0 I '$D(SRTN) D NON G:'$D(SRTN) END S SRTN("KILL")=1
5 I $P($G(^SRF(SRTN,"NON")),"^")'="Y" W !!,?5,"The case selected is not a Non-OR Procedure.",! D FOOT G END
6 N SRAGE,SRDIV,SRHDR,SRLOC,SRPRINT,SRSEL,SRSINED,SRDTITL
7 S SRDTITL="Procedure Report"
8DISPLY K %ZIS,IO("Q") S %ZIS="Q" D ^%ZIS I POP G END
9 I $D(IO("Q")) K IO("Q") S ZTDESC="Procedure Report",ZTRTN="EN^SRONPEN",(ZTSAVE("SRSITE("),ZTSAVE("SRTN"))="" D ^%ZTLOAD G END
10EN D OPTOP^SRONP2(SRTN) S DFN=$P(^SRF(SRTN,0),"^"),VAINDT=$P(^SRF(SRTN,0),"^",9)
11 S Y=$E(VAINDT,1,7) D D^DIQ S SRSDATE=Y D OERR^VADPT
12 S SRHDR=" "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
13 S Y=$E($$NOW^XLFDT,1,12) D DD^%DT S SRPRINT="Printed: "_Y
14 S SRLOC=" Pt Loc: "_$P(VAIN(4),"^",2)_" "_VAIN(5)
15 S SRAGE="",Z=$P(VADM(3),"^") I Z S X=$E($P(^SRF(SRTN,0),"^",9),1,12),Y=$E(X,1,7),SRAGE=$E(Y,1,3)-$E(Z,1,3)-($E(Y,4,7)<$E(Z,4,7))
16 S SRDIV=$$SITE^SROUTL0(SRTN) I SRDIV S X=$P(^SRO(133,SRDIV,0),"^"),SRDIV=$$EXTERNAL^DILFD(133,.01,"",X)
17 S SRDIV=$S(SRDIV'="":SRDIV,1:SRSITE("SITE"))
18 U IO S (SRPAGE,SRSOUT)=0,$P(SRLINE,"-",80)="" D HDR
19 S SRI=0 F S SRI=$O(^TMP("SRNOR",$J,SRTN,SRI)) Q:'SRI D Q:SRSOUT
20 .I $E(IOST)="P",$Y+11>IOSL D FOOT Q:SRSOUT D HDR
21 .I $E(IOST)'="P",$Y+3>IOSL D FOOT Q:SRSOUT D HDR
22 .W !,^TMP("SRNOR",$J,SRTN,SRI)
23 D:'SRSOUT FOOT D END
24 Q
25SRHDR S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT
26 S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) D D^DIQ S SRSDATE=Y
27 S SRHDR=" "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
28 Q
29END K ^TMP("SRNOR",$J)
30 W @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
31 D ^SRSKILL K VAIN,VAINDT I $D(SRSITE("KILL")) K SRSITE
32 I $D(SRTN("KILL")) K SRTN
33 D ^%ZISC
34 Q
35NON ; select patient and case
36 K DIC S DIC("A")="Select Patient: ",DIC=2,DIC(0)="QEAMZ" D ^DIC I Y<0 S SRSOUT=1 G END
37 S DFN=+Y D DEM^VADPT S SRNM=VADM(1)
38 W @IOF,!,"Non-O.R. Procedures for "_SRNM_" ("_VA("PID")_")" I $D(^DPT(DFN,.35)) S Y=$P(^(.35),"^") I Y D D^DIQ S Y=$P(Y,"@")_" "_$P(Y,"@",2) W !," (DIED ON "_Y_")"
39 W !! S (SRDT,CNT)=0 F S SRDT=$O(^SRF("ADT",DFN,SRDT)) Q:'SRDT!$D(SRTN) S SROP=0 F S SROP=$O(^SRF("ADT",DFN,SRDT,SROP)) Q:'SROP!$D(SRTN) I $P($G(^SRF(SROP,"NON")),"^")="Y" D LIST
40SEL W !!!,"Select Procedure: " R X:DTIME I '$T!("^"[X) G END
41 I '$D(SRCASE(X)) W !!,"Enter the number corresponding to the procedure for which you want to print",!,"a report." G SEL
42 S SRTN=+SRCASE(X)
43 Q
44LIST ; list case
45 I $Y+5>IOSL S SRBACK=0 D SEL^SROPER Q:$D(SRTN)!(SRSOUT) W @IOF,!,?1,"NON-O.R. PROCEDURES FOR "_VADM(1)_" ("_VA("PID")_")",! I SRBACK S CNT=0,SROP=SRCASE(1)-1,SRDT=$P(SRCASE(1),"^",2)
46 S CNT=CNT+1,SRSDATE=$P(^SRF(SROP,0),"^",9),SROPER=$P(^SRF(SROP,"OP"),"^"),SRCASE(CNT)=SROP
47 K SROPS,MM,MMM S:$L(SROPER)<55 SROPS(1)=SROPER I $L(SROPER)>54 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
48 S Y=SRSDATE D D^DIQ S SRSDATE=$P(Y,"@")_" "_$P(Y,"@",2)
49 W !,CNT_".",?4,SRSDATE,?20,SROPS(1) I $D(SROPS(2)) W !,?20,SROPS(2) I $D(SROPS(3)) W !,?20,SROPS(3) I $D(SROPS(4)) W !,?20,SROPS(4)
50 W !
51 Q
52LOOP ; break procedure if greater than 55 characters
53 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<55 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
54 Q
55FOOT I $E(IOST)'="P" W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
56 Q
57HDR ; heading
58 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
59 S SRPAGE=SRPAGE+1 I $Y'=0 W @IOF
60 W !,VADM(1)_" ("_VA("PID"),") Age: "_SRAGE,?(79-$L("PAGE "_SRPAGE)),"PAGE "_SRPAGE
61 W !,"NON-O.R. PROCEDURE - CASE #"_SRTN,?52,SRPRINT,!,SRLINE,!
62 Q
Note: See TracBrowser for help on using the repository browser.