- 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
