VistA-WorldVistAEHR/r/SURGERY-SR/SROAPCA4.m

51 lines
3.3 KiB
Mathematica

SROAPCA4 ;BIR/SJA - CARDIAC COMPLIANCE DATA ;07/05/06
;;3.0; Surgery ;**95,125,153**;24 Jun 93;Build 11
;
; Reference to ^DGPM("APTT1" supported by DBIA #565
; Reference to File #405 supported by DBIA #3029
; Reference to Field #27.02 in File #2 supported by DBIA #1850
;
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))
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
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
TS 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)
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)
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)
I $Y+7>IOSL D PAGE^SROAPCA I SRSOUT Q
D DD
Q
LAB ;D PAGE^SROAPCA I SRSOUT Q
W !!,"III. DETAILED LABORATORY INFO - PREOPERATIVE VALUES"
N SROUN S SROUN=" mg/dl"
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)_")"
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)_")"
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)_")"
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)_")"
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)_")"
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)_")"
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)_")"
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)_")"
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)_")"
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)_")"
Q
DD ;Detailed Discharge Information
N VAINDT,SRPTF,SRRES
S X=$P(SRA(208),"^",15) I X S X=X-.0001
S VAINDT=X D INP^VADPT S SRPTF=VAIN(10)
S SRRES="" D RPC^DGPTFAPI(.SRRES,SRPTF)
I $Y+9>IOSL D PAGE^SROAPCA I SRSOUT Q
W !!,"X. DETAILED DISCHARGE INFORMATION",!," Discharge ICD-9 Codes: " I $G(SRRES(0))>0 S SRRES="" D
.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=""
.W:$D(SRRES) !,?26,SRRES
W !!,"Type of Disposition: ",$P($G(SRRES(1)),U,1)
W !,"Place of Disposition: ",$P($G(SRRES(1)),U,2)
W !,"Preferred VAMC identification code: ",SRPREF
W !,"Primary care or referral VAMC identification code: ",SRREFP
W !,"Follow-up VAMC identification code: ",SRFOLP
Q
YN ; store answer
S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
Q
DT S X="NS" I Y>1 D DT^SROAPCA1
Q