BIEXPRT2 ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS; MAY 10, 2010
;;8.5;IMMUNIZATION;**9**;OCT 01,2014
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EXPORT IMMUNIZATION RECORDS: GATHER PATIENTS ACCORDING TO
;; CRITERIA AND STORE IN ^BITMP(1,.
;
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Changes to limit export of imms to specific vaccines within
;---> a date range. Parameters BIMMR and BIRDT added below.
;----------
PATIENT(BIPG,BIAG,BISVDT,BIHCF,BICC,BIMMR,BIRDT) ;EP
;---> Gather patients according to selection criteria and
;---> store in ^BITMP(.
;---> Parameters:
; 1 - BIPG (req) Patient Group
; 2 - BIAG (req) Age Range (=0 if not limited by age)
; 3 - BISVDT (req) Survey Date
; 4 - BIHCF (req) Facility array
; 5 - BICC (req) Current Community array
; 6 - BIMMR (opt) Immunizations Received, IEN's (array)
; 7 - BIRDT (opt) Date Range for Imms received (YYYMMDD:YYYMMDD)
;
S BIPOP=0 K ^BITMP($J)
;
;---> If there's an Age Range *or* if the Group is not limited to
;---> the Immunization Register, then scan ^DPT(.
I BIAG]""!(BIPG=3) D Q
.;
.;---> Set begin and end dates for search through PATIENT File.
.D AGEDATE^BIAGE(BIAG,BISVDT,.BIBEGDT,.BIENDDT)
.;---> Start 1 day prior to Begin Date and $O into the desired DOB's.
.S N=BIBEGDT-1
.F S N=$O(^DPT("ADOB",N)) Q:(N>BIENDDT!('N)) D
..S BIDFN=0
..F S BIDFN=$O(^DPT("ADOB",N,BIDFN)) Q:'BIDFN D
...D STORE(BIDFN,BISVDT,BIPG,.BIHCF,.BICC,1,.BIMMR,$G(BIRDT))
;
;---> If there is NO Age Range *and* the Group is limited to the
;---> Immunization Register, then scan ^BIP(.
S BIDFN=0
F S BIDFN=$O(^BIP(BIDFN)) Q:'BIDFN D
.D STORE(BIDFN,BISVDT,BIPG,.BIHCF,.BICC,0,.BIMMR,$G(BIRDT))
Q
;
;
;----------
STORE(BIDFN,BISVDT,BIPG,BIHCF,BICC,BIDPT,BIMMR,BIRDT) ;EP
;---> Store patients in ^BITMP if they pass all criteria.
;---> Parameters:
; 1 - BIDFN (req) Patient Group
; 2 - BISVDT (req) Survey Date
; 3 - BIPG (req) Patient Group
; 4 - BIHCF (req) Facility array
; 5 - BICC (req) Current Community array
; 6 - BIDPT (opt) =1 if searching ^DPT, =0 if searching ^BIP.
; 7 - BIMMR (opt) Immunizations Received, IEN's (array)
; 8 - BIRDT (opt) Date Range for Imms received (YYYMMDD:YYYMMDD)
;
;---> If Group is ACTIVE and patient was not ACTIVE<BISVDT, Quit.
I BIPG=1 Q:$$ACTIVE(BIDFN,BISVDT)
;
;---> If Group is ACTIVE & INACTIVE and patient was not in the
;---> Register, Quit.
I $G(BIDPT),BIPG=2 Q:'$D(^BIP(BIDFN))
;
;---> If patient has had NO IMMUNIZATIONS or has had none at
;---> the selected Health Care Facilities, Quit.
Q:$$VIMM(BIDFN,.BIHCF)
;
;---> If patient does not have one of the selected Current
;---> Communities, Quit.
Q:$$CURCOM(BIDFN,.BICC)
;
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> If limited to specific vaccines within a date range, check and
;---> store patient if it's a match.
I $O(BIMMR(0)) D Q
.N N,Z S N=0,Z=0 F S N=$O(BIMMR(N)) Q:'N Q:Z D
..I $$GOTDOSE^BIUTL11(BIDFN,N,$G(BIRDT)) S ^BITMP($J,1,BIDFN)="",Z=1
;**********
;
;---> Store this patient for data retrieval.
S ^BITMP($J,1,BIDFN)=""
Q
;
;
;----------
ACTIVE(BIDFN,BISVDT) ;EP
;---> Return Active indicator: 0=Active, 1=Inactive.
;---> Called if looking for Active Only.
;---> Parameters:
; 1 - BIDFN (req) IEN of Patient in ^DPT.
; 2 - BISVDT (opt) Survey Date.
;
;
N X S X=$$INACT^BIUTL1(BIDFN)
;---> If this patient is not in the Register, return 1.
Q:X]"A" 1
;---> If this patient is Active, return 0.
Q:X="" 0
;---> If this patient was Inactive PRIOR TO the Survey Date return 1.
Q:X<$G(BISVDT) 1
;---> This patient became Inactive AFTER the Survey Date return 0.
Q 0
;
;
;----------
CURCOM(BIDFN,BICC) ;EP
;---> Return Current Community indicator.
;---> Return 1 if not selecting all CURRENT COMMUNITIES and if this
;---> patient's CURRENT COMMUNITY is not one of the ones selected.
;---> Parameters:
; 1 - BIDFN (req) IEN of Patient in ^DPT.
; 2 - BICC (req) Current Community array.
;
Q:$D(BICC("ALL")) 0
N BICUR S BICUR=$$CURCOM^BIUTL11(BIDFN)
Q:'BICUR 1
Q:'$D(BICC(BICUR)) 1
Q 0
;
;
;----------
VIMM(BIDFN,BIHCF) ;EP
;---> Return Immunization Visit indicator: 1=None, 0=Yes.
;---> Parameters:
; 1 - BIDFN (req) IEN of Patient in ^DPT.
; 2 - BIHCF (req) Current Community array.
;
;---> Return 1 if patient has no V IMMUNIZATIONS at all.
Q:'$D(^AUPNVIMM("AC",BIDFN)) 1
;---> Return 0 if patient has a V IMMUNIZATION and "ALL" are selected.
Q:$D(BIHCF("ALL")) 0
;---> Return 1 if patient does not have an Immunization Visit at the
;---> selected Facilities.
N BIFLAG,N,X
S N=0,BIFLAG=1
F S N=$O(^AUPNVIMM("AC",BIDFN,N)) Q:'N Q:'BIFLAG D
.Q:'$D(^AUPNVIMM(N,0))
.S Y=$P(^AUPNVIMM(N,0),U,3) Q:'Y
.Q:'$D(^AUPNVSIT(Y,0))
.S X=$P(^AUPNVSIT(Y,0),U,6)
.S:$D(BIHCF(X)) BIFLAG=0
Q BIFLAG
;
;
;----------
VISIT(BIDFN,BIHCF) ;EP
;---> Return Visit indicator.
;**** NOT USED FOR NOW. Might be used if some report/list wants
; all patients who have had any type of Visit at a Facility.
;
;---> Return 1 if patient has no VISITS at all.
Q:'$D(^AUPNVSIT("AC",BIDFN)) 1
;---> Return 0 if patient has a VISIT and "ALL" are selected.
Q:$D(BIHCF("ALL")) 0
;---> Return 1 if patient does not have a VISIT at the selected
;---> Facilities.
N BIFLAG,N,X
S N=0,BIFLAG=1
F S N=$O(^AUPNVSIT("AC",BIDFN,N)) Q:'N Q:'BIFLAG D
.Q:'$D(^AUPNVSIT(N,0))
.S X=$P(^AUPNVSIT(N,0),U,6)
.S:$D(BIHCF(X)) BIFLAG=0
Q BIFLAG
;
;
;----------
HRCN(BIDFN,BIHCF,BIACT) ;EP
;---> Return Health Record Number Indicator.
;---> Return 1 if this patient DOES NOT HAVE an Active HRCN/Chart# at any
;---> of the facilities in the BIHCF array; otherwise, return 0.
;---> Also return 1 if patient has NO Chart# ANYWHERE.
;---> Parameters:
; 1 - BIDFN (req) IEN of Patient in ^DPT.
; 2 - BIHCF (req) Health Care Facility array. Can be BIHCF("ALL").
; 3 - BIACT (opt) If BIACT=1 INCLUDE Patients whose Chart#'s are
; INACTIVE. In other words, return 0 for patients
; that have Chart#'s even if they are INACTIVE.
;
Q:'$G(BIDFN) 1
;
;---> Quit if patient has no Chart# anywhere.
Q:'$O(^AUPNPAT(BIDFN,41,0)) 1
;
;---> Build local array of patient's Chart#'s.
N BIHRCN,BIMATCH,M,N
S N=0
F S N=$O(^AUPNPAT(BIDFN,41,N)) Q:'N S BIHRCN(N)=^(N,0)
;
;---> Check for match between array of Chart# Sites and array of HCF's.
S BIMATCH=1,M=0
F S M=$O(BIHRCN(M)) Q:'M D Q:'BIMATCH
.;
.;---> If there's a match or if accepting ALL, then check for Inactive.
.D:($D(BIHCF(M))!($D(BIHCF("ALL"))))
..;
..;---> Quit if the Chart# is Inactive and the flag to include
..;---> Inactive is not set to 1.
..Q:($P(BIHRCN(M),U,3)&('$G(BIACT)))
..;
..;---> Got a match.
..S BIMATCH=0
;
Q BIMATCH
BIEXPRT2 ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**9**;OCT 01,2014
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EXPORT IMMUNIZATION RECORDS: GATHER PATIENTS ACCORDING TO
+4 ;; CRITERIA AND STORE IN ^BITMP(1,.
+5 ;
+6 ;
+7 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+8 ;---> Changes to limit export of imms to specific vaccines within
+9 ;---> a date range. Parameters BIMMR and BIRDT added below.
+10 ;----------
PATIENT(BIPG,BIAG,BISVDT,BIHCF,BICC,BIMMR,BIRDT) ;EP
+1 ;---> Gather patients according to selection criteria and
+2 ;---> store in ^BITMP(.
+3 ;---> Parameters:
+4 ; 1 - BIPG (req) Patient Group
+5 ; 2 - BIAG (req) Age Range (=0 if not limited by age)
+6 ; 3 - BISVDT (req) Survey Date
+7 ; 4 - BIHCF (req) Facility array
+8 ; 5 - BICC (req) Current Community array
+9 ; 6 - BIMMR (opt) Immunizations Received, IEN's (array)
+10 ; 7 - BIRDT (opt) Date Range for Imms received (YYYMMDD:YYYMMDD)
+11 ;
+12 SET BIPOP=0
KILL ^BITMP($JOB)
+13 ;
+14 ;---> If there's an Age Range *or* if the Group is not limited to
+15 ;---> the Immunization Register, then scan ^DPT(.
+16 IF BIAG]""!(BIPG=3)
Begin DoDot:1
+17 ;
+18 ;---> Set begin and end dates for search through PATIENT File.
+19 DO AGEDATE^BIAGE(BIAG,BISVDT,.BIBEGDT,.BIENDDT)
+20 ;---> Start 1 day prior to Begin Date and $O into the desired DOB's.
+21 SET N=BIBEGDT-1
+22 FOR
SET N=$ORDER(^DPT("ADOB",N))
IF (N>BIENDDT!('N))
QUIT
Begin DoDot:2
+23 SET BIDFN=0
+24 FOR
SET BIDFN=$ORDER(^DPT("ADOB",N,BIDFN))
IF 'BIDFN
QUIT
Begin DoDot:3
+25 DO STORE(BIDFN,BISVDT,BIPG,.BIHCF,.BICC,1,.BIMMR,$GET(BIRDT))
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+26 ;
+27 ;---> If there is NO Age Range *and* the Group is limited to the
+28 ;---> Immunization Register, then scan ^BIP(.
+29 SET BIDFN=0
+30 FOR
SET BIDFN=$ORDER(^BIP(BIDFN))
IF 'BIDFN
QUIT
Begin DoDot:1
+31 DO STORE(BIDFN,BISVDT,BIPG,.BIHCF,.BICC,0,.BIMMR,$GET(BIRDT))
End DoDot:1
+32 QUIT
+33 ;
+34 ;
+35 ;----------
STORE(BIDFN,BISVDT,BIPG,BIHCF,BICC,BIDPT,BIMMR,BIRDT) ;EP
+1 ;---> Store patients in ^BITMP if they pass all criteria.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient Group
+4 ; 2 - BISVDT (req) Survey Date
+5 ; 3 - BIPG (req) Patient Group
+6 ; 4 - BIHCF (req) Facility array
+7 ; 5 - BICC (req) Current Community array
+8 ; 6 - BIDPT (opt) =1 if searching ^DPT, =0 if searching ^BIP.
+9 ; 7 - BIMMR (opt) Immunizations Received, IEN's (array)
+10 ; 8 - BIRDT (opt) Date Range for Imms received (YYYMMDD:YYYMMDD)
+11 ;
+12 ;---> If Group is ACTIVE and patient was not ACTIVE<BISVDT, Quit.
+13 IF BIPG=1
IF $$ACTIVE(BIDFN,BISVDT)
QUIT
+14 ;
+15 ;---> If Group is ACTIVE & INACTIVE and patient was not in the
+16 ;---> Register, Quit.
+17 IF $GET(BIDPT)
IF BIPG=2
IF '$DATA(^BIP(BIDFN))
QUIT
+18 ;
+19 ;---> If patient has had NO IMMUNIZATIONS or has had none at
+20 ;---> the selected Health Care Facilities, Quit.
+21 IF $$VIMM(BIDFN,.BIHCF)
QUIT
+22 ;
+23 ;---> If patient does not have one of the selected Current
+24 ;---> Communities, Quit.
+25 IF $$CURCOM(BIDFN,.BICC)
QUIT
+26 ;
+27 ;
+28 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+29 ;---> If limited to specific vaccines within a date range, check and
+30 ;---> store patient if it's a match.
+31 IF $ORDER(BIMMR(0))
Begin DoDot:1
+32 NEW N,Z
SET N=0
SET Z=0
FOR
SET N=$ORDER(BIMMR(N))
IF 'N
QUIT
IF Z
QUIT
Begin DoDot:2
+33 IF $$GOTDOSE^BIUTL11(BIDFN,N,$GET(BIRDT))
SET ^BITMP($JOB,1,BIDFN)=""
SET Z=1
End DoDot:2
End DoDot:1
QUIT
+34 ;**********
+35 ;
+36 ;---> Store this patient for data retrieval.
+37 SET ^BITMP($JOB,1,BIDFN)=""
+38 QUIT
+39 ;
+40 ;
+41 ;----------
ACTIVE(BIDFN,BISVDT) ;EP
+1 ;---> Return Active indicator: 0=Active, 1=Inactive.
+2 ;---> Called if looking for Active Only.
+3 ;---> Parameters:
+4 ; 1 - BIDFN (req) IEN of Patient in ^DPT.
+5 ; 2 - BISVDT (opt) Survey Date.
+6 ;
+7 ;
+8 NEW X
SET X=$$INACT^BIUTL1(BIDFN)
+9 ;---> If this patient is not in the Register, return 1.
+10 IF X]"A"
QUIT 1
+11 ;---> If this patient is Active, return 0.
+12 IF X=""
QUIT 0
+13 ;---> If this patient was Inactive PRIOR TO the Survey Date return 1.
+14 IF X<$GET(BISVDT)
QUIT 1
+15 ;---> This patient became Inactive AFTER the Survey Date return 0.
+16 QUIT 0
+17 ;
+18 ;
+19 ;----------
CURCOM(BIDFN,BICC) ;EP
+1 ;---> Return Current Community indicator.
+2 ;---> Return 1 if not selecting all CURRENT COMMUNITIES and if this
+3 ;---> patient's CURRENT COMMUNITY is not one of the ones selected.
+4 ;---> Parameters:
+5 ; 1 - BIDFN (req) IEN of Patient in ^DPT.
+6 ; 2 - BICC (req) Current Community array.
+7 ;
+8 IF $DATA(BICC("ALL"))
QUIT 0
+9 NEW BICUR
SET BICUR=$$CURCOM^BIUTL11(BIDFN)
+10 IF 'BICUR
QUIT 1
+11 IF '$DATA(BICC(BICUR))
QUIT 1
+12 QUIT 0
+13 ;
+14 ;
+15 ;----------
VIMM(BIDFN,BIHCF) ;EP
+1 ;---> Return Immunization Visit indicator: 1=None, 0=Yes.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) IEN of Patient in ^DPT.
+4 ; 2 - BIHCF (req) Current Community array.
+5 ;
+6 ;---> Return 1 if patient has no V IMMUNIZATIONS at all.
+7 IF '$DATA(^AUPNVIMM("AC",BIDFN))
QUIT 1
+8 ;---> Return 0 if patient has a V IMMUNIZATION and "ALL" are selected.
+9 IF $DATA(BIHCF("ALL"))
QUIT 0
+10 ;---> Return 1 if patient does not have an Immunization Visit at the
+11 ;---> selected Facilities.
+12 NEW BIFLAG,N,X
+13 SET N=0
SET BIFLAG=1
+14 FOR
SET N=$ORDER(^AUPNVIMM("AC",BIDFN,N))
IF 'N
QUIT
IF 'BIFLAG
QUIT
Begin DoDot:1
+15 IF '$DATA(^AUPNVIMM(N,0))
QUIT
+16 SET Y=$PIECE(^AUPNVIMM(N,0),U,3)
IF 'Y
QUIT
+17 IF '$DATA(^AUPNVSIT(Y,0))
QUIT
+18 SET X=$PIECE(^AUPNVSIT(Y,0),U,6)
+19 IF $DATA(BIHCF(X))
SET BIFLAG=0
End DoDot:1
+20 QUIT BIFLAG
+21 ;
+22 ;
+23 ;----------
VISIT(BIDFN,BIHCF) ;EP
+1 ;---> Return Visit indicator.
+2 ;**** NOT USED FOR NOW. Might be used if some report/list wants
+3 ; all patients who have had any type of Visit at a Facility.
+4 ;
+5 ;---> Return 1 if patient has no VISITS at all.
+6 IF '$DATA(^AUPNVSIT("AC",BIDFN))
QUIT 1
+7 ;---> Return 0 if patient has a VISIT and "ALL" are selected.
+8 IF $DATA(BIHCF("ALL"))
QUIT 0
+9 ;---> Return 1 if patient does not have a VISIT at the selected
+10 ;---> Facilities.
+11 NEW BIFLAG,N,X
+12 SET N=0
SET BIFLAG=1
+13 FOR
SET N=$ORDER(^AUPNVSIT("AC",BIDFN,N))
IF 'N
QUIT
IF 'BIFLAG
QUIT
Begin DoDot:1
+14 IF '$DATA(^AUPNVSIT(N,0))
QUIT
+15 SET X=$PIECE(^AUPNVSIT(N,0),U,6)
+16 IF $DATA(BIHCF(X))
SET BIFLAG=0
End DoDot:1
+17 QUIT BIFLAG
+18 ;
+19 ;
+20 ;----------
HRCN(BIDFN,BIHCF,BIACT) ;EP
+1 ;---> Return Health Record Number Indicator.
+2 ;---> Return 1 if this patient DOES NOT HAVE an Active HRCN/Chart# at any
+3 ;---> of the facilities in the BIHCF array; otherwise, return 0.
+4 ;---> Also return 1 if patient has NO Chart# ANYWHERE.
+5 ;---> Parameters:
+6 ; 1 - BIDFN (req) IEN of Patient in ^DPT.
+7 ; 2 - BIHCF (req) Health Care Facility array. Can be BIHCF("ALL").
+8 ; 3 - BIACT (opt) If BIACT=1 INCLUDE Patients whose Chart#'s are
+9 ; INACTIVE. In other words, return 0 for patients
+10 ; that have Chart#'s even if they are INACTIVE.
+11 ;
+12 IF '$GET(BIDFN)
QUIT 1
+13 ;
+14 ;---> Quit if patient has no Chart# anywhere.
+15 IF '$ORDER(^AUPNPAT(BIDFN,41,0))
QUIT 1
+16 ;
+17 ;---> Build local array of patient's Chart#'s.
+18 NEW BIHRCN,BIMATCH,M,N
+19 SET N=0
+20 FOR
SET N=$ORDER(^AUPNPAT(BIDFN,41,N))
IF 'N
QUIT
SET BIHRCN(N)=^(N,0)
+21 ;
+22 ;---> Check for match between array of Chart# Sites and array of HCF's.
+23 SET BIMATCH=1
SET M=0
+24 FOR
SET M=$ORDER(BIHRCN(M))
IF 'M
QUIT
Begin DoDot:1
+25 ;
+26 ;---> If there's a match or if accepting ALL, then check for Inactive.
+27 IF ($DATA(BIHCF(M))!($DATA(BIHCF("ALL"))))
Begin DoDot:2
+28 ;
+29 ;---> Quit if the Chart# is Inactive and the flag to include
+30 ;---> Inactive is not set to 1.
+31 IF ($PIECE(BIHRCN(M),U,3)&('$GET(BIACT)))
QUIT
+32 ;
+33 ;---> Got a match.
+34 SET BIMATCH=0
End DoDot:2
End DoDot:1
IF 'BIMATCH
QUIT
+35 ;
+36 QUIT BIMATCH
