source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARSRR.m@ 660

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1MCARSRR ;WISC/TJK,RMP-CATH SURGERY RISK COMPUTATION ;5/2/96 13:04
2 ;;2.3;Medicine;;09/13/1996
3GET K MCF S DR="27;74;36;31;3;38;30;21;42;75.5",DIQ="MCV(",DIQ(0)="I" D EN^DIQ1
4 I '$D(MCV(694.5)) F JJ=1:1:10 S KK=$P(DR,";",JJ),MCF(KK)=""
5 I D CANT G EXIT
6 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)=""
7 K MCV(694.5) I $D(MCF) G CANT
8PROC ;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)
9 S IC=-7.455009447,B1C=1.13743177,B2C=.48614314,B3C=.40570874,B4C=.46245638,B5C=.02927118,B6C=.50438306,B7C=.29901768,B8C=.28987855
10 S MCVI=-7.236265396,MCB2V=.78491219,MCB4V=.71141841,MCB5V=.04832140,MCB9V=.16933566,MCD1=.62625048,MCD2=.60725905,MCD3=.72498339
11 F JJ=1,4,6,7,8 S @("MCV"_JJ)=$S(@("MCV"_JJ)="N":0,1:1)
12 D @MCV10,EST2 S EST=EST2/(1+EST2)*100,EST=$J(EST,3,1),DR="75///"_EST D ^DIE
13 S DFN=$P(^MCAR(694.5,DA,0),U,2) D DEM^VADPT S MCARGNM=VADM(1) K VADM
14 W !!,*7,"The estimated mortality for ",MCARGNM," is ",EST," %."
15 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."
16 R !!,"Press <RETURN> to continue",X:DTIME
17EXIT K DIQ,MCV,MCV1,MCV2,MCV3,MCV4,MCV5,MCV6,MCV7,MCV8,MCV9,JJ,KK,MCV10,MCF
18 K DIC,DIE,DA,DR,EST,EST1,EST2,MCARGNM
19 K %X,%Y,%Y2,B1C,B2C,B3C,B4C,B5C,B6C,B7C,B8C,MCB2V,MCB4V,MCB5V,MCB9V
20 K D,D0,DFN,DI,DIPGM,DQ,DZ,IC,MCVI,MCVA,MCD1,MCD2,MCD3
21 Q
22EST2 ;
23 S X=EST1,E=0,B=1.4427*X\1+1 Q:B>90
24 S E=.693147*B-X,A=.00132988-(.000141316*E)
25 S A=((A*E-.00830136)*E+.0416574)*E
26 S E=(((A-.166665)*E+.5)*E-1)*E+1,A=2
27 I B'>0 S A=.5,B=-B
28 F I=1:1:B S E=A*E
29 S EST2=+E K A,B,I,E,X Q
301 S EST1=IC+(MCV1*B1C)+(MCV2*B2C)+(MCV3*B3C)+(MCV4*B4C)+(MCV5*B5C)+(MCV6*B6C)+(MCV7*B7C)+(MCV8*B8C) Q
312 S EST1=MCVI+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V) Q
323 S EST1=MCVI+MCD1+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V) Q
334 S EST1=MCVI+MCD2+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V) Q
345 S EST1=MCVI+MCD3+(MCV2*MCB2V)+(MCV4*MCB4V)+(MCV5*MCB5V)+(MCV9*MCB9V) Q
35CANT W !,*7,"Expected Mortality CAN NOT be Calculated because the following variables are missing:"
36 F KK=0:0 S KK=$O(MCF(KK)) Q:KK="" W !,$P(^DD(694.5,KK,0),U)
37 W !,"Please enter values for these variables in order to compute expected mortality"
38 R !,"Would you like to enter these now? Yes//",ZIP:DTIME G EXIT:'$T!(ZIP=U),EXIT:ZIP["N",CANT:ZIP'["Y"&(ZIP'="")
39 ;IF NOT GO EXIT
40 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=""
41 S DIE="^MCAR(694.5," D ^DIE K ZIP,MCF,TST G GET
Note: See TracBrowser for help on using the repository browser.