source: FOIAVistA/trunk/r/SURGERY-SR/SROAPS1.m@ 749

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1SROAPS1 ;BIR/MAM - PREOP INFO (PAGE 1) ;12/12/07
2 ;;3.0; Surgery ;**38,47,125,153,166**;24 Jun 93;Build 6
3 ;
4 ; Reference to EN1^GMRVUT0 supported by DBIA #1446
5 ;
6 N I S SRPAGE="PAGE: 1 OF 2" D HDR^SROAUTL,PRE1
7 W ! F I=1:1:80 W "-"
8 Q
9PRE1 N SRX,Y D HW F I=200,206 S SRA(I)=$G(^SRF(SRTN,I))
10 S Y=$P(SRA(200),"^"),SRX=402,SRAO(1)=$$OUT(SRX,Y)_"^"_SRX
11 S Y=$P(SRA(206),"^"),SRX=236,SRAO("1A")=$$OUT(SRX,Y)_"^"_SRX
12 S Y=$P(SRA(206),"^",2),SRX=237,SRAO("1B")=$$OUT(SRX,Y)_"^"_SRX
13 S Y=$P(SRA(200),"^",2),SRX=346,SRAO("1C")=$$OUT(SRX,Y)_"^"_SRX
14 S Y=$P(SRA(200),"^",3),SRX=202,SRAO("1D")=$$OUT(SRX,Y)_"^"_SRX
15 S Y=$P(SRA(200),"^",4),SRX=246,SRAO("1E")=$$OUT(SRX,Y)_"^"_SRX
16 S Y=$P(SRA(200),"^",6),SRX=325,SRAO("1F")=$$OUT(SRX,Y)_"^"_SRX
17 S Y=$P(SRA(200),"^",7),SRX=238,SRAO("1G")=$$OUT(SRX,Y)_"^"_SRX
18 S Y=$P($G(^SRF(SRTN,200.1)),"^",2),SRX=492,SRAO("1H")=$$OUT(SRX,Y)_"^"_SRX
19 S Y=$P(SRA(200),"^",9),SRX=241,SRAO(2)=$$OUT(SRX,Y)_"^"_SRX
20 S Y=$P(SRA(200),"^",10),SRX=204,SRAO("2A")=$$OUT(SRX,Y)_"^"_SRX
21 S Y=$P(SRA(200),"^",11),SRX=203,SRAO("2B")=$$OUT(SRX,Y)_"^"_SRX
22 S Y=$P(SRA(200),"^",12),SRX=326,SRAO("2C")=$$OUT(SRX,Y)_"^"_SRX
23 S Y=$P(SRA(200),"^",13),SRX=244,SRAO(3)=$$OUT(SRX,Y)_"^"_SRX
24 S Y=$P(SRA(200),"^",15),SRX=212,SRAO("3A")=$$OUT(SRX,Y)_"^"_SRX
25 S Y=$P($G(^SRF(SRTN,200.1)),"^"),SRX=486,SRAO(4)=$$OUT(SRX,Y)_"^"_SRX
26 S Y=$P(SRA(200),"^",16),SRX=213,SRAO("4A")=$$OUT(SRX,Y)_"^"_SRX
27 S Y=$P(SRA(200),"^",30),SRX=242,SRAO(5)=$$OUT(SRX,Y)_"^"_SRX
28 S Y=$P(SRA(200),"^",35),SRX=396,SRAO("5A")=$$OUT(SRX,Y)_"^"_SRX
29 S Y=$P(SRA(200),"^",31),SRX=394,SRAO("5B")=$$OUT(SRX,Y)_"^"_SRX
30 S Y=$P(SRA(200),"^",32),SRX=220,SRAO("5C")=$$OUT(SRX,Y)_"^"_SRX
31 S Y=$P(SRA(200),"^",33),SRX=266,SRAO("5D")=$$OUT(SRX,Y)_"^"_SRX
32 S Y=$P(SRA(200),"^",34),SRX=395,SRAO("5E")=$$OUT(SRX,Y)_"^"_SRX
33 S Y=$P(SRA(200),"^",36),SRX=208,SRAO("5F")=$$OUT(SRX,Y)_"^"_SRX
34 S Y=$P(SRA(200),"^",40),SRX=206,SRAO(6)=$$OUT(SRX,Y)_"^"_SRX
35 S Y=$P(SRA(200),"^",41),SRX=329,SRAO("6A")=$$OUT(SRX,Y)_"^"_SRX
36 S Y=$P(SRA(200),"^",42),SRX=330,SRAO("6B")=$$OUT(SRX,Y)_"^"_SRX K SRA
37 W "1. GENERAL:",?32,$P(SRAO(1),"^"),?41,"4. GASTROINTESTINAL:",?76,$P(SRAO(4),"^")
38 W !," A. Height:" S Y=$P(SRAO("1A"),"^") W:Y'="NS" ?14,$J($P(Y,"^"),25) W:Y="NS" ?32,Y
39 W ?43,"A. Esophageal Varices:",?76,$P(SRAO("4A"),"^")
40 W !," B. Weight:" S Y=$P(SRAO("1B"),"^") W ?($S(Y="NS":19,1:24)),$J(Y,15)
41 W !," C. Diabetes Mellitus:",?32,$P(SRAO("1C"),"^"),?41,"5. CARDIAC:",?76,$P(SRAO(5),"^")
42 W !," D. Current Smoker W/I 1 Year:",?32,$P(SRAO("1D"),"^"),?43,"A. CHF Within 1 Month:",?76,$P(SRAO("5A"),"^")
43 W !," E. ETOH > 2 Drinks/Day:",?32,$P(SRAO("1E"),"^"),?43,"B. MI Within 6 Months:",?76,$P(SRAO("5B"),"^")
44 W !," F. Dyspnea: ",?14,$J($P(SRAO("1F"),"^"),25),?43,"C. Previous PCI:",?76,$P(SRAO("5C"),"^")
45 W !," G. DNR Status: ",?32,$P(SRAO("1G"),"^"),?43,"D. Previous Cardiac Surgery:",?76,$P(SRAO("5D"),"^")
46 W !," H. Preop Funct Status: ",$J($P(SRAO("1H"),"^"),17),?43,"E. Angina Within 1 Month:",?76,$P(SRAO("5E"),"^")
47 W !,?43,"F. Hypertension Requiring Meds:",?76,$P(SRAO("5F"),"^")
48 W !,"2. PULMONARY:",?32,$P(SRAO(2),"^")
49 W !," A. Ventilator Dependent:",?32,$P(SRAO("2A"),"^"),?41,"6. VASCULAR:",?76,$P(SRAO(6),"^")
50 W !," B. History of Severe COPD:",?32,$P(SRAO("2B"),"^"),?43,"A. Revascularization/Amputation:",?76,$P(SRAO("6A"),"^")
51 W !," C. Current Pneumonia:",?32,$P(SRAO("2C"),"^"),?43,"B. Rest Pain/Gangrene:",?76,$P(SRAO("6B"),"^")
52 W !!,"3. HEPATOBILIARY:",?32,$P(SRAO(3),"^"),!," A. Ascites:",?32,$P(SRAO("3A"),"^")
53 Q
54OUT(SRFLD,SRY) ; get data in output form
55 N C,Y,Z
56 S Y=SRY,C=$P(^DD(130,SRFLD,0),"^",2) D:Y'="" Y^DIQ
57 I Y="NO STUDY" S Y="NS"
58 I SRFLD=237!(SRFLD=346) S Y=$E(Y,1,15)
59 I SRFLD=236 S Z=$P($G(^SRF(SRTN,200.1)),"^",7) I Z'="" S Y="("_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Z,2,3)_") "_Y
60 I SRFLD=492 D
61 .I SRY=2 S Y="PARTIAL DEPENDENT" Q
62 .I SRY=1 S Y=Y_" " Q
63 .I SRY=4 S Y=Y_" "
64 I SRFLD=325,$L(Y)=2 S Y=Y_" "
65 Q Y
66HW ; get weight & height from Vitals
67 N SREND,SREQ,SREX,SREY,SRSTRT
68WT I $P($G(^SRF(SRTN,206)),"^",2)="" D
69 .S SREND=$P($G(^SRF(SRTN,0)),"^",9),SRSTRT=$$FMADD^XLFDT(SREND,-30),SREX=$$HW^SROACL1(SRSTRT,SREND,"WT")
70 .I SREX'="" S SREX=SREX+.5\1 D CHK^DIE(130,237,"E",SREX,.SREY) I SREY'="^" S $P(^SRF(SRTN,206),"^",2)=SREY
71HT I $P($G(^SRF(SRTN,206)),"^")'="" Q
72 N GMRVSTR,SRBRDT,SRBIEN,SRBDATA,SRHTDT
73 K ^UTILITY($J,"GMRVD"),RESULTS S SREND=$P($G(^SRF(SRTN,0)),"^",9),GMRVSTR="HT",GMRVSTR(0)="^"_SREND_"^^0"
74 D EN1^GMRVUT0 Q:'$D(^UTILITY($J,"GMRVD"))
75 S SRBRDT="",SRBRDT=$O(^UTILITY($J,"GMRVD","HT",SRBRDT)) Q:'SRBRDT D
76 .S SRBIEN=0 F S SRBIEN=$O(^UTILITY($J,"GMRVD","HT",SRBRDT,SRBIEN)) Q:'SRBIEN D
77 ..S SRBDATA=$G(^UTILITY($J,"GMRVD","HT",SRBRDT,SRBIEN)),SREX=$P(SRBDATA,"^",8)
78 ..I SREX'="" S SREX=SREX+.5\1 D CHK^DIE(130,236,"E",SREX,.SREY) I SREY'="^" D
79 ...S $P(^SRF(SRTN,206),"^")=SREY
80 ...S SRHTDT=$P(SRBDATA,"^") I SRHTDT'="" S $P(^SRF(SRTN,200.1),"^",7)=SRHTDT
81 Q
Note: See TracBrowser for help on using the repository browser.