- 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