BIREPA3 ;IHS/CMI/MWR - REPORT, VAC ACCOUNTABILITY; MAY 10, 2010
;;8.5;IMMUNIZATION;**3**;SEP 10,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW OR PRINT VACCINE ACCOUNTABILITY REPORT.
;; PATCH 3: Add Source (MVX) to display of Lot Numbers. CHKSET+29
;
;
;----------
GETIMMS(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT) ;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.
;
;---> Set begin and end dates for search through V Immunization File.
;
Q:'$G(BIBEGDT) Q:'$G(BIENDDT)
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)
Q
;
;
;----------
CHKSET(BIDATE,BIVIEN,BIIIEN,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT) ;EP
;---> Check if this visit fits criteria; if so, set it
;---> in ^TMP("BIREPA1".
;---> 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.
;
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)
;
N BIAGRP,BIDFN,BIIMM,BILOT,BIVGRP,BIVNAM,BIDOSE,Y
S Y=^AUPNVIMM(BIIIEN,0)
S BIDFN=$P(Y,U,2),BIIMM=$P(Y,U),BILOT=$P(Y,U,5)
;
;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
;---> Add Source (.13 field) to display of Lot Numbers.
;I BILOT S BILOT=$P($G(^AUTTIML(BILOT,0)),U)
I BILOT D
.N BISRC D
..N Y S Y=$P($G(^AUTTIML(BILOT,0)),U,13)
..I Y="" S BISRC="No Source" Q
..I '$D(^DD(9999999.41,.13,0)) S BISRC="^DD missing" Q
..S BISRC=$P($P(^DD(9999999.41,.13,0),Y_":",2),";")
.;
.S BILOT=$P($G(^AUTTIML(BILOT,0)),U)
.I BILOT="" S BILOT="Bad pointer" Q
.;---> Append Source.
.S BILOT=BILOT_" ("_BISRC_")"
;**********
;
S:BILOT="" BILOT="No Lot Number"
;
;---> 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)
;
S BIVNAM=$$VNAME^BIUTL2(BIIMM)
;S:BIDOSE<1 BIDOSE=1 S:BIDOSE>4 BIDOSE=4
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
;
;---> Add for this Vaccine, ALL Lots, Age.
S Z=$G(BITMP("STATS",BIVGRP,BIVNAM,"ALL",BIAGRP))
S BITMP("STATS",BIVGRP,BIVNAM,"ALL",BIAGRP)=Z+1
;
;---> Add for this Vaccine, Total.
S Z=$G(BITMP("STATS",BIVGRP,BIVNAM,"ALL","TOTAL"))
S BITMP("STATS",BIVGRP,BIVNAM,"ALL","TOTAL")=Z+1
;
;---> Add for ALL Vaccines, Total.
S Z=$G(BITMP("STATS","ALL","TOTAL"))
S BITMP("STATS","ALL","TOTAL")=Z+1 K Z
;
;---> Add refusals, if any.
;---> Not desired on this report, per Ros 10-12-05
;D CONTRA^BIUTL11(BIDFN,.Z,1) I $O(Z(0)) S BITMP("REFUSALS",BIDFN)=""
;
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
BIREPA3 ;IHS/CMI/MWR - REPORT, VAC ACCOUNTABILITY; 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 ACCOUNTABILITY REPORT.
+4 ;; PATCH 3: Add Source (MVX) to display of Lot Numbers. CHKSET+29
+5 ;
+6 ;
+7 ;----------
GETIMMS(BIBEGDT,BIENDDT,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT) ;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 ;
+12 ;---> Set begin and end dates for search through V Immunization File.
+13 ;
+14 IF '$GET(BIBEGDT)
QUIT
IF '$GET(BIENDDT)
QUIT
+15 NEW N
SET N=BIBEGDT-.9999
+16 FOR
SET N=$ORDER(^AUPNVIMM("ADT",N))
IF (N>(BIENDDT+.9999)!('N))
QUIT
Begin DoDot:1
+17 NEW M
SET M=0
+18 FOR
SET M=$ORDER(^AUPNVIMM("ADT",N,M))
IF 'M
QUIT
Begin DoDot:2
+19 NEW P
SET P=0
+20 FOR
SET P=$ORDER(^AUPNVIMM("ADT",N,M,P))
IF 'P
QUIT
Begin DoDot:3
+21 DO CHKSET(N,M,P,.BICC,.BIHCF,.BICM,.BIBEN,BIHIST,.BIVT)
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
+24 ;
+25 ;----------
CHKSET(BIDATE,BIVIEN,BIIIEN,BICC,BIHCF,BICM,BIBEN,BIHIST,BIVT) ;EP
+1 ;---> Check if this visit fits criteria; if so, set it
+2 ;---> in ^TMP("BIREPA1".
+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 ;
+14 IF '$GET(BIDATE)
QUIT
+15 IF '$GET(BIVIEN)
QUIT
+16 IF '$GET(BIIIEN)
QUIT
+17 IF '$DATA(^AUPNVSIT(BIVIEN,0))
QUIT
+18 IF '$DATA(^AUPNVIMM(BIIIEN,0))
QUIT
+19 IF '$DATA(BICC)
QUIT
+20 IF '$DATA(BIHCF)
QUIT
+21 IF '$DATA(BICM)
QUIT
+22 IF '$DATA(BIBEN)
QUIT
+23 IF '$DATA(BIVT)
QUIT
+24 ;
+25 NEW BIAGRP,BIDFN,BIIMM,BILOT,BIVGRP,BIVNAM,BIDOSE,Y
+26 SET Y=^AUPNVIMM(BIIIEN,0)
+27 SET BIDFN=$PIECE(Y,U,2)
SET BIIMM=$PIECE(Y,U)
SET BILOT=$PIECE(Y,U,5)
+28 ;
+29 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+30 ;---> Add Source (.13 field) to display of Lot Numbers.
+31 ;I BILOT S BILOT=$P($G(^AUTTIML(BILOT,0)),U)
+32 IF BILOT
Begin DoDot:1
+33 NEW BISRC
Begin DoDot:2
+34 NEW Y
SET Y=$PIECE($GET(^AUTTIML(BILOT,0)),U,13)
+35 IF Y=""
SET BISRC="No Source"
QUIT
+36 IF '$DATA(^DD(9999999.41,.13,0))
SET BISRC="^DD missing"
QUIT
+37 SET BISRC=$PIECE($PIECE(^DD(9999999.41,.13,0),Y_":",2),";")
End DoDot:2
+38 ;
+39 SET BILOT=$PIECE($GET(^AUTTIML(BILOT,0)),U)
+40 IF BILOT=""
SET BILOT="Bad pointer"
QUIT
+41 ;---> Append Source.
+42 SET BILOT=BILOT_" ("_BISRC_")"
End DoDot:1
+43 ;**********
+44 ;
+45 IF BILOT=""
SET BILOT="No Lot Number"
+46 ;
+47 ;---> Quit if this Vaccine should not be included in this report.
+48 ;---> As of v8.4, include all vaccines given during the selected time.
+49 ;Q:'$P($G(^AUTTIMM(BIIMM,0)),U,17) ;vvv8.4
+50 ;
+51 ;---> Quit if Current Community doesn't match.
+52 IF $$CURCOM^BIEXPRT2(BIDFN,.BICC)
QUIT
+53 ;
+54 ;---> Quit if Health Care Facility doesn't match.
+55 NEW BIVDATA
SET BIVDATA=^AUPNVSIT(BIVIEN,0)
+56 IF $$HCF(BIVDATA,.BIHCF)
QUIT
+57 ;---> Quit if Visit Type doesn't match.
+58 IF $$VT(BIVDATA,.BIVT)
QUIT
+59 ;
+60 ;---> Quit if not including Historical Visits and this Visit has
+61 ;---> a Category of "Historical".
+62 IF '$GET(BIHIST)
IF $$HIST(BIVDATA)
QUIT
+63 ;
+64 ;---> Quit if Case Manager doesn't match.
+65 IF $$CMGR^BIDUR(BIDFN,.BICM)
QUIT
+66 ;
+67 ;---> Quit if Beneficiary Type doesn't match.
+68 IF $$BENT^BIDUR1(BIDFN,.BIBEN)
QUIT
+69 ;
+70 SET BIVNAM=$$VNAME^BIUTL2(BIIMM)
+71 ;S:BIDOSE<1 BIDOSE=1 S:BIDOSE>4 BIDOSE=4
+72 SET BIAGRP=$$AGEGRP(BIDFN,BIDATE)
+73 SET BIVGRP=$$IMMVG^BIUTL2(BIIMM,4)
+74 ;
+75 NEW Z
+76 ;---> Now store in stats arrays.
+77 ;
+78 ;---> Add for this Vaccine, Lot, Age.
+79 SET Z=$GET(BITMP("STATS",BIVGRP,BIVNAM,BILOT,BIAGRP))
+80 SET BITMP("STATS",BIVGRP,BIVNAM,BILOT,BIAGRP)=Z+1
+81 ;
+82 ;---> Add for this Vaccine, Lot, Total.
+83 SET Z=$GET(BITMP("STATS",BIVGRP,BIVNAM,BILOT,"TOTAL"))
+84 SET BITMP("STATS",BIVGRP,BIVNAM,BILOT,"TOTAL")=Z+1
+85 ;
+86 ;---> Add for this Vaccine, ALL Lots, Age.
+87 SET Z=$GET(BITMP("STATS",BIVGRP,BIVNAM,"ALL",BIAGRP))
+88 SET BITMP("STATS",BIVGRP,BIVNAM,"ALL",BIAGRP)=Z+1
+89 ;
+90 ;---> Add for this Vaccine, Total.
+91 SET Z=$GET(BITMP("STATS",BIVGRP,BIVNAM,"ALL","TOTAL"))
+92 SET BITMP("STATS",BIVGRP,BIVNAM,"ALL","TOTAL")=Z+1
+93 ;
+94 ;---> Add for ALL Vaccines, Total.
+95 SET Z=$GET(BITMP("STATS","ALL","TOTAL"))
+96 SET BITMP("STATS","ALL","TOTAL")=Z+1
KILL Z
+97 ;
+98 ;---> Add refusals, if any.
+99 ;---> Not desired on this report, per Ros 10-12-05
+100 ;D CONTRA^BIUTL11(BIDFN,.Z,1) I $O(Z(0)) S BITMP("REFUSALS",BIDFN)=""
+101 ;
+102 QUIT
+103 ;
+104 ;
+105 ;
+106 ;----------
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
