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