BGP8D214 ; IHS/CMI/LAB - measure 6 19 Sep 2014 8:12 AM ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
STATIN(P,BDATE,EDATE,BGPNDAYS) ;EP - GET STATIN MEDS
NEW X,Y,Z,%,E
NEW BGPMEDS1
;CHECK CPT CODE FIRST
S %="",E=+$$CODEN^ICPTCOD("4013F"),%=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
I % Q 1_U_"Statin: "_$$DATE^BGP8UTL($P(%,U,2))_" CPT 4013F"
K BGPMEDS1 S K=0,R=""
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
;I '$D(BGPMEDS1) Q ""
S T=$O(^ATXAX("B","BGP PQA STATIN MEDS",0))
S T1=$O(^ATXAX("B","BGP PQA STATIN NDC",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(R]"") S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I T,$D(^ATXAX(T,21,"B",D)) S G=1 G STAT1
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1
.Q:'G
STAT1 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.S S=$$DAYS^BGP8D82(Y,V,EDATE)
.S K=S+K ;TOTAL DAYS SUPPLY
.I K>BGPNDAYS D
..S R="Statin: "_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)
I K>BGPNDAYS Q 1_U_R
STATPRIO ;now add in any before BEG DATE
K BGPMEDS1
S R=""
D GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BDATE,-380),$$FMADD^XLFDT(BDATE,-1),"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
;I '$D(BGPMEDS1) Q ""
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(R]"") S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S G=0
.S D=$P(^AUPNVMED(Y,0),U)
.I T,$D(^ATXAX(T,21,"B",D)) S G=1 G STAT2
.S N=$P($G(^PSDRUG(D,2)),U,4)
.I N]"",T1,$D(^ATXAX(T1,21,"B",N)) S G=1 G STAT2
.Q:'G
STAT2 .;
.S J=$P(^AUPNVMED(Y,0),U,8)
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.;S IS DAYS SUPPLY, J IS DATE DISCONTINUED
.Q:J]"" ;don't use if discontinued
.S D=$$FMDIFF^XLFDT($$FMADD^XLFDT(BDATE,-1),$P($P(^AUPNVSIT(V,0),U),".")) ;difference between dsch date and date prescribed
.S S=$P(^AUPNVMED(Y,0),U,7)
.S S=S-D ;subtract the number of days used
.S:S<0 S=0
.S K=S+K ;TOTAL DAYS SUPPLY
.I K>BGPNDAYS D
..S R="Statin: "_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)
I K>BGPNDAYS Q 1_U_R
EHROUT ;
;any EHR outside meds?
K BGPMEDS1 S K=0,R=""
D GETMEDS^BGP8UTL2(P,$$DOB^AUPNPAT(P),EDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X!(R]"") S Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVMED(Y,0))
.Q:$P($G(^AUPNVMED(Y,11)),U,8)="" ;NOT AN EHR OUTSIDE MED
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S %=$P(^AUPNVMED(Y,0),U,8) ;discontinued date
.I %]"",%<$$FMADD^XLFDT(BDATE,1) Q ;if discontinued before 2nd day of report period
.S V=$P(^AUPNVMED(Y,0),U,3)
.Q:'V
.Q:'$D(^AUPNVSIT(V,0))
.S R=1_U_"Statin: "_$$DATE^BGP8UTL($P($P(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)_" (EHR OUTSIDE)"
Q R
BGP8D214 ; IHS/CMI/LAB - measure 6 19 Sep 2014 8:12 AM ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
STATIN(P,BDATE,EDATE,BGPNDAYS) ;EP - GET STATIN MEDS
+1 NEW X,Y,Z,%,E
+2 NEW BGPMEDS1
+3 ;CHECK CPT CODE FIRST
+4 SET %=""
SET E=+$$CODEN^ICPTCOD("4013F")
SET %=$$CPTI^BGP8DU(P,BDATE,EDATE,E)
+5 IF %
QUIT 1_U_"Statin: "_$$DATE^BGP8UTL($PIECE(%,U,2))_" CPT 4013F"
+6 KILL BGPMEDS1
SET K=0
SET R=""
+7 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
+8 ;I '$D(BGPMEDS1) Q ""
+9 SET T=$ORDER(^ATXAX("B","BGP PQA STATIN MEDS",0))
+10 SET T1=$ORDER(^ATXAX("B","BGP PQA STATIN NDC",0))
+11 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!(R]"")
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+12 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+13 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+14 SET G=0
+15 SET D=$PIECE(^AUPNVMED(Y,0),U)
+16 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO STAT1
+17 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+18 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
+19 IF 'G
QUIT
STAT1 ;
+1 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+2 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+3 IF 'V
QUIT
+4 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+5 SET S=$$DAYS^BGP8D82(Y,V,EDATE)
+6 ;TOTAL DAYS SUPPLY
SET K=S+K
+7 IF K>BGPNDAYS
Begin DoDot:2
+8 SET R="Statin: "_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)
End DoDot:2
End DoDot:1
+9 IF K>BGPNDAYS
QUIT 1_U_R
STATPRIO ;now add in any before BEG DATE
+1 KILL BGPMEDS1
+2 SET R=""
+3 DO GETMEDS^BGP8UTL2(P,$$FMADD^XLFDT(BDATE,-380),$$FMADD^XLFDT(BDATE,-1),"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
+4 ;I '$D(BGPMEDS1) Q ""
+5 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!(R]"")
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+6 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+7 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+8 SET G=0
+9 SET D=$PIECE(^AUPNVMED(Y,0),U)
+10 IF T
IF $DATA(^ATXAX(T,21,"B",D))
SET G=1
GOTO STAT2
+11 SET N=$PIECE($GET(^PSDRUG(D,2)),U,4)
+12 IF N]""
IF T1
IF $DATA(^ATXAX(T1,21,"B",N))
SET G=1
GOTO STAT2
+13 IF 'G
QUIT
STAT2 ;
+1 SET J=$PIECE(^AUPNVMED(Y,0),U,8)
+2 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+3 IF 'V
QUIT
+4 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+5 ;S IS DAYS SUPPLY, J IS DATE DISCONTINUED
+6 ;don't use if discontinued
IF J]""
QUIT
+7 ;difference between dsch date and date prescribed
SET D=$$FMDIFF^XLFDT($$FMADD^XLFDT(BDATE,-1),$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
+8 SET S=$PIECE(^AUPNVMED(Y,0),U,7)
+9 ;subtract the number of days used
SET S=S-D
+10 IF S<0
SET S=0
+11 ;TOTAL DAYS SUPPLY
SET K=S+K
+12 IF K>BGPNDAYS
Begin DoDot:2
+13 SET R="Statin: "_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)
End DoDot:2
End DoDot:1
+14 IF K>BGPNDAYS
QUIT 1_U_R
EHROUT ;
+1 ;any EHR outside meds?
+2 KILL BGPMEDS1
SET K=0
SET R=""
+3 DO GETMEDS^BGP8UTL2(P,$$DOB^AUPNPAT(P),EDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BGPMEDS1)
+4 IF '$DATA(BGPMEDS1)
QUIT ""
+5 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X!(R]"")
QUIT
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+6 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+7 ;NOT AN EHR OUTSIDE MED
IF $PIECE($GET(^AUPNVMED(Y,11)),U,8)=""
QUIT
+8 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+9 ;discontinued date
SET %=$PIECE(^AUPNVMED(Y,0),U,8)
+10 ;if discontinued before 2nd day of report period
IF %]""
IF %<$$FMADD^XLFDT(BDATE,1)
QUIT
+11 SET V=$PIECE(^AUPNVMED(Y,0),U,3)
+12 IF 'V
QUIT
+13 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+14 SET R=1_U_"Statin: "_$$DATE^BGP8UTL($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,Y,.01)_" (EHR OUTSIDE)"
End DoDot:1
+15 QUIT R
