BGP0D863 ; IHS/CMI/LAB - measure C ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;
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^BGP0UTL2(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))
.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))
.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))
.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))
.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))
.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))
.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))
.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))
.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))
.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))
.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))
.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^BGP0UTL2(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))
.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^BGP0D82(Y,V,EDATE)
.I $D(^ATXAX(T2,21,"B",Z)) D
..S $P(BGPZ("A"),U,2)=$P(BGPZ("A"),U,2)+$$DAYS^BGP0D82(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))
.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))
.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^BGP0D82(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))
.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^BGP0D82(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))
.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^BGP0D82(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))
.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^BGP0D82(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^BGP0D82(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))
.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^BGP0D82(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))
.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^BGP0D82(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))
.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^BGP0D82(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))
.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^BGP0D82(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
BGP0D863 ; IHS/CMI/LAB - measure C ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+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^BGP0UTL2(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 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+24 ;BAD POINTER
IF Z=""
QUIT
+25 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET BGPZ("A")=1
QUIT
+26 IF $DATA(^ATXAX(T2,21,"B",Z))
SET BGPZ("A")=1
End DoDot:1
+27 ;now check for B
+28 SET T1=$ORDER(^ATXAX("B","BGP RA IM GOLD MEDS",0))
+29 SET T4=$ORDER(^ATXAX("B","BGP RA IM GOLD NDC",0))
+30 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
+31 IF '$DATA(^AUPNVSIT(V,0))
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))
SET BGPZ("B")=1
End DoDot:1
+35 ;now check for C
+36 SET T1=$ORDER(^ATXAX("B","BGP RA AZATHIOPRINE MEDS",0))
+37 SET T4=$ORDER(^ATXAX("B","BGP RA AZATHIOPRINE NDC",0))
+38 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
+39 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+40 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+41 ;BAD POINTER
IF Z=""
QUIT
+42 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
Begin DoDot:2
+43 SET BGPZ("C")=1
End DoDot:2
End DoDot:1
+44 ;now check for D
+45 SET T1=$ORDER(^ATXAX("B","BGP RA LEFLUNOMIDE MEDS",0))
+46 SET T4=$ORDER(^ATXAX("B","BGP RA LEFLUNOMIDE NDC",0))
+47 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
+48 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+49 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+50 ;BAD POINTER
IF Z=""
QUIT
+51 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET BGPZ("D")=1
End DoDot:1
+52 ;now check for E
+53 SET T1=$ORDER(^ATXAX("B","BGP RA METHOTREXATE MEDS",0))
+54 SET T4=$ORDER(^ATXAX("B","BGP RA METHOTREXATE NDC",0))
+55 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
+56 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+57 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))
Begin DoDot:2
+60 SET BGPZ("E")=1
End DoDot:2
End DoDot:1
+61 ;now check for F
+62 SET T1=$ORDER(^ATXAX("B","BGP RA CYCLOSPORINE MEDS",0))
+63 SET T4=$ORDER(^ATXAX("B","BGP RA CYCLOSPORINE NDC",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 SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+67 ;BAD POINTER
IF Z=""
QUIT
+68 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET BGPZ("F")=1
End DoDot:1
+69 ;now check for G
+70 SET T1=$ORDER(^ATXAX("B","BGP RA ORAL GOLD MEDS",0))
+71 ;S T4=$O(^ATXAX("B","BGP RA ORAL GOLD NDC",0))
+72 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
+73 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+74 SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+75 ;BAD POINTER
IF Z=""
QUIT
+76 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET BGPZ("G")=1
End DoDot:1
+77 ;now check for H
+78 SET T1=$ORDER(^ATXAX("B","BGP RA MYCOPHENOLATE MEDS",0))
+79 SET T4=$ORDER(^ATXAX("B","BGP RA MYCOPHENOLATE NDC",0))
+80 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
+81 IF '$DATA(^AUPNVSIT(V,0))
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 BGPZ("H")=1
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 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+91 ;BAD POINTER
IF Z=""
QUIT
+92 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET BGPZ("I")=1
End DoDot:1
+93 ;now check for J
+94 SET T1=$ORDER(^ATXAX("B","BGP RA SULFASALAZINE MEDS",0))
+95 SET T4=$ORDER(^ATXAX("B","BGP RA SULFASALAZINE NDC",0))
+96 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
+97 IF '$DATA(^AUPNVSIT(V,0))
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("J")=1
End DoDot:1
+101 ;now check for K
+102 SET T1=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS MEDS",0))
+103 SET T4=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS CLASS",0))
+104 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
+105 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+106 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+107 ;BAD POINTER
IF Z=""
QUIT
+108 IF $DATA(^ATXAX(T1,21,"B",Z))!($$CLASS^BGP6D82(Z,T4))
SET BGPZ("K")=1
End DoDot:1
+109 SET C=0
FOR X="A","B","C","D","E","F","G","H","I","J","K"
IF BGPZ(X)
SET C=C+1
+110 ;none within time frame
IF C=0
QUIT ""
+111 SET BDATE=$$FMADD^XLFDT(EDATE,-465)
+112 KILL ^TMP($JOB,"A")
+113 SET (A,B)=0
+114 KILL BGPMEDS1
+115 DO GETMEDS^BGP0UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
+116 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 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+7 ;BAD POINTER
IF Z=""
QUIT
+8 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
Begin DoDot:2
+9 SET $PIECE(BGPZ("A"),U,2)=$PIECE(BGPZ("A"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:2
QUIT
+10 IF $DATA(^ATXAX(T2,21,"B",Z))
Begin DoDot:2
+11 SET $PIECE(BGPZ("A"),U,2)=$PIECE(BGPZ("A"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:2
End DoDot:1
+12 ;now check for B
+13 SET T1=$ORDER(^ATXAX("B","BGP RA IM GOLD MEDS",0))
+14 SET T4=$ORDER(^ATXAX("B","BGP RA IM GOLD NDC",0))
+15 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
+16 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+17 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+18 ;BAD POINTER
IF Z=""
QUIT
+19 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
Begin DoDot:2
+20 SET $PIECE(BGPZ("B"),U,2)=$PIECE(BGPZ("B"),U,2)+1
End DoDot:2
End DoDot:1
+21 ;now check for C
+22 SET T1=$ORDER(^ATXAX("B","BGP RA AZATHIOPRINE MEDS",0))
+23 SET T4=$ORDER(^ATXAX("B","BGP RA AZATHIOPRINE NDC",0))
+24 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
+25 IF '$DATA(^AUPNVSIT(V,0))
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))!($$NDC(Z,T4))
Begin DoDot:2
+29 SET $PIECE(BGPZ("C"),U,2)=$PIECE(BGPZ("C"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:2
End DoDot:1
+30 ;now check for D
+31 SET T1=$ORDER(^ATXAX("B","BGP RA LEFLUNOMIDE MEDS",0))
+32 SET T4=$ORDER(^ATXAX("B","BGP RA LEFLUNOMIDE 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 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+36 ;BAD POINTER
IF Z=""
QUIT
+37 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET $PIECE(BGPZ("D"),U,2)=$PIECE(BGPZ("D"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:1
+38 ;now check for E
+39 SET T1=$ORDER(^ATXAX("B","BGP RA METHOTREXATE MEDS",0))
+40 SET T4=$ORDER(^ATXAX("B","BGP RA METHOTREXATE NDC",0))
+41 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
+42 IF '$DATA(^AUPNVSIT(V,0))
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))
Begin DoDot:2
+46 SET $PIECE(BGPZ("E"),U,2)=$PIECE(BGPZ("E"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:2
End DoDot:1
+47 ;now check for F
+48 SET T1=$ORDER(^ATXAX("B","BGP RA CYCLOSPORINE MEDS",0))
+49 SET T4=$ORDER(^ATXAX("B","BGP RA CYCLOSPORINE NDC",0))
+50 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
+51 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+52 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+53 ;BAD POINTER
IF Z=""
QUIT
+54 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET $PIECE(BGPZ("F"),U,2)=$PIECE(BGPZ("F"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:1
+55 ;now check for G
+56 SET T1=$ORDER(^ATXAX("B","BGP RA ORAL GOLD MEDS",0))
+57 ;S T4=$O(^ATXAX("B","BGP RA ORAL GOLD NDC",0))
+58 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
+59 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+60 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+61 ;BAD POINTER
IF Z=""
QUIT
+62 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET $PIECE(BGPZ("G"),U,2)=$PIECE(BGPZ("G"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:1
+63 ;now check for H
+64 SET T1=$ORDER(^ATXAX("B","BGP RA MYCOPHENOLATE MEDS",0))
+65 SET T4=$ORDER(^ATXAX("B","BGP RA MYCOPHENOLATE NDC",0))
+66 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
+67 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+68 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+69 ;BAD POINTER
IF Z=""
QUIT
+70 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET $PIECE(BGPZ("H"),U,2)=$PIECE(BGPZ("H"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:1
+71 ;now check for I
+72 SET T1=$ORDER(^ATXAX("B","BGP RA PENICILLAMINE MEDS",0))
+73 SET T4=$ORDER(^ATXAX("B","BGP RA PENICILLAMINE 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 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+77 ;BAD POINTER
IF Z=""
QUIT
+78 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET $PIECE(BGPZ("I"),U,2)=$PIECE(BGPZ("I"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:1
+79 ;now check for J
+80 SET T1=$ORDER(^ATXAX("B","BGP RA SULFASALAZINE MEDS",0))
+81 SET T4=$ORDER(^ATXAX("B","BGP RA SULFASALAZINE NDC",0))
+82 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
+83 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+84 ;get drug ien
SET Z=$PIECE($GET(^AUPNVMED(Y,0)),U)
+85 ;BAD POINTER
IF Z=""
QUIT
+86 IF $DATA(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4))
SET $PIECE(BGPZ("J"),U,2)=$PIECE(BGPZ("J"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:1
+87 ;now check for K
+88 SET T1=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS MEDS",0))
+89 SET T4=$ORDER(^ATXAX("B","BGP RA GLUCOCORTICOIDS CLASS",0))
+90 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
+91 IF '$DATA(^AUPNVSIT(V,0))
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))!($$CLASS^BGP6D82(Z,T4))
SET $PIECE(BGPZ("K"),U,2)=$PIECE(BGPZ("K"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
End DoDot:1
+95 SET D=.75*($$FMDIFF^XLFDT(EDATE,BDATE))
SET D=D\1
+96 SET J=1
SET V=""
FOR X="A","B","C","D","E","F","G","H","I","J","K"
Begin DoDot:1
+97 SET J=J+1
+98 IF X="B"
Begin DoDot:2
+99 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
+100 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
+101 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
