Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BIEXPRT3

BIEXPRT3.m

Go to the documentation of this file. 
  1. BIEXPRT3 ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**8**;MAR 15,2014
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  EXPORT IMMUNIZATION RECORDS: GATHER IMM HISTORIES FOR PATIENTS
  1.  ;;  STORED IN ^BITMP(.
  1.  ;;  PATCH 5: Added BI01 for Admin Note at 1-node.  HISTORY+20,HISTORY1+13,+29
  1.  ;;  PATCH 5: Increase nodes to accommodate Admin Notes.  GLBSET+30
  1.  ;;  PATCH 8: Changes to accommodate new TCH Forecaster   HISTORY+99
  1.  ;
  1.  ;
  1.  ;----------
  1. HISTORY(BIFMT,BIDE,BIMM,BIFDT,BISKIN,BIDUZ2,BINF) ;EP
  1.  ;---> Gather Immunization History for each patient stored in
  1.  ;---> ^BITMP($J,1 and store data in ^BITMP($J.
  1.  ;---> Parameters:
  1.  ;     1 - BIFMT  (req) Format: 0=ASCII Split, 1=ASCII, 2=HL7, 3=IMM/SERVE
  1.  ;     2 - BIDE   (req) Data Elements array (null if HL7)
  1.  ;     3 - BIMM   (req) Array of Vaccine Types
  1.  ;     4 - BIFDT  (opt) Forecast Date (date used to calc Imms due).
  1.  ;                      For when this call is used to pass Imm Hx
  1.  ;                      to ImmServe for forecasting.
  1.  ;     5 - BISKIN (opt) BISKIN=1 if skin tests should be included
  1.  ;                      (ASCII Format only).
  1.  ;     6 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
  1.  ;                      Rules in Patient History data string.
  1.  ;     7 - BINF   (opt) Array of Vaccine Grp IEN's that should not be forecast.
  1.  ;
  1.  ;---> If no Forecast Date passed, set it equal to today.
  1.  S:'$G(BIFDT) BIFDT=DT
  1.  ;
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> Added BI01 for Admin Note at 1-node.
  1.  ;N BI0,BI012,BIDFN,BIVIMM,BIVSKN
  1.  N BI0,BI01,BI012,BIDFN,BIVIMM,BIVSKN
  1.  ;
  1.  ;---> Do not include Skin Test in HL7 or Immserve Formats.
  1.  S:BIFMT>1 BISKIN=0 S:'$G(BISKIN) BISKIN=0
  1.  ;
  1.  ;---> Gather Histories for all patients stored in ^BITMP($J,1,BIDFN.
  1.  S BIDFN=0
  1.  F  S BIDFN=$O(^BITMP($J,1,BIDFN)) Q:'BIDFN  D
  1.  .;
  1.  .;---> Gather Immunization History for one patient (BIDFN).
  1.  .S BIVIMM=0
  1.  .F  S BIVIMM=$O(^AUPNVIMM("AC",BIDFN,BIVIMM)) Q:'BIVIMM  D
  1.  ..;
  1.  ..;---> Gather Immunization data for one visit.
  1.  ..;---> If this is an invalid pointer, clean up and quit.
  1.  ..N BIVDATA  S BIVDATA=$G(^AUPNVIMM(BIVIMM,0))
  1.  ..I BIVDATA="" K ^AUPNVIMM("AC",BIDFN,BIVIMM) Q
  1.  ..I $P(BIVDATA,U,2)'=BIDFN K ^AUPNVIMM("AC",BIDFN,BIVIMM) Q
  1.  ..;
  1.  ..;---> Quit if not selecting all Immunization Types and if this
  1.  ..;---> record is not one of the Immunization Types selected.
  1.  ..I '$D(BIMM("ALL")) Q:'$D(BIMM(+BIVDATA))
  1.  ..;
  1.  ..;---> Don't pass this if format is ImmServe and it is HL7=0, "OTHER".
  1.  ..I BIFMT=3 Q:+BIVDATA=137
  1.  ..;
  1.  ..;---> If format=0 or 1, build ASCII record; format=3 build IMM/SERVE rec.
  1.  ..;I BIFMT=1!(BIFMT=3) D HISTORY1(BIVIMM,.BIDE,BIFMT,"I") Q  ;v8.0
  1.  ..I BIFMT'=2 D HISTORY1(BIVIMM,.BIDE,BIFMT,"I") Q
  1.  ..;
  1.  ..;---> If format=2, build HL7 record.
  1.  ..I BIFMT=2 D HISTORY2(BIVIMM) Q
  1.  .;
  1.  .;
  1.  .;---> NEXT SECTION IS ONLY FOR GATHERING PATIENT SKIN TESTS
  1.  .;---> TO RETURN IN ASCII CSV.
  1.  .;---> Quit if not gathering Skin Test history.
  1.  .Q:'BISKIN
  1.  .;
  1.  .;---> Gather Skin Test History for one patient (BIDFN).
  1.  .;
  1.  .;---> If BIDE local array for Data Elements is not passed, set
  1.  .;---> the following Data Elements to be returned by default.
  1.  .;---> The following are IEN's in ^BIEXPDD(.
  1.  .;---> IEN PC  DATA
  1.  .;---> --- --  ----
  1.  .;--->     1 = Visit Type: "I"=Immunization, "S"=Skin Test.
  1.  .;---> 24  2 = IEN, V File Visit.
  1.  .;---> 26  3 = Location (or Outside Location) of Visit.
  1.  .;---> 29  4 = Date of Visit (DD-Mmm-YYYY @HHMM).
  1.  .;---> 38  5 = Skin Test Result.
  1.  .;---> 39  6 = Skin Test Reading.
  1.  .;---> 40  7 = Skin Test date read.
  1.  .;---> 41  8 = Skin Test Name.
  1.  .;---> 42  9 = Skin Test Name IEN.
  1.  .;
  1.  .D:'$D(BIDE)
  1.  ..N I F I=24,26,29,38,39,40,41 S BIDE(I)=""
  1.  .;
  1.  .S BIVSKN=0
  1.  .F  S BIVSKN=$O(^AUPNVSK("AC",BIDFN,BIVSKN)) Q:'BIVSKN  D
  1.  ..;
  1.  ..;---> Gather Skin Test data for one visit.
  1.  ..;---> If this is an invalid pointer, clean up and quit.
  1.  ..I '$D(^AUPNVSK(BIVSKN,0)) K ^AUPNVSK("AC",BIDFN,BIVSKN) Q
  1.  ..I $P(^AUPNVSK(BIVSKN,0),U,2)'=BIDFN K ^AUPNVSK("AC",BIDFN,BIVSKN) Q
  1.  ..;
  1.  ..;---> If format=1, build ASCII record.
  1.  ..D HISTORY1(BIVSKN,.BIDE,BIFMT,"S") Q
  1.  ;
  1.  ;---> If format=HL7, call HL7 generator to populate ^BITMP($J,2.
  1.  ;I BIFMT=2 S BIHMH=0 D ^BIHIM Q
  1.  ;
  1.  ;---> If format=IMM/SERVE, call ^BIEXPRT5 to populate ^BITMP($J,2
  1.  ;---> with Patient Imm History in ImmServe format.
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Call to new TCH Forecaster.
  1.  ;I BIFMT=3 D IMMSERV^BIEXPRT5(BIFDT,$G(BIDUZ2),.BINF)
  1.  I BIFMT=3 D TCHHIST^BIEXPRT6(BIFDT,$G(BIDUZ2),.BINF)
  1.  ;**********
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HISTORY1(BIVIEN,BIDE,BIFMT,BIVTYPE,BIDATA,BIERR,BISTOR) ;EP
  1.  ;---> Build a record from one Imm Visit for ASCII export
  1.  ;---> and set in ^BITMP($J,1/2,.
  1.  ;---> NOTE: Might actually build TWO/more records if splitting out Combos.
  1.  ;---> Parameters:
  1.  ;     1 - BIVIEN  (req) V FILE IEN for unique subscript in ^BITMP(.
  1.  ;     2 - BIDE    (req) Array of DATA ELEMENTS to be exported.
  1.  ;     3 - BIFMT   (req) Format: 0=ASCII Split, 1=ASCII, 2=HL7, 3=IMM/SERVE
  1.  ;     4 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
  1.  ;     5 - BIDATA  (ret) Value of the built record for this visit.
  1.  ;     6 - BIERR   (ret) Text of Error Code if any, otherwise null.
  1.  ;     7 - BISTOR  (opt) Store: zero or null=store in ^BITMP; 1=don't.
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> Added BI01 for Admin Note at 1-node.
  1.  ;N BI0,BI012,BIDATE,BIVG,BISUB,BITMP,BIVPTR,N,Q,V
  1.  N BI0,BI01,BI012,BIDATE,BIVG,BISUB,BITMP,BIVPTR,N,Q,V
  1.  ;
  1.  ;---> Set local variables necessary for collection of Data Elements.
  1.  ;---> Set subscripts and delimiters necessary for selected format.
  1.  S BIERR="",BISUB=1,Q="",V=U
  1.  ;S:BIFMT=1 BISUB=2,Q="""",V="""|"""  ;v8.0
  1.  S:(BIFMT=1!(BIFMT=0)) BISUB=2,Q="""",V="""|"""
  1.  ;
  1.  ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
  1.  ;---> not="S" (Skin Test Visit), then set Error Code and quit.
  1.  I ($G(BIVTYPE)'="I")&($G(BIVTYPE)'="S") D  Q
  1.  .D ERRCD^BIUTL2(410,.BIERR)
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> Added BI01 for Admin Note at 1-node.
  1.  ;---> BI0=Zero node of V FILE Visit; BI012=12 node of V FILE Visit.
  1.  ;S:BIVTYPE="I" BI0=$G(^AUPNVIMM(BIVIEN,0)),BI012=$G(^(12))
  1.  ;S:BIVTYPE="S" BI0=$G(^AUPNVSK(BIVIEN,0)),BI012=$G(^(12))
  1.  S:BIVTYPE="I" BI0=$G(^AUPNVIMM(BIVIEN,0)),BI01=$G(^(1)),BI012=$G(^(12))
  1.  S:BIVTYPE="S" BI0=$G(^AUPNVSK(BIVIEN,0)),BI01=$G(^(1)),BI012=$G(^(12))
  1.  I BI0="" D ERRCD^BIUTL2(412,.BIERR) Q
  1.  ;
  1.  ;---> Quit if Format is Immserve and Vaccine is "OTHER" (HL7=0).
  1.  Q:BIFMT=3&($P(BI0,U)=137)
  1.  ;
  1.  ;---> BIDFN=DFN of the patient.
  1.  S BIDFN=$P(BI0,U,2)
  1.  Q:BIDFN'>0
  1.  ;
  1.  ;---> BIVG=Vaccine Group (for grouping).
  1.  D
  1.  .I BIVTYPE="I" S BIVG=$$IMMVG^BIUTL2($P(BI0,U),4) Q
  1.  .;---> If this is not an Immunization (i.e., is a Skin Test),
  1.  .;---> make it last in grouping order.
  1.  .S BIVG=99
  1.  ;
  1.  ;---> BIVPTR=Visit pointer.
  1.  S BIVPTR=$P(BI0,U,3)
  1.  ;
  1.  ;---> Check for valid pointer to Visit.
  1.  ;---> Fixed for v8.1.
  1.  ;I '$G(BIVPTR)!('$D(^AUPNVSIT(BIVPTR,0))) D ERRCD^BIUTL2(412,.BIERR) Q
  1.  I '$G(BIVPTR) D ERRCD^BIUTL2(412,.BIERR) Q
  1.  I '$D(^AUPNVSIT(BIVPTR,0)) D ERRCD^BIUTL2(412,.BIERR) Q
  1.  ;
  1.  ;---> BIDATE=Date of Immunization (for subscript).
  1.  S BIDATE=$P($P(^AUPNVSIT(BIVPTR,0),U),".")
  1.  ;
  1.  ;---> Build record according to selected Data Elements.
  1.  ;S:BIFMT=1 BITMP=Q_BIVTYPE  ;v8.0
  1.  S:(BIFMT=1!(BIFMT=0)) BITMP=Q_BIVTYPE
  1.  S N=0
  1.  F  S N=$O(BIDE(N)) Q:'N  D
  1.  .N X,Y,Z
  1.  .S Z=^BIEXPDD(N,0),Y=""
  1.  .;
  1.  .;---> If this Data Element pertains to this Visit Type (Imm or Skin),
  1.  .;---> then set Y=value; otherwise leave Y null.
  1.  .I BIVTYPE=$P(Z,U,4)!($P(Z,U,4)="A") D
  1.  ..S X=$TR($P(Z,U,2),"~",U) X X
  1.  .;
  1.  .I '$D(BITMP) S BITMP=Q_Y Q
  1.  .S BITMP=BITMP_V_Y
  1.  S BIDATA=BITMP_Q
  1.  ;
  1.  ;---> Get possible components of this immunization.
  1.  N BICOMPS
  1.  D
  1.  .N Y,X,Z S Z=^BIEXPDD(8,0),X=$TR($P(Z,U,2),"~",U) X X
  1.  .S BICOMPS=Y
  1.  ;
  1.  ;---> This Visit data now ready to be returned in BIDATA.
  1.  ;---> Store record in ^BITMP( for export unless BISTOR>0.
  1.  Q:$G(BISTOR)
  1.  ;
  1.  ;---> BISPLIT is a flag that indicates one or more components have been
  1.  ;---> GLBSET; therefore do not GLBSET the combination (at end of this sub).
  1.  N BISPLIT S BISPLIT=0
  1.  ;---> Only split out combos if format requests it (BIFMT)=0.
  1.  D:BIFMT=0
  1.  .N I,Y
  1.  .;---> For each possible component, set a new node in ^BITMP.
  1.  .F I=1:1:6 S Y=$P(BICOMPS,";",I) D:Y
  1.  ..;
  1.  ..N BIDATA1 S BIDATA1=BIDATA
  1.  ..;
  1.  ..;---> If Vaccine Component Name is requested, swap in Component Name.
  1.  ..D:$D(BIDE(4))
  1.  ...N BICOMBNM,J,K S K=0
  1.  ...F J=2:1 S K=$O(BIDE(K)) Q:'K  Q:K=4
  1.  ...S BICOMBNM=$P(BIDATA1,V,J)
  1.  ...S $P(BIDATA1,V,J)=$$VNAME^BIUTL2(Y)_" ("_BICOMBNM_")"
  1.  ..;
  1.  ..;---> If Vaccine Group IEN is requested, swap in Component Group IEN.
  1.  ..D:$D(BIDE(55))
  1.  ...N J,K S K=0
  1.  ...F J=2:1 S K=$O(BIDE(K)) Q:'K  Q:K=55
  1.  ...S $P(BIDATA1,V,J)=$$IMMVG^BIUTL2(Y,2)
  1.  ..;
  1.  ..;---> If Vaccine Group is requested, swap in Component Group.
  1.  ..D:$D(BIDE(27))
  1.  ...N J,K S K=0
  1.  ...F J=2:1 S K=$O(BIDE(K)) Q:'K  Q:K=27
  1.  ...S $P(BIDATA1,V,J)=$$IMMVG^BIUTL2(Y,1)
  1.  ..;
  1.  ..;---> If Vaccine Component CVX Code is requested, insert in Component CVX.
  1.  ..D:$D(BIDE(69))
  1.  ...N J,K S K=0
  1.  ...F J=2:1 S K=$O(BIDE(K)) Q:'K  Q:K=69
  1.  ...S $P(BIDATA1,V,J)=$$CODE^BIUTL2(Y)
  1.  ..;
  1.  ..;---> Now get Vaccine Component Vaccine Group (for collating below).
  1.  ..N BIVG S BIVG=$$IMMVG^BIUTL2(Y,4)
  1.  ..;---> Add a decimal value to each component's Visit IEN for uniqueness.
  1.  ..N BIVIEN1 S BIVIEN1=BIVIEN_"."_I
  1.  ..D GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN1,BIDATA1)
  1.  ..S BISPLIT=1
  1.  ;
  1.  ;---> If components have not aleady been set, then set this immunization.
  1.  D:'BISPLIT GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN,BIDATA)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. GLBSET(BISUB,BIDFN,BIVG,BIDATE,BIVIEN,BIDATA) ;EP
  1.  ;---> Set this immunization in the ^BITMP global.
  1.  ;---> This was the point where <MXSTR> errors could occur.
  1.  ;---> Allow for Maximum Global Length to be as small as 255.
  1.  ;---> These nodes get picked up in +63^BIEXPRT4.
  1.  ;---> Parameters:
  1.  ;     1 - BISUB  (req) Subnode for storing ASCII versus Immserve.
  1.  ;     2 - BIDFN  (req) Patient IEN.
  1.  ;     3 - BIVG   (req) Volume Group for this vaccine.
  1.  ;     4 - BIDATE (req) Date of immunization.
  1.  ;     5 - BIVIEN (req) V FILE IEN for unique subscript in ^BITMP(.
  1.  ;     6 - BIDATA (req) Data string for this immunization.
  1.  ;
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN)=$E(BIDATA,1,250)
  1.  Q:$L(BITMP)<251
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,1)=$E(BIDATA,251,500)
  1.  Q:$L(BITMP)<501
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,2)=$E(BIDATA,501,750)
  1.  Q:$L(BITMP)<751
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,3)=$E(BIDATA,751,1000)
  1.  Q:$L(BITMP)<1001
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,4)=$E(BIDATA,1001,1250)
  1.  Q:$L(BITMP)<1251
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,5)=$E(BIDATA,1251,1500)
  1.  Q:$L(BITMP)<1501
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,6)=$E(BIDATA,1501,1750)
  1.  Q:$L(BITMP)<1751
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,7)=$E(BIDATA,1751,2000)
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> Increase nodes to accommodate Admin Notes.
  1.  Q:$L(BITMP)<2001
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,8)=$E(BIDATA,2001,2250)
  1.  Q:$L(BITMP)<2251
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,9)=$E(BIDATA,2251,2500)
  1.  Q:$L(BITMP)<2501
  1.  S ^BITMP($J,BISUB,BIDFN,BIVG,BIDATE,BIVIEN,10)=$E(BIDATA,2501,2750)
  1.  ;**********
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HISTORY2(BIVIMM) ;EP
  1.  ;---> Build a record for HL7 export and set in ^BITMP($J,1.
  1.  ;---> Parameters:
  1.  ;     1 - BIVIMM (req) V IMM IEN for unique subscript in ^BITMP(.
  1.  ;
  1.  N BI0,BIDFN,Y
  1.  ;
  1.  ;---> BI0=Zero node of V IMM Visit.
  1.  S BI0=$G(^AUPNVIMM(BIVIMM,0))
  1.  Q:BI0=""
  1.  ;
  1.  ;---> BIDFN=DFN of the patient.
  1.  S BIDFN=$P(BI0,U,2)
  1.  Q:BIDFN'>0
  1.  ;
  1.  S Y=$P($P(^AUPNVSIT($P(BI0,U,3),0),U),".") ;   get visit date
  1.  S ^BITMP($J,1,BIDFN,$P(BI0,U),Y,BIVIMM)=""
  1.  Q