BIREPE3 ;IHS/CMI/MWR - REPORT, VAC ELIGIBILITY; MAY 10, 2010
;;8.5;IMMUNIZATION;**3**;SEP 10,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW OR PRINT VACCINE ELIGIBILITY REPORT.
;; PATCH 3: Return Eligibility values from BI TABLE ELIGIBILITY File. ELIGC+5
;
;
;----------
GETIMMS(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT,BIU19) ;EP
;---> Get Immunizations from V Files.
;---> Parameters:
; 1 - BIBEGDT (req) Begin Visit Date.
; 2 - BIENDDT (req) End Visit Date.
; 3 - BICC (req) Current Community array.
; 4 - BIHCF (req) Health Care Facility array.
; 5 - BICM (req) Case Manager array.
; 6 - BIBEN (req) Beneficiary Type array.
; 7 - BIHIST (req) Include Historical (1=yes,0=no).
; 8 - BIVT (req) Visit Type array.
; 9 - BIU19 (req) Include Adults parameter (1=yes,0=no).
;
;---> Set begin and end dates for search through V Immunization File.
;
Q:'$G(BIBEGDT) Q:'$G(BIENDDT)
S ^TMP("BIDUL",$J,"TOTAL")=0
N N S N=BIBEGDT-.9999
F S N=$O(^AUPNVIMM("ADT",N)) Q:(N>(BIENDDT+.9999)!('N)) D
.N M S M=0
.F S M=$O(^AUPNVIMM("ADT",N,M)) Q:'M D
..N P S P=0
..F S P=$O(^AUPNVIMM("ADT",N,M,P)) Q:'P D
...D CHKSET(N,M,P,.BICC,.BIHCF,.BICM,.BIBEN,BIHIST,.BIVT,BIU19)
Q
;
;
;----------
CHKSET(BIDATE,BIVIEN,BIIIEN,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT,BIU19) ;EP
;---> Check if this visit fits criteria; if so, set it
;---> in ^TMP("BIREPE1".
;---> Parameters:
; 1 - BIDATE (req) Date of Visit.
; 2 - BIVIEN (req) VISIT IEN.
; 3 - BIIIEN (req) V IMMUNIZAITON IEN.
; 4 - BICC (req) Current Community array.
; 5 - BIHCF (req) Health Care Facility array.
; 6 - BICM (req) Case Manager array.
; 7 - BIBEN (req) Beneficiary Type array.
; 8 - BIHIST (req) Include Historical (1=yes,0=no).
; 9 - BIVT (req) Visit Type array.
; 10 - BIU19 (req) Include Adults parameter (1=yes,0=no).
;
Q:'$G(BIDATE)
Q:'$G(BIVIEN)
Q:'$G(BIIIEN)
Q:'$D(^AUPNVSIT(BIVIEN,0))
Q:'$D(^AUPNVIMM(BIIIEN,0))
Q:'$D(BICC)
Q:'$D(BIHCF)
Q:'$D(BICM)
Q:'$D(BIBEN)
Q:'$D(BIVT)
Q:'$D(BIU19)
;
N BIVIMM,BIIMM,BIVNAME,BIDFN,BILOT,BIELIG
S BIVIMM=^AUPNVIMM(BIIIEN,0)
S BIIMM=$P(BIVIMM,U),BIVNAME=$$VNAME^BIUTL2(BIIMM)
S BIDFN=$P(BIVIMM,U,2)
S BILOT=$P(BIVIMM,U,5)
S BIELIG=$P(BIVIMM,U,14)
;
I BILOT S BILOT=$P($G(^AUTTIML(BILOT,0)),U)
S:BILOT="" BILOT="Not Entered"
;
;---> Quit if this Vaccine should not be included in this report.
;---> As of v8.4, include all vaccines given during the selected time.
;Q:'$P($G(^AUTTIMM(BIIMM,0)),U,17) ;vvv8.4
;
;---> Quit if Current Community doesn't match.
Q:$$CURCOM^BIEXPRT2(BIDFN,.BICC)
;
;---> Quit if Health Care Facility doesn't match.
N BIVDATA S BIVDATA=^AUPNVSIT(BIVIEN,0)
Q:$$HCF(BIVDATA,.BIHCF)
;
;---> Quit if Visit Type doesn't match.
Q:$$VT(BIVDATA,.BIVT)
;
;---> Quit if not including Historical Visits and this Visit has
;---> a Category of "Historical".
I '$G(BIHIST) Q:$$HIST(BIVDATA)
;
;---> Quit if Case Manager doesn't match.
Q:$$CMGR^BIDUR(BIDFN,.BICM)
;
;---> Quit if Beneficiary Type doesn't match.
Q:$$BENT^BIDUR1(BIDFN,.BIBEN)
;
;---> Quit if EXcluding adults and this patient was >19 on date of Visit.
I 'BIU19 Q:($$AGE^BIUTL1(BIDFN,1,BIDATE)>18)
;
;S BIVNAM=$$VNAME^BIUTL2(BIIMM)
;S BIAGRP=$$AGEGRP(BIDFN,BIDATE)
;S BIVGRP=$$IMMVG^BIUTL2(BIIMM,4)
;
;N Z
;---> Now store in stats arrays.
;
;---> Add for this Vaccine, Lot, Age.
;S Z=$G(BITMP("STATS",BIVGRP,BIVNAM,BILOT,BIAGRP))
;S BITMP("STATS",BIVGRP,BIVNAM,BILOT,BIAGRP)=Z+1
;
;---> Add for this Vaccine, Lot, Total.
;S Z=$G(BITMP("STATS",BIVGRP,BIVNAM,BILOT,"TOTAL"))
;S BITMP("STATS",BIVGRP,BIVNAM,BILOT,"TOTAL")=Z+1
;
N BINAME S BINAME=$$NAME^BIUTL1(BIDFN)
N BIDOB S BIDOB=$$DOBF^BIUTL1(BIDFN,,1,1,,1)
N BIELIGC S BIELIGC=$$ELIGC^BIELIG(BIELIG,6)
N BIVAL S BIVAL=$$SLDT2^BIUTL5(BIDATE,1)_U_$E(BINAME,1,20)_U_BIDOB_U_BIELIGC_U_BIVNAME_U_BILOT
S ^TMP("BIDUL",$J,BIDATE,BINAME,BIIIEN)=BIVAL
S ^TMP("BIDUL",$J,"TOTAL")=^TMP("BIDUL",$J,"TOTAL")+1
;
Q
;
;
;
;----------
AGEGRP(BIDFN,BIDATE) ;EP
;---> Return Patient's Age Group.
;---> Parameters:
; 1 - BIDFN (req) IEN in PATIENT File.
; 2 - BIDATE (req) Date of Visit.
;
N X S X=$$AGE^BIUTL1(BIDFN,1,BIDATE)
Q:X<1 1
Q:X=1 2
Q:X=2 3
Q:X<6 4
Q:X=6 5
Q:X<11 6
Q:X<13 7
Q:X<19 8
Q:X<25 9
Q:X<45 10
Q:X<65 11
Q 12
;
;
;----------
HCF(BIVDATA,BIHCF) ;EP
;---> Return Health Care Facility indicator.
;---> Return 1 if not selecting all Health Care Facilities (Locations)
;---> and if the Health Care Facility of this visit is not one of the
;---> ones selected.
;---> Parameters:
; 1 - BIVDATA (req) Data in ^AUPNVSIT(BIVIEN,0).
; 2 - BIHCF (req) Health Care Facility array.
;
Q:$D(BIHCF("ALL")) 0
Q:'$G(BIVDATA) 1
N BILOC S BILOC=$P(BIVDATA,U,6)
Q:'BILOC 1
Q:'$D(BIHCF(BILOC)) 1
Q 0
;
;
;----------
VT(BIVDATA,BIVT) ;EP
;---> Return Visit Type indicator.
;---> Return 1 if not selecting all Visit Types and if this Visit Type
;---> is not one of the ones selected.
;---> Parameters:
; 1 - BIVDATA (req) Data in ^AUPNVSIT(BIVIEN,0).
; 2 - BIVT (req) Health Care Facility array.
;
Q:$D(BIVT("ALL")) 0
Q:'$G(BIVDATA) 1
N BIVTYPE S BIVTYPE=$P(BIVDATA,U,3)
Q:BIVTYPE="" 1
Q:'$D(BIVT(BIVTYPE)) 1
Q 0
;
;
;----------
HIST(BIVDATA) ;EP
;---> Return Historical Visit indicator.
;---> Return 1 if this Visit has a Category of "Historical".
;---> Parameters:
; 1 - BIVDATA (req) Data in ^AUPNVSIT(BIVIEN,0).
;
Q:'$G(BIVDATA) 1
Q:$P(BIVDATA,U,7)="E" 1
Q 0
;
;
;----------
ELIGC(IEN,FORM) ;EP
;---> Return Eligibility Code or text.
;
;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
;---> Return Eligibility values from BI TABLE ELIGIBILITY File.
;---> Parameters:
; 1 - IEN (req) IEN of Elig Code.
; 2 - FORM (opt) FORM of Code to return:
; 1=Actual Code (also default)
; 2=Label Text of Code
; 3=Active/Inactive Status (1
; 4=Local Text
; 5=Local Report Abbreviation
;
Q:'$G(IEN) ""
Q:'$D(^BIELIG(IEN,0)) "NO GLOBAL"
N Y S Y=^BIELIG(IEN,0)
;
Q:$G(FORM)=2 $P(Y,U,2)
Q:$G(FORM)=3 $P(Y,U,3)
Q:$G(FORM)=4 $P(Y,U,4)
Q:$G(FORM)=5 $P(Y,U,5)
Q:$G(FORM)=6 $S($P(Y,U,5)]"":$P(Y,U,5),1:$P(Y,U))
Q $P(Y,U)
;**********
;
Q:(X=0) "Unknown"
Q:(X=1) "NotElig"
Q:(X=2) "Medicaid"
Q:(X=3) "Uninsured"
Q:(X=4) "AmIn/AKNa"
Q:(X=5) "Under/Fed"
Q:(X=6) "State"
Q:(X=7) "Local"
Q "Unknown"
BIREPE3 ;IHS/CMI/MWR - REPORT, VAC ELIGIBILITY; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW OR PRINT VACCINE ELIGIBILITY REPORT.
+4 ;; PATCH 3: Return Eligibility values from BI TABLE ELIGIBILITY File. ELIGC+5
+5 ;
+6 ;
+7 ;----------
GETIMMS(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT,BIU19) ;EP
+1 ;---> Get Immunizations from V Files.
+2 ;---> Parameters:
+3 ; 1 - BIBEGDT (req) Begin Visit Date.
+4 ; 2 - BIENDDT (req) End Visit Date.
+5 ; 3 - BICC (req) Current Community array.
+6 ; 4 - BIHCF (req) Health Care Facility array.
+7 ; 5 - BICM (req) Case Manager array.
+8 ; 6 - BIBEN (req) Beneficiary Type array.
+9 ; 7 - BIHIST (req) Include Historical (1=yes,0=no).
+10 ; 8 - BIVT (req) Visit Type array.
+11 ; 9 - BIU19 (req) Include Adults parameter (1=yes,0=no).
+12 ;
+13 ;---> Set begin and end dates for search through V Immunization File.
+14 ;
+15 IF '$GET(BIBEGDT)
QUIT
IF '$GET(BIENDDT)
QUIT
+16 SET ^TMP("BIDUL",$JOB,"TOTAL")=0
+17 NEW N
SET N=BIBEGDT-.9999
+18 FOR
SET N=$ORDER(^AUPNVIMM("ADT",N))
IF (N>(BIENDDT+.9999)!('N))
QUIT
Begin DoDot:1
+19 NEW M
SET M=0
+20 FOR
SET M=$ORDER(^AUPNVIMM("ADT",N,M))
IF 'M
QUIT
Begin DoDot:2
+21 NEW P
SET P=0
+22 FOR
SET P=$ORDER(^AUPNVIMM("ADT",N,M,P))
IF 'P
QUIT
Begin DoDot:3
+23 DO CHKSET(N,M,P,.BICC,.BIHCF,.BICM,.BIBEN,BIHIST,.BIVT,BIU19)
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
+26 ;
+27 ;----------
CHKSET(BIDATE,BIVIEN,BIIIEN,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT,BIU19) ;EP
+1 ;---> Check if this visit fits criteria; if so, set it
+2 ;---> in ^TMP("BIREPE1".
+3 ;---> Parameters:
+4 ; 1 - BIDATE (req) Date of Visit.
+5 ; 2 - BIVIEN (req) VISIT IEN.
+6 ; 3 - BIIIEN (req) V IMMUNIZAITON IEN.
+7 ; 4 - BICC (req) Current Community array.
+8 ; 5 - BIHCF (req) Health Care Facility array.
+9 ; 6 - BICM (req) Case Manager array.
+10 ; 7 - BIBEN (req) Beneficiary Type array.
+11 ; 8 - BIHIST (req) Include Historical (1=yes,0=no).
+12 ; 9 - BIVT (req) Visit Type array.
+13 ; 10 - BIU19 (req) Include Adults parameter (1=yes,0=no).
+14 ;
+15 IF '$GET(BIDATE)
QUIT
+16 IF '$GET(BIVIEN)
QUIT
+17 IF '$GET(BIIIEN)
QUIT
+18 IF '$DATA(^AUPNVSIT(BIVIEN,0))
QUIT
+19 IF '$DATA(^AUPNVIMM(BIIIEN,0))
QUIT
+20 IF '$DATA(BICC)
QUIT
+21 IF '$DATA(BIHCF)
QUIT
+22 IF '$DATA(BICM)
QUIT
+23 IF '$DATA(BIBEN)
QUIT
+24 IF '$DATA(BIVT)
QUIT
+25 IF '$DATA(BIU19)
QUIT
+26 ;
+27 NEW BIVIMM,BIIMM,BIVNAME,BIDFN,BILOT,BIELIG
+28 SET BIVIMM=^AUPNVIMM(BIIIEN,0)
+29 SET BIIMM=$PIECE(BIVIMM,U)
SET BIVNAME=$$VNAME^BIUTL2(BIIMM)
+30 SET BIDFN=$PIECE(BIVIMM,U,2)
+31 SET BILOT=$PIECE(BIVIMM,U,5)
+32 SET BIELIG=$PIECE(BIVIMM,U,14)
+33 ;
+34 IF BILOT
SET BILOT=$PIECE($GET(^AUTTIML(BILOT,0)),U)
+35 IF BILOT=""
SET BILOT="Not Entered"
+36 ;
+37 ;---> Quit if this Vaccine should not be included in this report.
+38 ;---> As of v8.4, include all vaccines given during the selected time.
+39 ;Q:'$P($G(^AUTTIMM(BIIMM,0)),U,17) ;vvv8.4
+40 ;
+41 ;---> Quit if Current Community doesn't match.
+42 IF $$CURCOM^BIEXPRT2(BIDFN,.BICC)
QUIT
+43 ;
+44 ;---> Quit if Health Care Facility doesn't match.
+45 NEW BIVDATA
SET BIVDATA=^AUPNVSIT(BIVIEN,0)
+46 IF $$HCF(BIVDATA,.BIHCF)
QUIT
+47 ;
+48 ;---> Quit if Visit Type doesn't match.
+49 IF $$VT(BIVDATA,.BIVT)
QUIT
+50 ;
+51 ;---> Quit if not including Historical Visits and this Visit has
+52 ;---> a Category of "Historical".
+53 IF '$GET(BIHIST)
IF $$HIST(BIVDATA)
QUIT
+54 ;
+55 ;---> Quit if Case Manager doesn't match.
+56 IF $$CMGR^BIDUR(BIDFN,.BICM)
QUIT
+57 ;
+58 ;---> Quit if Beneficiary Type doesn't match.
+59 IF $$BENT^BIDUR1(BIDFN,.BIBEN)
QUIT
+60 ;
+61 ;---> Quit if EXcluding adults and this patient was >19 on date of Visit.
+62 IF 'BIU19
IF ($$AGE^BIUTL1(BIDFN,1,BIDATE)>18)
QUIT
+63 ;
+64 ;S BIVNAM=$$VNAME^BIUTL2(BIIMM)
+65 ;S BIAGRP=$$AGEGRP(BIDFN,BIDATE)
+66 ;S BIVGRP=$$IMMVG^BIUTL2(BIIMM,4)
+67 ;
+68 ;N Z
+69 ;---> Now store in stats arrays.
+70 ;
+71 ;---> Add for this Vaccine, Lot, Age.
+72 ;S Z=$G(BITMP("STATS",BIVGRP,BIVNAM,BILOT,BIAGRP))
+73 ;S BITMP("STATS",BIVGRP,BIVNAM,BILOT,BIAGRP)=Z+1
+74 ;
+75 ;---> Add for this Vaccine, Lot, Total.
+76 ;S Z=$G(BITMP("STATS",BIVGRP,BIVNAM,BILOT,"TOTAL"))
+77 ;S BITMP("STATS",BIVGRP,BIVNAM,BILOT,"TOTAL")=Z+1
+78 ;
+79 NEW BINAME
SET BINAME=$$NAME^BIUTL1(BIDFN)
+80 NEW BIDOB
SET BIDOB=$$DOBF^BIUTL1(BIDFN,,1,1,,1)
+81 NEW BIELIGC
SET BIELIGC=$$ELIGC^BIELIG(BIELIG,6)
+82 NEW BIVAL
SET BIVAL=$$SLDT2^BIUTL5(BIDATE,1)_U_$EXTRACT(BINAME,1,20)_U_BIDOB_U_BIELIGC_U_BIVNAME_U_BILOT
+83 SET ^TMP("BIDUL",$JOB,BIDATE,BINAME,BIIIEN)=BIVAL
+84 SET ^TMP("BIDUL",$JOB,"TOTAL")=^TMP("BIDUL",$JOB,"TOTAL")+1
+85 ;
+86 QUIT
+87 ;
+88 ;
+89 ;
+90 ;----------
AGEGRP(BIDFN,BIDATE) ;EP
+1 ;---> Return Patient's Age Group.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) IEN in PATIENT File.
+4 ; 2 - BIDATE (req) Date of Visit.
+5 ;
+6 NEW X
SET X=$$AGE^BIUTL1(BIDFN,1,BIDATE)
+7 IF X<1
QUIT 1
+8 IF X=1
QUIT 2
+9 IF X=2
QUIT 3
+10 IF X<6
QUIT 4
+11 IF X=6
QUIT 5
+12 IF X<11
QUIT 6
+13 IF X<13
QUIT 7
+14 IF X<19
QUIT 8
+15 IF X<25
QUIT 9
+16 IF X<45
QUIT 10
+17 IF X<65
QUIT 11
+18 QUIT 12
+19 ;
+20 ;
+21 ;----------
HCF(BIVDATA,BIHCF) ;EP
+1 ;---> Return Health Care Facility indicator.
+2 ;---> Return 1 if not selecting all Health Care Facilities (Locations)
+3 ;---> and if the Health Care Facility of this visit is not one of the
+4 ;---> ones selected.
+5 ;---> Parameters:
+6 ; 1 - BIVDATA (req) Data in ^AUPNVSIT(BIVIEN,0).
+7 ; 2 - BIHCF (req) Health Care Facility array.
+8 ;
+9 IF $DATA(BIHCF("ALL"))
QUIT 0
+10 IF '$GET(BIVDATA)
QUIT 1
+11 NEW BILOC
SET BILOC=$PIECE(BIVDATA,U,6)
+12 IF 'BILOC
QUIT 1
+13 IF '$DATA(BIHCF(BILOC))
QUIT 1
+14 QUIT 0
+15 ;
+16 ;
+17 ;----------
VT(BIVDATA,BIVT) ;EP
+1 ;---> Return Visit Type indicator.
+2 ;---> Return 1 if not selecting all Visit Types and if this Visit Type
+3 ;---> is not one of the ones selected.
+4 ;---> Parameters:
+5 ; 1 - BIVDATA (req) Data in ^AUPNVSIT(BIVIEN,0).
+6 ; 2 - BIVT (req) Health Care Facility array.
+7 ;
+8 IF $DATA(BIVT("ALL"))
QUIT 0
+9 IF '$GET(BIVDATA)
QUIT 1
+10 NEW BIVTYPE
SET BIVTYPE=$PIECE(BIVDATA,U,3)
+11 IF BIVTYPE=""
QUIT 1
+12 IF '$DATA(BIVT(BIVTYPE))
QUIT 1
+13 QUIT 0
+14 ;
+15 ;
+16 ;----------
HIST(BIVDATA) ;EP
+1 ;---> Return Historical Visit indicator.
+2 ;---> Return 1 if this Visit has a Category of "Historical".
+3 ;---> Parameters:
+4 ; 1 - BIVDATA (req) Data in ^AUPNVSIT(BIVIEN,0).
+5 ;
+6 IF '$GET(BIVDATA)
QUIT 1
+7 IF $PIECE(BIVDATA,U,7)="E"
QUIT 1
+8 QUIT 0
+9 ;
+10 ;
+11 ;----------
ELIGC(IEN,FORM) ;EP
+1 ;---> Return Eligibility Code or text.
+2 ;
+3 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+4 ;---> Return Eligibility values from BI TABLE ELIGIBILITY File.
+5 ;---> Parameters:
+6 ; 1 - IEN (req) IEN of Elig Code.
+7 ; 2 - FORM (opt) FORM of Code to return:
+8 ; 1=Actual Code (also default)
+9 ; 2=Label Text of Code
+10 ; 3=Active/Inactive Status (1
+11 ; 4=Local Text
+12 ; 5=Local Report Abbreviation
+13 ;
+14 IF '$GET(IEN)
QUIT ""
+15 IF '$DATA(^BIELIG(IEN,0))
QUIT "NO GLOBAL"
+16 NEW Y
SET Y=^BIELIG(IEN,0)
+17 ;
+18 IF $GET(FORM)=2
QUIT $PIECE(Y,U,2)
+19 IF $GET(FORM)=3
QUIT $PIECE(Y,U,3)
+20 IF $GET(FORM)=4
QUIT $PIECE(Y,U,4)
+21 IF $GET(FORM)=5
QUIT $PIECE(Y,U,5)
+22 IF $GET(FORM)=6
QUIT $SELECT($PIECE(Y,U,5)]"":$PIECE(Y,U,5),1:$PIECE(Y,U))
+23 QUIT $PIECE(Y,U)
+24 ;**********
+25 ;
+26 IF (X=0)
QUIT "Unknown"
+27 IF (X=1)
QUIT "NotElig"
+28 IF (X=2)
QUIT "Medicaid"
+29 IF (X=3)
QUIT "Uninsured"
+30 IF (X=4)
QUIT "AmIn/AKNa"
+31 IF (X=5)
QUIT "Under/Fed"
+32 IF (X=6)
QUIT "State"
+33 IF (X=7)
QUIT "Local"
+34 QUIT "Unknown"
