BIEXP3 ;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: EXPORT ROUTINE
;; PATCH 9: Changes to limit export of imms to specific vaccines within
;; a date range. START+75
;
;
;----------
START(BIRTN) ;EP
;---> Export Data.
;---> Parameters:
; 1 - BIRTN (req) Calling routine for reset.
;
I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
;
;---> Variables:
; 1 - BISVDT (req) Survey Date
; 2 - BIPG (req) Group of patients (9=Individual)
; 3 - BIPAT (opt) Patient DFN's (array) if BIPG=9
; 4 - BIAG (req) Age Range (=0 if not limited by age)
; 5 - BIHCF (req) Facility (array)
; 6 - BICC (req) Current Community (array)
; 7 - BIMMR (req) Immunizations Received, IEN's (array)
; 8 - BIDE (req) Data Elements to be passed (array)
; 9 - BIFMT (req) Format: 1=ASCII,2=HL7,3=ImmServe
; 10 - BIOUT (req) Export: 0=screen, 1=host file
; 11 - BIFLNM (opt) File name
; 12 - BIPATH (opt) Path name for File
;
; 13 - BIMMRF (opt) Immunizations filtered for output, CVX's (array)
; 14 - BIRDT (opt) Date Range for Imms Received.
;
;
;---> Check for required variables.
N BIERR S BIERR=""
D
.I '$D(BISVDT) S BIERR=640 Q
.I '$D(BIPG) S BIERR=641 Q
.I BIPG=9&('$O(BIPAT(0))) S BIERR=650 Q
.I '$D(BIAG) S BIERR=642 Q
.I '$D(BIHCF) S BIERR=643 Q
.I '$D(BICC) S BIERR=644 Q
.I '$D(BIMMR) S BIERR=645 Q
.I '$D(BIDE)&(BIFMT=1) S BIERR=646 Q
.I '$D(BIFMT) S BIERR=647 Q
.I '$D(BIOUT) S BIERR=648 Q
.I BIOUT,$G(BIFLNM)="" S BIERR=649 Q
.I BIOUT,$G(BIPATH)="" S BIERR=651 Q
;
;---> If an error exists, report it and return to first screen.
I BIERR D Q
.D ERRCD^BIUTL2(BIERR,,1),@("RESET^"_BIRTN)
;
;
D INIT N BIPOP
;
;---> If exporting all Data Elements, set them now.
D:$D(BIDE("ALL")) BIDE(.BIDE)
;
;---> If format is ImmServe, set Data Elements necessary for ImmServe.
I BIFMT=3 D BIDE^BIPATUP(.BIDE)
;
;---> Get okay to proceed.
D FULL^VALM1
D TITLE^BIUTL5("EXPORT IMMUNIZATION RECORDS")
D OKAY^BIEXPRT8(.BIPOP)
I BIPOP D @("RESET^"_BIRTN) Q
;
;---> If export is to Host File, open Host File and test access,
;---> and LEAVE OPEN for export.
D
.I BIOUT D HFS^BIEXPRT8(BIFLNM,.BIPATH,1,.BIPOP) Q
.S IOP=0 D ^%ZIS
I BIPOP D @("RESET^"_BIRTN) Q
;
;---> Patients.
D
.;---> If individuals in local array, store in ^BITMP.
.I BIPG=9 D Q
..N DFN S DFN=0 F S DFN=$O(BIPAT(DFN)) Q:'DFN S ^BITMP($J,1,DFN)=""
.;
.;---> Gather patients by group and store in ^BITMP.
.;
.;********** 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.
.;D PATIENT^BIEXPRT2(BIPG,BIAG,BISVDT,.BIHCF,.BICC)
.D PATIENT^BIEXPRT2(BIPG,BIAG,BISVDT,.BIHCF,.BICC,.BIMMR,$G(BIRDT))
;
;---> Gather Immunization History for each patient stored.
;---> (If not all vaccines, gather only ones selected--BIMMR.)
;---> If ImmServe export, get vaccines that should not be forecast.
I BIFMT=3 D NOFORC^BIPATUP(.BINF)
;
D HISTORY^BIEXPRT3(BIFMT,.BIDE,.BIMMRF,,,,.BINF)
;**********
;
;---> Export data.
D WRITE^BIEXPRT4(BIOUT,BIFMT,$G(BIFLNM),$G(BIPATH),,1)
;
;---> If Data Element array was built for ImmServe, kill it.
K:BIFMT=3 BIDE
;
;---> Return to calling routine.
D @("RESET^"_BIRTN)
Q
;
;
;----------
INIT ;EP
;---> Initialization.
K ^BITMP($J)
D SETVARS^BIUTL5
Q
;
;
;----------
BIDE(BIDE) ;EP
;---> Build local array of ALL Data Elements (for cases when
;---> user selects all data elements).
;
N N S N=0
F S N=$O(^BIEXPDD(N)) Q:'N S BIDE(N)=""
Q
BIEXP3 ;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: EXPORT ROUTINE
+4 ;; PATCH 9: Changes to limit export of imms to specific vaccines within
+5 ;; a date range. START+75
+6 ;
+7 ;
+8 ;----------
START(BIRTN) ;EP
+1 ;---> Export Data.
+2 ;---> Parameters:
+3 ; 1 - BIRTN (req) Calling routine for reset.
+4 ;
+5 IF $GET(BIRTN)=""
DO ERRCD^BIUTL2(621,,1)
QUIT
+6 ;
+7 ;---> Variables:
+8 ; 1 - BISVDT (req) Survey Date
+9 ; 2 - BIPG (req) Group of patients (9=Individual)
+10 ; 3 - BIPAT (opt) Patient DFN's (array) if BIPG=9
+11 ; 4 - BIAG (req) Age Range (=0 if not limited by age)
+12 ; 5 - BIHCF (req) Facility (array)
+13 ; 6 - BICC (req) Current Community (array)
+14 ; 7 - BIMMR (req) Immunizations Received, IEN's (array)
+15 ; 8 - BIDE (req) Data Elements to be passed (array)
+16 ; 9 - BIFMT (req) Format: 1=ASCII,2=HL7,3=ImmServe
+17 ; 10 - BIOUT (req) Export: 0=screen, 1=host file
+18 ; 11 - BIFLNM (opt) File name
+19 ; 12 - BIPATH (opt) Path name for File
+20 ;
+21 ; 13 - BIMMRF (opt) Immunizations filtered for output, CVX's (array)
+22 ; 14 - BIRDT (opt) Date Range for Imms Received.
+23 ;
+24 ;
+25 ;---> Check for required variables.
+26 NEW BIERR
SET BIERR=""
+27 Begin DoDot:1
+28 IF '$DATA(BISVDT)
SET BIERR=640
QUIT
+29 IF '$DATA(BIPG)
SET BIERR=641
QUIT
+30 IF BIPG=9&('$ORDER(BIPAT(0)))
SET BIERR=650
QUIT
+31 IF '$DATA(BIAG)
SET BIERR=642
QUIT
+32 IF '$DATA(BIHCF)
SET BIERR=643
QUIT
+33 IF '$DATA(BICC)
SET BIERR=644
QUIT
+34 IF '$DATA(BIMMR)
SET BIERR=645
QUIT
+35 IF '$DATA(BIDE)&(BIFMT=1)
SET BIERR=646
QUIT
+36 IF '$DATA(BIFMT)
SET BIERR=647
QUIT
+37 IF '$DATA(BIOUT)
SET BIERR=648
QUIT
+38 IF BIOUT
IF $GET(BIFLNM)=""
SET BIERR=649
QUIT
+39 IF BIOUT
IF $GET(BIPATH)=""
SET BIERR=651
QUIT
End DoDot:1
+40 ;
+41 ;---> If an error exists, report it and return to first screen.
+42 IF BIERR
Begin DoDot:1
+43 DO ERRCD^BIUTL2(BIERR,,1)
DO @("RESET^"_BIRTN)
End DoDot:1
QUIT
+44 ;
+45 ;
+46 DO INIT
NEW BIPOP
+47 ;
+48 ;---> If exporting all Data Elements, set them now.
+49 IF $DATA(BIDE("ALL"))
DO BIDE(.BIDE)
+50 ;
+51 ;---> If format is ImmServe, set Data Elements necessary for ImmServe.
+52 IF BIFMT=3
DO BIDE^BIPATUP(.BIDE)
+53 ;
+54 ;---> Get okay to proceed.
+55 DO FULL^VALM1
+56 DO TITLE^BIUTL5("EXPORT IMMUNIZATION RECORDS")
+57 DO OKAY^BIEXPRT8(.BIPOP)
+58 IF BIPOP
DO @("RESET^"_BIRTN)
QUIT
+59 ;
+60 ;---> If export is to Host File, open Host File and test access,
+61 ;---> and LEAVE OPEN for export.
+62 Begin DoDot:1
+63 IF BIOUT
DO HFS^BIEXPRT8(BIFLNM,.BIPATH,1,.BIPOP)
QUIT
+64 SET IOP=0
DO ^%ZIS
End DoDot:1
+65 IF BIPOP
DO @("RESET^"_BIRTN)
QUIT
+66 ;
+67 ;---> Patients.
+68 Begin DoDot:1
+69 ;---> If individuals in local array, store in ^BITMP.
+70 IF BIPG=9
Begin DoDot:2
+71 NEW DFN
SET DFN=0
FOR
SET DFN=$ORDER(BIPAT(DFN))
IF 'DFN
QUIT
SET ^BITMP($JOB,1,DFN)=""
End DoDot:2
QUIT
+72 ;
+73 ;---> Gather patients by group and store in ^BITMP.
+74 ;
+75 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+76 ;---> Changes to limit export of imms to specific vaccines within
+77 ;---> a date range. Parameters BIMMR and BIRDT added below.
+78 ;D PATIENT^BIEXPRT2(BIPG,BIAG,BISVDT,.BIHCF,.BICC)
+79 DO PATIENT^BIEXPRT2(BIPG,BIAG,BISVDT,.BIHCF,.BICC,.BIMMR,$GET(BIRDT))
End DoDot:1
+80 ;
+81 ;---> Gather Immunization History for each patient stored.
+82 ;---> (If not all vaccines, gather only ones selected--BIMMR.)
+83 ;---> If ImmServe export, get vaccines that should not be forecast.
+84 IF BIFMT=3
DO NOFORC^BIPATUP(.BINF)
+85 ;
+86 DO HISTORY^BIEXPRT3(BIFMT,.BIDE,.BIMMRF,,,,.BINF)
+87 ;**********
+88 ;
+89 ;---> Export data.
+90 DO WRITE^BIEXPRT4(BIOUT,BIFMT,$GET(BIFLNM),$GET(BIPATH),,1)
+91 ;
+92 ;---> If Data Element array was built for ImmServe, kill it.
+93 IF BIFMT=3
KILL BIDE
+94 ;
+95 ;---> Return to calling routine.
+96 DO @("RESET^"_BIRTN)
+97 QUIT
+98 ;
+99 ;
+100 ;----------
INIT ;EP
+1 ;---> Initialization.
+2 KILL ^BITMP($JOB)
+3 DO SETVARS^BIUTL5
+4 QUIT
+5 ;
+6 ;
+7 ;----------
BIDE(BIDE) ;EP
+1 ;---> Build local array of ALL Data Elements (for cases when
+2 ;---> user selects all data elements).
+3 ;
+4 NEW N
SET N=0
+5 FOR
SET N=$ORDER(^BIEXPDD(N))
IF 'N
QUIT
SET BIDE(N)=""
+6 QUIT
