BIEXPRT4 ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS; MAY 10, 2010
;;8.5;IMMUNIZATION;**8**;MAR 15,2014
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EXPORT IMMUNIZATION RECORDS: WRITE IMM HISTORIES OF PATIENTS
;; STORED IN ^BITMP( TO SCREEN, HOST FILE, OR RETURN AS A STRING.
;; PATCH 1: If string of patient data is too long, set error and quit. WRITE+72
;; PATCH 5: Increase nodes to accommodate Admin Notes. WRITE+63
;; PATCH 8: Changes to accommodate new TCH Forecaster WRITE+83
;
;
;----------
WRITE(BIOUT,BIFMT,BIFLNM,BIPATH,BISTRING,BICSV) ;EP
;---> Write (export) data from ^BITMP( to Screen or to Host File.
;---> Parameters:
; 1 - BIOUT (req) Export: 0=screen, 1=host file, 2=string
; 2 - BIFMT (req) Format: 1=ASCII, 2=HL7, 3=TCH
; 3 - BIFLNM (opt) File name
; 4 - BIPATH (opt) BI Path name for host files
; 5 - BISTRING (ret) Immunization History in "|"-delimited string
; 6 - BICSV (opt) If BICSV=1 exported data to screen or host
; file will be Comma Separated Values; also
; first piece "I" for Imm or "S" for Skin Test
; will be removed.
;
I '$D(^BITMP($J,2)) D Q
.I BIOUT=2 S BISTRING="NO RECORDS TO BE EXPORTED" Q
.D ^%ZISC,IO^BIO("NO RECORDS TO BE EXPORTED.","!!?5")
.D DIRZ^BIUTL3()
;
N BIPOP S BIPOP=0
;
;---> Output to Screen.
I 'BIOUT D Q:BIPOP
.D FULL^VALM1
.N A S A="Turn on your screen capture now. Data will follow..."
.D IO^BIO(A,"!!?5")
.D DIRZ^BIUTL3(.BIPOP) W !
.I BIPOP D ^%ZISC,IO^BIO("NO RECORDS EXPORTED.","!?5"),DIRZ^BIUTL3()
;
;
;---> Use IO if output to either SCREEN or FILE (not STRING).
U:BIOUT<2 IO
N BICOUNT,I,N,M,P,Q,V
S BICOUNT=0,BISTRING="",N=0,V=""""
;---> If format=1, ASCII, write field names in first record.
I BIFMT=1&(BIOUT'=2) D W !
.F I=0:1 S N=$O(BIDE(N)) Q:'N W:I "," W V,$P(^BIEXPDD(N,0),U),V
;
S N=0
F S N=$O(^BITMP($J,2,N)) Q:'N D
.S M=0
.F S M=$O(^BITMP($J,2,N,M)) Q:'M D
..;
..;---> Stop at this level subscript for HL7 format.
..I BIFMT=2 W ^BITMP($J,2,N,M),! S BICOUNT=BICOUNT+1 Q
..;
..S P=0
..F S P=$O(^BITMP($J,2,N,M,P)) Q:'P D
...S Q=0
...;---> Continue to this level subscript for ASCII and TCH formats.
...F S Q=$O(^BITMP($J,2,N,M,P,Q)) Q:'Q D
....;
....N X
....S X=^BITMP($J,2,N,M,P,Q)
....;---> These additional nodes may be set in +170^BIEXPRT5
....;---> or in +182^BIEXPRT3.
....S:$D(^BITMP($J,2,N,M,P,Q,1)) X=X_^(1)
....S:$D(^BITMP($J,2,N,M,P,Q,2)) X=X_^(2)
....S:$D(^BITMP($J,2,N,M,P,Q,3)) X=X_^(3)
....S:$D(^BITMP($J,2,N,M,P,Q,4)) X=X_^(4)
....S:$D(^BITMP($J,2,N,M,P,Q,5)) X=X_^(5)
....S:$D(^BITMP($J,2,N,M,P,Q,6)) X=X_^(6)
....S:$D(^BITMP($J,2,N,M,P,Q,7)) X=X_^(7)
....;
....;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
....;---> Increase nodes to accommodate Admin Notes.
....S:$D(^BITMP($J,2,N,M,P,Q,8)) X=X_^(8)
....S:$D(^BITMP($J,2,N,M,P,Q,9)) X=X_^(9)
....S:$D(^BITMP($J,2,N,M,P,Q,10)) X=X_^(10)
....;**********
....;
....;---> If BICSV=1, translate to Comma Separated Values,
....;---> and remove first piece ("I" for Imm, "S" for Skin Test).
....I $G(BICSV)&(BIFMT=1) S X=$TR(X,"|",","),X=$P(X,",",2,99)
....;
....;---> If export is to a string; build string and quit.
....;
....;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
....;---> If string of patient data is too long, set error and quit.
....;I BIOUT=2 S BISTRING=BISTRING_X_U Q
....I BIOUT=2 D Q
.....I ($L(BISTRING)+$L(X))>32760 D Q
......S BISTRING="PATIENT HISTORY EXCEEDS MAXIMUM LENGTH"
.....;
.....;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
.....;---> Do not terminate BISTRING with "^" if Format=TCH.
.....I BIFMT=3 S BISTRING=BISTRING_X Q
.....;---> Format is ASCII, so terminate Imms with "^".
.....S BISTRING=BISTRING_X_U
.....;**********
....;
....;---> Export is to host file or screen.
....W X,! S BICOUNT=BICOUNT+1
;
I BIOUT=2 S BISTRING=$TR(BISTRING,"""","") Q
D ^%ZISC
I BIOUT D
.N A S A="File "_BIPATH_BIFLNM_" saved to Host File Server."
.D IO^BIO(A,"!!?5")
D IO^BIO("Records exported: "_BICOUNT,"!!?5")
D DIRZ^BIUTL3()
Q
BIEXPRT4 ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**8**;MAR 15,2014
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EXPORT IMMUNIZATION RECORDS: WRITE IMM HISTORIES OF PATIENTS
+4 ;; STORED IN ^BITMP( TO SCREEN, HOST FILE, OR RETURN AS A STRING.
+5 ;; PATCH 1: If string of patient data is too long, set error and quit. WRITE+72
+6 ;; PATCH 5: Increase nodes to accommodate Admin Notes. WRITE+63
+7 ;; PATCH 8: Changes to accommodate new TCH Forecaster WRITE+83
+8 ;
+9 ;
+10 ;----------
WRITE(BIOUT,BIFMT,BIFLNM,BIPATH,BISTRING,BICSV) ;EP
+1 ;---> Write (export) data from ^BITMP( to Screen or to Host File.
+2 ;---> Parameters:
+3 ; 1 - BIOUT (req) Export: 0=screen, 1=host file, 2=string
+4 ; 2 - BIFMT (req) Format: 1=ASCII, 2=HL7, 3=TCH
+5 ; 3 - BIFLNM (opt) File name
+6 ; 4 - BIPATH (opt) BI Path name for host files
+7 ; 5 - BISTRING (ret) Immunization History in "|"-delimited string
+8 ; 6 - BICSV (opt) If BICSV=1 exported data to screen or host
+9 ; file will be Comma Separated Values; also
+10 ; first piece "I" for Imm or "S" for Skin Test
+11 ; will be removed.
+12 ;
+13 IF '$DATA(^BITMP($JOB,2))
Begin DoDot:1
+14 IF BIOUT=2
SET BISTRING="NO RECORDS TO BE EXPORTED"
QUIT
+15 DO ^%ZISC
DO IO^BIO("NO RECORDS TO BE EXPORTED.","!!?5")
+16 DO DIRZ^BIUTL3()
End DoDot:1
QUIT
+17 ;
+18 NEW BIPOP
SET BIPOP=0
+19 ;
+20 ;---> Output to Screen.
+21 IF 'BIOUT
Begin DoDot:1
+22 DO FULL^VALM1
+23 NEW A
SET A="Turn on your screen capture now. Data will follow..."
+24 DO IO^BIO(A,"!!?5")
+25 DO DIRZ^BIUTL3(.BIPOP)
WRITE !
+26 IF BIPOP
DO ^%ZISC
DO IO^BIO("NO RECORDS EXPORTED.","!?5")
DO DIRZ^BIUTL3()
End DoDot:1
IF BIPOP
QUIT
+27 ;
+28 ;
+29 ;---> Use IO if output to either SCREEN or FILE (not STRING).
+30 IF BIOUT<2
USE IO
+31 NEW BICOUNT,I,N,M,P,Q,V
+32 SET BICOUNT=0
SET BISTRING=""
SET N=0
SET V=""""
+33 ;---> If format=1, ASCII, write field names in first record.
+34 IF BIFMT=1&(BIOUT'=2)
Begin DoDot:1
+35 FOR I=0:1
SET N=$ORDER(BIDE(N))
IF 'N
QUIT
IF I
WRITE ","
WRITE V,$PIECE(^BIEXPDD(N,0),U),V
End DoDot:1
WRITE !
+36 ;
+37 SET N=0
+38 FOR
SET N=$ORDER(^BITMP($JOB,2,N))
IF 'N
QUIT
Begin DoDot:1
+39 SET M=0
+40 FOR
SET M=$ORDER(^BITMP($JOB,2,N,M))
IF 'M
QUIT
Begin DoDot:2
+41 ;
+42 ;---> Stop at this level subscript for HL7 format.
+43 IF BIFMT=2
WRITE ^BITMP($JOB,2,N,M),!
SET BICOUNT=BICOUNT+1
QUIT
+44 ;
+45 SET P=0
+46 FOR
SET P=$ORDER(^BITMP($JOB,2,N,M,P))
IF 'P
QUIT
Begin DoDot:3
+47 SET Q=0
+48 ;---> Continue to this level subscript for ASCII and TCH formats.
+49 FOR
SET Q=$ORDER(^BITMP($JOB,2,N,M,P,Q))
IF 'Q
QUIT
Begin DoDot:4
+50 ;
+51 NEW X
+52 SET X=^BITMP($JOB,2,N,M,P,Q)
+53 ;---> These additional nodes may be set in +170^BIEXPRT5
+54 ;---> or in +182^BIEXPRT3.
+55 IF $DATA(^BITMP($JOB,2,N,M,P,Q,1))
SET X=X_^(1)
+56 IF $DATA(^BITMP($JOB,2,N,M,P,Q,2))
SET X=X_^(2)
+57 IF $DATA(^BITMP($JOB,2,N,M,P,Q,3))
SET X=X_^(3)
+58 IF $DATA(^BITMP($JOB,2,N,M,P,Q,4))
SET X=X_^(4)
+59 IF $DATA(^BITMP($JOB,2,N,M,P,Q,5))
SET X=X_^(5)
+60 IF $DATA(^BITMP($JOB,2,N,M,P,Q,6))
SET X=X_^(6)
+61 IF $DATA(^BITMP($JOB,2,N,M,P,Q,7))
SET X=X_^(7)
+62 ;
+63 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+64 ;---> Increase nodes to accommodate Admin Notes.
+65 IF $DATA(^BITMP($JOB,2,N,M,P,Q,8))
SET X=X_^(8)
+66 IF $DATA(^BITMP($JOB,2,N,M,P,Q,9))
SET X=X_^(9)
+67 IF $DATA(^BITMP($JOB,2,N,M,P,Q,10))
SET X=X_^(10)
+68 ;**********
+69 ;
+70 ;---> If BICSV=1, translate to Comma Separated Values,
+71 ;---> and remove first piece ("I" for Imm, "S" for Skin Test).
+72 IF $GET(BICSV)&(BIFMT=1)
SET X=$TRANSLATE(X,"|",",")
SET X=$PIECE(X,",",2,99)
+73 ;
+74 ;---> If export is to a string; build string and quit.
+75 ;
+76 ;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
+77 ;---> If string of patient data is too long, set error and quit.
+78 ;I BIOUT=2 S BISTRING=BISTRING_X_U Q
+79 IF BIOUT=2
Begin DoDot:5
+80 IF ($LENGTH(BISTRING)+$LENGTH(X))>32760
Begin DoDot:6
+81 SET BISTRING="PATIENT HISTORY EXCEEDS MAXIMUM LENGTH"
End DoDot:6
QUIT
+82 ;
+83 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
+84 ;---> Do not terminate BISTRING with "^" if Format=TCH.
+85 IF BIFMT=3
SET BISTRING=BISTRING_X
QUIT
+86 ;---> Format is ASCII, so terminate Imms with "^".
+87 SET BISTRING=BISTRING_X_U
+88 ;**********
End DoDot:5
QUIT
+89 ;
+90 ;---> Export is to host file or screen.
+91 WRITE X,!
SET BICOUNT=BICOUNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+92 ;
+93 IF BIOUT=2
SET BISTRING=$TRANSLATE(BISTRING,"""","")
QUIT
+94 DO ^%ZISC
+95 IF BIOUT
Begin DoDot:1
+96 NEW A
SET A="File "_BIPATH_BIFLNM_" saved to Host File Server."
+97 DO IO^BIO(A,"!!?5")
End DoDot:1
+98 DO IO^BIO("Records exported: "_BICOUNT,"!!?5")
+99 DO DIRZ^BIUTL3()
+100 QUIT
