Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP0D863

BGP0D863.m

Go to the documentation of this file. 
  1. BGP0D863 ; IHS/CMI/LAB - measure C ;
  1.  ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
  1.  ;
  1. MEDSPRE(P,BDATE,EDATE) ;EP
  1.  I $G(P)="" Q ""
  1.  K BGPZ
  1.  ;A-RA OS NSAID
  1.  ;B-GOLD IM
  1.  ;C-AZS
  1.  ;D-LEF
  1.  ;E-METHO
  1.  ;F-CYCLO
  1.  ;G=GOLD ORAL
  1.  ;H=MYCO
  1.  ;I=PENI
  1.  ;J=SULFA
  1.  ;K=GLUCO
  1.  F X="A","B","C","D","E","F","G","H","I","J","K" S BGPZ(X)=""
  1.  K BGPMEDS1
  1.  D GETMEDS^BGP0UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
  1.  I '$D(BGPMEDS1) Q ""
  1.  S T1=$O(^ATXAX("B","BGP RA OA NSAID MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA OA NSAID NDC",0))
  1.  S T2=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("A")=1 Q
  1.  .I $D(^ATXAX(T2,21,"B",Z)) S BGPZ("A")=1
  1.  ;now check for B
  1.  S T1=$O(^ATXAX("B","BGP RA IM GOLD MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA IM GOLD NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("B")=1
  1.  ;now check for C
  1.  S T1=$O(^ATXAX("B","BGP RA AZATHIOPRINE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA AZATHIOPRINE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) D
  1.  ..S BGPZ("C")=1
  1.  ;now check for D
  1.  S T1=$O(^ATXAX("B","BGP RA LEFLUNOMIDE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA LEFLUNOMIDE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("D")=1
  1.  ;now check for E
  1.  S T1=$O(^ATXAX("B","BGP RA METHOTREXATE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA METHOTREXATE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U)
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) D
  1.  ..S BGPZ("E")=1
  1.  ;now check for F
  1.  S T1=$O(^ATXAX("B","BGP RA CYCLOSPORINE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA CYCLOSPORINE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U)
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("F")=1
  1.  ;now check for G
  1.  S T1=$O(^ATXAX("B","BGP RA ORAL GOLD MEDS",0))
  1.  ;S T4=$O(^ATXAX("B","BGP RA ORAL GOLD NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U)
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("G")=1
  1.  ;now check for H
  1.  S T1=$O(^ATXAX("B","BGP RA MYCOPHENOLATE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA MYCOPHENOLATE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("H")=1
  1.  ;now check for I
  1.  S T1=$O(^ATXAX("B","BGP RA PENICILLAMINE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA PENICILLAMINE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("I")=1
  1.  ;now check for J
  1.  S T1=$O(^ATXAX("B","BGP RA SULFASALAZINE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA SULFASALAZINE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) S BGPZ("J")=1
  1.  ;now check for K
  1.  S T1=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS CLASS",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$CLASS^BGP6D82(Z,T4)) S BGPZ("K")=1
  1.  S C=0 F X="A","B","C","D","E","F","G","H","I","J","K" I BGPZ(X) S C=C+1
  1.  I C=0 Q ""  ;none within time frame
  1.  S BDATE=$$FMADD^XLFDT(EDATE,-465)
  1.  K ^TMP($J,"A")
  1.  S (A,B)=0
  1.  K BGPMEDS1
  1.  D GETMEDS^BGP0UTL2(P,BDATE,EDATE,,,,,.BGPMEDS1)
  1.  I '$D(BGPMEDS1) Q ""
  1. COUNTD ;count # days except for im gold and count hits
  1.  S T1=$O(^ATXAX("B","BGP RA OA NSAID MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA OA NSAID NDC",0))
  1.  S T2=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) D  Q
  1.  ..S $P(BGPZ("A"),U,2)=$P(BGPZ("A"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
  1.  .I $D(^ATXAX(T2,21,"B",Z)) D
  1.  ..S $P(BGPZ("A"),U,2)=$P(BGPZ("A"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
  1.  ;now check for B
  1.  S T1=$O(^ATXAX("B","BGP RA IM GOLD MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA IM GOLD NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) D
  1.  ..S $P(BGPZ("B"),U,2)=$P(BGPZ("B"),U,2)+1
  1.  ;now check for C
  1.  S T1=$O(^ATXAX("B","BGP RA AZATHIOPRINE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA AZATHIOPRINE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) D
  1.  ..S $P(BGPZ("C"),U,2)=$P(BGPZ("C"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
  1.  ;now check for D
  1.  S T1=$O(^ATXAX("B","BGP RA LEFLUNOMIDE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA LEFLUNOMIDE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .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)
  1.  ;now check for E
  1.  S T1=$O(^ATXAX("B","BGP RA METHOTREXATE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA METHOTREXATE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .I $D(^ATXAX(T1,21,"B",Z))!($$NDC(Z,T4)) D
  1.  ..S $P(BGPZ("E"),U,2)=$P(BGPZ("E"),U,2)+$$DAYS^BGP0D82(Y,V,EDATE)
  1.  ;now check for F
  1.  S T1=$O(^ATXAX("B","BGP RA CYCLOSPORINE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA CYCLOSPORINE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .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)
  1.  ;now check for G
  1.  S T1=$O(^ATXAX("B","BGP RA ORAL GOLD MEDS",0))
  1.  ;S T4=$O(^ATXAX("B","BGP RA ORAL GOLD NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .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)
  1.  ;now check for H
  1.  S T1=$O(^ATXAX("B","BGP RA MYCOPHENOLATE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA MYCOPHENOLATE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .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)
  1.  ;now check for I
  1.  S T1=$O(^ATXAX("B","BGP RA PENICILLAMINE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA PENICILLAMINE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .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)
  1.  ;now check for J
  1.  S T1=$O(^ATXAX("B","BGP RA SULFASALAZINE MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA SULFASALAZINE NDC",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .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)
  1.  ;now check for K
  1.  S T1=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS MEDS",0))
  1.  S T4=$O(^ATXAX("B","BGP RA GLUCOCORTICOIDS CLASS",0))
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .S Z=$P($G(^AUPNVMED(Y,0)),U) ;get drug ien
  1.  .Q:Z=""  ;BAD POINTER
  1.  .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)
  1.  S D=.75*($$FMDIFF^XLFDT(EDATE,BDATE)),D=D\1
  1.  S J=1,V="" F X="A","B","C","D","E","F","G","H","I","J","K" D
  1.  .S J=J+1
  1.  .I X="B" D  Q
  1.  ..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
  1.  .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)
  1.  Q V
  1. DAYS(I,V) ;
  1.  NEW %,N,S,D
  1.  S N=$P(^AUPNVMED(Y,0),U,7)  ;DAYS SUPPLY
  1.  S %=$P(^AUPNVMED(Y,0),U,8)  ;DATE DISCONTINUED
  1.  I %="" Q N
  1.  S D=$P($P($G(^AUPNVSIT(V,0)),U),".")
  1.  I D="" Q N
  1.  S S=$$FMDIFF^XLFDT(%,D)
  1.  I S>0,S<N Q S
  1.  Q N
  1. NDC(A,B) ;
  1.  ;a is drug ien
  1.  ;b is taxonomy ien
  1.  S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
  1.  I BGPNDC]"",B,$D(^ATXAX(B,21,"B",BGPNDC)) Q 1
  1.  Q 0
  1. A ;;NSAID
  1. B ;;IM GOLD
  1. C ;;AZATHRIOPRINE
  1. D ;;LEFLUNOMIDE
  1. E ;;METHOTREXATE
  1. F ;;CYCLOSPORINE
  1. G ;;ORAL GOLD
  1. H ;;MYCOPHENOLATE
  1. I ;;PENICILLAMINE
  1. J ;;SULFASALAZINE
  1. K ;;GLUCOCORTICOIDS