APCHS2A1.m

APCHS2A1 ; IHS/CMI/LAB - PART 2A1 OF APCHS -- COMPUTATIONS FOR MEASUREMENT TRANSFORMS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

MEASP ; ********** MEASUREMENT PANEL TRANSFORMS * 9000010.01 *******

 ;

AGEMO ; GET AGE IN MONTHS

 S APCHSPD2=-APCHSIVD\1+9999999,APCHSPD1=$P(^DPT(APCHSPAT,0),U,3)

 S APCHSPYR=$E(APCHSPD2,1,3)-$E(APCHSPD1,1,3),APCHSPMO=$E(APCHSPD2,4,5)-$E(APCHSPD1,4,5)

 I APCHSPMO<0 S APCHSPMO=APCHSPMO+12,APCHSPYR=APCHSPYR-1

 S APCHSAGE=12*APCHSPYR+APCHSPMO

 K APCHSPMO,APCHSPYR,APCHSPD1,APCHSPD2

 Q

 ;

WTPER ; GET WEIGHT PERCENTILE

 S APCHSPTY="WT" G COMMON

HTPER ; GET HEIGHT PERCENTILE

 S APCHSPTY="HT" G COMMON

COMMON ; COMMON PROCESSING FOR PERCENTILES

 D AGEMO

 S X=$$AUHTWT^APCHS2A2(APCHSPTY,$P(^DPT(APCHSPAT,0),U,2),APCHSAGE,X)

 K APCHSPTY,APCHSAGE

 Q

 ;

BMI ; GET BODY MASS INDEX

 S X=$$BMI^APCHS2A3(APCHSPAT,X,APCHSIDT) Q

RW ; GET RELATIVE WEIGHT PERCENTAGE

 S X=$$RW^APCHS2A3(APCHSPAT,X,APCHSIDT) Q

APCHS2A1  ; IHS/CMI/LAB - PART 2A1 OF APCHS -- COMPUTATIONS FOR MEASUREMENT TRANSFORMS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

MEASP     ; ********** MEASUREMENT PANEL TRANSFORMS * 9000010.01 *******

 +1       ;

AGEMO     ; GET AGE IN MONTHS

 +1        SET APCHSPD2=-APCHSIVD\1+9999999

           SET APCHSPD1=$PIECE(^DPT(APCHSPAT,0),U,3)

 +2        SET APCHSPYR=$EXTRACT(APCHSPD2,1,3)-$EXTRACT(APCHSPD1,1,3)

           SET APCHSPMO=$EXTRACT(APCHSPD2,4,5)-$EXTRACT(APCHSPD1,4,5)

 +3        IF APCHSPMO<0

               SET APCHSPMO=APCHSPMO+12

               SET APCHSPYR=APCHSPYR-1

 +4        SET APCHSAGE=12*APCHSPYR+APCHSPMO

 +5        KILL APCHSPMO,APCHSPYR,APCHSPD1,APCHSPD2

 +6        QUIT 

 +7       ;

WTPER     ; GET WEIGHT PERCENTILE

 +1        SET APCHSPTY="WT"

           GOTO COMMON

HTPER     ; GET HEIGHT PERCENTILE

 +1        SET APCHSPTY="HT"

           GOTO COMMON

COMMON    ; COMMON PROCESSING FOR PERCENTILES

 +1        DO AGEMO

 +2        SET X=$$AUHTWT^APCHS2A2(APCHSPTY,$PIECE(^DPT(APCHSPAT,0),U,2),APCHSAGE,X)

 +3        KILL APCHSPTY,APCHSAGE

 +4        QUIT 

 +5       ;

BMI       ; GET BODY MASS INDEX

 +1        SET X=$$BMI^APCHS2A3(APCHSPAT,X,APCHSIDT)

           QUIT 

RW        ; GET RELATIVE WEIGHT PERCENTAGE

 +1        SET X=$$RW^APCHS2A3(APCHSPAT,X,APCHSIDT)

           QUIT