BIEXPRT3 ;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: GATHER IMM HISTORIES FOR PATIENTS
;; STORED IN ^BITMP(.
;; PATCH 5: Added BI01 for Admin Note at 1-node. HISTORY+20,HISTORY1+13,+29
;; PATCH 5: Increase nodes to accommodate Admin Notes. GLBSET+30
;; PATCH 8: Changes to accommodate new TCH Forecaster HISTORY+99
;
;
;----------
HISTORY(BIFMT,BIDE,BIMM,BIFDT,BISKIN,BIDUZ2,BINF) ;EP
;---> Gather Immunization History for each patient stored in
;---> ^BITMP($J,1 and store data in ^BITMP($J.
;---> Parameters:
; 1 - BIFMT (req) Format: 0=ASCII Split, 1=ASCII, 2=HL7, 3=IMM/SERVE
; 2 - BIDE (req) Data Elements array (null if HL7)
; 3 - BIMM (req) Array of Vaccine Types
; 4 - BIFDT (opt) Forecast Date (date used to calc Imms due).
; For when this call is used to pass Imm Hx
; to ImmServe for forecasting.
; 5 - BISKIN (opt) BISKIN=1 if skin tests should be included
; (ASCII Format only).
; 6 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
; Rules in Patient History data string.
; 7 - BINF (opt) Array of Vaccine Grp IEN's that should not be forecast.
;
;---> If no Forecast Date passed, set it equal to today.
S:'$G(BIFDT) BIFDT=DT
;
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BI01 for Admin Note at 1-node.
;N BI0,BI012,BIDFN,BIVIMM,BIVSKN
N BI0,BI01,BI012,BIDFN,BIVIMM,BIVSKN
;
;---> Do not include Skin Test in HL7 or Immserve Formats.
S:BIFMT>1 BISKIN=0 S:'$G(BISKIN) BISKIN=0
;
;---> Gather Histories for all patients stored in ^BITMP($J,1,BIDFN.
S BIDFN=0
F S BIDFN=$O(^BITMP($J,1,BIDFN)) Q:'BIDFN D
.;
.;---> Gather Immunization History for one patient (BIDFN).
.S BIVIMM=0
.F S BIVIMM=$O(^AUPNVIMM("AC",BIDFN,BIVIMM)) Q:'BIVIMM D
..;
..;---> Gather Immunization data for one visit.
..;---> If this is an invalid pointer, clean up and quit.
..N BIVDATA S BIVDATA=$G(^AUPNVIMM(BIVIMM,0))
..I BIVDATA="" K ^AUPNVIMM("AC",BIDFN,BIVIMM) Q
..I $P(BIVDATA,U,2)'=BIDFN K ^AUPNVIMM("AC",BIDFN,BIVIMM) Q
..;
..;---> Quit if not selecting all Immunization Types and if this
..;---> record is not one of the Immunization Types selected.
..I '$D(BIMM("ALL")) Q:'$D(BIMM(+BIVDATA))
..;
..;---> Don't pass this if format is ImmServe and it is HL7=0, "OTHER".
..I BIFMT=3 Q:+BIVDATA=137
..;
..;---> If format=0 or 1, build ASCII record; format=3 build IMM/SERVE rec.
..;I BIFMT=1!(BIFMT=3) D HISTORY1(BIVIMM,.BIDE,BIFMT,"I") Q ;v8.0
..I BIFMT'=2 D HISTORY1(BIVIMM,.BIDE,BIFMT,"I") Q
..;
..;---> If format=2, build HL7 record.
..I BIFMT=2 D HISTORY2(BIVIMM) Q
.;
.;
.;---> NEXT SECTION IS ONLY FOR GATHERING PATIENT SKIN TESTS
.;---> TO RETURN IN ASCII CSV.
.;---> Quit if not gathering Skin Test history.
.Q:'BISKIN
.;
.;---> Gather Skin Test History for one patient (BIDFN).
.;
.;---> If BIDE local array for Data Elements is not passed, set
.;---> the following Data Elements to be returned by default.
.;---> The following are IEN's in ^BIEXPDD(.
.;---> IEN PC DATA
.;---> --- -- ----
.;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
.;---> 24 2 = IEN, V File Visit.
.;---> 26 3 = Location (or Outside Location) of Visit.
.;---> 29 4 = Date of Visit (DD-Mmm-YYYY @HHMM).
.;---> 38 5 = Skin Test Result.
.;---> 39 6 = Skin Test Reading.
.;---> 40 7 = Skin Test date read.
.;---> 41 8 = Skin Test Name.
.;---> 42 9 = Skin Test Name IEN.
.;
.D:'$D(BIDE)
..N I F I=24,26,29,38,39,40,41 S BIDE(I)=""
.;
.S BIVSKN=0
.F S BIVSKN=$O(^AUPNVSK("AC",BIDFN,BIVSKN)) Q:'BIVSKN D
..;
..;---> Gather Skin Test data for one visit.
..;---> If this is an invalid pointer, clean up and quit.
..I '$D(^AUPNVSK(BIVSKN,0)) K ^AUPNVSK("AC",BIDFN,BIVSKN) Q
..I $P(^AUPNVSK(BIVSKN,0),U,2)'=BIDFN K ^AUPNVSK("AC",BIDFN,BIVSKN) Q
..;
..;---> If format=1, build ASCII record.
..D HISTORY1(BIVSKN,.BIDE,BIFMT,"S") Q
;
;---> If format=HL7, call HL7 generator to populate ^BITMP($J,2.
;I BIFMT=2 S BIHMH=0 D ^BIHIM Q
;
;---> If format=IMM/SERVE, call ^BIEXPRT5 to populate ^BITMP($J,2
;---> with Patient Imm History in ImmServe format.
;
;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
;---> Call to new TCH Forecaster.
;I BIFMT=3 D IMMSERV^BIEXPRT5(BIFDT,$G(BIDUZ2),.BINF)
I BIFMT=3 D TCHHIST^BIEXPRT6(BIFDT,$G(BIDUZ2),.BINF)
;**********
;
Q
;
;
;----------
HISTORY1(BIVIEN,BIDE,BIFMT,BIVTYPE,BIDATA,BIERR,BISTOR) ;EP
;---> Build a record from one Imm Visit for ASCII export
;---> and set in ^BITMP($J,1/2,.
;---> NOTE: Might actually build TWO/more records if splitting out Combos.
;---> Parameters:
; 1 - BIVIEN (req) V FILE IEN for unique subscript in ^BITMP(.
; 2 - BIDE (req) Array of DATA ELEMENTS to be exported.
; 3 - BIFMT (req) Format: 0=ASCII Split, 1=ASCII, 2=HL7, 3=IMM/SERVE
; 4 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
; 5 - BIDATA (ret) Value of the built record for this visit.
; 6 - BIERR (ret) Text of Error Code if any, otherwise null.
; 7 - BISTOR (opt) Store: zero or null=store in ^BITMP; 1=don't.
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BI01 for Admin Note at 1-node.
;N BI0,BI012,BIDATE,BIVG,BISUB,BITMP,BIVPTR,N,Q,V
N BI0,BI01,BI012,BIDATE,BIVG,BISUB,BITMP,BIVPTR,N,Q,V
;
;---> Set local variables necessary for collection of Data Elements.
;---> Set subscripts and delimiters necessary for selected format.
S BIERR="",BISUB=1,Q="",V=U
;S:BIFMT=1 BISUB=2,Q="""",V="""|""" ;v8.0
S:(BIFMT=1!(BIFMT=0)) BISUB=2,Q="""",V="""|"""
;
;---> If BIVTYPE does not="I" (Immunization Visit) and it does
;---> not="S" (Skin Test Visit), then set Error Code and quit.
I ($G(BIVTYPE)'="I")&($G(BIVTYPE)'="S") D Q
.D ERRCD^BIUTL2(410,.BIERR)
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BI01 for Admin Note at 1-node.
;---> BI0=Zero node of V FILE Visit; BI012=12 node of V FILE Visit.
;S:BIVTYPE="I" BI0=$G(^AUPNVIMM(BIVIEN,0)),BI012=$G(^(12))
;S:BIVTYPE="S" BI0=$G(^AUPNVSK(BIVIEN,0)),BI012=$G(^(12))
S:BIVTYPE="I" BI0=$G(^AUPNVIMM(BIVIEN,0)),BI01=$G(^(1)),BI012=$G(^(12))
S:BIVTYPE="S" BI0=$G(^AUPNVSK(BIVIEN,0)),BI01=$G(^(1)),BI012=$G(^(12))
I BI0="" D ERRCD^BIUTL2(412,.BIERR) Q
;
;---> Quit if Format is Immserve and Vaccine is "OTHER" (HL7=0).
Q:BIFMT=3&($P(BI0,U)=137)
;
;---> BIDFN=DFN of the patient.
S BIDFN=$P(BI0,U,2)
Q:BIDFN'>0
;
;---> BIVG=Vaccine Group (for grouping).
D
.I BIVTYPE="I" S BIVG=$$IMMVG^BIUTL2($P(BI0,U),4) Q
.;---> If this is not an Immunization (i.e., is a Skin Test),
.;---> make it last in grouping order.
.S BIVG=99
;
;---> BIVPTR=Visit pointer.
S BIVPTR=$P(BI0,U,3)
;
;---> Check for valid pointer to Visit.
;---> Fixed for v8.1.
;I '$G(BIVPTR)!('$D(^AUPNVSIT(BIVPTR,0))) D ERRCD^BIUTL2(412,.BIERR) Q
I '$G(BIVPTR) D ERRCD^BIUTL2(412,.BIERR) Q
I '$D(^AUPNVSIT(BIVPTR,0)) D ERRCD^BIUTL2(412,.BIERR) Q
;
;---> BIDATE=Date of Immunization (for subscript).
S BIDATE=$P($P(^AUPNVSIT(BIVPTR,0),U),".")
;
;---> Build record according to selected Data Elements.
;S:BIFMT=1 BITMP=Q_BIVTYPE ;v8.0
S:(BIFMT=1!(BIFMT=0)) BITMP=Q_BIVTYPE
S N=0
F S N=$O(BIDE(N)) Q:'N D
.N X,Y,Z
.S Z=^BIEXPDD(N,0),Y=""
.;
.;---> If this Data Element pertains to this Visit Type (Imm or Skin),
.;---> then set Y=value; otherwise leave Y null.
.I BIVTYPE=$P(Z,U,4)!($P(Z,U,4)="A") D
..S X=$TR($P(Z,U,2),"~",U) X X
.;
.I '$D(BITMP) S BITMP=Q_Y Q
.S BITMP=BITMP_V_Y
S BIDATA=BITMP_Q
;
;---> Get possible components of this immunization.
N BICOMPS
D
.N Y,X,Z S Z=^BIEXPDD(8,0),X=$TR($P(Z,U,2),"~",U) X X
.S BICOMPS=Y
;
;---> This Visit data now ready to be returned in BIDATA.
;---> Store record in ^BITMP( for export unless BISTOR>0.
Q:$G(BISTOR)
;
;---> BISPLIT is a flag that indicates one or more components have been
;---> GLBSET; therefore do not GLBSET the combination (at end of this sub).
N BISPLIT S BISPLIT=0
;---> Only split out combos if format requests it (BIFMT)=0.
D:BIFMT=0
.N I,Y
.;---> For each possible component, set a new node in ^BITMP.
.F I=1:1:6 S Y=$P(BICOMPS,";",I) D:Y
..;
..N BIDATA1 S BIDATA1=BIDATA
..;
..;---> If Vaccine Component Name is requested, swap in Component Name.
..D:$D(BIDE(4))
...N BICOMBNM,J,K S K=0
...F J=2:1 S K=$O(BIDE(K)) Q:'K Q:K=4
...S BICOMBNM=$P(BIDATA1,V,J)
...S $P(BIDATA1,V,J)=$$VNAME^BIUTL2(Y)_" ("_BICOMBNM_")"
..;
..;---> If Vaccine Group IEN is requested, swap in Component Group IEN.
..D:$D(BIDE(55))
...N J,K S K=0
...F J=2:1 S K=$O(BIDE(K)) Q:'K Q:K=55
...S $P(BIDATA1,V,J)=$$IMMVG^BIUTL2(Y,2)
..;
..;---> If Vaccine Group is requested, swap in Component Group.
..D:$D(BIDE(27))
...N J,K S K=0
...F J=2:1 S K=$O(BIDE(K)) Q:'K Q:K=27
...S $P(BIDATA1,V,J)=$$IMMVG^BIUTL2(Y,1)
..;
..;---> If Vaccine Component CVX Code is requested, insert in Component CVX.
..D:$D(BIDE(69))
...N J,K S K=0
...F J=2:1 S K=$O(BIDE(K)) Q:'K Q:K=69
...S $P(BIDATA1,V,J)=$$CODE^BIUTL2(Y)
..;
..;---> Now get Vaccine Component Vaccine Group (for collating below).
..N BIVG S BIVG=$$IMMVG^BIUTL2(Y,4)
..;---> Add a decimal value to each component's Visit IEN for uniqueness.
..N BIVIEN1 S BIVIEN1=BIVIEN_"."_I
..D GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN1,BIDATA1)
..S BISPLIT=1
;
;---> If components have not aleady been set, then set this immunization.
D:'BISPLIT GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN,BIDATA)
Q
;
;
;----------
GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN,BIDATA) ;EP
;---> Set this immunization in the ^BITMP global.
;---> This was the point where <MXSTR> errors could occur.
;---> Allow for Maximum Global Length to be as small as 255.
;---> These nodes get picked up in +63^BIEXPRT4.
;---> Parameters:
; 1 - BISUB (req) Subnode for storing ASCII versus Immserve.
; 2 - BIDFN (req) Patient IEN.
; 3 - BIVG (req) Volume Group for this vaccine.
; 4 - BIDATE (req) Date of immunization.
; 5 - BIVIEN (req) V FILE IEN for unique subscript in ^BITMP(.
; 6 - BIDATA (req) Data string for this immunization.
;
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN)=$E(BIDATA,1,250)
Q:$L(BITMP)<251
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,1)=$E(BIDATA,251,500)
Q:$L(BITMP)<501
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,2)=$E(BIDATA,501,750)
Q:$L(BITMP)<751
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,3)=$E(BIDATA,751,1000)
Q:$L(BITMP)<1001
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,4)=$E(BIDATA,1001,1250)
Q:$L(BITMP)<1251
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,5)=$E(BIDATA,1251,1500)
Q:$L(BITMP)<1501
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,6)=$E(BIDATA,1501,1750)
Q:$L(BITMP)<1751
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,7)=$E(BIDATA,1751,2000)
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Increase nodes to accommodate Admin Notes.
Q:$L(BITMP)<2001
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,8)=$E(BIDATA,2001,2250)
Q:$L(BITMP)<2251
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,9)=$E(BIDATA,2251,2500)
Q:$L(BITMP)<2501
S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,10)=$E(BIDATA,2501,2750)
;**********
Q
;
;
;----------
HISTORY2(BIVIMM) ;EP
;---> Build a record for HL7 export and set in ^BITMP($J,1.
;---> Parameters:
; 1 - BIVIMM (req) V IMM IEN for unique subscript in ^BITMP(.
;
N BI0,BIDFN,Y
;
;---> BI0=Zero node of V IMM Visit.
S BI0=$G(^AUPNVIMM(BIVIMM,0))
Q:BI0=""
;
;---> BIDFN=DFN of the patient.
S BIDFN=$P(BI0,U,2)
Q:BIDFN'>0
;
S Y=$P($P(^AUPNVSIT($P(BI0,U,3),0),U),".") ; get visit date
S ^BITMP($J,1,BIDFN,$P(BI0,U),Y,BIVIMM)=""
Q
BIEXPRT3 ;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: GATHER IMM HISTORIES FOR PATIENTS
+4 ;; STORED IN ^BITMP(.
+5 ;; PATCH 5: Added BI01 for Admin Note at 1-node. HISTORY+20,HISTORY1+13,+29
+6 ;; PATCH 5: Increase nodes to accommodate Admin Notes. GLBSET+30
+7 ;; PATCH 8: Changes to accommodate new TCH Forecaster HISTORY+99
+8 ;
+9 ;
+10 ;----------
HISTORY(BIFMT,BIDE,BIMM,BIFDT,BISKIN,BIDUZ2,BINF) ;EP
+1 ;---> Gather Immunization History for each patient stored in
+2 ;---> ^BITMP($J,1 and store data in ^BITMP($J.
+3 ;---> Parameters:
+4 ; 1 - BIFMT (req) Format: 0=ASCII Split, 1=ASCII, 2=HL7, 3=IMM/SERVE
+5 ; 2 - BIDE (req) Data Elements array (null if HL7)
+6 ; 3 - BIMM (req) Array of Vaccine Types
+7 ; 4 - BIFDT (opt) Forecast Date (date used to calc Imms due).
+8 ; For when this call is used to pass Imm Hx
+9 ; to ImmServe for forecasting.
+10 ; 5 - BISKIN (opt) BISKIN=1 if skin tests should be included
+11 ; (ASCII Format only).
+12 ; 6 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
+13 ; Rules in Patient History data string.
+14 ; 7 - BINF (opt) Array of Vaccine Grp IEN's that should not be forecast.
+15 ;
+16 ;---> If no Forecast Date passed, set it equal to today.
+17 IF '$GET(BIFDT)
SET BIFDT=DT
+18 ;
+19 ;
+20 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+21 ;---> Added BI01 for Admin Note at 1-node.
+22 ;N BI0,BI012,BIDFN,BIVIMM,BIVSKN
+23 NEW BI0,BI01,BI012,BIDFN,BIVIMM,BIVSKN
+24 ;
+25 ;---> Do not include Skin Test in HL7 or Immserve Formats.
+26 IF BIFMT>1
SET BISKIN=0
IF '$GET(BISKIN)
SET BISKIN=0
+27 ;
+28 ;---> Gather Histories for all patients stored in ^BITMP($J,1,BIDFN.
+29 SET BIDFN=0
+30 FOR
SET BIDFN=$ORDER(^BITMP($JOB,1,BIDFN))
IF 'BIDFN
QUIT
Begin DoDot:1
+31 ;
+32 ;---> Gather Immunization History for one patient (BIDFN).
+33 SET BIVIMM=0
+34 FOR
SET BIVIMM=$ORDER(^AUPNVIMM("AC",BIDFN,BIVIMM))
IF 'BIVIMM
QUIT
Begin DoDot:2
+35 ;
+36 ;---> Gather Immunization data for one visit.
+37 ;---> If this is an invalid pointer, clean up and quit.
+38 NEW BIVDATA
SET BIVDATA=$GET(^AUPNVIMM(BIVIMM,0))
+39 IF BIVDATA=""
KILL ^AUPNVIMM("AC",BIDFN,BIVIMM)
QUIT
+40 IF $PIECE(BIVDATA,U,2)'=BIDFN
KILL ^AUPNVIMM("AC",BIDFN,BIVIMM)
QUIT
+41 ;
+42 ;---> Quit if not selecting all Immunization Types and if this
+43 ;---> record is not one of the Immunization Types selected.
+44 IF '$DATA(BIMM("ALL"))
IF '$DATA(BIMM(+BIVDATA))
QUIT
+45 ;
+46 ;---> Don't pass this if format is ImmServe and it is HL7=0, "OTHER".
+47 IF BIFMT=3
IF +BIVDATA=137
QUIT
+48 ;
+49 ;---> If format=0 or 1, build ASCII record; format=3 build IMM/SERVE rec.
+50 ;I BIFMT=1!(BIFMT=3) D HISTORY1(BIVIMM,.BIDE,BIFMT,"I") Q ;v8.0
+51 IF BIFMT'=2
DO HISTORY1(BIVIMM,.BIDE,BIFMT,"I")
QUIT
+52 ;
+53 ;---> If format=2, build HL7 record.
+54 IF BIFMT=2
DO HISTORY2(BIVIMM)
QUIT
End DoDot:2
+55 ;
+56 ;
+57 ;---> NEXT SECTION IS ONLY FOR GATHERING PATIENT SKIN TESTS
+58 ;---> TO RETURN IN ASCII CSV.
+59 ;---> Quit if not gathering Skin Test history.
+60 IF 'BISKIN
QUIT
+61 ;
+62 ;---> Gather Skin Test History for one patient (BIDFN).
+63 ;
+64 ;---> If BIDE local array for Data Elements is not passed, set
+65 ;---> the following Data Elements to be returned by default.
+66 ;---> The following are IEN's in ^BIEXPDD(.
+67 ;---> IEN PC DATA
+68 ;---> --- -- ----
+69 ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
+70 ;---> 24 2 = IEN, V File Visit.
+71 ;---> 26 3 = Location (or Outside Location) of Visit.
+72 ;---> 29 4 = Date of Visit (DD-Mmm-YYYY @HHMM).
+73 ;---> 38 5 = Skin Test Result.
+74 ;---> 39 6 = Skin Test Reading.
+75 ;---> 40 7 = Skin Test date read.
+76 ;---> 41 8 = Skin Test Name.
+77 ;---> 42 9 = Skin Test Name IEN.
+78 ;
+79 IF '$DATA(BIDE)
Begin DoDot:2
+80 NEW I
FOR I=24,26,29,38,39,40,41
SET BIDE(I)=""
End DoDot:2
+81 ;
+82 SET BIVSKN=0
+83 FOR
SET BIVSKN=$ORDER(^AUPNVSK("AC",BIDFN,BIVSKN))
IF 'BIVSKN
QUIT
Begin DoDot:2
+84 ;
+85 ;---> Gather Skin Test data for one visit.
+86 ;---> If this is an invalid pointer, clean up and quit.
+87 IF '$DATA(^AUPNVSK(BIVSKN,0))
KILL ^AUPNVSK("AC",BIDFN,BIVSKN)
QUIT
+88 IF $PIECE(^AUPNVSK(BIVSKN,0),U,2)'=BIDFN
KILL ^AUPNVSK("AC",BIDFN,BIVSKN)
QUIT
+89 ;
+90 ;---> If format=1, build ASCII record.
+91 DO HISTORY1(BIVSKN,.BIDE,BIFMT,"S")
QUIT
End DoDot:2
End DoDot:1
+92 ;
+93 ;---> If format=HL7, call HL7 generator to populate ^BITMP($J,2.
+94 ;I BIFMT=2 S BIHMH=0 D ^BIHIM Q
+95 ;
+96 ;---> If format=IMM/SERVE, call ^BIEXPRT5 to populate ^BITMP($J,2
+97 ;---> with Patient Imm History in ImmServe format.
+98 ;
+99 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
+100 ;---> Call to new TCH Forecaster.
+101 ;I BIFMT=3 D IMMSERV^BIEXPRT5(BIFDT,$G(BIDUZ2),.BINF)
+102 IF BIFMT=3
DO TCHHIST^BIEXPRT6(BIFDT,$GET(BIDUZ2),.BINF)
+103 ;**********
+104 ;
+105 QUIT
+106 ;
+107 ;
+108 ;----------
HISTORY1(BIVIEN,BIDE,BIFMT,BIVTYPE,BIDATA,BIERR,BISTOR) ;EP
+1 ;---> Build a record from one Imm Visit for ASCII export
+2 ;---> and set in ^BITMP($J,1/2,.
+3 ;---> NOTE: Might actually build TWO/more records if splitting out Combos.
+4 ;---> Parameters:
+5 ; 1 - BIVIEN (req) V FILE IEN for unique subscript in ^BITMP(.
+6 ; 2 - BIDE (req) Array of DATA ELEMENTS to be exported.
+7 ; 3 - BIFMT (req) Format: 0=ASCII Split, 1=ASCII, 2=HL7, 3=IMM/SERVE
+8 ; 4 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
+9 ; 5 - BIDATA (ret) Value of the built record for this visit.
+10 ; 6 - BIERR (ret) Text of Error Code if any, otherwise null.
+11 ; 7 - BISTOR (opt) Store: zero or null=store in ^BITMP; 1=don't.
+12 ;
+13 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+14 ;---> Added BI01 for Admin Note at 1-node.
+15 ;N BI0,BI012,BIDATE,BIVG,BISUB,BITMP,BIVPTR,N,Q,V
+16 NEW BI0,BI01,BI012,BIDATE,BIVG,BISUB,BITMP,BIVPTR,N,Q,V
+17 ;
+18 ;---> Set local variables necessary for collection of Data Elements.
+19 ;---> Set subscripts and delimiters necessary for selected format.
+20 SET BIERR=""
SET BISUB=1
SET Q=""
SET V=U
+21 ;S:BIFMT=1 BISUB=2,Q="""",V="""|""" ;v8.0
+22 IF (BIFMT=1!(BIFMT=0))
SET BISUB=2
SET Q=""""
SET V="""|"""
+23 ;
+24 ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
+25 ;---> not="S" (Skin Test Visit), then set Error Code and quit.
+26 IF ($GET(BIVTYPE)'="I")&($GET(BIVTYPE)'="S")
Begin DoDot:1
+27 DO ERRCD^BIUTL2(410,.BIERR)
End DoDot:1
QUIT
+28 ;
+29 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+30 ;---> Added BI01 for Admin Note at 1-node.
+31 ;---> BI0=Zero node of V FILE Visit; BI012=12 node of V FILE Visit.
+32 ;S:BIVTYPE="I" BI0=$G(^AUPNVIMM(BIVIEN,0)),BI012=$G(^(12))
+33 ;S:BIVTYPE="S" BI0=$G(^AUPNVSK(BIVIEN,0)),BI012=$G(^(12))
+34 IF BIVTYPE="I"
SET BI0=$GET(^AUPNVIMM(BIVIEN,0))
SET BI01=$GET(^(1))
SET BI012=$GET(^(12))
+35 IF BIVTYPE="S"
SET BI0=$GET(^AUPNVSK(BIVIEN,0))
SET BI01=$GET(^(1))
SET BI012=$GET(^(12))
+36 IF BI0=""
DO ERRCD^BIUTL2(412,.BIERR)
QUIT
+37 ;
+38 ;---> Quit if Format is Immserve and Vaccine is "OTHER" (HL7=0).
+39 IF BIFMT=3&($PIECE(BI0,U)=137)
QUIT
+40 ;
+41 ;---> BIDFN=DFN of the patient.
+42 SET BIDFN=$PIECE(BI0,U,2)
+43 IF BIDFN'>0
QUIT
+44 ;
+45 ;---> BIVG=Vaccine Group (for grouping).
+46 Begin DoDot:1
+47 IF BIVTYPE="I"
SET BIVG=$$IMMVG^BIUTL2($PIECE(BI0,U),4)
QUIT
+48 ;---> If this is not an Immunization (i.e., is a Skin Test),
+49 ;---> make it last in grouping order.
+50 SET BIVG=99
End DoDot:1
+51 ;
+52 ;---> BIVPTR=Visit pointer.
+53 SET BIVPTR=$PIECE(BI0,U,3)
+54 ;
+55 ;---> Check for valid pointer to Visit.
+56 ;---> Fixed for v8.1.
+57 ;I '$G(BIVPTR)!('$D(^AUPNVSIT(BIVPTR,0))) D ERRCD^BIUTL2(412,.BIERR) Q
+58 IF '$GET(BIVPTR)
DO ERRCD^BIUTL2(412,.BIERR)
QUIT
+59 IF '$DATA(^AUPNVSIT(BIVPTR,0))
DO ERRCD^BIUTL2(412,.BIERR)
QUIT
+60 ;
+61 ;---> BIDATE=Date of Immunization (for subscript).
+62 SET BIDATE=$PIECE($PIECE(^AUPNVSIT(BIVPTR,0),U),".")
+63 ;
+64 ;---> Build record according to selected Data Elements.
+65 ;S:BIFMT=1 BITMP=Q_BIVTYPE ;v8.0
+66 IF (BIFMT=1!(BIFMT=0))
SET BITMP=Q_BIVTYPE
+67 SET N=0
+68 FOR
SET N=$ORDER(BIDE(N))
IF 'N
QUIT
Begin DoDot:1
+69 NEW X,Y,Z
+70 SET Z=^BIEXPDD(N,0)
SET Y=""
+71 ;
+72 ;---> If this Data Element pertains to this Visit Type (Imm or Skin),
+73 ;---> then set Y=value; otherwise leave Y null.
+74 IF BIVTYPE=$PIECE(Z,U,4)!($PIECE(Z,U,4)="A")
Begin DoDot:2
+75 SET X=$TRANSLATE($PIECE(Z,U,2),"~",U)
XECUTE X
End DoDot:2
+76 ;
+77 IF '$DATA(BITMP)
SET BITMP=Q_Y
QUIT
+78 SET BITMP=BITMP_V_Y
End DoDot:1
+79 SET BIDATA=BITMP_Q
+80 ;
+81 ;---> Get possible components of this immunization.
+82 NEW BICOMPS
+83 Begin DoDot:1
+84 NEW Y,X,Z
SET Z=^BIEXPDD(8,0)
SET X=$TRANSLATE($PIECE(Z,U,2),"~",U)
XECUTE X
+85 SET BICOMPS=Y
End DoDot:1
+86 ;
+87 ;---> This Visit data now ready to be returned in BIDATA.
+88 ;---> Store record in ^BITMP( for export unless BISTOR>0.
+89 IF $GET(BISTOR)
QUIT
+90 ;
+91 ;---> BISPLIT is a flag that indicates one or more components have been
+92 ;---> GLBSET; therefore do not GLBSET the combination (at end of this sub).
+93 NEW BISPLIT
SET BISPLIT=0
+94 ;---> Only split out combos if format requests it (BIFMT)=0.
+95 IF BIFMT=0
Begin DoDot:1
+96 NEW I,Y
+97 ;---> For each possible component, set a new node in ^BITMP.
+98 FOR I=1:1:6
SET Y=$PIECE(BICOMPS,";",I)
IF Y
Begin DoDot:2
+99 ;
+100 NEW BIDATA1
SET BIDATA1=BIDATA
+101 ;
+102 ;---> If Vaccine Component Name is requested, swap in Component Name.
+103 IF $DATA(BIDE(4))
Begin DoDot:3
+104 NEW BICOMBNM,J,K
SET K=0
+105 FOR J=2:1
SET K=$ORDER(BIDE(K))
IF 'K
QUIT
IF K=4
QUIT
+106 SET BICOMBNM=$PIECE(BIDATA1,V,J)
+107 SET $PIECE(BIDATA1,V,J)=$$VNAME^BIUTL2(Y)_" ("_BICOMBNM_")"
End DoDot:3
+108 ;
+109 ;---> If Vaccine Group IEN is requested, swap in Component Group IEN.
+110 IF $DATA(BIDE(55))
Begin DoDot:3
+111 NEW J,K
SET K=0
+112 FOR J=2:1
SET K=$ORDER(BIDE(K))
IF 'K
QUIT
IF K=55
QUIT
+113 SET $PIECE(BIDATA1,V,J)=$$IMMVG^BIUTL2(Y,2)
End DoDot:3
+114 ;
+115 ;---> If Vaccine Group is requested, swap in Component Group.
+116 IF $DATA(BIDE(27))
Begin DoDot:3
+117 NEW J,K
SET K=0
+118 FOR J=2:1
SET K=$ORDER(BIDE(K))
IF 'K
QUIT
IF K=27
QUIT
+119 SET $PIECE(BIDATA1,V,J)=$$IMMVG^BIUTL2(Y,1)
End DoDot:3
+120 ;
+121 ;---> If Vaccine Component CVX Code is requested, insert in Component CVX.
+122 IF $DATA(BIDE(69))
Begin DoDot:3
+123 NEW J,K
SET K=0
+124 FOR J=2:1
SET K=$ORDER(BIDE(K))
IF 'K
QUIT
IF K=69
QUIT
+125 SET $PIECE(BIDATA1,V,J)=$$CODE^BIUTL2(Y)
End DoDot:3
+126 ;
+127 ;---> Now get Vaccine Component Vaccine Group (for collating below).
+128 NEW BIVG
SET BIVG=$$IMMVG^BIUTL2(Y,4)
+129 ;---> Add a decimal value to each component's Visit IEN for uniqueness.
+130 NEW BIVIEN1
SET BIVIEN1=BIVIEN_"."_I
+131 DO GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN1,BIDATA1)
+132 SET BISPLIT=1
End DoDot:2
End DoDot:1
+133 ;
+134 ;---> If components have not aleady been set, then set this immunization.
+135 IF 'BISPLIT
DO GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN,BIDATA)
+136 QUIT
+137 ;
+138 ;
+139 ;----------
GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN,BIDATA) ;EP
+1 ;---> Set this immunization in the ^BITMP global.
+2 ;---> This was the point where <MXSTR> errors could occur.
+3 ;---> Allow for Maximum Global Length to be as small as 255.
+4 ;---> These nodes get picked up in +63^BIEXPRT4.
+5 ;---> Parameters:
+6 ; 1 - BISUB (req) Subnode for storing ASCII versus Immserve.
+7 ; 2 - BIDFN (req) Patient IEN.
+8 ; 3 - BIVG (req) Volume Group for this vaccine.
+9 ; 4 - BIDATE (req) Date of immunization.
+10 ; 5 - BIVIEN (req) V FILE IEN for unique subscript in ^BITMP(.
+11 ; 6 - BIDATA (req) Data string for this immunization.
+12 ;
+13 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN)=$EXTRACT(BIDATA,1,250)
+14 IF $LENGTH(BITMP)<251
QUIT
+15 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,1)=$EXTRACT(BIDATA,251,500)
+16 IF $LENGTH(BITMP)<501
QUIT
+17 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,2)=$EXTRACT(BIDATA,501,750)
+18 IF $LENGTH(BITMP)<751
QUIT
+19 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,3)=$EXTRACT(BIDATA,751,1000)
+20 IF $LENGTH(BITMP)<1001
QUIT
+21 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,4)=$EXTRACT(BIDATA,1001,1250)
+22 IF $LENGTH(BITMP)<1251
QUIT
+23 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,5)=$EXTRACT(BIDATA,1251,1500)
+24 IF $LENGTH(BITMP)<1501
QUIT
+25 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,6)=$EXTRACT(BIDATA,1501,1750)
+26 IF $LENGTH(BITMP)<1751
QUIT
+27 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,7)=$EXTRACT(BIDATA,1751,2000)
+28 ;
+29 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+30 ;---> Increase nodes to accommodate Admin Notes.
+31 IF $LENGTH(BITMP)<2001
QUIT
+32 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,8)=$EXTRACT(BIDATA,2001,2250)
+33 IF $LENGTH(BITMP)<2251
QUIT
+34 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,9)=$EXTRACT(BIDATA,2251,2500)
+35 IF $LENGTH(BITMP)<2501
QUIT
+36 SET ^BITMP($JOB,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,10)=$EXTRACT(BIDATA,2501,2750)
+37 ;**********
+38 QUIT
+39 ;
+40 ;
+41 ;----------
HISTORY2(BIVIMM) ;EP
+1 ;---> Build a record for HL7 export and set in ^BITMP($J,1.
+2 ;---> Parameters:
+3 ; 1 - BIVIMM (req) V IMM IEN for unique subscript in ^BITMP(.
+4 ;
+5 NEW BI0,BIDFN,Y
+6 ;
+7 ;---> BI0=Zero node of V IMM Visit.
+8 SET BI0=$GET(^AUPNVIMM(BIVIMM,0))
+9 IF BI0=""
QUIT
+10 ;
+11 ;---> BIDFN=DFN of the patient.
+12 SET BIDFN=$PIECE(BI0,U,2)
+13 IF BIDFN'>0
QUIT
+14 ;
+15 ; get visit date
SET Y=$PIECE($PIECE(^AUPNVSIT($PIECE(BI0,U,3),0),U),".")
+16 SET ^BITMP($JOB,1,BIDFN,$PIECE(BI0,U),Y,BIVIMM)=""
+17 QUIT
