source: FOIAVistA/trunk/r/MEDICINE-MC/MCARLV.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 953 bytes
Line 
1MCARLV ;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
11EXIT ;
12 K MCBSA,MCSEP,MCPWALL,MCLVD,MCX,MCINDEX,MCSEX
13 Q
14CALC ;
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
21CUBE ;
22 S X=X*X*X Q
23CALC2 ;
24 S X=MCSEP+MCPWALL+MCLVD/10 D CUBE
25 G EXIT
Note: See TracBrowser for help on using the repository browser.