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

BGPMUF02.m

Go to the documentation of this file. 
  1. BGPMUF02 ; IHS/MSC/MMT - MI measure NQF0038 support routines ;02-Mar-2011 11:44;DU
  1.  ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
  1.  ;
  1. HEPA(P,EDATE) ;EP
  1.  K BGPC,BGPG,BGPX
  1.  N B,C,X,ED,BD,G,D,E,I,BGP00743,V,Y,Z,R,BGPIMM,BGPNMI
  1.  ;gather up all immunizations, cpts, povs and check for 3 each ten days apart
  1.  K BGPHEPA
  1.  ;get all immunizations
  1.  S C="83" ;per CMS specification spreadsheet, only CVX 83, CPT 90633
  1.  D GETIMMS^BGPMUUT2(P,EDATE,C,.BGPX)
  1.  ;go through and set into array if 10 days apart
  1.  S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPHEPA(X)=""
  1.  ;now get cpts
  1.  S ED=9999999-EDATE,BD=9999999-$$DOB^AUPNPAT(P),G=0
  1.  S BGP00743=0 F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X  D
  1.  ...S Y=$P(^AUPNVCPT(X,0),U) S Y=$P($$CPT^ICPTCOD(Y),U,2) I Y=90633 S BGPHEPA(9999999-$P(ED,"."))=""
  1.  ..S X=0 F  S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X  D
  1.  ...S Y=$P(^AUPNVTC(X,0),U,7) Q:'Y  S Y=$P($$CPT^ICPTCOD(Y),U,2) I Y=90633 S BGPHEPA(9999999-$P(ED,"."))=""
  1.  ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
  1.  S X="",Y="",C=0 F  S X=$O(BGPHEPA(X)) Q:X'=+X  S C=C+1 D
  1.  .I C=1 S Y=X Q
  1.  .I $$FMDIFF^XLFDT(X,Y)<11 K BGPHEPA(X) Q
  1.  .S Y=X
  1.  ;now count them and see if there are 2 of them
  1.  S BGPHEPA=0,X=0 F  S X=$O(BGPHEPA(X)) Q:X'=+X  S BGPHEPA=BGPHEPA+1
  1.  I BGPHEPA>1 Q 1_U_"2 HEP A"
  1.  ;check for allergy to vaccine
  1.  ;look in file 120.8
  1.  S R=""
  1.  ;check refusals in imm pkg
  1.  S B=$$DOB^AUPNPAT(P),E=EDATE,BGPNMI="",R=""
  1.  F BGPIMM=83 S R=$$IMMREF^BGPMUUT2(P,BGPIMM,B,EDATE)+R
  1.  I R Q $S(BGPNMI:4,1:3)_U_$S(BGPNMI:"NMI",1:"ref")_" hep A"
  1.  ;contraindication
  1.  F BGPZ=83 S X=$$ANCONT(P,BGPZ,EDATE) Q:X]""
  1.  I X]"" Q 4_U_"contra - HEP A"
  1.  ;NO! This should not stop here - this code needs to be reinstated and reworked!
  1.  ;QUIT here since CMS specs do not call for exclusions based on disease, refusals or contraind.
  1.  Q ""
  1.  ;check for evidence of disease and contraindications and if yes, then quit
  1.  K BGPG S %=P_"^LAST DX [BGP HEP EVIDENCE;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
  1.  I $D(BGPG(1)) Q 4_U_"evid hep A"
  1.  I $$PLTAX^BGP0DU(P,"BGP HEP EVIDENCE") Q 4_U_"evid hep A"
  1.  ;now go to refusals
  1.  S B=$$DOB^AUPNPAT(P),E=EDATE,BGPNMI="",R=""
  1.  F BGPIMM=83  D
  1.  .S I=$O(^AUTTIMM("C",BGPIMM,0)) Q:'I
  1.  .S X=0 F  S X=$O(^AUPNPREF("AA",P,9999999.14,I,X)) Q:X'=+X  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,9999999.14,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S:$P(^AUPNPREF(Y,0),U,7)="N" BGPNMI=1 S R=1
  1.  I R Q $S(BGPNMI:4,1:3)_U_$S(BGPNMI:"NMI",1:"ref")_" hep A"
  1.  ;now check refusals in imm pkg
  1.  F BGPIMM=83 S R=$$IMMREF^BGP0D32(P,BGPIMM,$$DOB^AUPNPAT(P),EDATE)+R
  1.  I R Q $S(BGPNMI:4,1:3)_U_$S(BGPNMI:"NMI",1:"ref")_" hep A"
  1.  F BGPZ=83 S X=$$ANCONT^BGP0D31(P,BGPZ,EDATE) Q:X]""
  1.  I X]"" Q 4_U_"contra - HEP A"
  1.  Q ""
  1. ROTA(P,EDATE) ;EP
  1.  K BGPC,BGPG,BGPX
  1.  N B,C,X,ED,BD,G,BGP00743,V,Y,Z,R,BGPIMM,BGPNMI
  1.  ;gather up all immunizations, cpts, povs and check for 3 each ten days apart
  1.  K BGPROTA
  1.  ;get all immunizations
  1.  S C="116^119" ;per CMS specification spreadsheet, only CVX 116&119, CPT 90680 & 90681
  1.  D GETIMMS^BGPMUUT2(P,EDATE,C,.BGPX)
  1.  ;go through and set into array if 10 days apart
  1.  S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPROTA(X)=""
  1.  ;now get cpts
  1.  S ED=9999999-EDATE,BD=9999999-$$DOB^AUPNPAT(P),G=0
  1.  S BGP00743=0 F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X  D
  1.  ...S Y=$P(^AUPNVCPT(X,0),U) S Y=$P($$CPT^ICPTCOD(Y),U,2) I Y=90680!(Y=90681) S BGPROTA(9999999-$P(ED,"."))=""
  1.  ..S X=0 F  S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X  D
  1.  ...S Y=$P(^AUPNVTC(X,0),U,7) Q:'Y  S Y=$P($$CPT^ICPTCOD(Y),U,2) I Y=90680!(Y=90681) S BGPROTA(9999999-$P(ED,"."))=""
  1.  ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
  1.  S X="",Y="",C=0 F  S X=$O(BGPROTA(X)) Q:X'=+X  S C=C+1 D
  1.  .I C=1 S Y=X Q
  1.  .I $$FMDIFF^XLFDT(X,Y)<11 K BGPROTA(X) Q
  1.  .S Y=X
  1.  ;now count them and see if there are 2 of them
  1.  S BGPROTA=0,X=0 F  S X=$O(BGPROTA(X)) Q:X'=+X  S BGPROTA=BGPROTA+1
  1.  I BGPROTA>1 Q 1_U_"2 ROTA"
  1.  ;check for allergy to vaccine
  1.  S R=""
  1.  ;check refusals in imm pkg
  1.  S B=$$DOB^AUPNPAT(P),E=EDATE,BGPNMI="",R=""
  1.  F BGPIMM=116,119 S R=$$IMMREF^BGPMUUT2(P,BGPIMM,B,EDATE)+R
  1.  I R Q $S(BGPNMI:4,1:3)_U_$S(BGPNMI:"NMI",1:"ref")_" ROTA"
  1.  ;check contraindications
  1.  F BGPZ=116,119 S X=$$ANCONT(P,BGPZ,EDATE) Q:X]""
  1.  I X]"" Q 4_U_"contra - ROTA A"
  1.  ;for diag chks, $$LASTDX and $$PLCODE
  1.  ;QUIT here since CMS specs do not call for exclusions based on disease, refusals or contraind.
  1.  Q ""
  1. FLU(P,EDATE) ;EP
  1.  K BGPC,BGPG,BGPX
  1.  N B,C,X,ED,BD,G,BGP00743,V,Y,Z,R,BGPIMM,BGPNMI
  1.  ;gather up all immunizations, cpts, povs and check for 3 each ten days apart
  1.  K BGPFLU
  1.  ;get all immunizations
  1.  S C="135^15" ;per CMS specification spreadsheet, only CVX 135 & 15, CPTs 90655, 90657, 90661, 90662
  1.  D GETIMMS^BGPMUUT2(P,EDATE,C,.BGPX)
  1.  ;go through and set into array if 10 days apart
  1.  S X=0 F  S X=$O(BGPX(X)) Q:X'=+X  S BGPFLU(X)=""
  1.  ;now get cpts
  1.  S ED=9999999-EDATE,BD=9999999-$$DOB^AUPNPAT(P),G=0
  1.  S BGP00743=0 F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X  D
  1.  ...S Y=$P(^AUPNVCPT(X,0),U) S Y=$P($$CPT^ICPTCOD(Y),U,2) I Y=90655!(Y=90657)!(Y=90661)!(Y=90662) S BGPFLU(9999999-$P(ED,"."))=""
  1.  ..S X=0 F  S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X  D
  1.  ...S Y=$P(^AUPNVTC(X,0),U,7) Q:'Y  S Y=$P($$CPT^ICPTCOD(Y),U,2) I Y=90655!(Y=90657)!(Y=90661)!(Y=90662) S BGPFLU(9999999-$P(ED,"."))=""
  1.  ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
  1.  S X="",Y="",C=0 F  S X=$O(BGPFLU(X)) Q:X'=+X  S C=C+1 D
  1.  .I C=1 S Y=X Q
  1.  .I $$FMDIFF^XLFDT(X,Y)<11 K BGPFLU(X) Q
  1.  .S Y=X
  1.  ;now count them and see if there are 2 of them
  1.  S BGPFLU=0,X=0 F  S X=$O(BGPFLU(X)) Q:X'=+X  S BGPFLU=BGPFLU+1
  1.  I BGPFLU>1 Q 1_U_"2 FLU"
  1.  ;check for allergy to vaccine
  1.  S R=""
  1.  ;now check refusals in imm pkg
  1.  S B=$$DOB^AUPNPAT(P),E=EDATE,BGPNMI="",R=""
  1.  F BGPIMM=135,15 S R=$$IMMREF^BGPMUUT2(P,BGPIMM,B,EDATE)+R
  1.  I R Q $S(BGPNMI:4,1:3)_U_$S(BGPNMI:"NMI",1:"ref")_" FLU"
  1.  F BGPZ=135,15 S X=$$ANCONT(P,BGPZ,EDATE) Q:X]""
  1.  I X]"" Q 4_U_"contra - FLU"
  1.  ;QUIT here since CMS specs do not call for exclusions based on disease, refusals or contraind.
  1.  Q ""
  1. ANCONT(P,C,ED) ;EP - ANALPHYLAXIS CONTRAINDICATION
  1.  NEW X
  1.  S X=0,G="",Y=$O(^AUTTIMM("C",C,0)) I Y F  S X=$O(^BIPC("AC",P,Y,X)) Q:X'=+X!(G)  D
  1.  .S R=$P(^BIPC(X,0),U,3)
  1.  .Q:R=""
  1.  .Q:'$D(^BICONT(R,0))
  1.  .S D=$P(^BIPC(X,0),U,4)
  1.  .Q:D=""
  1.  .;Q:$P(^BIPC(X,0),U,4)<BD
  1.  .Q:$P(^BIPC(X,0),U,4)>ED
  1.  .I $P(^BICONT(R,0),U,1)="Anaphylaxis" S G=D_U_"Contraindication: Anaphylaxis"
  1.  Q G