- BQIRGHEP ;GDHD/HCD/ALA-Hepatitis Immunizations ; 25 May 2016 12:09 PM
- ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
- ;
- HEPA(P,EDATE) ;EP
- NEW BGPC,BGPG,BGPX,BGPHEPA,C,X,ED,BD,G,V,Y,T,I,R,BGPIMM,BGPNMI
- K BGPC,BGPG,BGPX,HCT
- ;gather up all immunizations, cpts, povs and check for 3 each ten days apart
- K BGPHEPA
- ;get all immunizations
- S C="31^52^83^84^85^104"
- D GETIMMS^BGP6D32(P,EDATE,C,.BGPX)
- ;go through and set into array if 10 days apart
- S X=0 F S X=$O(BGPX(X)) Q:X'=+X S BGPHEPA(X)=""
- ;now get cpts
- S ED=9999999-EDATE,BD=9999999-$$DOB^AUPNPAT(P),G=0
- S T=$O(^ATXAX("B","BGP HEPATITIS A CPTS",0))
- F S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD) D
- .S V=0 F S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V D
- ..Q:'$D(^AUPNVSIT(V,0))
- ..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X D
- ...S Y=$P(^AUPNVCPT(X,0),U) S Z=$P($$CPT^ICPTCOD(Y),U,2) I $$ICD^BGP6UTL2(Y,T,1) S BGPHEPA(9999999-$P(ED,"."))=""
- ..S X=0 F S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X D
- ...S Y=$P(^AUPNVTC(X,0),U,7) Q:'Y S Z=$P($$CPT^ICPTCOD(Y),U,2) I $$ICD^BGP6UTL2(Y,T,1) S BGPHEPA(9999999-$P(ED,"."))=""
- ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
- S X="",Y="",C=0 F S X=$O(BGPHEPA(X)) Q:X'=+X S C=C+1 D
- .I C=1 S Y=X Q
- .I $$FMDIFF^XLFDT(X,Y)<11 K BGPHEPA(X) Q
- .S Y=X
- ;now count them and see if there are 2 of them
- S HCT=0,X=0 F S X=$O(BGPHEPA(X)) Q:X'=+X S HCT=HCT+1
- I HCT=1 Q "1 dose Hep A"
- I HCT>1 Q "YES"
- ;check for Evidence of disease and Contraindications and if yes, then quit
- K BGPG S %=P_"^LAST DX [BGP HEPATITIS A EVIDENCE;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
- I $D(BGPG(1)) Q "Evidence of Hep A"
- I $$PLTAX^BGP6DU(P,"BGP HEPATITIS A EVIDENCE") Q "Evidence of Hep A"
- ;
- F BGPZ=31,52,83,84,85,104 S X=$$ANCONT^BGP6D31(P,BGPZ,EDATE) Q:X]"" ;cmi/maw 12/17/07 missing edate
- I X]"" Q "Contra Hep A"
- ;
- S B=$$DOB^AUPNPAT(P),E=EDATE,BGPNMI="",R=""
- F BGPIMM=31,52,83,84,85,104 D
- .S I=$O(^AUTTIMM("C",BGPIMM,0)) Q:'I
- .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) I $P(^AUPNPREF(Y,0),U,7)="N" S BGPNMI=1 S R=1
- I R Q $S(BGPNMI:"NMI",1:"Ref")_" Hep A"
- S R=$$CPTREFT^BGP6UTL1(P,$$DOB^AUPNPAT(P),EDATE,$O(^ATXAX("B","BGP HEPATITIS A CPTS",0)))
- I R,$P(R,U,3)="N" S BGPNMI=1 Q $S(BGPNMI:"NMI",1:"Ref")_" Hep A"
- Q ""
- BQIRGHEP ;GDHD/HCD/ALA-Hepatitis Immunizations ; 25 May 2016 12:09 PM
- +1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
- +2 ;
- HEPA(P,EDATE) ;EP
- +1 NEW BGPC,BGPG,BGPX,BGPHEPA,C,X,ED,BD,G,V,Y,T,I,R,BGPIMM,BGPNMI
- +2 KILL BGPC,BGPG,BGPX,HCT
- +3 ;gather up all immunizations, cpts, povs and check for 3 each ten days apart
- +4 KILL BGPHEPA
- +5 ;get all immunizations
- +6 SET C="31^52^83^84^85^104"
- +7 DO GETIMMS^BGP6D32(P,EDATE,C,.BGPX)
- +8 ;go through and set into array if 10 days apart
- +9 SET X=0
- FOR
- SET X=$ORDER(BGPX(X))
- IF X'=+X
- QUIT
- SET BGPHEPA(X)=""
- +10 ;now get cpts
- +11 SET ED=9999999-EDATE
- SET BD=9999999-$$DOB^AUPNPAT(P)
- SET G=0
- +12 SET T=$ORDER(^ATXAX("B","BGP HEPATITIS A CPTS",0))
- +13 FOR
- SET ED=$ORDER(^AUPNVSIT("AA",P,ED))
- IF ED=""!($PIECE(ED,".")>BD)
- QUIT
- Begin DoDot:1
- +14 SET V=0
- FOR
- SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))
- IF V'=+V
- QUIT
- Begin DoDot:2
- +15 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +16 SET X=0
- FOR
- SET X=$ORDER(^AUPNVCPT("AD",V,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +17 SET Y=$PIECE(^AUPNVCPT(X,0),U)
- SET Z=$PIECE($$CPT^ICPTCOD(Y),U,2)
- IF $$ICD^BGP6UTL2(Y,T,1)
- SET BGPHEPA(9999999-$PIECE(ED,"."))=""
- End DoDot:3
- +18 SET X=0
- FOR
- SET X=$ORDER(^AUPNVTC("AD",V,X))
- IF X'=+X
- QUIT
- Begin DoDot:3
- +19 SET Y=$PIECE(^AUPNVTC(X,0),U,7)
- IF 'Y
- QUIT
- SET Z=$PIECE($$CPT^ICPTCOD(Y),U,2)
- IF $$ICD^BGP6UTL2(Y,T,1)
- SET BGPHEPA(9999999-$PIECE(ED,"."))=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +20 ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
- +21 SET X=""
- SET Y=""
- SET C=0
- FOR
- SET X=$ORDER(BGPHEPA(X))
- IF X'=+X
- QUIT
- SET C=C+1
- Begin DoDot:1
- +22 IF C=1
- SET Y=X
- QUIT
- +23 IF $$FMDIFF^XLFDT(X,Y)<11
- KILL BGPHEPA(X)
- QUIT
- +24 SET Y=X
- End DoDot:1
- +25 ;now count them and see if there are 2 of them
- +26 SET HCT=0
- SET X=0
- FOR
- SET X=$ORDER(BGPHEPA(X))
- IF X'=+X
- QUIT
- SET HCT=HCT+1
- +27 IF HCT=1
- QUIT "1 dose Hep A"
- +28 IF HCT>1
- QUIT "YES"
- +29 ;check for Evidence of disease and Contraindications and if yes, then quit
- +30 KILL BGPG
- SET %=P_"^LAST DX [BGP HEPATITIS A EVIDENCE;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE
- SET E=$$START1^APCLDF(%,"BGPG(")
- +31 IF $DATA(BGPG(1))
- QUIT "Evidence of Hep A"
- +32 IF $$PLTAX^BGP6DU(P,"BGP HEPATITIS A EVIDENCE")
- QUIT "Evidence of Hep A"
- +33 ;
- +34 ;cmi/maw 12/17/07 missing edate
- FOR BGPZ=31,52,83,84,85,104
- SET X=$$ANCONT^BGP6D31(P,BGPZ,EDATE)
- IF X]""
- QUIT
- +35 IF X]""
- QUIT "Contra Hep A"
- +36 ;
- +37 SET B=$$DOB^AUPNPAT(P)
- SET E=EDATE
- SET BGPNMI=""
- SET R=""
- +38 FOR BGPIMM=31,52,83,84,85,104
- Begin DoDot:1
- +39 SET I=$ORDER(^AUTTIMM("C",BGPIMM,0))
- IF 'I
- QUIT
- +40 SET X=0
- FOR
- SET X=$ORDER(^AUPNPREF("AA",P,9999999.14,I,X))
- IF X'=+X
- QUIT
- SET Y=0
- FOR
- SET Y=$ORDER(^AUPNPREF("AA",P,9999999.14,I,X,Y))
- IF Y'=+Y
- QUIT
- SET D=$PIECE(^AUPNPREF(Y,0),U,3)
- IF D'<B&(D'>E)
- IF $PIECE(^AUPNPREF(Y,0),U,7)="N"
- SET BGPNMI=1
- SET R=1
- End DoDot:1
- +41 IF R
- QUIT $SELECT(BGPNMI:"NMI",1:"Ref")_" Hep A"
- +42 SET R=$$CPTREFT^BGP6UTL1(P,$$DOB^AUPNPAT(P),EDATE,$ORDER(^ATXAX("B","BGP HEPATITIS A CPTS",0)))
- +43 IF R
- IF $PIECE(R,U,3)="N"
- SET BGPNMI=1
- QUIT $SELECT(BGPNMI:"NMI",1:"Ref")_" Hep A"
- +44 QUIT ""
