MCARLV.m

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

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