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