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

CIMGAGP1.m

Go to the documentation of this file. 
  1. CIMGAGP1 ; CMI/TUCSON/LAB - aberdeen area GPRA ;   [ 03/15/00  8:38 AM ]
  1.  ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
  1.  ;
  1.  ;
  1. PROC ;EP - called from XBDBQUE
  1.  S (CIMINJC,CIMINJP)=0
  1.  S CIMGJ=$J,CIMGH=$H
  1.  ;calculate 3 years before end of each time frame
  1.  S CIM3YE=$$FMADD^XLFDT(CIMED,-1096)
  1.  S CIM98B=$S(CIMQTR=0:($E(CIMED,1,3)-2),1:$E(CIMED,1,3)-1)_$E(CIMBD,4,7)
  1.  ;S CIM98E=$S(CIMQTR=1:($E(CIMED,1,3)-2),1:$E(CIMED,1,3)-1)_$E(CIMED,4,7)
  1.  S CIM98E=($E(CIMED,1,3)-1)_$E(CIMED,4,7)
  1.  S CIM983B=$$FMADD^XLFDT(CIM98E,-1096)
  1.  S DFN=0 F  S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN  D PROC1,PROC98
  1.  Q
  1.  ;
  1. PROC1 ;current time period
  1.  ;check to see if patient is active and in communities
  1.  Q:$$BEN^AUPNPAT(DFN,"C")'="01"
  1.  S X=$P($G(^AUPNPAT(DFN,11)),U,18) Q:X=""
  1.  Q:'$D(CIMTAX($P(^AUPNPAT(DFN,11),U,18)))  ;not a community of interest)
  1.  S X=$$LASTVD(DFN,CIM3YE,CIMED)
  1.  Q:X=""  ;not an active user
  1.  S CIMACT=1 ;an active user by end of time frame
  1.  S CIMEDATE=CIMED,CIMTIME=1,CIMBDATE=CIMBD D CALCIND
  1.  Q
  1. PROC98 ;
  1.  ;check to see if patient is active and in communities
  1.  Q:$$BEN^AUPNPAT(DFN,"C")'="01"
  1.  S X=$P($G(^AUPNPAT(DFN,11)),U,18) Q:X=""
  1.  Q:'$D(CIMTAX($P(^AUPNPAT(DFN,11),U,18)))  ;not a community of interest)
  1.  S X=$$LASTVD(DFN,CIM983B,CIM98E)
  1.  Q:X=""  ;not an active user
  1.  S CIMACT=1 ;an active user by end of time frame
  1.  S CIMEDATE=CIM98E,CIMBDATE=CIM98B,CIMTIME=0
  1.  D CALCIND
  1.  Q
  1. CALCIND ;
  1. IND11P ;indicator 1/1 prevalance current/98
  1.  S CIMAGE=$$AGE^AUPNPAT(DFN,CIMEDATE) ;age at end of time frame
  1.  ;demom=all active users, numer=all w/DM dx prior to CIMED
  1.  D S(CIMRPT,$S(CIMTIME:1,1:12),1,CIMACT) ;set total denom for 1/1 prevalance
  1.  S CIMAGEP=$S(CIMAGE<1:2,CIMAGE>0&(CIMAGE<5):3,CIMAGE>4&(CIMAGE<15):4,CIMAGE>14&(CIMAGE<20):5,CIMAGE>19&(CIMAGE<25):6,CIMAGE>24&(CIMAGE<45):7,CIMAGE>44&(CIMAGE<65):8,CIMAGE>64:9,1:BBBBB)
  1.  D S(CIMRPT,$S(CIMTIME:1,1:12),CIMAGEP,1) ;set denominator for 1/1 prevalance by age
  1.  S CIMDMPAT=$$DM(DFN,CIMEDATE)
  1.  D S(CIMRPT,$S(CIMTIME:1,1:12),10,CIMDMPAT)
  1.  I CIMDMPAT,$D(CIMLIST(1)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",1,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=""
  1.  S CIMAGEP=$S(CIMAGE=0:11,CIMAGE>0&(CIMAGE<5):12,CIMAGE>4&(CIMAGE<15):13,CIMAGE>14&(CIMAGE<20):14,CIMAGE>19&(CIMAGE<25):15,CIMAGE>24&(CIMAGE<45):16,CIMAGE>44&(CIMAGE<65):17,CIMAGE>64:18,1:BBBBB)
  1.  D S(CIMRPT,$S(CIMTIME:1,1:12),CIMAGEP,CIMDMPAT) ;set numerator for 1/1 prevalance age piece
  1.  ;set 1/1 incidence first dx within time frame
  1.  D S(CIMRPT,$S(CIMTIME:11,1:13),1,CIMACT) ;set total denom for 1/2 incidence
  1.  S CIMAGEP=$S(CIMAGE<1:2,CIMAGE>0&(CIMAGE<5):3,CIMAGE>4&(CIMAGE<15):4,CIMAGE>14&(CIMAGE<20):5,CIMAGE>19&(CIMAGE<25):6,CIMAGE>24&(CIMAGE<45):7,CIMAGE>44&(CIMAGE<65):8,CIMAGE>64:9,1:BBBBB)
  1.  D S(CIMRPT,$S(CIMTIME:11,1:13),CIMAGEP,1) ;set denominator for 1/2 incidence
  1.  S X=$$FDM(DFN,CIMBDATE,CIMEDATE)
  1.  I X,$D(CIMLIST(2)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",2,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=""
  1.  D S(CIMRPT,$S(CIMTIME:11,1:13),10,X)
  1.  S CIMAGEP=$S(CIMAGE=0:11,CIMAGE>0&(CIMAGE<5):12,CIMAGE>4&(CIMAGE<15):13,CIMAGE>14&(CIMAGE<20):14,CIMAGE>19&(CIMAGE<25):15,CIMAGE>24&(CIMAGE<45):16,CIMAGE>44&(CIMAGE<65):17,CIMAGE>64:18,1:BBBBB)
  1.  D S(CIMRPT,$S(CIMTIME:11,1:13),CIMAGEP,X) ;set numerator for 1/1 prevalance age piece
  1. IND22 ;glycemic control
  1.  K CIMP,CIMC
  1.  S CIMC=""
  1.  G:'CIMDMPAT IND33  ;if not a DM dx'ed patient go to 3/3
  1.  ;get most recent HGBA1C in year prior to end of time frame
  1.  ;if null get most recent Glucose in year prior to end of time frame
  1.  ;tally appropriately
  1.  S CIMP=$$HBA1C(DFN,CIMEDATE)
  1.  I CIMP]"" D  D IND22T G COMPARE
  1.  .D S(CIMRPT,$S(CIMTIME:14,1:15),1,1)
  1.  .I CIMP<7.5 D S(CIMRPT,$S(CIMTIME:14,1:15),2,1) S CIMC="A" Q
  1.  .I CIMP>7.5&(CIMP<10.1) D S(CIMRPT,$S(CIMTIME:14,1:15),3,1) S CIMC="F"
  1.  .I CIMP>10.0&(CIMP<12.0) D S(CIMRPT,$S(CIMTIME:14,1:15),4,1) S CIMC="H" Q
  1.  .I CIMP>12 D S(CIMRPT,$S(CIMTIME:14,1:15),5,1) S CIMC="V" Q
  1.  .Q
  1.  S CIMP=$$BS(DFN,CIMEDATE)
  1.  I CIMP]"" D  D IND22T G COMPARE
  1.  .D S(CIMRPT,$S(CIMTIME:14,1:15),1,1)
  1.  .I CIMP<165 D S(CIMRPT,$S(CIMTIME:14,1:15),2,1) S CIMC="A" Q
  1.  .I CIMP>165&(CIMP<251) D S(CIMRPT,$S(CIMTIME:14,1:15),3,1) S CIMC="F" Q
  1.  .I CIMP>250&(CIMP<341) D S(CIMRPT,$S(CIMTIME:14,1:15),4,1) S CIMC="H" Q
  1.  .I CIMP>340 D S(CIMRPT,$S(CIMTIME:14,1:15),5,1) S CIMC="V" Q
  1.  .Q
  1. COMPARE ;compare only 98
  1.  I CIMTIME G IND33
  1.  I CIMC="" G IND33
  1.  S CIMD=""
  1.  S CIMP=$$HBA1C(DFN,CIMED)
  1.  I CIMP]"" D  G COMPARE1
  1.  .D S(CIMRPT,15,6,1)
  1.  .I CIMP<7.5 S CIMD="A" Q
  1.  .I CIMP>7.5&(CIMP<10.1) S CIMD="F"
  1.  .I CIMP>10.0&(CIMP<12.0) S CIMD="H" Q
  1.  .I CIMP>12 S CIMD="V" Q
  1.  .Q
  1.  S CIMP=$$BS(DFN,CIMED)
  1.  I CIMP]"" D  G COMPARE1
  1.  .D S(CIMRPT,15,6,1)
  1.  .I CIMP<165 S CIMD="A" Q
  1.  .I CIMP>165&(CIMP<251) S CIMD="F" Q
  1.  .I CIMP>250&(CIMP<341) S CIMD="H" Q
  1.  .I CIMP>340 S CIMD="V" Q
  1.  .Q
  1. COMPARE1 ;
  1.  I CIMD="" G IND33 ;no category in current
  1.  I CIMD="A",CIMC="A" D S(CIMRPT,15,9,1)
  1.  I CIMC="A","FHV"[CIMD D S(CIMRPT,15,8,1)
  1.  I CIMC="F","FHV"[CIMD D S(CIMRPT,15,8,1)
  1.  I CIMC="H","HV"[CIMD D S(CIMRPT,15,8,1)
  1.  I CIMC="V",CIMD="V" D S(CIMRPT,15,8,1)
  1.  I CIMC="V","HFA"[CIMD D S(CIMRPT,15,7,1)
  1.  I CIMC="H","FA"[CIMD D S(CIMRPT,15,7,1)
  1.  I CIMC="F",CIMD="A" D S(CIMRPT,15,7,1)
  1. IND33 ;DM and htn and bp okay
  1.  K CIMP
  1.  G:'CIMDMPAT IND44
  1.  S X=$$HTN(DFN,CIMEDATE) ;dx of htn before end of time frame
  1.  D S(CIMRPT,$S(CIMTIME:17,1:18),1,X) ;set denom of htn's
  1.  G:'X IND44
  1.  S CIMP=$$BP(DFN,CIMEDATE)
  1.  I CIMP]"" D  D IND33T
  1.  .D S(CIMRPT,$S(CIMTIME:17,1:18),2,1)
  1.  .D S(CIMRPT,$S(CIMTIME:17,1:18),$P(CIMP,U,2),1)
  1.  .Q
  1. IND44 ;assesed for LDL
  1.  D ^CIMGAGP2
  1.  Q
  1. IND33T ;
  1.  I $D(CIMLIST(4)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",4,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),CIMAGE,DFN)=$P(CIMP,U)
  1.  Q
  1. IND22T ;
  1.  I $D(CIMLIST(3)),CIMTIME S ^XTMP("CIMGAGP",CIMGJ,CIMGH,"LIST",3,$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
  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. FDM(P,BDATE,EDATE) ;
  1.  ;get date of first dx (is it within b and e)
  1.  I $G(P)="" Q ""
  1.  ;check povs
  1.  NEW X,E,CIMG,Y
  1.  K CIMG
  1.  S Y="CIMG("
  1.  S X=P_"^FIRST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
  1.  I '$D(CIMG(1)) Q 0  ;has no dx
  1.  NEW D S D=$P(CIMG(1),U)
  1.  I D<BDATE Q 0
  1.  I D>EDATE Q 0
  1.  Q 1
  1.  ;
  1. DM(P,EDATE) ;is patient diabetic 1 or 0
  1.  I $G(P)="" Q ""
  1.  ;check povs
  1.  NEW X,E,CIMG,Y
  1.  K CIMG
  1.  S Y="CIMG("
  1.  S X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(CIMG(1)) Q 1  ;has a dx
  1.  Q 0
  1.  ;
  1. HTN(P,EDATE) ;
  1.  I $G(P)="" Q ""
  1.  ;check povs
  1.  NEW X,E,CIMG,Y
  1.  K CIMG
  1.  S Y="CIMG("
  1.  S X=P_"^LAST DX [SURVEILLANCE HYPERTENSION;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(CIMG(1)) Q 1  ;has a dx
  1.  Q 0
  1.  ;
  1. HBA1C(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 HGB A1C;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
  1.  I '$D(CIM(1)) Q ""
  1.  I $P(^AUPNVLAB(+$P(CIM(1),U,4),0),U,4)="" Q ""
  1.  Q $P(^AUPNVLAB(+$P(CIM(1),U,4),0),U,4)
  1. BS(P,EDATE) ;EP
  1.  NEW CIM,X,%,E,R,V
  1.  K CIM
  1.  S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1.  S %=P_"^LAST LAB [DM AUDIT GLUCOSE TESTS TAX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"CIM(")
  1.  I '$D(CIM(1)) Q ""
  1.  I $P(^AUPNVLAB(+$P(CIM(1),U,4),0),U,4)="" Q ""
  1.  Q $P(^AUPNVLAB(+$P(CIM(1),U,4),0),U,4)
  1. BP(P,EDATE) ;
  1.  NEW CIM,X,%,E,R,V,S,D
  1.  K CIM
  1.  S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1.  S %=P_"^LAST MEASUREMENT BP;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"CIM(")
  1.  I '$D(CIM(1)) Q ""
  1.  S X=$P(^AUPNVMSR(+$P(CIM(1),U,4),0),U,4)
  1.  S S=$P(X,"/"),D=$P(X,"/",2)
  1.  I S<121&(D<81) Q "Ideal^3"
  1.  I S>160!(D>95) Q "Markedly Poor^7"
  1.  I S>140!(D>90) Q "Inadequate^6"
  1.  I S>130!(D>85) Q "Adequate^5"
  1.  I S>120!(D>80) Q "Target^4"
  1.  Q "?????"
  1. LASTVD(P,BDATE,EDATE) ;
  1.  ;   using the data fetcher.  Returns date in format specified in F.
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNVSIT("AC",P)) Q ""
  1.  NEW Y,ERR,LVD
  1.  S ERR=$$START1^APCLDF(P_"^LAST VISIT;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),"LVD(")
  1.  I '$D(LVD(1)) Q ""
  1.  Q $P(LVD(1),U)
  1.  ;