Routine: BIEXPRT2

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))

 ;----------

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)=""

 ;----------

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

BIEXPRT2.m