- BGP1D863 ; IHS/CMI/LAB - measure C ;
- ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- ;
- 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^BGP1UTL2(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^BGP1UTL2(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^BGP1D82(Y,V,EDATE)
- .I $D(^ATXAX(T2,21,"B",Z)) D
- ..S $P(BGPZ("A"),U,2)=$P(BGPZ("A"),U,2)+$$DAYS^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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
- BGP1D863 ; IHS/CMI/LAB - measure C ;
- +1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- +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^BGP1UTL2(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^BGP1UTL2(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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^BGP1D82(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