| [613] | 1 | MCARBSA ;WISC/TJK,RCH-COMPUTE BODY SURFACE AREA .001*71.84*((WT/2.2)**.425*(HT*2.5)**.725) ;5/2/96 13:53
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | N BS
|
|---|
| 4 | Q:'$D(^MCAR(691,DA,13)) S BS=^(13),WT=$P(BS,U,1),HT=$P(BS,U,2)
|
|---|
| 5 | Q:(WT="")!(HT="") D COMPUTE S $P(BS,U,3)=X,^MCAR(691,DA,13)=BS
|
|---|
| 6 | A I $D(DJDN) S V(7)=X,DJVV=7 D EN^MCARDNJ1 K DJVV
|
|---|
| 7 | Q
|
|---|
| 8 | CATH S BS=^MCAR(691.1,DA,0),WT=$P(BS,U,7),HT=$P(BS,U,8)
|
|---|
| 9 | Q:(WT="")!(HT="") D COMPUTE S $P(BS,U,9)=X,^MCAR(691.1,DA,0)=BS K BS
|
|---|
| 10 | B I $D(DJDN) S V(8)=X,DJVV=8 D EN^MCARDNJ1 K DJVV
|
|---|
| 11 | Q
|
|---|
| 12 | RISK S BS=^MCAR(694.5,DA,0),WT=$P(BS,U,7),HT=$P(BS,U,5)
|
|---|
| 13 | D RISK1:(WT="")!(HT="")
|
|---|
| 14 | Q:(WT="")!(HT="") D COMPUTE S $P(BS,U,9)=X,^MCAR(694.5,DA,0)=BS K BS
|
|---|
| 15 | Q
|
|---|
| 16 | RISK1 I '$P(BS,U,5),$P(BS,U,6) S HT=$P(BS,U,6)/2.5,$P(BS,U,5)=HT
|
|---|
| 17 | I '$P(BS,U,7),$P(BS,U,8) S WT=$P(BS,U,8)*2.2,$P(BS,U,7)=WT
|
|---|
| 18 | Q
|
|---|
| 19 | COMPUTE ;
|
|---|
| 20 | S MCARX=WT/2.2 D LN S MCARX=MCARR*0.425 D EXP S MCARW=MCARR
|
|---|
| 21 | S MCARX=HT*2.5 D LN S MCARX=MCARR*0.725 D EXP
|
|---|
| 22 | S X=(0.0001)*(71.84)*(MCARW*MCARR),X=$J(X,4,2) K MCARR,MCARW,MCARX,WT,HT
|
|---|
| 23 | Q
|
|---|
| 24 | LN ;
|
|---|
| 25 | S F=MCARX,(LN,D)=0 Q:MCARX'>0
|
|---|
| 26 | LN2 I F'<1 S F=.5*F,D=D+1 G LN2
|
|---|
| 27 | LN3 I F<.5 S F=2*F,D=D-1 G LN3
|
|---|
| 28 | S F=(F-.707107)/(F+.707107),LN=F*F
|
|---|
| 29 | S LN=(((.598979*LN+.961471)*LN+2.88539)*F+D-.5)*.693147
|
|---|
| 30 | S MCARR=LN K LN,D,F Q
|
|---|
| 31 | EXP ;
|
|---|
| 32 | S X=MCARX,E=0,B=1.4427*X\1+1 Q:B>90
|
|---|
| 33 | S E=.693147*B-X,A=.00132988-(.000141316*E)
|
|---|
| 34 | S A=((A*E-.00830136)*E+.0416574)*E
|
|---|
| 35 | S E=(((A-.166665)*E+.5)*E-1)*E+1,A=2
|
|---|
| 36 | I B'>0 S A=.5,B=-B
|
|---|
| 37 | F I=1:1:B S E=A*E
|
|---|
| 38 | S MCARR=+E K A,B,I,E,X Q
|
|---|
