- 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