source: WorldVistAEHR/trunk/r/SURGERY-SR/SROAPCA.m@ 836

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1SROAPCA ;BIR/MAM - PRINT CLINICAL DATA ;09/27/04
2 ;;3.0; Surgery ;**38,47,71,95,125,134,153,160**;24 Jun 93;Build 7
3 F I=0,206,207,208,200.1 S SRA(I)=$G(^SRF(SRTN,I)),$P(LN,"-",79)=""
4 S X=$P(SRA(0),"^",9),SRADATE=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
5 W:$Y @IOF W !,?5,"VA CONTINUOUS IMPROVEMENT IN CARDIAC SURGERY PROGRAM (CICSP/CICSP-X)",!
6 W ! F MOE=1:1:80 W "="
7 W !,"I. IDENTIFYING DATA",?60,"Case #: "_SRTN
8 N SRSPH1,SRZIP S (SRSPH1,SRZIP)=""
9 S STATNUM=+$P($$SITE^SROVAR,"^",3) D ADD^VADPT
10 W !,"Patient: "_SRANM,?60,"Fac./Div. #: "_STATNUM
11 W !,"Surgery Date: "_SRADATE,?25,"Address: "_VAPA(1)
12 S SRSPH1=VAPA(8) S:SRSPH1="" SRSPH1="NS/Unknown" S SRZIP=$S(VAPA(11)'="":$P(VAPA(11),"^",2),1:VAPA(6)) S:SRZIP="" SRZIP="NS/Unknown"
13 W !,"Phone: "_SRSPH1,?25,"Zip Code: "_SRZIP
14 S X=VADM(3) W ?53,"Date of Birth: ",$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
15 S SRAO(1)=SRADATE,NYUK=$P(SRA(0),"^",4),SRAO(2)=$P(VADM(5),"^",2)
16 S SRAO(3)=AGE,NYUK=$P(SRA(206),"^") S:NYUK'="" NYUK=$S(NYUK["C"!(NYUK["c"):+NYUK_" cm",1:+NYUK_" in") S SRAO(4)=NYUK_"^236"
17 S NYUK=$P(SRA(206),"^",2) S:NYUK'="" NYUK=$S(NYUK["K"!(NYUK["k"):+NYUK_" kg",1:+NYUK_" lb") S SRAO(5)=NYUK_"^237"
18 S SRA(200)=$G(^SRF(SRTN,200)),SRA(209)=$G(^SRF(SRTN,209))
19 S NYUK=$P(SRA(209),"^",3),SRAO(6)=$S(NYUK="N":"NO",NYUK="O":"ORAL",NYUK="D":"DIET",NYUK="I":"INSULIN",1:"")_"^475",NYUK=$P(SRA(200),"^",11) D YN S SRAO(7)=SHEMP_"^203"
20 S SRAO(8)=$P(SRA(206),"^",5)_"^347",NYUK=$P(SRA(206),"^",6) D YN S SRAO(9)=SHEMP_"^209",NYUK=$P(SRA(206),"^",7) D YN S SRAO(10)=SHEMP_"^348"
21 S Y=$P(SRA(200.1),"^",5),C=$P(^DD(130,510,0),"^",2) D Y^DIQ S SRAO(11)=$S(Y["-":$E($P(Y,"-",2),1,22),1:$E(Y,1,22))_"^510"
22 S NYUK=$P(SRA(206),"^",11) D YN S SRAO(14)=SHEMP_"^350",NYUK=$P(SRA(200),"^",8),SRAO(15)=$S(NYUK=1:"INDEPENDENT",NYUK=2:"PARTIAL DEPENDENT",NYUK=3:"TOTALLY DEPENDENT",NYUK="NS":"NS",1:"")_"^240"
23 S NYUK=$P(SRA(206),"^",13),SRAO(16)=$S(NYUK=0:"None",NYUK=1:"NONE RECENT",NYUK=2:"12-72 HRS",NYUK=3:"<12 hrs",NYUK=12:"12 - 72 hrs",NYUK=72:">72 hrs - 7 days",NYUK=7:">7 days",NYUK="NS":"NO STUDY",1:"")_"^351"
24 S NYUK=$P(SRA(206),"^",14),SRAO(17)=$S(NYUK=0:"NONE",NYUK=1:"< OR = 7 DAYS OF SURG",NYUK=2:"> 7 DAYS OF SURG",NYUK="NS":"NS",1:"")_"^205"
25 S NYUK=$P(SRA(206),"^",15) S SHEMP=$S(NYUK=0:"NONE",NYUK=">":">3",NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:NYUK) S SRAO(18)=SHEMP_"^352"
26 S NYUK=$P(SRA(206),"^",42)
27 S NYUK=$P(SRA(206),"^",16) D YN S SRAO(19)=SHEMP_"^265",NYUK=$P(SRA(206),"^",17) D YN S SRAO(20)=SHEMP_"^264"
28 S SRAO(21)=$P(SRA(206),"^",18)_"^267",SRAO(22)=$P(SRA(206),"^",19)_"^207",NYUK=$P(SRA(206),"^",20) D YN S SRAO(23)=SHEMP_"^353",NYUK=$P(SRA(206),"^",21) D YN S SRAO(24)=SHEMP_"^354"
29 S NYUK=$P(SRA(206),"^",22) D YN S SRAO(25)=SHEMP_"^355"
30 S NYUK=$P(SRA(209),"^",2),SRAO(26)=$S(NYUK="N":"NONE",NYUK="I":"IABP",NYUK="V":"VAD",NYUK="A":"ARTI",NYUK="O":"OTHER",1:NYUK)_"^474"
31 S NYUK=$P(SRA(206),"^",38) D YN S SRAO(27)=SHEMP_"^463"
32 S NYUK=$P(SRA(206),"^",10) D YN S SRAO(29)=SHEMP_"^349"
33DISP ; display fields
34 W ! F MOE=1:1:80 W "="
35 W !,"II. CLINICAL DATA"
36 W !,"Gender:",?26,$P(SRAO(2),"^"),?40,"PCI: ",$J($P(SRAO(16),"^"),34)
37 W !,"Age:",?26,SRAO(3),?40,"Prior MI:",$J($P(SRAO(17),"^"),30)
38 W !,"Height:",?26,$P(SRAO(4),"^"),?40,"# of prior heart surgeries:",?75,$P(SRAO(18),"^")
39 W !,"Weight:",?26,$P(SRAO(5),"^"),?40,"Prior heart surgeries: " D H485
40 W !,"Diabetes:",?26,$P(SRAO(6),"^"),?40,"Peripheral Vascular Disease:",?75,$P(SRAO(19),"^")
41 W !,"COPD:",?26,$P(SRAO(7),"^"),?40,"Cerebral Vascular Disease:",?75,$P(SRAO(20),"^")
42 W !,"FEV1:",?26,$P(SRAO(8),"^")_$S($P(SRAO(8),"^")="":"",$P(SRAO(8),"^")="NS":"",1:" liters"),?40,"Angina (use CCS Class):",?75,$P(SRAO(21),"^")
43 W !,"Cardiomegaly (X-ray): ",?26,$P(SRAO(9),"^"),?40,"CHF (use NYHA Class):",?75,$P(SRAO(22),"^")
44 W !,"Pulmonary Rales:",?26,$P(SRAO(10),"^"),?40,"Current Diuretic Use:",?75,$P(SRAO(23),"^")
45 W !,"Current Smoker: ",$J($P(SRAO(11),"^"),22),?40,"Current Digoxin Use:",?75,$P(SRAO(24),"^")
46 W !,"Active Endocarditis:",?26,$P(SRAO(29),"^"),?40,"IV NTG 48 Hours Preceding Surgery:",?75,$P(SRAO(25),"^")
47 W !,"Resting ST Depression:",?26,$P(SRAO(14),"^"),?40,"Preop circulatory Device:",?74,$P(SRAO(26),"^")
48 W !,"Functional Status: ",$J($P(SRAO(15),"^"),18),?40,"Hypertension:",?75,$P(SRAO(27),"^")
49 K SRA,SRAO D ^SROAPCA1
50 Q
51YN ; store answer
52 S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
53 Q
54PAGE I $E(IOST)'="P" W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
55 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
56 W @IOF,!,SRANM,! F MOE=1:1:80 W "="
57 Q
58H485 S SHEMP="",X=$P(SRA(206),"^",42) F I=1:1:$L(X,",") D
59 .S C=$P(X,",",I) S:I>1 SHEMP=SHEMP_", " S SHEMP=SHEMP_$S(C=0:"None",C=1:"CABG-only",C=2:"Valve-only",C=3:"CABG/valve",C=4:"Other",C=5:"CABG/Other",1:"")
60 S X=SHEMP I $L(X)<17 W $J(X,16) Q
61 W $J($P(X,",")_",",16) I $L($P(X,", ",2,9))<40 W !,?41,$P(X,", ",2,9) Q
62 W !,?41,$P(X,", ",2,4)_",",!,?41,$P(X,", ",5,9)
63 Q
Note: See TracBrowser for help on using the repository browser.