MCARLV ;WISC/RMP-MEDICINE PACKAGE ECHO LVINDEX ;7/12/96 14:20
;;2.3;Medicine;;09/13/1996
S MCDX=+$G(DA)
S:'MCDX MCDX=D0
S MCX=$S($D(^MCAR(691,MCDX,4)):^(4),1:"")
S MCSEP=$P(MCX,U),MCPWALL=$P(MCX,U,2),MCLVD=$P(MCX,U,7)
S MCBSA=$P($G(^MCAR(691,MCDX,13)),U,3)
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=""
I MCBSA>0,MCSEP>0,MCPWALL>0,MCLVD>0,MCSEX'="" G CALC
I MCSEP>0,MCPWALL>0,MCLVD>0 G CALC2
EXIT ;
K MCBSA,MCSEP,MCPWALL,MCLVD,MCX,MCINDEX,MCSEX
Q
CALC ;
S X=MCSEP+MCPWALL+MCLVD/10 D CUBE S MCINDEX=X
S X=MCLVD/10 D CUBE S MCINDEX=MCINDEX-X*1.05
S MCINDEX=$S(MCSEX="MALE":.93*MCINDEX-17.92,MCSEX="FEMALE":.88*MCINDEX-9,1:"")
; DAD 7-12-96 I MCINDEX'="" S MCINDEX=MCINDEX/MCBSA,MCINDEX=$J(MCINDEX,3,2),$P(^MCAR(691,MCDX,13),U,6)=MCINDEX
S X="" I MCINDEX'="" S MCINDEX=MCINDEX/MCBSA,(X,MCINDEX)=$J(MCINDEX,3,2)
G EXIT
CUBE ;
S X=X*X*X Q
CALC2 ;
S X=MCSEP+MCPWALL+MCLVD/10 D CUBE
G EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARLV 978 printed Oct 16, 2024@18:13:40 Page 2
MCARLV ;WISC/RMP-MEDICINE PACKAGE ECHO LVINDEX ;7/12/96 14:20
+1 ;;2.3;Medicine;;09/13/1996
+2 SET MCDX=+$GET(DA)
+3 if 'MCDX
SET MCDX=D0
+4 SET MCX=$SELECT($DATA(^MCAR(691,MCDX,4)):^(4),1:"")
+5 SET MCSEP=$PIECE(MCX,U)
SET MCPWALL=$PIECE(MCX,U,2)
SET MCLVD=$PIECE(MCX,U,7)
+6 SET MCBSA=$PIECE($GET(^MCAR(691,MCDX,13)),U,3)
+7 SET DFN=$PIECE(^MCAR(691,MCDX,0),U,2)
DO DEM^VADPT
SET MCSEX=$SELECT($DATA(VADM(5)):$PIECE(VADM(5),U,2),1:"")
SET X=""
+8 IF MCBSA>0
IF MCSEP>0
IF MCPWALL>0
IF MCLVD>0
IF MCSEX'=""
GOTO CALC
+9 IF MCSEP>0
IF MCPWALL>0
IF MCLVD>0
GOTO CALC2
EXIT ;
+1 KILL MCBSA,MCSEP,MCPWALL,MCLVD,MCX,MCINDEX,MCSEX
+2 QUIT
CALC ;
+1 SET X=MCSEP+MCPWALL+MCLVD/10
DO CUBE
SET MCINDEX=X
+2 SET X=MCLVD/10
DO CUBE
SET MCINDEX=MCINDEX-X*1.05
+3 SET MCINDEX=$SELECT(MCSEX="MALE":.93*MCINDEX-17.92,MCSEX="FEMALE":.88*MCINDEX-9,1:"")
+4 ; DAD 7-12-96 I MCINDEX'="" S MCINDEX=MCINDEX/MCBSA,MCINDEX=$J(MCINDEX,3,2),$P(^MCAR(691,MCDX,13),U,6)=MCINDEX
+5 SET X=""
IF MCINDEX'=""
SET MCINDEX=MCINDEX/MCBSA
SET (X,MCINDEX)=$JUSTIFY(MCINDEX,3,2)
+6 GOTO EXIT
CUBE ;
+1 SET X=X*X*X
QUIT
CALC2 ;
+1 SET X=MCSEP+MCPWALL+MCLVD/10
DO CUBE
+2 GOTO EXIT
