- APCDGC ; IHS/CMI/LAB - DATA ENTRY ENTER MODE ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;;
- ;;PLEASE NOTE: This routine was given to me by Cameron Schlehuber (VA).
- ;;I copied it into APCDGC so I could distribute it with the APCD package.
- ;;file 882 if from the VA, PED is a VA namespace.
- ;;
- ;;
- ;^APCDPED(D0,0)= (#.01) NAME [1F] ^
- ;^APCDPED(D0,1,0)=^882.01SA^^ (#1) SEX
- ;^APCDPED(D0,1,D1,0)= (#.01) SEX [1S] ^
- ;^APCDPED(D0,1,D1,1,0)=^882.11^^ (#1) AGE or LENGTH or HEIGHT
- ;^APCDPED(D0,1,D1,1,D2,0)= (#.01) AGE or LENGTH or HEIGHT [1N] ^
- ;^APCDPED(D0,1,D1,1,D2,1,0)=^882.111^^ (#1) PERCENTILE
- ;^APCDPED(D0,1,D1,1,D2,1,D3,0)= (#.01) PERCENTILE [1N] ^ (#1) VALUE [2N] ^
- ;^APCDPED(D0,1,D1,1,D2,2)= (#2) L [1N] ^ (#3) M [2N] ^ (#4) S [3N] ^
- ; D0 = 1 WTAGEINF - WEIGHT AGE INFANT
- ; D0 = 2 LENAGEINF - LENGTH FOR AGE INFANT
- ; D0 = 3 WTLENINF - WEIGHT FOR RECUMBENT LENGTH
- ; D0 = 4 HCAGEINF - HEAD CIRCUMFERENCE FOR AGE
- ; D0 = 5 WTSTAT - WEIGHT FOR STATURE
- ; D0 = 6 WTAGE - WEIGHT FOR AGE
- ; D0 = 7 STATAGE - STATURE FOR AGE
- ; D0 = 8 BMIAGE - BODY MASS INDEX FOR AGE
- CHART ;EP
- N AGEL,AIEN,CHART,DIR,DIRUT,ECHO,L,M,P,S,SEX,WT,X,Y,Z
- S DIR(0)="SO^1:WEIGHT FOR AGE INFANT;2:LENGTH FOR AGE INFANT;3:WEIGHT FOR RECUMBENT LENGTH;4:HEAD CIRCUMFERENCE FOR AGE;5:WEIGHT FOR STATURE;6:WEIGHT FOR AGE;7:STATURE FOR AGE;8:BODY MASS INDEX FOR AGE"
- S DIR("A")="Growth Chart" D ^DIR Q:$D(DIRUT) S CHART=Y,ECHO=Y(0)
- S DIR(0)="SO^1:MALE;2:FEMALE"
- S DIR("A")="Sex" D ^DIR G:$D(DIRUT) CHART S SEX=Y
- I "124678"[CHART D
- . S DIR(0)="NO^"_$S("124"[CHART:0,CHART=3:45,CHART=5:77,"678"[CHART:24)_":"_$S("14"[CHART:36,CHART=2:36.9,CHART=3:103.9,CHART=5:121.9,"678"[CHART:240)_":1"
- . S DIR("A")="Age in months" D ^DIR Q:$D(DIRUT)
- . S AGEL=$S(CHART=1&(Y=0!(Y=36)):Y,CHART=3&(Y=45):Y,CHART=5&(Y=77):Y,"678"[CHART&(Y=24!(Y=240)):Y,1:$P(Y,".")+.5) W !!,"Age approximated to ",AGEL," months."
- G:$D(DIRUT) CHART
- I CHART=3 D
- . S DIR(0)="NO^45:103.9:1"
- . S DIR("A")="Length in centimeters" D ^DIR Q:$D(DIRUT) S AGEL=$P(Y,".")+.5 W !!,"Length approximated to ",AGEL," centimeters."
- G:$D(DIRUT) CHART
- I CHART=5 D
- . S DIR(0)="NO^77:121.9:1"
- . S DIR("A")="Height in centimeters" D ^DIR Q:$D(DIRUT) S AGEL=$P(Y,".")+.5 W !!,"Height approximated to ",AGEL," centimeters."
- G:$D(DIRUT) CHART
- S AIEN=+$O(^APCDPED(CHART,1,SEX,1,"B",AGEL,"")) I '$D(^APCDPED(CHART,1,SEX,1,AIEN,0)) W !,"Not on the chart." G CHART
- I "13568"[CHART S DIR(0)="NO^.1:90:3",DIR("A")="Weight in kilograms" D ^DIR G:$D(DIRUT) CHART S X=Y G:CHART'=8 COMPUTE S:CHART=8 WT=X
- I CHART=2 S DIR(0)="NO^40:110:1",DIR("A")="Length in centimeters" D ^DIR G:$D(DIRUT) CHART S X=Y G COMPUTE
- I CHART=4 S DIR(0)="NO^28:60:1",DIR("A")="Head circumference in centimeters" D ^DIR G:$D(DIRUT) CHART S X=Y G COMPUTE
- I "78"[CHART S DIR(0)="NO^75:200:1",DIR("A")="Height in centimeters" D ^DIR G:$D(DIRUT) CHART S X=Y G:CHART'=8 COMPUTE
- I CHART=8 S X=10000*WT/(X**2) W !!,"Body Mass Index is ",$J(X,1,2)
- ;I CHART=8 S DIR(0)="NO^12:40:1",DIR("A")="Body Mass Index (killograms/meters squared)" D ^DIR G:$D(DIRUT) CHART S X=Y G COMPUTE
- COMPUTE S L=$P(^APCDPED(CHART,1,SEX,1,AIEN,2),U),M=$P(^(2),U,2),S=$P(^(2),U,3)
- S Z=(((X/M)**L)-1)/(L*S)
- ;And from P=1-1/SQRT(2*3.14159265)*EXP(-(ABS(Z)**2)/2)*(0.4361836*(1/(1+0.33267*ABS(Z)))-0.1201676*(1/(1+0.33267*ABS(Z)))**2+0.937298*(1/(1+0.33267*ABS(Z)))**3)
- S P=1-((1/$$SQRT^XLFMTH(2*3.14159265))*$$EXP^XLFMTH(-($$ABS^XLFMTH(Z)**2)/2)*(0.4361836*(1/(1+(0.33267*$$ABS^XLFMTH(Z))))-(0.1201676*((1/(1+(0.33267*$$ABS^XLFMTH(Z))))**2))+(0.937298*((1/(1+(0.33267*$$ABS^XLFMTH(Z))))**3))))
- I Z>0 S P=P*100
- E S P=100-(P*100)
- W !!,"Percentile for ",ECHO," is ",$J(P,1,1)
- G CHART
- APCDGC ; IHS/CMI/LAB - DATA ENTRY ENTER MODE ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;;
- +3 ;;PLEASE NOTE: This routine was given to me by Cameron Schlehuber (VA).
- +4 ;;I copied it into APCDGC so I could distribute it with the APCD package.
- +5 ;;file 882 if from the VA, PED is a VA namespace.
- +6 ;;
- +7 ;;
- +8 ;^APCDPED(D0,0)= (#.01) NAME [1F] ^
- +9 ;^APCDPED(D0,1,0)=^882.01SA^^ (#1) SEX
- +10 ;^APCDPED(D0,1,D1,0)= (#.01) SEX [1S] ^
- +11 ;^APCDPED(D0,1,D1,1,0)=^882.11^^ (#1) AGE or LENGTH or HEIGHT
- +12 ;^APCDPED(D0,1,D1,1,D2,0)= (#.01) AGE or LENGTH or HEIGHT [1N] ^
- +13 ;^APCDPED(D0,1,D1,1,D2,1,0)=^882.111^^ (#1) PERCENTILE
- +14 ;^APCDPED(D0,1,D1,1,D2,1,D3,0)= (#.01) PERCENTILE [1N] ^ (#1) VALUE [2N] ^
- +15 ;^APCDPED(D0,1,D1,1,D2,2)= (#2) L [1N] ^ (#3) M [2N] ^ (#4) S [3N] ^
- +16 ; D0 = 1 WTAGEINF - WEIGHT AGE INFANT
- +17 ; D0 = 2 LENAGEINF - LENGTH FOR AGE INFANT
- +18 ; D0 = 3 WTLENINF - WEIGHT FOR RECUMBENT LENGTH
- +19 ; D0 = 4 HCAGEINF - HEAD CIRCUMFERENCE FOR AGE
- +20 ; D0 = 5 WTSTAT - WEIGHT FOR STATURE
- +21 ; D0 = 6 WTAGE - WEIGHT FOR AGE
- +22 ; D0 = 7 STATAGE - STATURE FOR AGE
- +23 ; D0 = 8 BMIAGE - BODY MASS INDEX FOR AGE
- CHART ;EP
- +1 NEW AGEL,AIEN,CHART,DIR,DIRUT,ECHO,L,M,P,S,SEX,WT,X,Y,Z
- +2 SET DIR(0)="SO^1:WEIGHT FOR AGE INFANT;2:LENGTH FOR AGE INFANT;3:WEIGHT FOR RECUMBENT LENGTH;4:HEAD CIRCUMFERENCE FOR AGE;5:WEIGHT FOR STATURE;6:WEIGHT FOR AGE;7:STATURE FOR AGE;8:BODY MASS INDEX FOR AGE"
- +3 SET DIR("A")="Growth Chart"
- DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- SET CHART=Y
- SET ECHO=Y(0)
- +4 SET DIR(0)="SO^1:MALE;2:FEMALE"
- +5 SET DIR("A")="Sex"
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO CHART
- SET SEX=Y
- +6 IF "124678"[CHART
- Begin DoDot:1
- +7 SET DIR(0)="NO^"_$SELECT("124"[CHART:0,CHART=3:45,CHART=5:77,"678"[CHART:24)_":"_$SELECT("14"[CHART:36,CHART=2:36.9,CHART=3:103.9,CHART=5:121.9,"678"[CHART:240)_":1"
- +8 SET DIR("A")="Age in months"
- DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- +9 SET AGEL=$SELECT(CHART=1&(Y=0!(Y=36)):Y,CHART=3&(Y=45):Y,CHART=5&(Y=77):Y,"678"[CHART&(Y=24!(Y=240)):Y,1:$PIECE(Y,".")+.5)
- WRITE !!,"Age approximated to ",AGEL," months."
- End DoDot:1
- +10 IF $DATA(DIRUT)
- GOTO CHART
- +11 IF CHART=3
- Begin DoDot:1
- +12 SET DIR(0)="NO^45:103.9:1"
- +13 SET DIR("A")="Length in centimeters"
- DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- SET AGEL=$PIECE(Y,".")+.5
- WRITE !!,"Length approximated to ",AGEL," centimeters."
- End DoDot:1
- +14 IF $DATA(DIRUT)
- GOTO CHART
- +15 IF CHART=5
- Begin DoDot:1
- +16 SET DIR(0)="NO^77:121.9:1"
- +17 SET DIR("A")="Height in centimeters"
- DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- SET AGEL=$PIECE(Y,".")+.5
- WRITE !!,"Height approximated to ",AGEL," centimeters."
- End DoDot:1
- +18 IF $DATA(DIRUT)
- GOTO CHART
- +19 SET AIEN=+$ORDER(^APCDPED(CHART,1,SEX,1,"B",AGEL,""))
- IF '$DATA(^APCDPED(CHART,1,SEX,1,AIEN,0))
- WRITE !,"Not on the chart."
- GOTO CHART
- +20 IF "13568"[CHART
- SET DIR(0)="NO^.1:90:3"
- SET DIR("A")="Weight in kilograms"
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO CHART
- SET X=Y
- IF CHART'=8
- GOTO COMPUTE
- IF CHART=8
- SET WT=X
- +21 IF CHART=2
- SET DIR(0)="NO^40:110:1"
- SET DIR("A")="Length in centimeters"
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO CHART
- SET X=Y
- GOTO COMPUTE
- +22 IF CHART=4
- SET DIR(0)="NO^28:60:1"
- SET DIR("A")="Head circumference in centimeters"
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO CHART
- SET X=Y
- GOTO COMPUTE
- +23 IF "78"[CHART
- SET DIR(0)="NO^75:200:1"
- SET DIR("A")="Height in centimeters"
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO CHART
- SET X=Y
- IF CHART'=8
- GOTO COMPUTE
- +24 IF CHART=8
- SET X=10000*WT/(X**2)
- WRITE !!,"Body Mass Index is ",$JUSTIFY(X,1,2)
- +25 ;I CHART=8 S DIR(0)="NO^12:40:1",DIR("A")="Body Mass Index (killograms/meters squared)" D ^DIR G:$D(DIRUT) CHART S X=Y G COMPUTE
- COMPUTE SET L=$PIECE(^APCDPED(CHART,1,SEX,1,AIEN,2),U)
- SET M=$PIECE(^(2),U,2)
- SET S=$PIECE(^(2),U,3)
- +1 SET Z=(((X/M)**L)-1)/(L*S)
- +2 ;And from P=1-1/SQRT(2*3.14159265)*EXP(-(ABS(Z)**2)/2)*(0.4361836*(1/(1+0.33267*ABS(Z)))-0.1201676*(1/(1+0.33267*ABS(Z)))**2+0.937298*(1/(1+0.33267*ABS(Z)))**3)
- +3 SET P=1-((1/$$SQRT^XLFMTH(2*3.14159265))*$$EXP^XLFMTH(-($$ABS^XLFMTH(Z)**2)/2)*(0.4361836*(1/(1+(0.33267*$$ABS^XLFMTH(Z))))-(0.1201676*((1/(1+(0.33267*$$ABS^XLFMTH(Z))))**2))+(0.937298*((1/(1+(0.33267*$$ABS^XLFMTH(Z))))**3))))
- +4 IF Z>0
- SET P=P*100
- +5 IF '$TEST
- SET P=100-(P*100)
- +6 WRITE !!,"Percentile for ",ECHO," is ",$JUSTIFY(P,1,1)
- +7 GOTO CHART
