source: FOIAVistA/tag/r/MEDICINE-MC/MCARSRR.m@ 1154

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