BGP8D863 ; IHS/CMI/LAB - measure C ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
MEDSPRE(P,BDATE,EDATE) ;EP
I $G(P)="" Q ""
K BGPZ
NEW T1,T4,T2,T5,X,V,Y
;A-RA OS NSAID
;B-GOLD IM
;C-AZS
;D-LEF
;E-METHO
;F-CYCLO
;G=GOLD ORAL
;H=MYCO
;I=PENI
;J=SULFA
;K=GLUCO
F X="A","B","C","D","E","F","G","H","I","J","K" S BGPZ(X)=""
K BGPMEDS1
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
S T1=$O(^ATXAX("B","BGP RA OA NSAID MEDS",0))
S T4=$O(^ATXAX("B","BGP RA OA NSAID VAPI",0))
S T2=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S BGPZ("A")=1 Q
.I $D(^ATXAX(T2,21,"B",Z)) S BGPZ("A")=1
;now check for B
S T1=$O(^ATXAX("B","BGP RA IM GOLD MEDS",0))
S T4=$O(^ATXAX("B","BGP RA IM GOLD NDC",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("B")=1
;now check for C
S T1=$O(^ATXAX("B","BGP RA AZATHIOPRINE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA AZATHIOPRINE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) D
..S BGPZ("C")=1
;now check for D
S T1=$O(^ATXAX("B","BGP RA LEFLUNOMIDE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA LEFLUNOMIDE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S BGPZ("D")=1
;now check for E
S T1=$O(^ATXAX("B","BGP RA METHOTREXATE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA METHOTREXATE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U)
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) D
..S BGPZ("E")=1
;now check for F
S T1=$O(^ATXAX("B","BGP RA CYCLOSPORINE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA CYCLOSPORINE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U)
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S BGPZ("F")=1
;now check for G
S T1=$O(^ATXAX("B","BGP RA ORAL GOLD MEDS",0))
S T4=$O(^ATXAX("B","BGP RA ORAL GOLD VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U)
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S BGPZ("G")=1
;now check for H
S T1=$O(^ATXAX("B","BGP RA MYCOPHENOLATE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA MYCOPHENOLATE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S BGPZ("H")=1
;now check for I
S T1=$O(^ATXAX("B","BGP RA PENICILLAMINE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA PENICILLAMINE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S BGPZ("I")=1
;now check for J
S T1=$O(^ATXAX("B","BGP RA SULFASALAZINE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA SULFASALAZINE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S BGPZ("J")=1
;now check for K
S T1=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS MEDS",0))
S T4=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS CLASS",0))
S T5=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS VAPI",0))
S (X,G,M,E)=0,C="" F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$CLASS^BGP8D82(Z,T4))!($$VAPI^BGP8D81(Z,T5)) S BGPZ("K")=1
S C=0 F X="A","B","C","D","E","F","G","H","I","J","K" I BGPZ(X) S C=C+1
I C=0 Q "" ;none within time frame
S BDATE=$$FMADD^XLFDT(EDATE,-465)
K ^TMP($J,"A")
S (A,B)=0
K BGPMEDS1
D GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
I '$D(BGPMEDS1) Q ""
COUNTD ;count # days except for im gold and count hits
S T1=$O(^ATXAX("B","BGP RA OA NSAID MEDS",0))
S T4=$O(^ATXAX("B","BGP RA OA NSAID VAPI",0))
S T2=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) D Q
..S $P(BGPZ("A"),U,2)=$P(BGPZ("A"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
.I $D(^ATXAX(T2,21,"B",Z)) D
..S $P(BGPZ("A"),U,2)=$P(BGPZ("A"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for B
S T1=$O(^ATXAX("B","BGP RA IM GOLD MEDS",0))
S T4=$O(^ATXAX("B","BGP RA IM GOLD NDC",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) D
..S $P(BGPZ("B"),U,2)=$P(BGPZ("B"),U,2)+1
;now check for C
S T1=$O(^ATXAX("B","BGP RA AZATHIOPRINE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA AZATHIOPRINE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) D
..S $P(BGPZ("C"),U,2)=$P(BGPZ("C"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for D
S T1=$O(^ATXAX("B","BGP RA LEFLUNOMIDE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA LEFLUNOMIDE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S $P(BGPZ("D"),U,2)=$P(BGPZ("D"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for E
S T1=$O(^ATXAX("B","BGP RA METHOTREXATE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA METHOTREXATE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) D
..S $P(BGPZ("E"),U,2)=$P(BGPZ("E"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for F
S T1=$O(^ATXAX("B","BGP RA CYCLOSPORINE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA CYCLOSPORINE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S $P(BGPZ("F"),U,2)=$P(BGPZ("F"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for G
S T1=$O(^ATXAX("B","BGP RA ORAL GOLD MEDS",0))
S T4=$O(^ATXAX("B","BGP RA ORAL GOLD VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S $P(BGPZ("G"),U,2)=$P(BGPZ("G"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for H
S T1=$O(^ATXAX("B","BGP RA MYCOPHENOLATE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA MYCOPHENOLATE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S $P(BGPZ("H"),U,2)=$P(BGPZ("H"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for I
S T1=$O(^ATXAX("B","BGP RA PENICILLAMINE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA PENICILLAMINE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S $P(BGPZ("I"),U,2)=$P(BGPZ("I"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for J
S T1=$O(^ATXAX("B","BGP RA SULFASALAZINE MEDS",0))
S T4=$O(^ATXAX("B","BGP RA SULFASALAZINE VAPI",0))
S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4)) S $P(BGPZ("J"),U,2)=$P(BGPZ("J"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
;now check for K
S T1=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS MEDS",0))
S T4=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS CLASS",0))
S (X,G,M,E)=0,C="" F S X=$O(BGPMEDS1(X)) Q:X'=+X S V=$P(BGPMEDS1(X),U,5),Y=+$P(BGPMEDS1(X),U,4) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$D(^AUPNVMED(Y,0))
.Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
.S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
.Q:Z="" ;BAD POINTER
.I $D(^ATXAX(T1,21,"B",Z))!($$CLASS^BGP8D82(Z,T4)) S $P(BGPZ("K"),U,2)=$P(BGPZ("K"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
S D=.75*($$FMDIFF^XLFDT(EDATE,BDATE)),D=D\1
S J=1,V="" F X="A","B","C","D","E","F","G","H","I","J","K" D
.S J=J+1
.I X="B" D Q
..I $P(BGPZ(X),U),$P(BGPZ(X),U,2)>11 S $P(V,U,1)=1,$P(V,U,J)=1,$P(V,U,15)=$P(V,U,15)_" "_BGPZ(X)_" IM Injections of "_$P($T(@X),";;",2) Q
.I $P(BGPZ(X),U),D'>$P(BGPZ(X),U,2) S $P(V,U,1)=1,$P(V,U,J)=1,$P(V,U,15)=$P(V,U,15)_" "_BGPZ(X)_" days of "_$P($T(@X),";;",2)
Q V
DAYS(I,V) ;
NEW %,N,S,D
S N=$P(^AUPNVMED(Y,0),U,7) ;DAYS SUPPLY
S %=$P(^AUPNVMED(Y,0),U,8) ;DATE DISCONTINUED
I %="" Q N
S D=$P($P($G(^AUPNVSIT(V,0)),U),".")
I D="" Q N
S S=$$FMDIFF^XLFDT(%,D)
I S>0,S<N Q S
Q N
NDC(A,B) ;
;a is drug ien
;b is taxonomy ien
S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
I BGPNDC]"",B,$D(^ATXAX(B,21,"B",BGPNDC)) Q 1
Q 0
A ;;NSAID
B ;;IM GOLD
C ;;AZATHRIOPRINE
D ;;LEFLUNOMIDE
E ;;METHOTREXATE
F ;;CYCLOSPORINE
G ;;ORAL GOLD
H ;;MYCOPHENOLATE
I ;;PENICILLAMINE
J ;;SULFASALAZINE
K ;;GLUCOCORTICOIDS
BGP8D863 ; IHS/CMI/LAB - measure C ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
MEDSPRE(P,BDATE,EDATE) ;EP
+1 IF $GET(P)=""
QUIT ""
+2 KILL BGPZ
+3 NEW T1,T4,T2,T5,X,V,Y
+4 ;A-RA OS NSAID
+5 ;B-GOLD IM
+6 ;C-AZS
+7 ;D-LEF
+8 ;E-METHO
+9 ;F-CYCLO
+10 ;G=GOLD ORAL
+11 ;H=MYCO
+12 ;I=PENI
+13 ;J=SULFA
+14 ;K=GLUCO
+15 FOR X="A","B","C","D","E","F","G","H","I","J","K"
SET BGPZ(X)=""
+16 KILL BGPMEDS1
+17 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+18 IF '$DATA(BGPMEDS1)
QUIT ""
+19 SET T1=$ORDER(^ATXAX("B","BGP RA OA NSAID MEDS",0))
+20 SET T4=$ORDER(^ATXAX("B","BGP RA OA NSAID VAPI",0))
+21 SET T2=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+22 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+23 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+24 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+25 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+26 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+27 ;BAD POINTER
IF Z=""
QUIT
+28 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET BGPZ("A")=1
QUIT
+29 IF $DATA(^ATXAX(T2,21,"B",Z))
SET BGPZ("A")=1
End DoDot:1
+30 ;now check for B
+31 SET T1=$ORDER(^ATXAX("B","BGP RA IM GOLD MEDS",0))
+32 SET T4=$ORDER(^ATXAX("B","BGP RA IM GOLD NDC",0))
+33 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+34 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+35 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+36 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+37 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+38 ;BAD POINTER
IF Z=""
QUIT
+39 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET BGPZ("B")=1
End DoDot:1
+40 ;now check for C
+41 SET T1=$ORDER(^ATXAX("B","BGP RA AZATHIOPRINE MEDS",0))
+42 SET T4=$ORDER(^ATXAX("B","BGP RA AZATHIOPRINE VAPI",0))
+43 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+44 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+45 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+46 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+47 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+48 ;BAD POINTER
IF Z=""
QUIT
+49 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
Begin DoDot:2
+50 SET BGPZ("C")=1
End DoDot:2
End DoDot:1
+51 ;now check for D
+52 SET T1=$ORDER(^ATXAX("B","BGP RA LEFLUNOMIDE MEDS",0))
+53 SET T4=$ORDER(^ATXAX("B","BGP RA LEFLUNOMIDE VAPI",0))
+54 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+55 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+56 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+57 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+58 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+59 ;BAD POINTER
IF Z=""
QUIT
+60 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET BGPZ("D")=1
End DoDot:1
+61 ;now check for E
+62 SET T1=$ORDER(^ATXAX("B","BGP RA METHOTREXATE MEDS",0))
+63 SET T4=$ORDER(^ATXAX("B","BGP RA METHOTREXATE VAPI",0))
+64 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+65 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+66 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+67 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+68 SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+69 ;BAD POINTER
IF Z=""
QUIT
+70 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
Begin DoDot:2
+71 SET BGPZ("E")=1
End DoDot:2
End DoDot:1
+72 ;now check for F
+73 SET T1=$ORDER(^ATXAX("B","BGP RA CYCLOSPORINE MEDS",0))
+74 SET T4=$ORDER(^ATXAX("B","BGP RA CYCLOSPORINE VAPI",0))
+75 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+76 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+77 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+78 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+79 SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+80 ;BAD POINTER
IF Z=""
QUIT
+81 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET BGPZ("F")=1
End DoDot:1
+82 ;now check for G
+83 SET T1=$ORDER(^ATXAX("B","BGP RA ORAL GOLD MEDS",0))
+84 SET T4=$ORDER(^ATXAX("B","BGP RA ORAL GOLD VAPI",0))
+85 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+86 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+87 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+88 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+89 SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+90 ;BAD POINTER
IF Z=""
QUIT
+91 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET BGPZ("G")=1
End DoDot:1
+92 ;now check for H
+93 SET T1=$ORDER(^ATXAX("B","BGP RA MYCOPHENOLATE MEDS",0))
+94 SET T4=$ORDER(^ATXAX("B","BGP RA MYCOPHENOLATE VAPI",0))
+95 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+96 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+97 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+98 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+99 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+100 ;BAD POINTER
IF Z=""
QUIT
+101 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET BGPZ("H")=1
End DoDot:1
+102 ;now check for I
+103 SET T1=$ORDER(^ATXAX("B","BGP RA PENICILLAMINE MEDS",0))
+104 SET T4=$ORDER(^ATXAX("B","BGP RA PENICILLAMINE VAPI",0))
+105 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+106 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+107 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+108 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+109 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+110 ;BAD POINTER
IF Z=""
QUIT
+111 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET BGPZ("I")=1
End DoDot:1
+112 ;now check for J
+113 SET T1=$ORDER(^ATXAX("B","BGP RA SULFASALAZINE MEDS",0))
+114 SET T4=$ORDER(^ATXAX("B","BGP RA SULFASALAZINE VAPI",0))
+115 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+116 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+117 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+118 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+119 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+120 ;BAD POINTER
IF Z=""
QUIT
+121 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET BGPZ("J")=1
End DoDot:1
+122 ;now check for K
+123 SET T1=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS MEDS",0))
+124 SET T4=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS CLASS",0))
+125 SET T5=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS VAPI",0))
+126 SET (X,G,M,E)=0
SET C=""
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+127 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+128 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+129 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+130 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+131 ;BAD POINTER
IF Z=""
QUIT
+132 IF $DATA(^ATXAX(T1,21,"B",Z))!($$CLASS^BGP8D82(Z,T4))!($$VAPI^BGP8D81(Z,T5))
SET BGPZ("K")=1
End DoDot:1
+133 SET C=0
FOR X="A","B","C","D","E","F","G","H","I","J","K"
IF BGPZ(X)
SET C=C+1
+134 ;none within time frame
IF C=0
QUIT ""
+135 SET BDATE=$$FMADD^XLFDT(EDATE,-465)
+136 KILL ^TMP($JOB,"A")
+137 SET (A,B)=0
+138 KILL BGPMEDS1
+139 DO GETMEDS^BGP8UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+140 IF '$DATA(BGPMEDS1)
QUIT ""
COUNTD ;count # days except for im gold and count hits
+1 SET T1=$ORDER(^ATXAX("B","BGP RA OA NSAID MEDS",0))
+2 SET T4=$ORDER(^ATXAX("B","BGP RA OA NSAID VAPI",0))
+3 SET T2=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+4 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+5 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+6 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+7 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+8 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+9 ;BAD POINTER
IF Z=""
QUIT
+10 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
Begin DoDot:2
+11 SET $PIECE(BGPZ("A"),U,2)=$PIECE(BGPZ("A"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:2
QUIT
+12 IF $DATA(^ATXAX(T2,21,"B",Z))
Begin DoDot:2
+13 SET $PIECE(BGPZ("A"),U,2)=$PIECE(BGPZ("A"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:2
End DoDot:1
+14 ;now check for B
+15 SET T1=$ORDER(^ATXAX("B","BGP RA IM GOLD MEDS",0))
+16 SET T4=$ORDER(^ATXAX("B","BGP RA IM GOLD NDC",0))
+17 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+18 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+19 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+20 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+21 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+22 ;BAD POINTER
IF Z=""
QUIT
+23 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
Begin DoDot:2
+24 SET $PIECE(BGPZ("B"),U,2)=$PIECE(BGPZ("B"),U,2)+1
End DoDot:2
End DoDot:1
+25 ;now check for C
+26 SET T1=$ORDER(^ATXAX("B","BGP RA AZATHIOPRINE MEDS",0))
+27 SET T4=$ORDER(^ATXAX("B","BGP RA AZATHIOPRINE VAPI",0))
+28 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+29 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+30 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+31 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+32 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+33 ;BAD POINTER
IF Z=""
QUIT
+34 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
Begin DoDot:2
+35 SET $PIECE(BGPZ("C"),U,2)=$PIECE(BGPZ("C"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:2
End DoDot:1
+36 ;now check for D
+37 SET T1=$ORDER(^ATXAX("B","BGP RA LEFLUNOMIDE MEDS",0))
+38 SET T4=$ORDER(^ATXAX("B","BGP RA LEFLUNOMIDE VAPI",0))
+39 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+40 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+41 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+42 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+43 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+44 ;BAD POINTER
IF Z=""
QUIT
+45 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET $PIECE(BGPZ("D"),U,2)=$PIECE(BGPZ("D"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:1
+46 ;now check for E
+47 SET T1=$ORDER(^ATXAX("B","BGP RA METHOTREXATE MEDS",0))
+48 SET T4=$ORDER(^ATXAX("B","BGP RA METHOTREXATE VAPI",0))
+49 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+50 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+51 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+52 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+53 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+54 ;BAD POINTER
IF Z=""
QUIT
+55 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
Begin DoDot:2
+56 SET $PIECE(BGPZ("E"),U,2)=$PIECE(BGPZ("E"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:2
End DoDot:1
+57 ;now check for F
+58 SET T1=$ORDER(^ATXAX("B","BGP RA CYCLOSPORINE MEDS",0))
+59 SET T4=$ORDER(^ATXAX("B","BGP RA CYCLOSPORINE VAPI",0))
+60 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+61 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+62 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+63 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+64 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+65 ;BAD POINTER
IF Z=""
QUIT
+66 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET $PIECE(BGPZ("F"),U,2)=$PIECE(BGPZ("F"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:1
+67 ;now check for G
+68 SET T1=$ORDER(^ATXAX("B","BGP RA ORAL GOLD MEDS",0))
+69 SET T4=$ORDER(^ATXAX("B","BGP RA ORAL GOLD VAPI",0))
+70 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+71 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+72 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+73 ;BAD POINTER
IF Z=""
QUIT
+74 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET $PIECE(BGPZ("G"),U,2)=$PIECE(BGPZ("G"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:1
+75 ;now check for H
+76 SET T1=$ORDER(^ATXAX("B","BGP RA MYCOPHENOLATE MEDS",0))
+77 SET T4=$ORDER(^ATXAX("B","BGP RA MYCOPHENOLATE VAPI",0))
+78 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+79 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+80 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+81 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+82 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+83 ;BAD POINTER
IF Z=""
QUIT
+84 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET $PIECE(BGPZ("H"),U,2)=$PIECE(BGPZ("H"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:1
+85 ;now check for I
+86 SET T1=$ORDER(^ATXAX("B","BGP RA PENICILLAMINE MEDS",0))
+87 SET T4=$ORDER(^ATXAX("B","BGP RA PENICILLAMINE VAPI",0))
+88 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+89 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+90 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+91 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+92 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+93 ;BAD POINTER
IF Z=""
QUIT
+94 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET $PIECE(BGPZ("I"),U,2)=$PIECE(BGPZ("I"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:1
+95 ;now check for J
+96 SET T1=$ORDER(^ATXAX("B","BGP RA SULFASALAZINE MEDS",0))
+97 SET T4=$ORDER(^ATXAX("B","BGP RA SULFASALAZINE VAPI",0))
+98 SET X=0
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+99 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+100 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+101 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+102 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+103 ;BAD POINTER
IF Z=""
QUIT
+104 IF $DATA(^ATXAX(T1,21,"B",Z))!($$VAPI^BGP8D81(Z,T4))
SET $PIECE(BGPZ("J"),U,2)=$PIECE(BGPZ("J"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:1
+105 ;now check for K
+106 SET T1=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS MEDS",0))
+107 SET T4=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS CLASS",0))
+108 SET (X,G,M,E)=0
SET C=""
FOR
SET X=$ORDER(BGPMEDS1(X))
IF X'=+X
QUIT
SET V=$PIECE(BGPMEDS1(X),U,5)
SET Y=+$PIECE(BGPMEDS1(X),U,4)
Begin DoDot:1
+109 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+110 IF '$DATA(^AUPNVMED(Y,0))
QUIT
+111 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
QUIT
+112 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+113 ;BAD POINTER
IF Z=""
QUIT
+114 IF $DATA(^ATXAX(T1,21,"B",Z))!($$CLASS^BGP8D82(Z,T4))
SET $PIECE(BGPZ("K"),U,2)=$PIECE(BGPZ("K"),U,2)+$$DAYS^BGP8D82(Y,V,EDATE)
End DoDot:1
+115 SET D=.75*($$FMDIFF^XLFDT(EDATE,BDATE))
SET D=D\1
+116 SET J=1
SET V=""
FOR X="A","B","C","D","E","F","G","H","I","J","K"
Begin DoDot:1
+117 SET J=J+1
+118 IF X="B"
Begin DoDot:2
+119 IF $PIECE(BGPZ(X),U)
IF $PIECE(BGPZ(X),U,2)>11
SET $PIECE(V,U,1)=1
SET $PIECE(V,U,J)=1
SET $PIECE(V,U,15)=$PIECE(V,U,15)_" "_BGPZ(X)_" IM Injections of "_$PIECE($TEXT(@X),";;",2)
QUIT
End DoDot:2
QUIT
+120 IF $PIECE(BGPZ(X),U)
IF D'>$PIECE(BGPZ(X),U,2)
SET $PIECE(V,U,1)=1
SET $PIECE(V,U,J)=1
SET $PIECE(V,U,15)=$PIECE(V,U,15)_" "_BGPZ(X)_" days of "_$PIECE($TEXT(@X),";;",2)
End DoDot:1
+121 QUIT V
DAYS(I,V) ;
+1 NEW %,N,S,D
+2 ;DAYS SUPPLY
SET N=$PIECE(^AUPNVMED(Y,0),U,7)
+3 ;DATE DISCONTINUED
SET %=$PIECE(^AUPNVMED(Y,0),U,8)
+4 IF %=""
QUIT N
+5 SET D=$PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
+6 IF D=""
QUIT N
+7 SET S=$$FMDIFF^XLFDT(%,D)
+8 IF S>0
IF S<N
QUIT S
+9 QUIT N
NDC(A,B) ;
+1 ;a is drug ien
+2 ;b is taxonomy ien
+3 SET BGPNDC=$PIECE($GET(^PSDRUG(A,2)),U,4)
+4 IF BGPNDC]""
IF B
IF $DATA(^ATXAX(B,21,"B",BGPNDC))
QUIT 1
+5 QUIT 0
A ;;NSAID
B ;;IM GOLD
C ;;AZATHRIOPRINE
D ;;LEFLUNOMIDE
E ;;METHOTREXATE
F ;;CYCLOSPORINE
G ;;ORAL GOLD
H ;;MYCOPHENOLATE
I ;;PENICILLAMINE
J ;;SULFASALAZINE
K ;;GLUCOCORTICOIDS
