CIMGAGP2 ; CMI/TUCSON/LAB - aberdeen area GPRA ; [ 03/15/00 8:38 AM ]
;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
;
;
IND44 ;
G:'CIMDMPAT IND55
S V=$$LDL(DFN,CIMEDATE)
I V]"" D S(CIMRPT,$S(CIMTIME:19,1:20),1,1)
I $D(CIMLIST(5)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",5,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
IND55 ;
G:'CIMDMPAT IND66
S V=$$PROTEIN(DFN,CIMEDATE)
I V]"" D S(CIMRPT,$S(CIMTIME:19,1:20),2,1)
I $D(CIMLIST(6)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",6,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
IND66 ;WH ANNUAL PAP
S CIMAGE=$$AGE^AUPNPAT(DFN,CIMBDATE) ;recalc age at beginning of time frame
I $P(^DPT(DFN,0),U,2)="F",CIMAGE>17 D
.D S(CIMRPT,$S(CIMTIME:19,1:20),3,1) ;wh denom pap
.S V=$$PAP(DFN,CIMEDATE)
.I V["Yes" D S(CIMRPT,$S(CIMTIME:19,1:20),4,1)
.I $D(CIMLIST(7)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",7,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
.Q
IND77 ;WH MAMMOGRAM
S CIMAGE=$$AGE^AUPNPAT(DFN,CIMBDATE) ;recalc age at beginning of time frame
I $P(^DPT(DFN,0),U,2)="F",CIMAGE>39,CIMAGE<70 D
.D S(CIMRPT,$S(CIMTIME:19,1:20),5,1) ;wh denom pap
.S V=$$MAMMOG(DFN,CIMEDATE)
.I V["Yes" D S(CIMRPT,$S(CIMTIME:19,1:20),6,1)
.I $D(CIMLIST(8)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",8,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
.Q
IND88 ;
K CIMP
;calculate age in months at beginning of time frame
S CIMAMON=$$MON(DFN,CIMBDATE,CIMQTR)
I CIMAMON D
.D S(CIMRPT,$S(CIMTIME:19,1:20),7,1)
.S CIMP=$$WCV(DFN)
.I CIMP>3 D S(CIMRPT,$S(CIMTIME:19,1:20),8,1)
.I $D(CIMLIST(9)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",9,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=CIMP_" well child visits"
IND1112 ;dental
S V=$$DENT(DFN,CIMEDATE)
I V]"" D S(CIMRPT,$S(CIMTIME:19,1:20),9,1) D
.I $D(CIMLIST(10)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",10,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
IND1213 ;
S CIMAGE=$$AGE^AUPNPAT(DFN,CIMBDATE)
I CIMAGE=6!(CIMAGE=7)!(CIMAGE=8) D
.D S(CIMRPT,$S(CIMTIME:19,1:20),10,1) ;denom
.S V=$$SEAL(DFN,CIMEDATE)
.I V]"" D S(CIMRPT,$S(CIMTIME:19,1:20),11,1) I $D(CIMLIST(11)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",11,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
I CIMAGE=14!(CIMAGE=15) D
.D S(CIMRPT,$S(CIMTIME:19,1:20),27,1) ;denom
.S V=$$SEAL(DFN,CIMEDATE)
.I V]"" D S(CIMRPT,$S(CIMTIME:19,1:20),28,1) I $D(CIMLIST(11)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",11,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
IND1820 ;immunizations
I $$AGE^AUPNPAT(DFN,CIMEDATE)=2 D
.D S(CIMRPT,$S(CIMTIME:19,1:20),12,1)
.S CIMGDAT=$P(^DPT(DFN,0),U,3)+20000
.S X=$$KIDS^CIMGAGPR(DFN,CIMGDAT)
.I X=1 D S(CIMRPT,$S(CIMTIME:19,1:20),13,1)
.I X=2 S V=^TMP("CIMGAGPR",$J,"CHILD",$P(^DPT(DFN,0),U),DFN,"NEEDS")
.I X=1 S V="UP TO DATE"
.I $D(CIMLIST(12)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",12,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
I $$MONAGE(DFN,CIMEDATE)>26&($$MONAGE(DFN,CIMEDATE)<40) D
.D S(CIMRPT,$S(CIMTIME:22,1:23),12,1)
.S CIMGDAT=$$FMADD^XLFDT($P(^DPT(DFN,0),U,3),(27*30.5))
.S X=$$KIDS^CIMGAGPR(DFN,CIMGDAT)
.I X=1 D S(CIMRPT,$S(CIMTIME:22,1:23),13,1)
IND2023 ;obesity
D IND2023^CIMGAGP4
D ^CIMGAGP3
Q
S(R,N,P,V) ;
I 'R Q
S $P(^CIMAGP(R,N),U,P)=$P($G(^CIMAGP(R,N)),U,P)+V
Q
;
WCPV(V) ;
I '$G(V) Q ""
NEW X,I,G S (X,G)=0 F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(G) S I=$P(^AUPNVPOV(X,0),U),I=$P(^ICD9(I,0),U) I I="V20.1"!(I="V20.2") S G=1
Q G
WCV(P) ;
;return # of well child visits between dob and 27 month birthday
NEW C S C=0
I '$D(^AUPNVSIT("AA",P)) Q C
NEW B S B=$P(^DPT(P,0),U,3)
I B="" Q C
NEW X,E S E=$$FMADD^XLFDT(B,(27*30.5))
S X=0 F S X=$O(^AUPNVSIT("AC",P,X)) Q:X'=+X S D=$P($P(^AUPNVSIT(X,0),U),".") I D<E,$$CLINIC^APCLV(X,"C")=24!($$CLINIC^APCLV(X,"C")=27)!($$CLINIC^APCLV(X,"C")=57)!($$WCPV(X)) S C=C+1
Q C
DNKA(V) ;is this a DNKA visit?
I '$G(V) Q ""
NEW D,N S D=$$PRIMPOV^APCLV(V,"C")
I D=".0860" Q 1
S N=$$PRIMPOV^APCLV(V,"N")
I $E(D)="V",N["DNKA" Q 1
I $E(D)="V",N["DID NOT KEEP APPOINTMENT" Q 1
I $E(D)="V",N["DID NOT KEEP APPT" Q 1
Q 0
MONAGE(P,D) ;
I '$G(P) Q ""
I '$D(^DPT(P,0)) Q ""
NEW % S %=$$FMDIFF^XLFDT(D,$P(^DPT(P,0),U,3))
Q %\30.5
MON(P,D,Q) ;
I $P(^DPT(P,0),U,3)="" Q ""
NEW %
S %=$$FMDIFF^XLFDT(D,$P(^DPT(P,0),U,3))
S %=%\30
I 'Q,%>14,%<28 Q 1
I Q,%>23,%<28 Q 1
Q 0
;
PAP(P,EDATE) ;
NEW CIM,%,E,BDATE S BDATE=$$FMADD^XLFDT(EDATE,-(365*3)),%=P_"^LAST LAB PAP SMEAR;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) Q "Yes "_$$FMTE^XLFDT($P(CIM(1),U))
K CIM S %=P_"^LAST DX V76.2;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) Q "Yes "_$$FMTE^XLFDT($P(CIM(1),U))
K CIM S %=P_"^LAST PROCEDURE 91.46;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) Q "Yes "_$$FMTE^XLFDT($P(CIM(1),U))
Q "No"
MAMMOG(P,EDATE) ;
NEW CIM,%,E,BDATE S BDATE=$$FMADD^XLFDT(EDATE,-365)
I '$G(P) Q ""
NEW LMAM S LMAM=""
NEW CIM S %=P_"^LAST RAD MAMMOGRAM BILAT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) D
.Q:LMAM>$P(CIM(1),U)
.S LMAM=$P(CIM(1),U)
K CIM S %=P_"^LAST RAD SCREENING MAMMOGRAM;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) D
.Q:LMAM>$P(CIM(1),U)
.S LMAM=$P(CIM(1),U)
K CIM S %=P_"^LAST DX V76.11;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) D
.Q:LMAM>$P(CIM(1),U)
.S LMAM=$P(CIM(1),U)
K CIM S %=P_"^LAST DX V76.12;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) D
.Q:LMAM>$P(CIM(1),U)
.S LMAM=$P(CIM(1),U)
K CIM S %=P_"^LAST PROCEDURE 87.37;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) D
.Q:LMAM>$P(CIM(1),U)
.S LMAM=$P(CIM(1),U)
Q $S(LMAM]"":"Yes "_$$FMTE^XLFDT(LMAM),1:"No")
;
DENT(P,EDATE) ;
NEW CIM,X,%,E,R,V,BDATE
K CIM
S BDATE=$$FMADD^XLFDT(EDATE,-365)
S %=P_"^LAST ADA 0000;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) Q $$FMTE^XLFDT($P(CIM(1),U))
;look for dental clinic or dental provider visit date
K CIM
S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
NEW X,Y S X=0,Y="" F S X=$O(CIM(X)) Q:X'=+X!(Y]"") I $$CLINIC^APCLV($P(CIM(X),U,5),"C")=56,'$$DNKA($P(CIM(X),U,5)) S Y=$$FMTE^XLFDT($P(CIM(X),U))
I Y]"" Q Y
S X=0,Y="" F S X=$O(CIM(X)) Q:X'=+X!(Y]"") I $$PRIMPROV^APCLV($P(CIM(X),U,5),"D")=52,'$$DNKA($P(CIM(X),U,5)) S Y=$$FMTE^XLFDT($P(CIM(X),U))
Q Y
SEAL(P,EDATE) ;
NEW CIM,X,%,E,R,V
K CIM
S %=P_"^LAST ADA 1351;DURING "_$$FMTE^XLFDT($P(^DPT(P,0),U,3))_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I '$D(CIM(1)) Q ""
Q $$FMTE^XLFDT($P(CIM(1),U))
LDL(P,EDATE) ;
NEW CIM,X,%,E,R,V,BDATE
K CIM
S BDATE=$$FMADD^XLFDT(EDATE,-365)
S %=P_"^LAST LAB [DM AUDIT LIPID PROFILE TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) Q $P(^AUPNVLAB(+$P(CIM(1),U,4),0),U,4)_" mg/dl "_$$FMTE^XLFDT($P(CIM(1),U),5)
S %=P_"^LAST LAB [DM AUDIT LDL CHOLESTEROL TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) Q $P(^AUPNVLAB(+$P(CIM(1),U,4),0),U,4)_" mg/dl "_$$FMTE^XLFDT($P(CIM(1),U),5)
S %=P_"^LAST LAB [DM AUDIT TRIGLYCERIDE TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I $D(CIM(1)) Q $P(^AUPNVLAB(+$P(CIM(1),U,4),0),U,4)_" mg/dl "_$$FMTE^XLFDT($P(CIM(1),U),5)
Q ""
PROTEIN(P,EDATE) ;EP
NEW CIM,X,%,E,R,V,BDATE
K CIM
S BDATE=$$FMADD^XLFDT(EDATE,-365)
S %=P_"^LAST LAB [DM AUDIT URINE PROTEIN TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
I '$D(CIM(1)) Q ""
S %=$P(^AUPNVLAB(+$P(CIM(1),U,4),0),U,4)
Q %_" "_$$FMTE^XLFDT($P(CIM(1),U),"5")
CIMGAGP2 ; CMI/TUCSON/LAB - aberdeen area GPRA ; [ 03/15/00 8:38 AM ]
+1 ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
+2 ;
+3 ;
IND44 ;
+1 IF 'CIMDMPAT
GOTO IND55
+2 SET V=$$LDL(DFN,CIMEDATE)
+3 IF V]""
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),1,1)
+4 IF $DATA(CIMLIST(5))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",5,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
IND55 ;
+1 IF 'CIMDMPAT
GOTO IND66
+2 SET V=$$PROTEIN(DFN,CIMEDATE)
+3 IF V]""
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),2,1)
+4 IF $DATA(CIMLIST(6))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",6,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
IND66 ;WH ANNUAL PAP
+1 ;recalc age at beginning of time frame
SET CIMAGE=$$AGE^AUPNPAT(DFN,CIMBDATE)
+2 IF $PIECE(^DPT(DFN,0),U,2)="F"
IF CIMAGE>17
Begin DoDot:1
+3 ;wh denom pap
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),3,1)
+4 SET V=$$PAP(DFN,CIMEDATE)
+5 IF V["Yes"
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),4,1)
+6 IF $DATA(CIMLIST(7))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",7,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
+7 QUIT
End DoDot:1
IND77 ;WH MAMMOGRAM
+1 ;recalc age at beginning of time frame
SET CIMAGE=$$AGE^AUPNPAT(DFN,CIMBDATE)
+2 IF $PIECE(^DPT(DFN,0),U,2)="F"
IF CIMAGE>39
IF CIMAGE<70
Begin DoDot:1
+3 ;wh denom pap
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),5,1)
+4 SET V=$$MAMMOG(DFN,CIMEDATE)
+5 IF V["Yes"
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),6,1)
+6 IF $DATA(CIMLIST(8))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",8,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
+7 QUIT
End DoDot:1
IND88 ;
+1 KILL CIMP
+2 ;calculate age in months at beginning of time frame
+3 SET CIMAMON=$$MON(DFN,CIMBDATE,CIMQTR)
+4 IF CIMAMON
Begin DoDot:1
+5 DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),7,1)
+6 SET CIMP=$$WCV(DFN)
+7 IF CIMP>3
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),8,1)
+8 IF $DATA(CIMLIST(9))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",9,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=CIMP_" well child visits"
End DoDot:1
IND1112 ;dental
+1 SET V=$$DENT(DFN,CIMEDATE)
+2 IF V]""
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),9,1)
Begin DoDot:1
+3 IF $DATA(CIMLIST(10))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",10,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
End DoDot:1
IND1213 ;
+1 SET CIMAGE=$$AGE^AUPNPAT(DFN,CIMBDATE)
+2 IF CIMAGE=6!(CIMAGE=7)!(CIMAGE=8)
Begin DoDot:1
+3 ;denom
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),10,1)
+4 SET V=$$SEAL(DFN,CIMEDATE)
+5 IF V]""
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),11,1)
IF $DATA(CIMLIST(11))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",11,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
End DoDot:1
+6 IF CIMAGE=14!(CIMAGE=15)
Begin DoDot:1
+7 ;denom
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),27,1)
+8 SET V=$$SEAL(DFN,CIMEDATE)
+9 IF V]""
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),28,1)
IF $DATA(CIMLIST(11))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",11,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
End DoDot:1
IND1820 ;immunizations
+1 IF $$AGE^AUPNPAT(DFN,CIMEDATE)=2
Begin DoDot:1
+2 DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),12,1)
+3 SET CIMGDAT=$PIECE(^DPT(DFN,0),U,3)+20000
+4 SET X=$$KIDS^CIMGAGPR(DFN,CIMGDAT)
+5 IF X=1
DO S(CIMRPT,$SELECT(CIMTIME:19,1:20),13,1)
+6 IF X=2
SET V=^TMP("CIMGAGPR",$JOB,"CHILD",$PIECE(^DPT(DFN,0),U),DFN,"NEEDS")
+7 IF X=1
SET V="UP TO DATE"
+8 IF $DATA(CIMLIST(12))
IF CIMTIME
SET ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",12,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),CIMAGE,DFN)=V
End DoDot:1
+9 IF $$MONAGE(DFN,CIMEDATE)>26&($$MONAGE(DFN,CIMEDATE)<40)
Begin DoDot:1
+10 DO S(CIMRPT,$SELECT(CIMTIME:22,1:23),12,1)
+11 SET CIMGDAT=$$FMADD^XLFDT($PIECE(^DPT(DFN,0),U,3),(27*30.5))
+12 SET X=$$KIDS^CIMGAGPR(DFN,CIMGDAT)
+13 IF X=1
DO S(CIMRPT,$SELECT(CIMTIME:22,1:23),13,1)
End DoDot:1
IND2023 ;obesity
+1 DO IND2023^CIMGAGP4
+2 DO ^CIMGAGP3
+3 QUIT
S(R,N,P,V) ;
+1 IF 'R
QUIT
+2 SET $PIECE(^CIMAGP(R,N),U,P)=$PIECE($GET(^CIMAGP(R,N)),U,P)+V
+3 QUIT
+4 ;
WCPV(V) ;
+1 IF '$GET(V)
QUIT ""
+2 NEW X,I,G
SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",V,X))
IF X'=+X!(G)
QUIT
SET I=$PIECE(^AUPNVPOV(X,0),U)
SET I=$PIECE(^ICD9(I,0),U)
IF I="V20.1"!(I="V20.2")
SET G=1
+3 QUIT G
WCV(P) ;
+1 ;return # of well child visits between dob and 27 month birthday
+2 NEW C
SET C=0
+3 IF '$DATA(^AUPNVSIT("AA",P))
QUIT C
+4 NEW B
SET B=$PIECE(^DPT(P,0),U,3)
+5 IF B=""
QUIT C
+6 NEW X,E
SET E=$$FMADD^XLFDT(B,(27*30.5))
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVSIT("AC",P,X))
IF X'=+X
QUIT
SET D=$PIECE($PIECE(^AUPNVSIT(X,0),U),".")
IF D<E
IF $$CLINIC^APCLV(X,"C")=24!($$CLINIC^APCLV(X,"C")=27)!($$CLINIC^APCLV(X,"C")=57)!($$WCPV(X))
SET C=C+1
+8 QUIT C
DNKA(V) ;is this a DNKA visit?
+1 IF '$GET(V)
QUIT ""
+2 NEW D,N
SET D=$$PRIMPOV^APCLV(V,"C")
+3 IF D=".0860"
QUIT 1
+4 SET N=$$PRIMPOV^APCLV(V,"N")
+5 IF $EXTRACT(D)="V"
IF N["DNKA"
QUIT 1
+6 IF $EXTRACT(D)="V"
IF N["DID NOT KEEP APPOINTMENT"
QUIT 1
+7 IF $EXTRACT(D)="V"
IF N["DID NOT KEEP APPT"
QUIT 1
+8 QUIT 0
MONAGE(P,D) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^DPT(P,0))
QUIT ""
+3 NEW %
SET %=$$FMDIFF^XLFDT(D,$PIECE(^DPT(P,0),U,3))
+4 QUIT %\30.5
MON(P,D,Q) ;
+1 IF $PIECE(^DPT(P,0),U,3)=""
QUIT ""
+2 NEW %
+3 SET %=$$FMDIFF^XLFDT(D,$PIECE(^DPT(P,0),U,3))
+4 SET %=%\30
+5 IF 'Q
IF %>14
IF %<28
QUIT 1
+6 IF Q
IF %>23
IF %<28
QUIT 1
+7 QUIT 0
+8 ;
PAP(P,EDATE) ;
+1 NEW CIM,%,E,BDATE
SET BDATE=$$FMADD^XLFDT(EDATE,-(365*3))
SET %=P_"^LAST LAB PAP SMEAR;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+2 IF $DATA(CIM(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(CIM(1),U))
+3 KILL CIM
SET %=P_"^LAST DX V76.2;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+4 IF $DATA(CIM(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(CIM(1),U))
+5 KILL CIM
SET %=P_"^LAST PROCEDURE 91.46;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+6 IF $DATA(CIM(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(CIM(1),U))
+7 QUIT "No"
MAMMOG(P,EDATE) ;
+1 NEW CIM,%,E,BDATE
SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+2 IF '$GET(P)
QUIT ""
+3 NEW LMAM
SET LMAM=""
+4 NEW CIM
SET %=P_"^LAST RAD MAMMOGRAM BILAT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+5 IF $DATA(CIM(1))
Begin DoDot:1
+6 IF LMAM>$PIECE(CIM(1),U)
QUIT
+7 SET LMAM=$PIECE(CIM(1),U)
End DoDot:1
+8 KILL CIM
SET %=P_"^LAST RAD SCREENING MAMMOGRAM;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+9 IF $DATA(CIM(1))
Begin DoDot:1
+10 IF LMAM>$PIECE(CIM(1),U)
QUIT
+11 SET LMAM=$PIECE(CIM(1),U)
End DoDot:1
+12 KILL CIM
SET %=P_"^LAST DX V76.11;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+13 IF $DATA(CIM(1))
Begin DoDot:1
+14 IF LMAM>$PIECE(CIM(1),U)
QUIT
+15 SET LMAM=$PIECE(CIM(1),U)
End DoDot:1
+16 KILL CIM
SET %=P_"^LAST DX V76.12;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+17 IF $DATA(CIM(1))
Begin DoDot:1
+18 IF LMAM>$PIECE(CIM(1),U)
QUIT
+19 SET LMAM=$PIECE(CIM(1),U)
End DoDot:1
+20 KILL CIM
SET %=P_"^LAST PROCEDURE 87.37;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+21 IF $DATA(CIM(1))
Begin DoDot:1
+22 IF LMAM>$PIECE(CIM(1),U)
QUIT
+23 SET LMAM=$PIECE(CIM(1),U)
End DoDot:1
+24 QUIT $SELECT(LMAM]"":"Yes "_$$FMTE^XLFDT(LMAM),1:"No")
+25 ;
DENT(P,EDATE) ;
+1 NEW CIM,X,%,E,R,V,BDATE
+2 KILL CIM
+3 SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+4 SET %=P_"^LAST ADA 0000;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+5 IF $DATA(CIM(1))
QUIT $$FMTE^XLFDT($PIECE(CIM(1),U))
+6 ;look for dental clinic or dental provider visit date
+7 KILL CIM
+8 SET %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+9 NEW X,Y
SET X=0
SET Y=""
FOR
SET X=$ORDER(CIM(X))
IF X'=+X!(Y]"")
QUIT
IF $$CLINIC^APCLV($PIECE(CIM(X),U,5),"C")=56
IF '$$DNKA($PIECE(CIM(X),U,5))
SET Y=$$FMTE^XLFDT($PIECE(CIM(X),U))
+10 IF Y]""
QUIT Y
+11 SET X=0
SET Y=""
FOR
SET X=$ORDER(CIM(X))
IF X'=+X!(Y]"")
QUIT
IF $$PRIMPROV^APCLV($PIECE(CIM(X),U,5),"D")=52
IF '$$DNKA($PIECE(CIM(X),U,5))
SET Y=$$FMTE^XLFDT($PIECE(CIM(X),U))
+12 QUIT Y
SEAL(P,EDATE) ;
+1 NEW CIM,X,%,E,R,V
+2 KILL CIM
+3 SET %=P_"^LAST ADA 1351;DURING "_$$FMTE^XLFDT($PIECE(^DPT(P,0),U,3))_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+4 IF '$DATA(CIM(1))
QUIT ""
+5 QUIT $$FMTE^XLFDT($PIECE(CIM(1),U))
LDL(P,EDATE) ;
+1 NEW CIM,X,%,E,R,V,BDATE
+2 KILL CIM
+3 SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+4 SET %=P_"^LAST LAB [DM AUDIT LIPID PROFILE TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+5 IF $DATA(CIM(1))
QUIT $PIECE(^AUPNVLAB(+$PIECE(CIM(1),U,4),0),U,4)_" mg/dl "_$$FMTE^XLFDT($PIECE(CIM(1),U),5)
+6 SET %=P_"^LAST LAB [DM AUDIT LDL CHOLESTEROL TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+7 IF $DATA(CIM(1))
QUIT $PIECE(^AUPNVLAB(+$PIECE(CIM(1),U,4),0),U,4)_" mg/dl "_$$FMTE^XLFDT($PIECE(CIM(1),U),5)
+8 SET %=P_"^LAST LAB [DM AUDIT TRIGLYCERIDE TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+9 IF $DATA(CIM(1))
QUIT $PIECE(^AUPNVLAB(+$PIECE(CIM(1),U,4),0),U,4)_" mg/dl "_$$FMTE^XLFDT($PIECE(CIM(1),U),5)
+10 QUIT ""
PROTEIN(P,EDATE) ;EP
+1 NEW CIM,X,%,E,R,V,BDATE
+2 KILL CIM
+3 SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+4 SET %=P_"^LAST LAB [DM AUDIT URINE PROTEIN TAX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"CIM(")
+5 IF '$DATA(CIM(1))
QUIT ""
+6 SET %=$PIECE(^AUPNVLAB(+$PIECE(CIM(1),U,4),0),U,4)
+7 QUIT %_" "_$$FMTE^XLFDT($PIECE(CIM(1),U),"5")
