- 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