APCLW61 ; IHS/CMI/LAB - CALC WEIGHT REPORT ;
;;2.0;IHS PCC SUITE;**4,10,11**;MAY 14, 2009;Build 58
;
;cmi/anch/maw 9/12/2007 code set versioning PREGDX
;
START ;EP
;calculate 365 days ago and 1095 days ago
S APCLJ=$J,APCLH=$H
S APCLGRAN=0
D XTMP^APCLOSUT("APCLW6","PCC BMI REPORT")
;
PROC ;
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D
.Q:'$D(^DPT(DFN,0))
.Q:$P(^DPT(DFN,0),U,19)
.I APCLSEAT="" Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
.I APCLSEAT]"" Q:'$D(^DIBT(APCLSEAT,1,DFN))
.I APCLTYPE="P" Q:'$$AGEAP(DFN,APCLBD,APCLED,APCLLOWA,APCLHGHA,APCLBEG)
.S APCLAGE=$$AGE^AUPNPAT(DFN,$S($G(APCLBEG)="":APCLBD,APCLBEG="B":APCLBD,1:APCLED))
.I APCLTYPE="P" Q:APCLAGE<APCLLOWA Q:APCLAGE>APCLHGHA
.S Y=DFN D ^AUPNPAT
.Q:AUPNSEX=""
.Q:AUPNSEX="U"
.Q:APCLSEX'="B"&(APCLSEX'=AUPNSEX)
.D GETBMI1
.I APCLBMI1="" Q ;no beginning BMI
.I APCLOB1="" Q ;no beginning ob/ow
.D GETBMI2
.K ^TMP($J,"A")
.I APCLBMI2="" Q ;no ending BMI
.I APCLOB2="" Q ;no ending ob/ow value
.I APCLOB1=APCLOB2 Q ;same beg and end
.S APCLMOVE=""
.I APCLOB1<APCLOB2 S APCLMOVE="UP"
.I APCLOB1>APCLOB2 S APCLMOVE="DOWN"
.S ^XTMP("APCLW6",APCLJ,APCLH,"PATIENTS",APCLMOVE,APCLAGE,$P(^DPT(DFN,0),U),DFN)=APCLWT1_U_APCLHT1_U_APCLBMI1_U_APCLOB1_U_APCLWT2_U_APCLHT2_U_APCLBMI2_U_APCLOB2
.S APCLGRAN=APCLGRAN+1
.Q
Q
GETBMI1 ;
;TABLE ALL VISITS CHRONOLOGICALLY FROM BEGINNING DATE
S APCLBMI1="",APCLOB1=""
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q
S (APCLX,G)=0 F S APCLX=$O(^TMP($J,"A",APCLX)) Q:APCLX'=+APCLX!(APCLBMI1]"") S APCLV=$P(^TMP($J,"A",APCLX),U,5) D
.Q:'$D(^AUPNVSIT(APCLV,0))
.Q:'$P(^AUPNVSIT(APCLV,0),U,9)
.Q:$P(^AUPNVSIT(APCLV,0),U,11)
.Q:$$PREGDX(APCLV) ;quit if pregnant on this visit
.S APCLWT1=$$WT(APCLV)
.Q:$P(APCLWT1,U)="" ;no weight on this visit
.;got a weight so get a height
.S APCLHT1=$$HT(DFN,APCLV,$$AGE^AUPNPAT(DFN,$P($P(^AUPNVSIT(APCLV,0),U),".")),$P(APCLWT1,U,2))
.Q:$P(APCLHT1,U)=""
.Q:$P(APCLHT1,U)="?"
.S APCLCHT=$P(APCLHT1,U),APCLCWT=$P(APCLWT1,U) D CALCBMI
.S APCLBMI1=APCLBMI
.S APCLOB1=""
.;find entry in reference table
.S APCLREF=$O(^APCLBMI("H",AUPNSEX,$$AGE^AUPNPAT(DFN,$P($P(^AUPNVSIT(APCLV,0),U),".")),0))
.I 'APCLREF S APCLREF=$O(^APCLBMI("H",AUPNSEX,$$AGE^AUPNPAT(DFN,$P($P(^AUPNVSIT(APCLV,0),U),".")))) I APCLREF S APCLREF=$O(^APCLBMI("H",AUPNSEX,APCLREF,""))
.Q:'APCLREF
.;I APCLBMI1>$P(^APCLBMI(APCLREF,0),U,7)!(APCLBMI1<$P(^APCLBMI(APCLREF,0),U,6)) S APCLOB1="" Q
.I APCLBMI1'<$P(^APCLBMI(APCLREF,0),U,4),APCLBMI1<$P(^APCLBMI(APCLREF,0),U,5) S APCLOB1=2 Q
.I APCLBMI1'<$P(^APCLBMI(APCLREF,0),U,5) S APCLOB1=3 Q
.S APCLOB1=1
.Q
Q
GETBMI2 ;
;TABLE ALL VISITS CHRONOLOGICALLY FROM BEGINNING DATE
S APCLBMI2="",APCLOB2=""
;K ^TMP($J,"A")
;S A="^TMP($J,""A"",",B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),E=$$START1^APCLDF(B,A)
;I '$D(^TMP($J,"A",1)) Q
S G=0,APCLX="A" F S APCLX=$O(^TMP($J,"A",APCLX),-1) Q:APCLX'=+APCLX!(APCLBMI2]"") S APCLV=$P(^TMP($J,"A",APCLX),U,5) D
.Q:'$D(^AUPNVSIT(APCLV,0))
.Q:'$P(^AUPNVSIT(APCLV,0),U,9)
.Q:$P(^AUPNVSIT(APCLV,0),U,11)
.Q:$$PREGDX(APCLV) ;quit if pregnant on this visit
.S APCLWT2=$$WT(APCLV)
.Q:$P(APCLWT2,U)="" ;no weight on this visit
.;got a weight so get a height
.S APCLHT2=$$HT(DFN,APCLV,$$AGE^AUPNPAT(DFN,$P($P(^AUPNVSIT(APCLV,0),U),".")),$P(APCLWT2,U,2))
.Q:$P(APCLHT2,U)=""
.Q:$P(APCLHT2,U)="?"
.S APCLCHT=$P(APCLHT2,U),APCLCWT=$P(APCLWT2,U) D CALCBMI
.S APCLBMI2=APCLBMI
.S APCLOB2=""
.;find entry in reference table
.S APCLREF=$O(^APCLBMI("H",AUPNSEX,$$AGE^AUPNPAT(DFN,$P($P(^AUPNVSIT(APCLV,0),U),".")),0))
.I 'APCLREF S APCLREF=$O(^APCLBMI("H",AUPNSEX,$$AGE^AUPNPAT(DFN,$P($P(^AUPNVSIT(APCLV,0),U),".")))) I APCLREF S APCLREF=$O(^APCLBMI("H",AUPNSEX,APCLREF,""))
.Q:'APCLREF
.;I APCLBMI2>$P(^APCLBMI(APCLREF,0),U,7)!(APCLBMI2<$P(^APCLBMI(APCLREF,0),U,6)) S APCLOB2="" Q
.I APCLBMI2'<$P(^APCLBMI(APCLREF,0),U,4),APCLBMI2<$P(^APCLBMI(APCLREF,0),U,5) S APCLOB2=2 Q
.I APCLBMI2'<$P(^APCLBMI(APCLREF,0),U,5) S APCLOB2=3 Q
.S APCLOB2=1
.Q
Q
WT(V) ;return wt on this visit
NEW X,M,W
S W="",D=""
S M=$O(^AUTTMSR("B","WT",0))
S X=0 F S X=$O(^AUPNVMSR("AD",V,X)) Q:X'=+X I '$P($G(^AUPNVMSR(X,2)),U,1) S Z=$P(^AUPNVMSR(X,0),U) I Z=M S W=$P(^AUPNVMSR(X,0),U,4),D=$P($P(^AUPNVSIT(V,0),U),".")
Q W_U_D
HT(P,V,AGE,DATE) ;return wt on this visit
NEW X,M,W,APCLY,APCLX,BD,ED
S W="",D=""
S M=$O(^AUTTMSR("B","HT",0))
I AGE<19 D Q W_U_D
.S W=""
.;call data fetcher to get ht on DATE-DATE
.K APCLG S (W,D)=""
.S APCLY="APCLG(",APCLX=P_"^LAST MEASUREMENT HT;DURING "_DATE_"-"_DATE S APCLER=$$START1^APCLDF(APCLX,APCLY)
.I $D(APCLG(1)) S W=$P(APCLG(1),U,2),D=$P(APCLG(1),U)
.Q
K APCLG S (W,D)=""
I AGE>18,AGE<50 D Q W_U_D
.S BD=$$FMADD^XLFDT(DATE,-(3*365))
.S ED=DATE
.S APCLY="APCLG(",APCLX=P_"^LAST MEASUREMENT HT;DURING "_BD_"-"_ED S APCLER=$$START1^APCLDF(APCLX,APCLY)
.I $D(APCLG(1)) S W=$P(APCLG(1),U,2),D=$P(APCLG(1),U)
.Q
K APCLG S (W,D)=""
S BD=$$FMADD^XLFDT(DATE,-365)
S ED=DATE
S APCLY="APCLG(",APCLX=P_"^LAST MEASUREMENT HT;DURING "_BD_"-"_ED S APCLER=$$START1^APCLDF(APCLX,APCLY)
I $D(APCLG(1)) S W=$P(APCLG(1),U,2),D=$P(APCLG(1),U)
Q W_U_D
PREGDX(V) ;
NEW P,D,G
S G=0
S P=0 F S P=$O(^AUPNVPOV("AD",V,P)) Q:P'=+P!(G) S D=$P(^AUPNVPOV(P,0),U) D ;cmi/anch/maw 9/12/2007 csv
.I $$ICD^AUPNVUTL(D,$O(^ATXAX("B","BGP PREGNANCY DIAGNOSES 2",0)),9) S G=1
.Q
Q G
CALCBMI ;calculate BMI value
S APCLMWT=APCLCWT*.45359,APCLMHT=APCLCHT*.0254,APCLBMI=APCLMWT/(APCLMHT*APCLMHT)
Q
EOJ ;
K APCL1YR,APCL3YR,APCLA,APCLBD,APCLMGI,APCLCHT,APCLCWT,APCLGHT,APCLGWT,APCLROWT,APCLROHT,APCLER,APCLMHT,APCLMWT,APCLX,APCLY,APCLNN,APCLREF
K AUPNPAT,AUPNDOB,AUPNSEX,AUPNDAYS,AUPNDOD
K DFN,X,Y,V,A,D,I,J,Z
Q
AGEAP(P,BD,ED,LOW,HIGH,TP) ;
I '$G(P) Q ""
S A=$$AGE^AUPNPAT(P,$S(TP="B":BD,1:ED))
I A<LOW Q 0
I A>HIGH Q 0
Q 1
APCLW61 ; IHS/CMI/LAB - CALC WEIGHT REPORT ;
+1 ;;2.0;IHS PCC SUITE;**4,10,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;cmi/anch/maw 9/12/2007 code set versioning PREGDX
+4 ;
START ;EP
+1 ;calculate 365 days ago and 1095 days ago
+2 SET APCLJ=$JOB
SET APCLH=$HOROLOG
+3 SET APCLGRAN=0
+4 DO XTMP^APCLOSUT("APCLW6","PCC BMI REPORT")
+5 ;
PROC ;
+1 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+2 IF '$DATA(^DPT(DFN,0))
QUIT
+3 IF $PIECE(^DPT(DFN,0),U,19)
QUIT
+4 IF APCLSEAT=""
IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+5 IF APCLSEAT]""
IF '$DATA(^DIBT(APCLSEAT,1,DFN))
QUIT
+6 IF APCLTYPE="P"
IF '$$AGEAP(DFN,APCLBD,APCLED,APCLLOWA,APCLHGHA,APCLBEG)
QUIT
+7 SET APCLAGE=$$AGE^AUPNPAT(DFN,$SELECT($GET(APCLBEG)="":APCLBD,APCLBEG="B":APCLBD,1:APCLED))
+8 IF APCLTYPE="P"
IF APCLAGE<APCLLOWA
QUIT
IF APCLAGE>APCLHGHA
QUIT
+9 SET Y=DFN
DO ^AUPNPAT
+10 IF AUPNSEX=""
QUIT
+11 IF AUPNSEX="U"
QUIT
+12 IF APCLSEX'="B"&(APCLSEX'=AUPNSEX)
QUIT
+13 DO GETBMI1
+14 ;no beginning BMI
IF APCLBMI1=""
QUIT
+15 ;no beginning ob/ow
IF APCLOB1=""
QUIT
+16 DO GETBMI2
+17 KILL ^TMP($JOB,"A")
+18 ;no ending BMI
IF APCLBMI2=""
QUIT
+19 ;no ending ob/ow value
IF APCLOB2=""
QUIT
+20 ;same beg and end
IF APCLOB1=APCLOB2
QUIT
+21 SET APCLMOVE=""
+22 IF APCLOB1<APCLOB2
SET APCLMOVE="UP"
+23 IF APCLOB1>APCLOB2
SET APCLMOVE="DOWN"
+24 SET ^XTMP("APCLW6",APCLJ,APCLH,"PATIENTS",APCLMOVE,APCLAGE,$PIECE(^DPT(DFN,0),U),DFN)=APCLWT1_U_APCLHT1_U_APCLBMI1_U_APCLOB1_U_APCLWT2_U_APCLHT2_U_APCLBMI2_U_APCLOB2
+25 SET APCLGRAN=APCLGRAN+1
+26 QUIT
End DoDot:1
+27 QUIT
GETBMI1 ;
+1 ;TABLE ALL VISITS CHRONOLOGICALLY FROM BEGINNING DATE
+2 SET APCLBMI1=""
SET APCLOB1=""
+3 KILL ^TMP($JOB,"A")
+4 SET A="^TMP($J,""A"","
SET B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED)
SET E=$$START1^APCLDF(B,A)
+5 IF '$DATA(^TMP($JOB,"A",1))
QUIT
+6 SET (APCLX,G)=0
FOR
SET APCLX=$ORDER(^TMP($JOB,"A",APCLX))
IF APCLX'=+APCLX!(APCLBMI1]"")
QUIT
SET APCLV=$PIECE(^TMP($JOB,"A",APCLX),U,5)
Begin DoDot:1
+7 IF '$DATA(^AUPNVSIT(APCLV,0))
QUIT
+8 IF '$PIECE(^AUPNVSIT(APCLV,0),U,9)
QUIT
+9 IF $PIECE(^AUPNVSIT(APCLV,0),U,11)
QUIT
+10 ;quit if pregnant on this visit
IF $$PREGDX(APCLV)
QUIT
+11 SET APCLWT1=$$WT(APCLV)
+12 ;no weight on this visit
IF $PIECE(APCLWT1,U)=""
QUIT
+13 ;got a weight so get a height
+14 SET APCLHT1=$$HT(DFN,APCLV,$$AGE^AUPNPAT(DFN,$PIECE($PIECE(^AUPNVSIT(APCLV,0),U),".")),$PIECE(APCLWT1,U,2))
+15 IF $PIECE(APCLHT1,U)=""
QUIT
+16 IF $PIECE(APCLHT1,U)="?"
QUIT
+17 SET APCLCHT=$PIECE(APCLHT1,U)
SET APCLCWT=$PIECE(APCLWT1,U)
DO CALCBMI
+18 SET APCLBMI1=APCLBMI
+19 SET APCLOB1=""
+20 ;find entry in reference table
+21 SET APCLREF=$ORDER(^APCLBMI("H",AUPNSEX,$$AGE^AUPNPAT(DFN,$PIECE($PIECE(^AUPNVSIT(APCLV,0),U),".")),0))
+22 IF 'APCLREF
SET APCLREF=$ORDER(^APCLBMI("H",AUPNSEX,$$AGE^AUPNPAT(DFN,$PIECE($PIECE(^AUPNVSIT(APCLV,0),U),"."))))
IF APCLREF
SET APCLREF=$ORDER(^APCLBMI("H",AUPNSEX,APCLREF,""))
+23 IF 'APCLREF
QUIT
+24 ;I APCLBMI1>$P(^APCLBMI(APCLREF,0),U,7)!(APCLBMI1<$P(^APCLBMI(APCLREF,0),U,6)) S APCLOB1="" Q
+25 IF APCLBMI1'<$PIECE(^APCLBMI(APCLREF,0),U,4)
IF APCLBMI1<$PIECE(^APCLBMI(APCLREF,0),U,5)
SET APCLOB1=2
QUIT
+26 IF APCLBMI1'<$PIECE(^APCLBMI(APCLREF,0),U,5)
SET APCLOB1=3
QUIT
+27 SET APCLOB1=1
+28 QUIT
End DoDot:1
+29 QUIT
GETBMI2 ;
+1 ;TABLE ALL VISITS CHRONOLOGICALLY FROM BEGINNING DATE
+2 SET APCLBMI2=""
SET APCLOB2=""
+3 ;K ^TMP($J,"A")
+4 ;S A="^TMP($J,""A"",",B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),E=$$START1^APCLDF(B,A)
+5 ;I '$D(^TMP($J,"A",1)) Q
+6 SET G=0
SET APCLX="A"
FOR
SET APCLX=$ORDER(^TMP($JOB,"A",APCLX),-1)
IF APCLX'=+APCLX!(APCLBMI2]"")
QUIT
SET APCLV=$PIECE(^TMP($JOB,"A",APCLX),U,5)
Begin DoDot:1
+7 IF '$DATA(^AUPNVSIT(APCLV,0))
QUIT
+8 IF '$PIECE(^AUPNVSIT(APCLV,0),U,9)
QUIT
+9 IF $PIECE(^AUPNVSIT(APCLV,0),U,11)
QUIT
+10 ;quit if pregnant on this visit
IF $$PREGDX(APCLV)
QUIT
+11 SET APCLWT2=$$WT(APCLV)
+12 ;no weight on this visit
IF $PIECE(APCLWT2,U)=""
QUIT
+13 ;got a weight so get a height
+14 SET APCLHT2=$$HT(DFN,APCLV,$$AGE^AUPNPAT(DFN,$PIECE($PIECE(^AUPNVSIT(APCLV,0),U),".")),$PIECE(APCLWT2,U,2))
+15 IF $PIECE(APCLHT2,U)=""
QUIT
+16 IF $PIECE(APCLHT2,U)="?"
QUIT
+17 SET APCLCHT=$PIECE(APCLHT2,U)
SET APCLCWT=$PIECE(APCLWT2,U)
DO CALCBMI
+18 SET APCLBMI2=APCLBMI
+19 SET APCLOB2=""
+20 ;find entry in reference table
+21 SET APCLREF=$ORDER(^APCLBMI("H",AUPNSEX,$$AGE^AUPNPAT(DFN,$PIECE($PIECE(^AUPNVSIT(APCLV,0),U),".")),0))
+22 IF 'APCLREF
SET APCLREF=$ORDER(^APCLBMI("H",AUPNSEX,$$AGE^AUPNPAT(DFN,$PIECE($PIECE(^AUPNVSIT(APCLV,0),U),"."))))
IF APCLREF
SET APCLREF=$ORDER(^APCLBMI("H",AUPNSEX,APCLREF,""))
+23 IF 'APCLREF
QUIT
+24 ;I APCLBMI2>$P(^APCLBMI(APCLREF,0),U,7)!(APCLBMI2<$P(^APCLBMI(APCLREF,0),U,6)) S APCLOB2="" Q
+25 IF APCLBMI2'<$PIECE(^APCLBMI(APCLREF,0),U,4)
IF APCLBMI2<$PIECE(^APCLBMI(APCLREF,0),U,5)
SET APCLOB2=2
QUIT
+26 IF APCLBMI2'<$PIECE(^APCLBMI(APCLREF,0),U,5)
SET APCLOB2=3
QUIT
+27 SET APCLOB2=1
+28 QUIT
End DoDot:1
+29 QUIT
WT(V) ;return wt on this visit
+1 NEW X,M,W
+2 SET W=""
SET D=""
+3 SET M=$ORDER(^AUTTMSR("B","WT",0))
+4 SET X=0
FOR
SET X=$ORDER(^AUPNVMSR("AD",V,X))
IF X'=+X
QUIT
IF '$PIECE($GET(^AUPNVMSR(X,2)),U,1)
SET Z=$PIECE(^AUPNVMSR(X,0),U)
IF Z=M
SET W=$PIECE(^AUPNVMSR(X,0),U,4)
SET D=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
+5 QUIT W_U_D
HT(P,V,AGE,DATE) ;return wt on this visit
+1 NEW X,M,W,APCLY,APCLX,BD,ED
+2 SET W=""
SET D=""
+3 SET M=$ORDER(^AUTTMSR("B","HT",0))
+4 IF AGE<19
Begin DoDot:1
+5 SET W=""
+6 ;call data fetcher to get ht on DATE-DATE
+7 KILL APCLG
SET (W,D)=""
+8 SET APCLY="APCLG("
SET APCLX=P_"^LAST MEASUREMENT HT;DURING "_DATE_"-"_DATE
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+9 IF $DATA(APCLG(1))
SET W=$PIECE(APCLG(1),U,2)
SET D=$PIECE(APCLG(1),U)
+10 QUIT
End DoDot:1
QUIT W_U_D
+11 KILL APCLG
SET (W,D)=""
+12 IF AGE>18
IF AGE<50
Begin DoDot:1
+13 SET BD=$$FMADD^XLFDT(DATE,-(3*365))
+14 SET ED=DATE
+15 SET APCLY="APCLG("
SET APCLX=P_"^LAST MEASUREMENT HT;DURING "_BD_"-"_ED
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+16 IF $DATA(APCLG(1))
SET W=$PIECE(APCLG(1),U,2)
SET D=$PIECE(APCLG(1),U)
+17 QUIT
End DoDot:1
QUIT W_U_D
+18 KILL APCLG
SET (W,D)=""
+19 SET BD=$$FMADD^XLFDT(DATE,-365)
+20 SET ED=DATE
+21 SET APCLY="APCLG("
SET APCLX=P_"^LAST MEASUREMENT HT;DURING "_BD_"-"_ED
SET APCLER=$$START1^APCLDF(APCLX,APCLY)
+22 IF $DATA(APCLG(1))
SET W=$PIECE(APCLG(1),U,2)
SET D=$PIECE(APCLG(1),U)
+23 QUIT W_U_D
PREGDX(V) ;
+1 NEW P,D,G
+2 SET G=0
+3 ;cmi/anch/maw 9/12/2007 csv
SET P=0
FOR
SET P=$ORDER(^AUPNVPOV("AD",V,P))
IF P'=+P!(G)
QUIT
SET D=$PIECE(^AUPNVPOV(P,0),U)
Begin DoDot:1
+4 IF $$ICD^AUPNVUTL(D,$ORDER(^ATXAX("B","BGP PREGNANCY DIAGNOSES 2",0)),9)
SET G=1
+5 QUIT
End DoDot:1
+6 QUIT G
CALCBMI ;calculate BMI value
+1 SET APCLMWT=APCLCWT*.45359
SET APCLMHT=APCLCHT*.0254
SET APCLBMI=APCLMWT/(APCLMHT*APCLMHT)
+2 QUIT
EOJ ;
+1 KILL APCL1YR,APCL3YR,APCLA,APCLBD,APCLMGI,APCLCHT,APCLCWT,APCLGHT,APCLGWT,APCLROWT,APCLROHT,APCLER,APCLMHT,APCLMWT,APCLX,APCLY,APCLNN,APCLREF
+2 KILL AUPNPAT,AUPNDOB,AUPNSEX,AUPNDAYS,AUPNDOD
+3 KILL DFN,X,Y,V,A,D,I,J,Z
+4 QUIT
AGEAP(P,BD,ED,LOW,HIGH,TP) ;
+1 IF '$GET(P)
QUIT ""
+2 SET A=$$AGE^AUPNPAT(P,$SELECT(TP="B":BD,1:ED))
+3 IF A<LOW
QUIT 0
+4 IF A>HIGH
QUIT 0
+5 QUIT 1
