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

BGP1D52.m

Go to the documentation of this file.
BGP1D52 ; IHS/CMI/LAB - measure 31 ;
 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
 ;
 ;
EAPT(P,BDATE,EDATE,BGPDAYS,BGPGAP,BGPDAYS1) ;EP
 ;get all ANTIDEPRESSANTS
 K ^TMP($J,"MEDS")
 K BGPZ,M
 S (G,N,Y,X,T,T1,T2,M,K,S,C,R,A)=""
 S K=0
 S Y="^TMP($J,""MEDS"",",X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
 S T=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT MEDS",0))
 S T2=$O(^ATXAX("B","BGP HEDIS ANTIDEPRESSANT VA CLASS",0))
 S X=0 F  S X=$O(^TMP($J,"MEDS",X)) Q:X'=+X  S Y=+$P(^TMP($J,"MEDS",X),U,4) D
 .Q:'$D(^AUPNVMED(Y,0))
 .S V=$P(^AUPNVMED(Y,0),U,3)
 .Q:'$D(^AUPNVSIT(V,0))
 .S G=0
 .S D=$P(^AUPNVMED(Y,0),U)
 .I T,$D(^ATXAX(T,21,"B",D)) S G=1 G EAPT1
 .S C=$P($G(^PSDRUG(D,0)),U,2)
 .I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S G=1 G EAPT1
 .Q:'G
EAPT1 .;
 .S J=$P(^AUPNVMED(Y,0),U,8)
 .S S=$$DAYS^BGP1D82(Y,V,EDATE)
 .S K=S+K  ;TOTAL DAYS SUPPLY
 .I R]"" S R=R_";"
 .S R=R_$$DATE^BGP1UTL($P($P(^AUPNVSIT(V,0),U),"."))_"("_S_")"
 .S F=$P($P(^AUPNVSIT(V,0),U),".")
 .S A=$$FMADD^XLFDT(F,$P(^AUPNVMED(Y,0),U,7))
 .I J]"",J<A S A=J
 .S M(F)=A  ;$S(J:J,1:$$FMADD^XLFDT(F,$P(^AUPNVMED(Y,0),U,7)))
 ;I K>83 S BGPREG=1_U_Q 1_U_" total days beta blocker: "_K
GAP ;now FIGURE OUT GAP DAYS
 S G=0  ;gap days
 S B=0 F  S B=$O(M(B)) Q:B'=+B  S E=M(B) D
 .S Y=$O(M(B)) ;NEXT BEGINNING
 .;I Y="" S Y=$$FMADD^XLFDT(BDATE,BGPDAYS1)
 .I Y="" Q
 .I Y>EDATE Q
 .S Z=$$FMDIFF^XLFDT(Y,E)
 .I Z>0 S G=Z+G
 .Q
 I G>BGPGAP!(K<BGPDAYS) Q 0_U_R_U_"DAYS="_K_", GAP="_G
 Q 1_U_R_U_"DAYS="_K_", GAP="_G