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

BGPMUUT1.m

Go to the documentation of this file. 
  1. BGPMUUT1 ; IHS/MSC/MGH - Meaningful use utility calls ;01-Mar-2011 15:35;MGH
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;
  1.  ;
  1. WH(P,BDATE,EDATE,T,F) ;EP
  1.  I '$G(P) Q ""
  1.  I $G(EDATE)="" Q ""
  1.  I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1.  I $G(T)="" Q ""
  1.  I '$G(F) S F=1
  1.  ;go through procedures in a date range for this patient, check proc type
  1.  NEW D,X,Y,G,V,O
  1.  S (G,V)=0,I="" F  S V=$O(^BWPCD("C",P,V)) Q:V=""  D
  1.  .Q:'$D(^BWPCD(V,0))
  1.  .I $P(^BWPCD(V,0),U,4)'=T Q
  1.  .S D=$P(^BWPCD(V,0),U,12)
  1.  .Q:D<BDATE
  1.  .Q:D>EDATE
  1.  .S I=$O(G(0)) I I>D Q
  1.  .S G=V,G(D)=""
  1.  .Q
  1.  I 'G Q ""
  1.  I F=1 Q $S(G:1,1:"")
  1.  I F=2 Q G
  1.  I F=3 S D=$P(^BWPCD(G,0),U,12) Q D
  1.  I F=4 S D=$P(^BWPCD(G,0),U,12) Q $$FMTE^XLFDT(D)
  1.  Q ""
  1. PLCODE(P,A) ;EP
  1.  I $G(P)="" Q ""
  1.  I $G(A)="" Q ""
  1.  N T
  1.  ;S T=$O(^ICD9("AB",A,0))
  1.  S T=+$$CODEN^ICDCODE(A,80)
  1.  I T'>0 Q ""
  1.  N X,Y,I S (X,Y,I)=0 F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(I)  I $D(^AUPNPROB(X,0)) S Y=$P(^AUPNPROB(X,0),U) I Y=T S I=1
  1.  Q I
  1. PLTAX(DFN,TAX,STAT,CDATE) ;EP - is DX on problem list 1 or 0
  1.  ;Input variables
  1.  ;STAT - A for all problems, C for active problems, I for inactive
  1.  ;DFN=IEN of the patient
  1.  ;TAX=Name of the taxonomy
  1.  ;CDATE=Date to check against
  1.  I $G(CDATE)="" S CDATE=0
  1.  I $G(DFN)="" Q 0
  1.  I $G(TAX)="" Q 0
  1.  I $G(STAT)="" S STAT="A"
  1.  N TIEN,PLSTAT S TIEN=$O(^ATXAX("B",TAX,0))
  1.  I 'TIEN Q 0
  1.  N PROB,ICD,I,SDTE,EDTE,PDTE,EDT
  1.  S (PROB,ICD,I)=0
  1.  F  S PROB=$O(^AUPNPROB("AC",DFN,PROB)) Q:PROB'=+PROB!(+I)  D
  1.  .I $D(^AUPNPROB(PROB,0)) S ICD=$P($G(^AUPNPROB(PROB,0)),U),PLSTAT=$P($G(^AUPNPROB(PROB,0)),U,12)
  1.  .S EDT=$P($G(^AUPNPROB(PROB,0)),U,8)
  1.  .S SDTE=$P($G(^AUPNPROB(PROB,0)),U,13)
  1.  .I SDTE'="" S EDT=SDTE
  1.  .Q:+CDATE&(EDT>CDATE)
  1.  .I $$ICD^ATXCHK(ICD,TIEN,9) D
  1.  ..S SDTE=$P($G(^AUPNPROB(PROB,0)),U,13)
  1.  ..S EDTE=$P($G(^AUPNPROB(PROB,0)),U,8)
  1.  ..I +SDTE S PDTE=SDTE
  1.  ..E  S PDTE=EDTE
  1.  ..I STAT="A" S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y_U_PDTE_U_PROB
  1.  ..I (STAT="C")&(PLSTAT="A") S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y_U_PDTE_U_PROB
  1.  ..I (STAT="I")&(PLSTAT="I") S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y_U_PDTE_U_PROB
  1.  Q I
  1. CPT(DFN,BDATE,EDATE,TAX) ;EP - return ien of CPT entry if patient had this CPT
  1.  N TIEN,ED,BD,G,CPTT,CPTDATE,VDATE,VST
  1.  I '$G(DFN) Q 0
  1.  I $G(TAX)="" Q 0
  1.  I $G(EDATE)="" Q 0
  1.  S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) Q:'TIEN 0
  1.  I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1.  ;go through visits in a date range for this patient, check cpt
  1.  NEW D,BD,ED,X,Y,D,G,V
  1.  S ED=(9999999-EDATE),BD=9999999-BDATE,G=0
  1.  F  S ED=$O(^AUPNVSIT("AA",DFN,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",DFN,ED,V)) Q:V'=+V!(G)  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:'$D(^AUPNVCPT("AD",V))
  1.  ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G)  D
  1.  ...I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),TIEN,1) S G=X
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I 'G Q 0
  1.  I G D
  1.  .S VDATE=""
  1.  .S CPT=$P($G(^AUPNVCPT(G,0)),U,1),CPTT=$P($G(^ICPT(CPT,0)),U,1)
  1.  .S CPTDATE=$P($G(^AUPNVCPT(G,12)),U,1)
  1.  .S VST=$P($G(^AUPNVCPT(G,0)),U,3),VDATE=$P($G(^AUPNVSIT(VST,0)),U,1)
  1.  .S G=1_U_CPTT_U_CPTDATE_U_VDATE_U_VST
  1.  Q $S(G:G,1:0)
  1. VSTCPT(DFN,VIEN,TAX) ;EP Check to see if the patient had a CPT on a particular visit
  1.  N TIEN,X,G,CPTT,CPT,EVDT
  1.  S G=0
  1.  I '$G(DFN) Q 0
  1.  I $G(TAX)="" Q 0
  1.  I $G(VIEN)="" Q 0
  1.  S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) Q:'TIEN
  1.  I '$D(^AUPNVSIT(VIEN,0)) Q 0
  1.  I '$D(^AUPNVCPT("AD",VIEN)) Q 0
  1.  S X=0 F  S X=$O(^AUPNVCPT("AD",VIEN,X)) Q:X'=+X!(G)  D
  1.  .I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),TIEN,1) S G=X
  1.  .Q
  1.  I 'G Q 0
  1.  I G D
  1.  .S EVDT=$P($G(^AUPNVCPT(G,12)),U,1)
  1.  .S CPT=$P($G(^AUPNVCPT(G,0)),U,1),CPTT=$P($G(^ICPT(CPT,0)),U,1)
  1.  .S G=1_U_CPTT_U_EVDT_U_G
  1.  Q $S(G:G,1:0)
  1. RAD(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT
  1.  I '$G(P) Q ""
  1.  I $G(EDATE)="" Q ""
  1.  I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1.  I $G(T)="" Q ""
  1.  I '$G(F) S F=1
  1.  ;go through visits in a date range for this patient, check cpts
  1.  NEW D,BD,ED,X,Y,D,G,V,C,TIEN
  1.  S TIEN="" S TIEN=$O(^ATXAX("B",T,TIEN)) Q:'TIEN
  1.  S ED=(9999999-EDATE),BD=9999999-BDATE,G=0
  1.  F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G)  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:'$D(^AUPNVRAD("AD",V))
  1.  ..S X=0 F  S X=$O(^AUPNVRAD("AD",V,X)) Q:X'=+X!(G)  D
  1.  ...S EVDATE=$P($G(^AUPNVRAD(X,12)),U)
  1.  ...Q:EVDATE<BDATE!(EVDATE>EDATE)
  1.  ...S C=$P(^AUPNVRAD(X,0),U) Q:C=""  S C=$P($G(^RAMIS(71,C,0)),U,9) Q:C=""
  1.  ...I $$ICD^ATXCHK(C,TIEN,1) S G=X
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I 'G Q ""
  1.  I F=1 Q $S(G:1,1:"")
  1.  I F=2 Q G
  1.  I F=3 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
  1.  I F=4 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
  1.  I F=5 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^RAMIS(71,$P(^AUPNVRAD(G,0),U),0),U,9)
  1.  I F=6 S V=$P(^AUPNVRAD(G,0),U,3) I V Q 1_"^"_$P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^RAMIS(71,$P(^AUPNVRAD(G,0),U),0),U)_"^"_G
  1.  I F=7 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVRAD(G,12)),U),".")_"^"_$P(^RAMIS(71,$P(^AUPNVRAD(G,0),U),0),U,9)
  1.  Q ""
  1. CPTI(DFN,BDATE,EDATE,CPTI,SCEX,SCLN,SMOD) ;EP - did patient have this cpt (ien) in date range
  1.  I '$G(P) Q ""
  1.  I $G(CPTI)="" Q ""
  1.  I $G(BDATE)="" Q ""
  1.  I $G(EDATE)="" Q ""
  1.  S SCEX=$G(SCEX)
  1.  S SCLN=$G(SCLN)
  1.  S SMOD=$G(SMOD)
  1.  I '$D(^ICPT(CPTI)) Q ""  ;not a valid cpt ien
  1.  I '$D(^AUPNVCPT("AA",P)) Q ""  ;no cpts for this patient
  1.  NEW D,BD,ED,X,Y,D,G,V,I,M,M1,Z,J,K,Q
  1.  S ED=9999999-EDATE-1,BD=9999999-BDATE,G=""
  1.  F  S ED=$O(^AUPNVCPT("AA",P,CPTI,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D
  1.  .S I=0 F  S I=$O(^AUPNVCPT("AA",P,CPTI,ED,I)) Q:I'=+I!(G)  D
  1.  ..S V=$P($G(^AUPNVCPT(I,0)),U,3)
  1.  ..I SCEX]"",SCEX[$P(^AUPNVSIT(V,0),U,7) Q
  1.  ..I SCLN]"",$$CLINIC^APCLV(V,"C")=SCLN Q
  1.  ..S M=$$VAL^XBDIQ1(9000010.18,I,.08)
  1.  ..S M1=$$VAL^XBDIQ1(9000010.18,I,.09)
  1.  ..S Q=0
  1.  ..I SMOD]"" F J=1:1 S K=$P(SMOD,";",J) Q:K=""  I K=M S Q=1
  1.  ..Q:Q
  1.  ..I SMOD]"" F J=1:1 S K=$P(SMOD,";",J) Q:K=""  I K=M1 S Q=1
  1.  ..Q:Q
  1.  ..S G="1"_"^"_(9999999-ED)
  1.  Q G
  1.  ;
  1. LASTITEM(P,BD,ED,BGPT,BGPV) ;PEP - return last item APCLV OF TYPE APCLT DURING BD TO ED IN FORM APCLF
  1.  I $G(BD)="" S BD=$$DOB^AUPNPAT(P)
  1.  I $G(ED)="" S ED=DT
  1.  I $G(BGPT)="" Q ""
  1.  I $G(BGPV)="" Q ""
  1.  NEW BGPR,%,E,Y K R S %=P_"^LAST "_BGPT_" "_BGPV_";DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"BGPR(")
  1.  I '$D(BGPR(1)) Q ""
  1.  Q 1_U_$P(BGPR(1),U,1)_U_$P(BGPR(1),U,3)_U_$P(BGPR(1),U,2)
  1.  ;
  1. PRV(VISIT,PROV) ;EP - Is this provider a provider for this visit
  1.  ;CHANGED ON 10/26 TO ONLY RETURN TRUE IF PRIMARY PROVIDER - PER Aneel Advani
  1.  N I,PRVIEN,PRVDATA
  1.  S I=""
  1.  S PRVIEN="" F  S PRVIEN=$O(^AUPNVPRV("AD",VISIT,PRVIEN)) Q:'+PRVIEN!(I)  D
  1.  .S PRVDATA=$G(^AUPNVPRV(PRVIEN,0))
  1.  .I $P(PRVDATA,U,1)=PROV&($P(PRVDATA,U,4)="P") S I=1
  1.  Q $S(I=1:1,1:"")
  1. PRVOLD(VISIT,PROV) ;Is this provider a provider for this visit - NO PRIMARY/SECONDARY CHECK
  1.  N I,PRVIEN
  1.  S I=""
  1.  S PRVIEN="" F  S PRVIEN=$O(^AUPNVPRV("AD",VISIT,PRVIEN)) Q:'+PRVIEN!(I)  D
  1.  .I $P($G(^AUPNVPRV(PRVIEN,0)),U,1)=PROV S I=1
  1.  Q $S(I=1:1,1:"")