| 1 | MCARLV ;WISC/RMP-MEDICINE PACKAGE ECHO LVINDEX ;7/12/96 14:20
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | S MCDX=+$G(DA)
|
|---|
| 4 | S:'MCDX MCDX=D0
|
|---|
| 5 | S MCX=$S($D(^MCAR(691,MCDX,4)):^(4),1:"")
|
|---|
| 6 | S MCSEP=$P(MCX,U),MCPWALL=$P(MCX,U,2),MCLVD=$P(MCX,U,7)
|
|---|
| 7 | S MCBSA=$P($G(^MCAR(691,MCDX,13)),U,3)
|
|---|
| 8 | S DFN=$P(^MCAR(691,MCDX,0),U,2) D DEM^VADPT S MCSEX=$S($D(VADM(5)):$P(VADM(5),U,2),1:""),X=""
|
|---|
| 9 | I MCBSA>0,MCSEP>0,MCPWALL>0,MCLVD>0,MCSEX'="" G CALC
|
|---|
| 10 | I MCSEP>0,MCPWALL>0,MCLVD>0 G CALC2
|
|---|
| 11 | EXIT ;
|
|---|
| 12 | K MCBSA,MCSEP,MCPWALL,MCLVD,MCX,MCINDEX,MCSEX
|
|---|
| 13 | Q
|
|---|
| 14 | CALC ;
|
|---|
| 15 | S X=MCSEP+MCPWALL+MCLVD/10 D CUBE S MCINDEX=X
|
|---|
| 16 | S X=MCLVD/10 D CUBE S MCINDEX=MCINDEX-X*1.05
|
|---|
| 17 | S MCINDEX=$S(MCSEX="MALE":.93*MCINDEX-17.92,MCSEX="FEMALE":.88*MCINDEX-9,1:"")
|
|---|
| 18 | ; DAD 7-12-96 I MCINDEX'="" S MCINDEX=MCINDEX/MCBSA,MCINDEX=$J(MCINDEX,3,2),$P(^MCAR(691,MCDX,13),U,6)=MCINDEX
|
|---|
| 19 | S X="" I MCINDEX'="" S MCINDEX=MCINDEX/MCBSA,(X,MCINDEX)=$J(MCINDEX,3,2)
|
|---|
| 20 | G EXIT
|
|---|
| 21 | CUBE ;
|
|---|
| 22 | S X=X*X*X Q
|
|---|
| 23 | CALC2 ;
|
|---|
| 24 | S X=MCSEP+MCPWALL+MCLVD/10 D CUBE
|
|---|
| 25 | G EXIT
|
|---|
