SROAPCA1 ;BIR/MAM - PRINT CARDIAC CATH INFO ;02/05/08
;;3.0;Surgery;**38,63,71,88,95,125,142,153,166,174,175,184,200**;24 Jun 93;Build 9
N SRX F I=200:1:202,206,208,209,202.1 S SRA(I)=$G(^SRF(SRTN,I))
I $Y+14>IOSL D PAGE^SROAPCA I SRSOUT Q
D LAB^SROAPCA4
I $Y+16>IOSL D PAGE^SROAPCA I SRSOUT Q
S Y=$P(SRA(209),"^",4),SRAO(1)=$S(Y="C":"CATH",Y="I":"IVUS",Y="B":"BOTH",Y="NS":" NS",1:"")_"^476"
S Y=$P(SRA(206),"^",24),SRX=357,SRAO(2)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(206),"^",25),SRX=358,SRAO(3)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(206),"^",26),SRX=359,SRAO(4)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(206),"^",27),SRX=360,SRAO(5)=$$OUT(SRX,Y)_"^"_SRX
S NYUK=$P(SRA(206),"^",30) D LV S SRAO(6)=SHEMP_"^363"
S Y=$P(SRA(206),"^",9),SRX=415,SRAO(7)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(209),"^",5),SRX=477,SRAO(8)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(206),"^",28),SRX=361,SRAO(9)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(206),"^",33),SRX=362.1,SRAO(10)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(206),"^",34),SRX=362.2,SRAO(11)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(206),"^",35),SRX=362.3,SRAO(12)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(209),"^",6),SRX=478,SRAO(13)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(209),"^",7),SRX=479,SRAO(14)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(209),"^",8),SRX=480,SRAO(15)=$$OUT(SRX,Y)_"^"_SRX
W !!,"IV. CARDIAC CATHETERIZATION AND ANGIOGRAPHIC DATA"
S Y=$P($G(^SRF(SRTN,207)),"^",21) I Y>1 D DT S Y=X
D NS W !,"Cardiac Catheterization Date: ",$E(Y,1,8)
W !,"Procedure:",?30,$P(SRAO(1),"^"),?41,"Native Coronaries:"
S SRX=$P(SRAO(2),"^") W !,"LVEDP:",?30,SRX D MMHG
S SRX=$P(SRAO(9),"^") W ?41,"Left Main Stenosis:",?71,$J(SRX,3) I SRX?1.3N W "%"
S SRX=$P(SRAO(3),"^") W !,"Aortic Systolic Pressure:",?26,SRX D MMHG
S SRX=$P(SRAO(10),"^") W ?41,"LAD Stenosis:",?71,$J(SRX,3) I SRX?1.3N W "%"
S SRX=$P(SRAO(11),"^") W !,?41,"Right Coronary Stenosis:",?71,$J(SRX,3) I SRX?1.3N W "%"
W !,"For patients having right heart cath:" S SRX=$P(SRAO(12),"^") W ?41,"Circumflex Stenosis:",?71,$J(SRX,3) I SRX?1.3N W "%"
;
S SRX=$P(SRAO(4),"^") W !,"PA Systolic Pressure:",?30,$J(SRX,3) D MMHG
S SRX=$P(SRAO(5),"^") W !,"PAW Mean Pressure:",?30,$J(SRX,3) D MMHG
W ?41,"If a Re-do, indicate stenosis",!,?44," in graft to:"
S SRX=$P(SRAO(13),"^") W !,?41,"LAD:",?71,$J(SRX,3) I SRX?1.3N W "%"
S SRX=$P(SRAO(14),"^") W !,?41,"Right coronary (include PDA): ",$J(SRX,3) I SRX?1.3N W "%"
S SRX=$P(SRAO(15),"^") W !,?41,"Circumflex:",?71,$J(SRX,3) I SRX?1.3N W "%"
W !,LN
W !,"LV Contraction Grade (from contrast or radionuclide angiogram or 2D Echo):",!,?7,"Grade",?17,"Ejection Fraction Range",?51,"Definition"
W !,?8,$P(SRAO(6),"^")
W !,LN,!,"Mitral Regurgitation:",?30,$P(SRAO(7),"^")
W !,"Aortic stenosis:",?30,$P(SRAO(8),"^")
I $Y+14>IOSL D PAGE^SROAPCA I SRSOUT Q
K SRAO
S Y=$P($G(^SRF(SRTN,1.1)),"^",3),SRX=1.13,SRAO(1)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(208),"^",12),SRX=414,SRAO(2)=$$OUT(SRX,Y)_"^"_SRX
S Y=$P(SRA(208),"^",13),SRX=414.1 D DT S SRAO("3A")=X_"^"_SRX
S Y=$P($G(^SRF(SRTN,.2)),"^",2),SRX=.22 D DT S SRAO(0)=X_"^"_SRX
W !!,"V. OPERATIVE RISK SUMMARY DATA"
W !,?5,"ASA Classification:",?35,$P(SRAO(1),"^")
S X=$P(SRAO(2),"^") W !,?5,"Surgical Priority:",?($S($L(X)>10:24,1:35)),X S X=$P(SRAO("3A"),"^") I X'="" W ?57,"("_X_")"
S X=$P($G(^SRO(136,SRTN,0)),"^",2) I X S Y=$P($$CPT^ICPTCOD(X),"^",2) D SSPRIN^SROCPT0 S X=Y
S X=$S(X'="":X,1:"CPT Code Missing")
W !,?5,"Principal CPT Code:",?35,X,!,?5,"Other Procedures CPT Codes: "
S CNT=32,OTH=0 F S OTH=$O(^SRO(136,SRTN,3,OTH)) Q:'OTH S CPT=$P($G(^SRO(136,SRTN,3,OTH,0)),"^") D
.I CPT S Y=$P($$CPT^ICPTCOD(CPT),"^",2) S SRDA=OTH D SSOTH^SROCPT0 S CPT=Y
.S:CPT="" CPT="NONE" S CNT=CNT+3
.I CNT+$L(CPT)'>80 W:CNT>35 ";" W ?(CNT),CPT S CNT=CNT+$L(CPT) Q
.W !,?35,CPT S CNT=35+$L(CPT)
S Y=$P($G(^SRF(SRTN,"1.0")),"^",8),C=$P(^DD(130,1.09,0),"^",2) D:Y'="" Y^DIQ
W !,?5,"Wound Classification:",?35,Y
W !,?5,"Robotic Assistance (Y/N):",?35,$$GET1^DIQ(130,SRTN_",",2006,"E")
I $Y+20>IOSL D PAGE^SROAPCA I SRSOUT Q
K SRA,SRAO D ^SROAPCA2
Q
YN ; store answer
S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
Q
DT I 'Y S X="" Q
S Z=$E($P(Y,".",2),1,4),Z=Z_"0000",Z=$E(Z,1,4),X=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_" "_$E(Z,1,2)_":"_$E(Z,3,4)
Q
OUT(SRFLD,SRY) ; get data in output form
N C,Y
S Y=SRY,C=$P(^DD(130,SRFLD,0),"^",2) D:Y'="" Y^DIQ
I Y="NO STUDY" S Y="NS" Q Y
Q Y
MMHG I SRX="NO STUDY"!(SRX="NS") Q
W " mm Hg"
Q
NS S Y=$S(Y="NS":"NO STUDY",1:Y)
Q
LV K SHEMP S SHEMP=$S(NYUK="I":" I > or = 0.55 NORMAL",NYUK="II":"II 0.45-0.54 MILD DYSFUNCTION",1:NYUK)
Q:SHEMP'=NYUK S SHEMP=$S(NYUK="III":"III 0.35-0.44 MODERATE DYSFUNCTION",1:NYUK)
Q:SHEMP'=NYUK S SHEMP=$S(NYUK="IIIa":"IIIa 0.40-0.44 MODERATE DYSFUNCTION A",1:NYUK)
Q:SHEMP'=NYUK S SHEMP=$S(NYUK="IIIb":"IIIb 0.35-0.39 MODERATE DYSFUNCTION B",1:NYUK)
Q:SHEMP'=NYUK S SHEMP=$S(NYUK="IV":"IV 0.25-0.34 SEVERE DYSFUNCTION",NYUK="V":" V <0.25 VERY SEVERE DYSFUNCTION",NYUK="NS":"NO LV STUDY",1:"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAPCA1 5243 printed Apr 09, 2024@21:51:15 Page 2
SROAPCA1 ;BIR/MAM - PRINT CARDIAC CATH INFO ;02/05/08
+1 ;;3.0;Surgery;**38,63,71,88,95,125,142,153,166,174,175,184,200**;24 Jun 93;Build 9
+2 NEW SRX
FOR I=200:1:202,206,208,209,202.1
SET SRA(I)=$GET(^SRF(SRTN,I))
+3 IF $Y+14>IOSL
DO PAGE^SROAPCA
IF SRSOUT
QUIT
+4 DO LAB^SROAPCA4
+5 IF $Y+16>IOSL
DO PAGE^SROAPCA
IF SRSOUT
QUIT
+6 SET Y=$PIECE(SRA(209),"^",4)
SET SRAO(1)=$SELECT(Y="C":"CATH",Y="I":"IVUS",Y="B":"BOTH",Y="NS":" NS",1:"")_"^476"
+7 SET Y=$PIECE(SRA(206),"^",24)
SET SRX=357
SET SRAO(2)=$$OUT(SRX,Y)_"^"_SRX
+8 SET Y=$PIECE(SRA(206),"^",25)
SET SRX=358
SET SRAO(3)=$$OUT(SRX,Y)_"^"_SRX
+9 SET Y=$PIECE(SRA(206),"^",26)
SET SRX=359
SET SRAO(4)=$$OUT(SRX,Y)_"^"_SRX
+10 SET Y=$PIECE(SRA(206),"^",27)
SET SRX=360
SET SRAO(5)=$$OUT(SRX,Y)_"^"_SRX
+11 SET NYUK=$PIECE(SRA(206),"^",30)
DO LV
SET SRAO(6)=SHEMP_"^363"
+12 SET Y=$PIECE(SRA(206),"^",9)
SET SRX=415
SET SRAO(7)=$$OUT(SRX,Y)_"^"_SRX
+13 SET Y=$PIECE(SRA(209),"^",5)
SET SRX=477
SET SRAO(8)=$$OUT(SRX,Y)_"^"_SRX
+14 SET Y=$PIECE(SRA(206),"^",28)
SET SRX=361
SET SRAO(9)=$$OUT(SRX,Y)_"^"_SRX
+15 SET Y=$PIECE(SRA(206),"^",33)
SET SRX=362.1
SET SRAO(10)=$$OUT(SRX,Y)_"^"_SRX
+16 SET Y=$PIECE(SRA(206),"^",34)
SET SRX=362.2
SET SRAO(11)=$$OUT(SRX,Y)_"^"_SRX
+17 SET Y=$PIECE(SRA(206),"^",35)
SET SRX=362.3
SET SRAO(12)=$$OUT(SRX,Y)_"^"_SRX
+18 SET Y=$PIECE(SRA(209),"^",6)
SET SRX=478
SET SRAO(13)=$$OUT(SRX,Y)_"^"_SRX
+19 SET Y=$PIECE(SRA(209),"^",7)
SET SRX=479
SET SRAO(14)=$$OUT(SRX,Y)_"^"_SRX
+20 SET Y=$PIECE(SRA(209),"^",8)
SET SRX=480
SET SRAO(15)=$$OUT(SRX,Y)_"^"_SRX
+21 WRITE !!,"IV. CARDIAC CATHETERIZATION AND ANGIOGRAPHIC DATA"
+22 SET Y=$PIECE($GET(^SRF(SRTN,207)),"^",21)
IF Y>1
DO DT
SET Y=X
+23 DO NS
WRITE !,"Cardiac Catheterization Date: ",$EXTRACT(Y,1,8)
+24 WRITE !,"Procedure:",?30,$PIECE(SRAO(1),"^"),?41,"Native Coronaries:"
+25 SET SRX=$PIECE(SRAO(2),"^")
WRITE !,"LVEDP:",?30,SRX
DO MMHG
+26 SET SRX=$PIECE(SRAO(9),"^")
WRITE ?41,"Left Main Stenosis:",?71,$JUSTIFY(SRX,3)
IF SRX?1.3N
WRITE "%"
+27 SET SRX=$PIECE(SRAO(3),"^")
WRITE !,"Aortic Systolic Pressure:",?26,SRX
DO MMHG
+28 SET SRX=$PIECE(SRAO(10),"^")
WRITE ?41,"LAD Stenosis:",?71,$JUSTIFY(SRX,3)
IF SRX?1.3N
WRITE "%"
+29 SET SRX=$PIECE(SRAO(11),"^")
WRITE !,?41,"Right Coronary Stenosis:",?71,$JUSTIFY(SRX,3)
IF SRX?1.3N
WRITE "%"
+30 WRITE !,"For patients having right heart cath:"
SET SRX=$PIECE(SRAO(12),"^")
WRITE ?41,"Circumflex Stenosis:",?71,$JUSTIFY(SRX,3)
IF SRX?1.3N
WRITE "%"
+31 ;
+32 SET SRX=$PIECE(SRAO(4),"^")
WRITE !,"PA Systolic Pressure:",?30,$JUSTIFY(SRX,3)
DO MMHG
+33 SET SRX=$PIECE(SRAO(5),"^")
WRITE !,"PAW Mean Pressure:",?30,$JUSTIFY(SRX,3)
DO MMHG
+34 WRITE ?41,"If a Re-do, indicate stenosis",!,?44," in graft to:"
+35 SET SRX=$PIECE(SRAO(13),"^")
WRITE !,?41,"LAD:",?71,$JUSTIFY(SRX,3)
IF SRX?1.3N
WRITE "%"
+36 SET SRX=$PIECE(SRAO(14),"^")
WRITE !,?41,"Right coronary (include PDA): ",$JUSTIFY(SRX,3)
IF SRX?1.3N
WRITE "%"
+37 SET SRX=$PIECE(SRAO(15),"^")
WRITE !,?41,"Circumflex:",?71,$JUSTIFY(SRX,3)
IF SRX?1.3N
WRITE "%"
+38 WRITE !,LN
+39 WRITE !,"LV Contraction Grade (from contrast or radionuclide angiogram or 2D Echo):",!,?7,"Grade",?17,"Ejection Fraction Range",?51,"Definition"
+40 WRITE !,?8,$PIECE(SRAO(6),"^")
+41 WRITE !,LN,!,"Mitral Regurgitation:",?30,$PIECE(SRAO(7),"^")
+42 WRITE !,"Aortic stenosis:",?30,$PIECE(SRAO(8),"^")
+43 IF $Y+14>IOSL
DO PAGE^SROAPCA
IF SRSOUT
QUIT
+44 KILL SRAO
+45 SET Y=$PIECE($GET(^SRF(SRTN,1.1)),"^",3)
SET SRX=1.13
SET SRAO(1)=$$OUT(SRX,Y)_"^"_SRX
+46 SET Y=$PIECE(SRA(208),"^",12)
SET SRX=414
SET SRAO(2)=$$OUT(SRX,Y)_"^"_SRX
+47 SET Y=$PIECE(SRA(208),"^",13)
SET SRX=414.1
DO DT
SET SRAO("3A")=X_"^"_SRX
+48 SET Y=$PIECE($GET(^SRF(SRTN,.2)),"^",2)
SET SRX=.22
DO DT
SET SRAO(0)=X_"^"_SRX
+49 WRITE !!,"V. OPERATIVE RISK SUMMARY DATA"
+50 WRITE !,?5,"ASA Classification:",?35,$PIECE(SRAO(1),"^")
+51 SET X=$PIECE(SRAO(2),"^")
WRITE !,?5,"Surgical Priority:",?($SELECT($LENGTH(X)>10:24,1:35)),X
SET X=$PIECE(SRAO("3A"),"^")
IF X'=""
WRITE ?57,"("_X_")"
+52 SET X=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
IF X
SET Y=$PIECE($$CPT^ICPTCOD(X),"^",2)
DO SSPRIN^SROCPT0
SET X=Y
+53 SET X=$SELECT(X'="":X,1:"CPT Code Missing")
+54 WRITE !,?5,"Principal CPT Code:",?35,X,!,?5,"Other Procedures CPT Codes: "
+55 SET CNT=32
SET OTH=0
FOR
SET OTH=$ORDER(^SRO(136,SRTN,3,OTH))
if 'OTH
QUIT
SET CPT=$PIECE($GET(^SRO(136,SRTN,3,OTH,0)),"^")
Begin DoDot:1
+56 IF CPT
SET Y=$PIECE($$CPT^ICPTCOD(CPT),"^",2)
SET SRDA=OTH
DO SSOTH^SROCPT0
SET CPT=Y
+57 if CPT=""
SET CPT="NONE"
SET CNT=CNT+3
+58 IF CNT+$LENGTH(CPT)'>80
if CNT>35
WRITE ";"
WRITE ?(CNT),CPT
SET CNT=CNT+$LENGTH(CPT)
QUIT
+59 WRITE !,?35,CPT
SET CNT=35+$LENGTH(CPT)
End DoDot:1
+60 SET Y=$PIECE($GET(^SRF(SRTN,"1.0")),"^",8)
SET C=$PIECE(^DD(130,1.09,0),"^",2)
if Y'=""
DO Y^DIQ
+61 WRITE !,?5,"Wound Classification:",?35,Y
+62 WRITE !,?5,"Robotic Assistance (Y/N):",?35,$$GET1^DIQ(130,SRTN_",",2006,"E")
+63 IF $Y+20>IOSL
DO PAGE^SROAPCA
IF SRSOUT
QUIT
+64 KILL SRA,SRAO
DO ^SROAPCA2
+65 QUIT
YN ; store answer
+1 SET SHEMP=$SELECT(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
+2 QUIT
DT IF 'Y
SET X=""
QUIT
+1 SET Z=$EXTRACT($PIECE(Y,".",2),1,4)
SET Z=Z_"0000"
SET Z=$EXTRACT(Z,1,4)
SET X=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_" "_$EXTRACT(Z,1,2)_":"_$EXTRACT(Z,3,4)
+2 QUIT
OUT(SRFLD,SRY) ; get data in output form
+1 NEW C,Y
+2 SET Y=SRY
SET C=$PIECE(^DD(130,SRFLD,0),"^",2)
if Y'=""
DO Y^DIQ
+3 IF Y="NO STUDY"
SET Y="NS"
QUIT Y
+4 QUIT Y
MMHG IF SRX="NO STUDY"!(SRX="NS")
QUIT
+1 WRITE " mm Hg"
+2 QUIT
NS SET Y=$SELECT(Y="NS":"NO STUDY",1:Y)
+1 QUIT
LV KILL SHEMP
SET SHEMP=$SELECT(NYUK="I":" I > or = 0.55 NORMAL",NYUK="II":"II 0.45-0.54 MILD DYSFUNCTION",1:NYUK)
+1 if SHEMP'=NYUK
QUIT
SET SHEMP=$SELECT(NYUK="III":"III 0.35-0.44 MODERATE DYSFUNCTION",1:NYUK)
+2 if SHEMP'=NYUK
QUIT
SET SHEMP=$SELECT(NYUK="IIIa":"IIIa 0.40-0.44 MODERATE DYSFUNCTION A",1:NYUK)
+3 if SHEMP'=NYUK
QUIT
SET SHEMP=$SELECT(NYUK="IIIb":"IIIb 0.35-0.39 MODERATE DYSFUNCTION B",1:NYUK)
+4 if SHEMP'=NYUK
QUIT
SET SHEMP=$SELECT(NYUK="IV":"IV 0.25-0.34 SEVERE DYSFUNCTION",NYUK="V":" V <0.25 VERY SEVERE DYSFUNCTION",NYUK="NS":"NO LV STUDY",1:"")
+5 QUIT
