source: WorldVistAEHR/trunk/r/SURGERY-SR/SROAPCA4.m@ 691

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1SROAPCA4 ;BIR/SJA - CARDIAC COMPLIANCE DATA ;07/05/06
2 ;;3.0; Surgery ;**95,125,153**;24 Jun 93;Build 11
3 ;
4 ; Reference to ^DGPM("APTT1" supported by DBIA #565
5 ; Reference to File #405 supported by DBIA #3029
6 ; Reference to Field #27.02 in File #2 supported by DBIA #1850
7 ;
8 S SRA(201)=$G(^SRF(SRTN,201)),SRA(202)=$G(^SRF(SRTN,202)),SRA(208)=$G(^SRF(SRTN,208)),SRA(0)=$G(^SRF(SRTN,0)),SRA(202.1)=$G(^SRF(SRTN,202.1))
9 N SRPREF,SRREF,SRREFP,SRFOL,SRFOLP,SRSOUT,SRY S (SRPREF,SRREF,SRREFP,SRFOL,SRFOLP)="",SRSOUT=0,(VAIP("D"),SRSDATE)=$P(SRA(0),"^",9) D IN5^VADPT
10 I 'VAIP(13) S X1=$P($G(^SRF(SRTN,.2)),"^",12),X2=1 D C^%DTC S SR24=X,SRDT=$O(^DGPM("APTT1",DFN,SRSDATE)) G:'SRDT!(SRDT>SR24) TS S VAIP("D")=SRDT D IN5^VADPT
11TS I VAIP(13) K DA,DIC,DIQ,DR S DIC=405,DR=.05,DA=VAIP(13),DIQ="SRY",DIQ(0)="IE" D EN^DIQ1 S SRREF=SRY(405,VAIP(13),.05,"E"),SRREFP=SRY(405,VAIP(13),.05,"I") I SRREFP S SRREFP=$$GET1^DIQ(4,SRREFP,99)
12 I VAIP(17) K DA,DIC,DIQ,DR,SRY S DIC=405,DR=.05,DA=VAIP(17),DIQ="SRY",DIQ(0)="IE" D EN^DIQ1 S SRFOL=SRY(405,VAIP(17),.05,"E"),SRFOLP=SRY(405,VAIP(17),.05,"I") I SRFOLP S SRFOLP=$$GET1^DIQ(4,SRFOLP,99)
13 K DA,DIC,DIQ,DR,SRY S DIC="^DPT(",DIQ="SRY",DIQ(0)="I",DA=DFN,DR=27.02 D EN^DIQ1 S X=$G(SRY(2,DFN,27.02,"I")) I X S SRPREF=$$GET1^DIQ(4,X,99)
14 I $Y+7>IOSL D PAGE^SROAPCA I SRSOUT Q
15 D DD
16 Q
17LAB ;D PAGE^SROAPCA I SRSOUT Q
18 W !!,"III. DETAILED LABORATORY INFO - PREOPERATIVE VALUES"
19 N SROUN S SROUN=" mg/dl"
20 W !,"Creatinine:",?14,$J($P(SRA(201),U,4),4),SROUN S Y=$P(SRA(202),"^",4) D DT W ?25,"("_$E(X,1,8)_")"
21 W ?41,"T. Bilirubin:",?57,$J($P(SRA(201),U,24),4),SROUN S Y=$P(SRA(202),"^",24) D DT W ?68,"("_$E(X,1,8)_")"
22 W !,"Hemoglobin:",?14,$J($P(SRA(201),U,20),4),SROUN S Y=$P(SRA(202),"^",20) D DT W ?25,"("_$E(X,1,8)_")"
23 W ?41,"T. Cholesterol:",?57,$J($P(SRA(201),U,26),4),SROUN S Y=$P(SRA(202),"^",26) D DT W ?68,"("_$E(X,1,8)_")"
24 W !,"Albumin:",?14,$J($P(SRA(201),U,8),4)," g/dl" S Y=$P(SRA(202),"^",8) D DT W ?25,"("_$E(X,1,8)_")"
25 W ?41,"HDL:",?57,$J($P(SRA(201),U,21),4),SROUN S Y=$P(SRA(202),"^",22) D DT W ?68,"("_$E(X,1,8)_")"
26 W !,"Triglyceride:",?14,$J($P(SRA(201),U,22),4),SROUN S Y=$P(SRA(202),"^",22) D DT W ?25,"("_$E(X,1,8)_")"
27 W ?41,"LDL:",?57,$J($P(SRA(201),U,25),4),SROUN S Y=$P(SRA(202),"^",25) D DT W ?68,"("_$E(X,1,8)_")"
28 W !,"Potassium:",?14,$J($P(SRA(201),U,23),4)," mg/L" S Y=$P(SRA(202),"^",23) D DT W ?25,"("_$E(X,1,8)_")"
29 W ?41,"Hemoglobin A1c:",?57,$J($P(SRA(201),U,28),4)," %" S Y=$P(SRA(202.1),"^") D DT W ?68,"("_$E(X,1,8)_")"
30 Q
31DD ;Detailed Discharge Information
32 N VAINDT,SRPTF,SRRES
33 S X=$P(SRA(208),"^",15) I X S X=X-.0001
34 S VAINDT=X D INP^VADPT S SRPTF=VAIN(10)
35 S SRRES="" D RPC^DGPTFAPI(.SRRES,SRPTF)
36 I $Y+9>IOSL D PAGE^SROAPCA I SRSOUT Q
37 W !!,"X. DETAILED DISCHARGE INFORMATION",!," Discharge ICD-9 Codes: " I $G(SRRES(0))>0 S SRRES="" D
38 .S SRRES=$P(SRRES(1),U,3)_" " I $D(SRRES(2)) F I=1:1:9 S:$P(SRRES(2),"^",I)'="" SRRES=SRRES_$P(SRRES(2),"^",I)_" " I $L(SRRES)>45 W SRRES S SRRES=""
39 .W:$D(SRRES) !,?26,SRRES
40 W !!,"Type of Disposition: ",$P($G(SRRES(1)),U,1)
41 W !,"Place of Disposition: ",$P($G(SRRES(1)),U,2)
42 W !,"Preferred VAMC identification code: ",SRPREF
43 W !,"Primary care or referral VAMC identification code: ",SRREFP
44 W !,"Follow-up VAMC identification code: ",SRFOLP
45 Q
46YN ; store answer
47 S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
48 Q
49DT S X="NS" I Y>1 D DT^SROAPCA1
50 Q
Note: See TracBrowser for help on using the repository browser.