Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: CIMGAGP2

CIMGAGP2.m

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