MCARSRR ;WISC/TJK,RMP-CATH SURGERY RISK COMPUTATION ;5/2/96 13:04
;;2.3;Medicine;;09/13/1996
GET K MCF S DR="27;74;36;31;3;38;30;21;42;75.5",DIQ="MCV(",DIQ(0)="I" D EN^DIQ1
I '$D(MCV(694.5)) F JJ=1:1:10 S KK=$P(DR,";",JJ),MCF(KK)=""
I D CANT G EXIT
F JJ=1:1:10 S KK=$S(JJ=1:27,JJ=2:74,JJ=3:36,JJ=4:31,JJ=5:3,JJ=6:38,JJ=7:30,JJ=8:21,JJ=9:42,1:75.5) S:'$D(MCV(694.5,DA,KK,"I")) MCV(694.5,DA,KK,"I")="" S @("MCV"_JJ)=MCV(694.5,DA,KK,"I") S:MCV(694.5,DA,KK,"I")="" MCF(KK)=""
K MCV(694.5) I $D(MCF) G CANT
PROC ;S MCP=MCV10 ;S DR=75.5 D ^DIE G EXIT:$D(Y),PROC:'$P(^MCAR(694.5,DA,4),U,11) S MCP=$P(^(4),U,11)
S IC=-7.455009447,B1C=1.13743177,B2C=.48614314,B3C=.40570874,B4C=.46245638,B5C=.02927118,B6C=.50438306,B7C=.29901768,B8C=.28987855
S MCVI=-7.236265396,MCB2V=.78491219,MCB4V=.71141841,MCB5V=.04832140,MCB9V=.16933566,MCD1=.62625048,MCD2=.60725905,MCD3=.72498339
F JJ=1,4,6,7,8 S @("MCV"_JJ)=$S(@("MCV"_JJ)="N":0,1:1)
D @MCV10,EST2 S EST=EST2/(1+EST2)*100,EST=$J(EST,3,1),DR="75///"_EST D ^DIE
S DFN=$P(^MCAR(694.5,DA,0),U,2) D DEM^VADPT S MCARGNM=VADM(1) K VADM
W !!,*7,"The estimated mortality for ",MCARGNM," is ",EST," %."
W:MCV10=5 !!,*7,*7,"This mortality estimate should be interpreted with caution because of the variety of high and low risk procedures included in this group."
R !!,"Press <RETURN> to continue",X:DTIME
EXIT K DIQ,MCV,MCV1,MCV2,MCV3,MCV4,MCV5,MCV6,MCV7,MCV8,MCV9,JJ,KK,MCV10,MCF
K DIC,DIE,DA,DR,EST,EST1,EST2,MCARGNM
K %X,%Y,%Y2,B1C,B2C,B3C,B4C,B5C,B6C,B7C,B8C,MCB2V,MCB4V,MCB5V,MCB9V
K D,D0,DFN,DI,DIPGM,DQ,DZ,IC,MCVI,MCVA,MCD1,MCD2,MCD3
Q
EST2 ;
S X=EST1,E=0,B=1.4427*X\1+1 Q:B>90
S E=.693147*B-X,A=.00132988-(.000141316*E)
S A=((A*E-.00830136)*E+.0416574)*E
S E=(((A-.166665)*E+.5)*E-1)*E+1,A=2
I B'>0 S A=.5,B=-B
F I=1:1:B S E=A*E
S EST2=+E K A,B,I,E,X Q
1 S EST1=IC+(MCV1*B1C)+(MCV2*B2C)+(MCV3*B3C)+(MCV4*B4C)+(MCV5*B5C)+(MCV6*B6C)+(MCV7*B7C)+(MCV8*B8C) Q
2 S EST1=MCVI+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V) Q
3 S EST1=MCVI+MCD1+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V) Q
4 S EST1=MCVI+MCD2+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V) Q
5 S EST1=MCVI+MCD3+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V) Q
CANT W !,*7,"Expected Mortality CAN NOT be Calculated because the following variables are missing:"
F KK=0:0 S KK=$O(MCF(KK)) Q:KK="" W !,$P(^DD(694.5,KK,0),U)
W !,"Please enter values for these variables in order to compute expected mortality"
R !,"Would you like to enter these now? Yes//",ZIP:DTIME G EXIT:'$T!(ZIP=U),EXIT:ZIP["N",CANT:ZIP'["Y"&(ZIP'="")
;IF NOT GO EXIT
S DR="" F K=0:0 S K=$O(MCF(K)) Q:K="" S:'$D(TST) DR=K S:$D(TST) DR=DR_";"_K S TST=""
S DIE="^MCAR(694.5," D ^DIE K ZIP,MCF,TST G GET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARSRR 2757 printed Oct 16, 2024@18:15:10 Page 2
MCARSRR ;WISC/TJK,RMP-CATH SURGERY RISK COMPUTATION ;5/2/96 13:04
+1 ;;2.3;Medicine;;09/13/1996
GET KILL MCF
SET DR="27;74;36;31;3;38;30;21;42;75.5"
SET DIQ="MCV("
SET DIQ(0)="I"
DO EN^DIQ1
+1 IF '$DATA(MCV(694.5))
FOR JJ=1:1:10
SET KK=$PIECE(DR,";",JJ)
SET MCF(KK)=""
+2 IF $TEST
DO CANT
GOTO EXIT
+3 FOR JJ=1:1:10
SET KK=$SELECT(JJ=1:27,JJ=2:74,JJ=3:36,JJ=4:31,JJ=5:3,JJ=6:38,JJ=7:30,JJ=8:21,JJ=9:42,1:75.5)
if '$DATA(MCV(694.5,DA,KK,"I"))
SET MCV(694.5,DA,KK,"I")=""
SET @("MCV"_JJ)=MCV(694.5,DA,KK,"I")
if MCV(694.5,DA,KK,"I")=""
SET MCF(KK)=""
+4 KILL MCV(694.5)
IF $DATA(MCF)
GOTO CANT
PROC ;S MCP=MCV10 ;S DR=75.5 D ^DIE G EXIT:$D(Y),PROC:'$P(^MCAR(694.5,DA,4),U,11) S MCP=$P(^(4),U,11)
+1 SET IC=-7.455009447
SET B1C=1.13743177
SET B2C=.48614314
SET B3C=.40570874
SET B4C=.46245638
SET B5C=.02927118
SET B6C=.50438306
SET B7C=.29901768
SET B8C=.28987855
+2 SET MCVI=-7.236265396
SET MCB2V=.78491219
SET MCB4V=.71141841
SET MCB5V=.04832140
SET MCB9V=.16933566
SET MCD1=.62625048
SET MCD2=.60725905
SET MCD3=.72498339
+3 FOR JJ=1,4,6,7,8
SET @("MCV"_JJ)=$SELECT(@("MCV"_JJ)="N":0,1:1)
+4 DO @MCV10
DO EST2
SET EST=EST2/(1+EST2)*100
SET EST=$JUSTIFY(EST,3,1)
SET DR="75///"_EST
DO ^DIE
+5 SET DFN=$PIECE(^MCAR(694.5,DA,0),U,2)
DO DEM^VADPT
SET MCARGNM=VADM(1)
KILL VADM
+6 WRITE !!,*7,"The estimated mortality for ",MCARGNM," is ",EST," %."
+7 if MCV10=5
WRITE !!,*7,*7,"This mortality estimate should be interpreted with caution because of the variety of high and low risk procedures included in this group."
+8 READ !!,"Press <RETURN> to continue",X:DTIME
EXIT KILL DIQ,MCV,MCV1,MCV2,MCV3,MCV4,MCV5,MCV6,MCV7,MCV8,MCV9,JJ,KK,MCV10,MCF
+1 KILL DIC,DIE,DA,DR,EST,EST1,EST2,MCARGNM
+2 KILL %X,%Y,%Y2,B1C,B2C,B3C,B4C,B5C,B6C,B7C,B8C,MCB2V,MCB4V,MCB5V,MCB9V
+3 KILL D,D0,DFN,DI,DIPGM,DQ,DZ,IC,MCVI,MCVA,MCD1,MCD2,MCD3
+4 QUIT
EST2 ;
+1 SET X=EST1
SET E=0
SET B=1.4427*X\1+1
if B>90
QUIT
+2 SET E=.693147*B-X
SET A=.00132988-(.000141316*E)
+3 SET A=((A*E-.00830136)*E+.0416574)*E
+4 SET E=(((A-.166665)*E+.5)*E-1)*E+1
SET A=2
+5 IF B'>0
SET A=.5
SET B=-B
+6 FOR I=1:1:B
SET E=A*E
+7 SET EST2=+E
KILL A,B,I,E,X
QUIT
1 SET EST1=IC+(MCV1*B1C)+(MCV2*B2C)+(MCV3*B3C)+(MCV4*B4C)+(MCV5*B5C)+(MCV6*B6C)+(MCV7*B7C)+(MCV8*B8C)
QUIT
2 SET EST1=MCVI+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V)
QUIT
3 SET EST1=MCVI+MCD1+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V)
QUIT
4 SET EST1=MCVI+MCD2+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V)
QUIT
5 SET EST1=MCVI+MCD3+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V)
QUIT
CANT WRITE !,*7,"Expected Mortality CAN NOT be Calculated because the following variables are missing:"
+1 FOR KK=0:0
SET KK=$ORDER(MCF(KK))
if KK=""
QUIT
WRITE !,$PIECE(^DD(694.5,KK,0),U)
+2 WRITE !,"Please enter values for these variables in order to compute expected mortality"
+3 READ !,"Would you like to enter these now? Yes//",ZIP:DTIME
if '$TEST!(ZIP=U)
GOTO EXIT
if ZIP["N"
GOTO EXIT
if ZIP'["Y"&(ZIP'="")
GOTO CANT
+4 ;IF NOT GO EXIT
+5 SET DR=""
FOR K=0:0
SET K=$ORDER(MCF(K))
if K=""
QUIT
if '$DATA(TST)
SET DR=K
if $DATA(TST)
SET DR=DR_";"_K
SET TST=""
+6 SET DIE="^MCAR(694.5,"
DO ^DIE
KILL ZIP,MCF,TST
GOTO GET
