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

VPSSEND.m

Go to the documentation of this file. 
  1. VPSSEND ;SLOIFO/BT - Send HL7 messages (Appointment Status Change) to VetLink HL7 Server ;01/16/2015 11:23
  1.  ;;1.0;VA POINT OF SERVICE (KIOSKS);**5**;Jan 16, 2015;Build 31
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; External Reference DBIA#
  1.  ; ------------------------
  1.  ; #1496  - ^HLCS(870,            (Controlled Subs)
  1.  ; #2171  - $$NS^XUAF4            (Supported)
  1.  ; #2462  - ^DGEN( reference      (Controlled Sub) 
  1.  ; #2541  - $$KSP^XUPARAM         (Supported)
  1.  ; #3065  - STDNAME^XLFNAME       (Supported)
  1.  ; #4080  - $$BADADR^DGUTL3       (Supported)
  1.  ; #4433  - SDAMA301 call         (Supported)
  1.  ; #4716  - $$NEWMSG^HLOAPI       (Supported)
  1.  ; #4716  - $$SET^HLOAPI          (Supported)
  1.  ; #4716  - $$ADDSEG^HLOAPI       (Supported)
  1.  ; #4717  - $$SENDONE^HLOAPI1     (Supported)
  1.  ; #4730  - HLOQUE                (Supported)
  1.  ; #4853  - $$SETDT^HLOAPI4       (Supported)
  1.  ; #10040 - ^SC( references       (Supported)
  1.  ; #10063 - %ZTLOAD               (Supported)
  1.  ; #6137  - File 2.98, Field 17 (Cancellation Remark) (Private)
  1.  ; #6122  - locking/unlocking ^HLB("QUEUE","OUT",LINKPORT,QUEUE,IEN)) 
  1.  QUIT
  1.  ;
  1. EN ;Entry Point called by SDAM APPOINTMENT EVENTS protocol
  1.  ; SDATA will be defined when SDAM APPOINTMENT EVENTS protocol calls this entry
  1.  N AFTERSTS S AFTERSTS=$G(SDATA("AFTER","STATUS"))
  1.  N STATUS S STATUS=$P(AFTERSTS,"^",3)
  1.  QUIT:STATUS=""  ; Not a valid appointment
  1.  ;
  1.  ; -- is VPS HL7 active?
  1.  I '$$ACTIVE D ERROR("VPS HL7 IS INACTIVE") QUIT
  1.  ;
  1.  ; -- queue transmission process
  1.  N DFN S DFN=$P(SDATA,"^",2)
  1.  N APPTDT S APPTDT=$P(SDATA,"^",3)
  1.  N CLINIC S CLINIC=$P(SDATA,"^",4)
  1.  ;
  1.  I '$$QUE(DFN,APPTDT,CLINIC,STATUS) D ERROR("Unable to queue VPS SEND APPOINTMENT STATUS") QUIT
  1.  QUIT
  1.  ;
  1. ACTIVE() ;Is VPS HL7 active? 
  1.  ;Return 1 if HL7 active, 0 othewise
  1.  N SITE S SITE=$O(^VPS(853.1,"B","VPS HL7 SITE PARAMETER",0))
  1.  QUIT:'SITE 0
  1.  QUIT $P(^VPS(853.1,SITE,0),U,2)="Y"
  1.  ;
  1. QUE(DFN,APPTDT,CLINIC,STATUS) ; -- Queue Send appointment status Job
  1.  K ZTSK,IO("Q")
  1.  S ZTIO="NULL"
  1.  S ZTDTH=$H
  1.  S ZTDESC="VPS SEND APPOINTMENT STATUS"
  1.  S ZTRTN="SEND^VPSSEND"
  1.  ;
  1.  N SENDAPP S SENDAPP="VPS SEND APPT STATUS"
  1.  N RCVAPP S RCVAPP="VPS VECNA APPT STATUS"
  1.  N LINK S LINK="VPSAPPT"
  1.  ;
  1.  N SAV F SAV="CLINIC","DFN","APPTDT","STATUS","SENDAPP","RCVAPP","LINK" S ZTSAVE(SAV)=""
  1.  D ^%ZTLOAD
  1.  QUIT ZTSK
  1.  ;
  1. SEND ; -- Send HL7 message to VetLink
  1.  ;At this point LINK, CLINIC, APPTDT, STATUS, RCVAPP, SENDAPP should exist, sent by Taskman queue
  1.  N QUEUE S QUEUE="VPSSEND"_$J
  1.  N LINKPORT S LINKPORT=$$PREPQUE(LINK,QUEUE)
  1.  I +LINKPORT=-1 D ERROR($P(LINKPORT,U,2)) QUIT
  1.  ;
  1.  N APPT
  1.  S APPT("DFN")=DFN
  1.  S APPT("CLINIC")=CLINIC
  1.  S APPT("CLINIC NAME")=$P($G(^SC(CLINIC,0)),U)
  1.  S APPT("APPOINTMENT DATE")=APPTDT
  1.  ;
  1.  N PARMS,MSG
  1.  S PARMS("MESSAGE TYPE")="ADT"
  1.  S PARMS("EVENT")="A01"
  1.  S PARMS("MESSAGE STRUCTURE")="ADT_A01"
  1.  S PARMS("SENDING APPLICATION")=SENDAPP
  1.  S PARMS("ACCEPT ACK TYPE")="AL"
  1.  S PARMS("APP ACK TYPE")="NE"
  1.  S PARMS("QUEUE")=QUEUE
  1.  ;
  1.  N WHOTO
  1.  S WHOTO("RECEIVING APPLICATION")=RCVAPP
  1.  S WHOTO("FACILITY LINK NAME")=LINK
  1.  ;
  1.  N OK,ERR
  1.  S OK=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  ; -- Event segment
  1.  I OK D EVN(.APPT,.SEG)
  1.  I OK S OK=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  ; -- Patient ID segment
  1.  I OK D PID(DFN,.SEG)
  1.  I OK S OK=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  ; -- Patient Visit Segment for Record Flags
  1.  S OK=$$PV1(DFN,.SEG,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  ; -- Insurance segment
  1.  I OK D IN1(DFN,.SEG)
  1.  I OK S OK=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  ; -- VA Patient Eligibility segment
  1.  N VAEL D ELIG^VADPT
  1.  I OK D ZEL(.VAEL,.SEG)
  1.  I OK S OK=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  ; -- VA Enrollment segment
  1.  I OK D ZEN(DFN,.SEG)
  1.  I OK S OK=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  ; -- VA Means Test segment
  1.  I OK D ZMT(.VAEL,.SEG)
  1.  I OK S OK=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  ; -- Send message
  1.  I OK S OK=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERR)
  1.  I 'OK D ERROR(ERR,LINKPORT,QUEUE) QUIT
  1.  ;
  1.  D STARTQUE(LINKPORT,QUEUE) ;Start HLO Queue to send message
  1.  D UNLQUE(LINKPORT,QUEUE)
  1.  QUIT
  1.  ;
  1. ERROR(ERR,LINKPORT,QUEUE) ;Store error
  1.  I $G(LINKPORT)'="",$G(QUEUE)'="" D UNLQUE(LINKPORT,QUEUE)
  1.  ;
  1.  N VPSFDA,VPSERR,SITE
  1.  S SITE=$O(^VPS(853.1,"B","VPS HL7 SITE PARAMETER",0))
  1.  ;
  1.  I SITE D
  1.  . S VPSFDA(853.1,SITE_",",2)=$$NOW^XLFDT()
  1.  . S VPSFDA(853.1,SITE_",",3)=ERR
  1.  . D FILE^DIE("E","VPSFDA","VPSERR")
  1.  ;
  1.  I 'SITE D
  1.  . S VPSFDA(853.1,"+1,",.01)="VPS HL7 SITE PARAMETER"
  1.  . S VPSFDA(853.1,"+1,",1)="N"
  1.  . S VPSFDA(853.1,"+1,",2)=$$NOW^XLFDT()
  1.  . S VPSFDA(853.1,"+1,",3)=ERR
  1.  . D UPDATE^DIE("E","VPSFDA","IENS","VPSERR")
  1.  ;
  1.  QUIT
  1.  ;
  1. PREPQUE(LINK,QUEUE) ; -- Prepare to use HL7 Queue
  1.  ; INPUT 
  1.  ;   LINK  : HL LOGICAL LINK
  1.  ;   QUEUE : HL7 Transmission Queue
  1.  ; RETURN
  1.  ;   LINK_":"_HLOPORT  for success
  1.  ;   -1^Error Message  for error
  1.  ;
  1.  N IEN S IEN=$O(^HLCS(870,"B",LINK,0))
  1.  QUIT:'IEN "-1^HL LOGICAL LINK NOT DEFINED"
  1.  ;
  1.  N NODE S NODE=$G(^HLCS(870,IEN,400))
  1.  N HLOPORT S HLOPORT=$P(NODE,"^",8)
  1.  S:'HLOPORT HLOPORT=$P(NODE,"^",2)
  1.  QUIT:'HLOPORT "-1^INVALID HL LOGICAL LINK PORT"
  1.  ;
  1.  N LINKPORT S LINKPORT=LINK_":"_HLOPORT
  1.  L +^HLB("QUEUE","OUT",LINKPORT,QUEUE):3 E  QUIT "-1^QUEUE is busy"
  1.  D STOPQUE^HLOQUE("OUT",QUEUE)
  1.  ;
  1.  QUIT LINKPORT
  1.  ;
  1. STARTQUE(LINKPORT,QUEUE) ;start Queue
  1.  D UNLQUE(LINKPORT,QUEUE)
  1.  D STARTQUE^HLOQUE("OUT",QUEUE)
  1.  QUIT
  1.  ;
  1. UNLQUE(LINKPORT,QUEUE) ;Unlock Queue
  1.  L -^HLB("QUEUE","OUT",LINKPORT,QUEUE)
  1.  QUIT
  1.  ;
  1. EVN(APPT,SEG) ; -- generate PID segment
  1.  ;
  1.  ;Description:
  1.  ; Builds the EVN segment using the HLO segment building APIs.
  1.  ;
  1.  ; The fields that are included in the segment are:
  1.  ;  EVN-1 Not used
  1.  ;  EVN-2 Appointment date (Fileman)
  1.  ;  EVN-3 Appointment date (HL7)
  1.  ;
  1.  ;Input:
  1.  ;  APPT (pass-by-refernce) - Appointment information 
  1.  ;
  1.  ;Output:
  1.  ;  SEG (pass-by-reference) The segment, returned as a list of fields.
  1.  ;
  1.  K SEG S SEG="" ;The segment should start off blank.
  1.  ;
  1.  ; -- Use the HLO APIs to set the data into the segment.
  1.  D SET^HLOAPI(.SEG,"EVN",0) ;Set the segment type.
  1.  ;
  1.  ;Set Appointment Date into EVN-2 (Fileman date format) and EVN-3 (HL7 date format)
  1.  D SET^HLOAPI(.SEG,APPT("APPOINTMENT DATE"),2)
  1.  D SETDT^HLOAPI4(.SEG,APPT("APPOINTMENT DATE"),3)
  1.  ;
  1.  ;get appointment Status/type info
  1.  N PARAM
  1.  S PARAM(1)=APPT("APPOINTMENT DATE")_";"_APPT("APPOINTMENT DATE")
  1.  S PARAM("FLDS")="1;2;4;10;22"
  1.  S PARAM(4)=APPT("DFN")
  1.  N APPTCNT S APPTCNT=$$SDAPI^SDAMA301(.PARAM)
  1.  N TMP S TMP=$G(^TMP($J,"SDAMA301",APPT("DFN"),APPT("CLINIC"),APPT("APPOINTMENT DATE")))
  1.  ;
  1.  I TMP'="" D
  1.  . ;Set appointment Status IEN into EVN-4
  1.  . N STATUS S STATUS=$P(TMP,U,22)
  1.  . D SET^HLOAPI(.SEG,$P(STATUS,";"),4) ;appointment status ien
  1.  . ;
  1.  . ;Set Status (Display) into EVN-5, component 1
  1.  . D SET^HLOAPI(.SEG,$P(STATUS,";",3),5,1) ;Appointment Print Status (what is displayed)
  1.  . ;
  1.  . ;Set appointment type IEN/name into ENV-5, component 4 and 5
  1.  . N ATYPE S ATYPE=$P(TMP,U,10)
  1.  . D SET^HLOAPI(.SEG,$P(ATYPE,";"),5,4) ;appointment type ien
  1.  . D SET^HLOAPI(.SEG,$P(ATYPE,";",2),5,5) ;appointment type name
  1.  ;
  1.  ;Set the Clinic IEN/Name into ENV-5, component 2 and 3
  1.  D SET^HLOAPI(.SEG,APPT("CLINIC"),5,2)
  1.  D SET^HLOAPI(.SEG,APPT("CLINIC NAME"),5,3)
  1.  ;
  1.  ;Set comments/cancellation remarks into ENV-6
  1.  N IENS S IENS=APPT("APPOINTMENT DATE")_","_APPT("DFN")_","
  1.  N APPTOUT D GETS^DIQ(2.98,IENS,"17","IE","APPTOUT")
  1.  N APPTCMTS S APPTCMTS=$G(APPTOUT(2.98,IENS,17,"I"))
  1.  K APPTOUT
  1.  I APPTCMTS'="" D SET^HLOAPI(.SEG,APPTCMTS,6,1) ;cancellation remarks
  1.  ;
  1.  QUIT
  1.  ;
  1. PID(DFN,SEG) ; -- generate PID segment
  1.  ;
  1.  ;Description:
  1.  ; Builds the PID segment using the HLO segment building APIs.
  1.  ; PIMS APIs are called to obtain data from PATIENT file (#2).
  1.  ;
  1.  ; The fields that are included in the segment are:
  1.  ;  PID-1 Always set to '1'
  1.  ;  PID-2 Patient DFN, Station#, unused, Assigning Authority code
  1.  ;  PID-4 Sensitive flag
  1.  ;  PID-11 BadAddressID_BadAddressName
  1.  ;  PID-13 unused, unused, unused, unused, Patient Email Address
  1.  ;  PID-19 patient SSN
  1.  ;
  1.  ;Input:
  1.  ; DFN (required) The IEN of the record in the PATIENT file (#2).
  1.  ;
  1.  ;Output:
  1.  ;  SEG (pass-by-reference) The segment, returned as a list of fields.
  1.  ;
  1.  K SEG S SEG="" ;The segment should start off blank.
  1.  ;
  1.  ; -- Use the HLO APIs to set the data into the segment.
  1.  D SET^HLOAPI(.SEG,"PID",0) ;Set the segment type.
  1.  D SET^HLOAPI(.SEG,1,1) ;Set PID-1.
  1.  ;
  1.  ; -- Set dfn to PID-2, component 1
  1.  D SET^HLOAPI(.SEG,DFN,2,1)
  1.  ;
  1.  ; -- Set station number to PID-2, component 2
  1.  N STATION S STATION=$E($P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3) ; station number
  1.  D SET^HLOAPI(.SEG,STATION,2,2)
  1.  ;
  1.  ; -- Set As Assigning Authority code to PID-2, component 4
  1.  D SET^HLOAPI(.SEG,"USVHA",2,4)
  1.  ; 
  1.  ; -- Set Sensitive to PD1-4
  1.  N VPSARR D SENLOG^VPSRPC16(.VPSARR,DFN)
  1.  N SENS S SENS=$P($G(VPSARR(1)),U,4)
  1.  D:SENS'="" SET^HLOAPI(.SEG,SENS,4)
  1.  ;
  1.  ; -- Set Patient Name  to PD1-5
  1.  N RES D GETS^DIQ(2,DFN_",",".01;.09;.133","E","RES")
  1.  N PATNAM S PATNAM=$G(RES(2,DFN_",",.01,"E"))
  1.  N NAMPARSE S NAMPARSE=$$NAMPARSE(PATNAM)
  1.  D SET^HLOAPI(.SEG,$P(NAMPARSE,U),5,1) ;Last name
  1.  D SET^HLOAPI(.SEG,$P(NAMPARSE,U,2),5,2) ;First name
  1.  D SET^HLOAPI(.SEG,$P(NAMPARSE,U,3),5,3) ;Initial
  1.  ;
  1.  ; -- Set Bad Address Indicator to PD1-11, component 2
  1.  N BADADR S BADADR=$$BADADR^DGUTL3(DFN)
  1.  I BADADR'="" D
  1.  . N BADADRNM S BADADRNM=""
  1.  . I BADADR=1 S BADADRNM="UNDELIVERABLE"
  1.  . I BADADR=2 S BADADRNM="HOMELESS"
  1.  . I BADADR=3 S BADADRNM="OTHER"
  1.  . D SET^HLOAPI(.SEG,BADADR_"_"_BADADRNM,11,2)
  1.  ;
  1.  ; -- Set Patient Email information to PID-13, component 5
  1.  N EMAIL S EMAIL=$G(RES(2,DFN_",",.133,"E"))
  1.  D:EMAIL'="" SET^HLOAPI(.SEG,EMAIL,13,5)
  1.  ;
  1.  ; -- Set Social Security Number to PID-19
  1.  N SSN S SSN=$G(RES(2,DFN_",",.09,"E"))
  1.  D SET^HLOAPI(.SEG,SSN,19)
  1.  ;
  1.  QUIT
  1.  ;
  1. PV1(DFN,SEG,ERR) ; -- Patient Visit segment for patient record Flags
  1.  ;
  1.  ;Description:
  1.  ; Builds the PV1 segment using the HLO segment building APIs.
  1.  ;
  1.  ; The fields that are included in the segment are:
  1.  ;  PV1-1 PRF number (1..n)
  1.  ;  PV1-2 Always set to 'U' - Unknown
  1.  ;  PV1-5 Record flags: Flag Origin(national/local), Flag Type, unused, Flag Name
  1.  ;
  1.  ;Input:
  1.  ;  DFN (required) The IEN of the record in the PATIENT file (#2).
  1.  ;
  1.  ;Output:
  1.  ;  SEG (pass-by-reference) The segment, returned as a list of fields.
  1.  ;  ERR (pass-by-reference) Error Message
  1.  ;
  1.  ; -- Set Balance to PV1-26 for the first flag only
  1.  K SEG S SEG="" ;The segment should start off blank.
  1.  K VPSARR D BAL^VPSRPC26(.VPSARR,DFN)
  1.  N BAL S BAL=$P($G(VPSARR(1)),U,4)
  1.  D:BAL'="" SET^HLOAPI(.SEG,BAL,26)
  1.  ;
  1.  ; -- Set patient record flags to PV1-5
  1.  N PRFLAGS D GETPRF^VPSAPPT(DFN,.PRFLAGS)
  1.  N IDX,NARR,NARRTXT
  1.  N OK S OK=1
  1.  N PRF,CNT S CNT=$O(PRFLAGS("PRF",""),-1)
  1.  S:CNT="" CNT=1
  1.  ;
  1.  F PRF=1:1:CNT D  Q:'OK
  1.  . D SET^HLOAPI(.SEG,"PV1",0) ;Set the segment type.
  1.  . D SET^HLOAPI(.SEG,PRF,1) ;Set PV1-1
  1.  . D SET^HLOAPI(.SEG,"U",2) ;Set PV1-2 to Unknown
  1.  . I $D(PRFLAGS("PRF",PRF)) D
  1.  . . D SET^HLOAPI(.SEG,$G(PRFLAGS("PRF",PRF,"FLAG ORIGINATION")),5,1) ;Flag From (National/Local)
  1.  . . D SET^HLOAPI(.SEG,$G(PRFLAGS("PRF",PRF,"FLAG TYPE")),5,2) ;Flag Type
  1.  . . D SET^HLOAPI(.SEG,$G(PRFLAGS("PRF",PRF,"FLAG NAME")),5,4) ;Flag Name
  1.  . S OK=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERR)
  1.  ;
  1.  QUIT OK
  1.  ;
  1. ZEN(DFN,SEG) ; -- generate ZEN segment (VA Enrollment)
  1.  ;
  1.  ;Description:
  1.  ; Builds the ZEN segment using the HLO segment building APIs.
  1.  ;
  1.  ; The fields that are included in the segment are:
  1.  ;  ZEN-1  Always set to '1'
  1.  ;  ZEN-4  Enrollment Status
  1.  ;  ZEN-10 Pre-Registration Date Changed
  1.  ;
  1.  ;Input:
  1.  ;  DFN (required) The IEN of the record in the PATIENT file (#2).
  1.  ;
  1.  ;Output:
  1.  ;  SEG (pass-by-reference) The segment, returned as a list of fields.
  1.  ;
  1.  K SEG S SEG="" ;The segment should start off blank.
  1.  ;
  1.  ; -- Use the HLO APIs to set the data into the segment.
  1.  D SET^HLOAPI(.SEG,"ZEN",0) ;Set the segment type.
  1.  D SET^HLOAPI(.SEG,1,1) ;Set ZEN-1.
  1.  ;
  1.  ; -- Set Enrollment Status to ZEN-4
  1.  N ENRIEN S ENRIEN=$O(^DGEN(27.11,"C",DFN,""),-1)
  1.  I ENRIEN D
  1.  . N DFENR D GET^DGENA(ENRIEN,.DGENR)
  1.  . N ENRSTAT S ENRSTAT=$G(DGENR("STATUS"))
  1.  . I ENRSTAT'="" D
  1.  . . N ESNAME S ESNAME=$$GET1^DIQ(27.11,ENRIEN_",",.04,"E")
  1.  . . D SET^HLOAPI(.SEG,ENRSTAT,4,1)
  1.  . . D SET^HLOAPI(.SEG,ESNAME,4,2)
  1.  ;
  1.  ; -- Set Pre-Registration Date Changed TO ZEN-10 (Fileman Date) and ZEN-11 (HL7 Date)
  1.  K VPSARR D DGS^VPSRPC26(.VPSARR,DFN)
  1.  N PRDT S PRDT=$P($G(VPSARR(1)),U,4)
  1.  I PRDT'="" D
  1.  . D SET^HLOAPI(.SEG,PRDT,10,1)
  1.  . D SETDT^HLOAPI4(.SEG,PRDT,11,2)
  1.  ;
  1.  QUIT
  1.  ;
  1. ZEL(VAEL,SEG) ; -- generate ZEL segment (VA Patient Eligibility)
  1.  ;
  1.  ;Description:
  1.  ; Builds the ZEL segment using the HLO segment building APIs.
  1.  ;
  1.  ; The fields that are included in the segment are:
  1.  ;  ZEL-1   Always set to '1'
  1.  ;  ZEL-2   Eligibility Code
  1.  ;  ZEL-4   Eligibility Status
  1.  ;  ZEL-11  Ineligible date (Fileman format)
  1.  ;  ZEL-12  Ineligible date (HL7 format)
  1.  ;
  1.  ;Input:
  1.  ; DFN (required) The IEN of the record in the PATIENT file (#2).
  1.  ;
  1.  ;Output:
  1.  ;  SEG (pass-by-reference) The segment, returned as a list of fields.
  1.  ;
  1.  K SEG S SEG="" ;The segment should start off blank.
  1.  ;
  1.  ; -- Use the HLO APIs to set the data into the segment.
  1.  D SET^HLOAPI(.SEG,"ZEL",0) ;Set the segment type.
  1.  D SET^HLOAPI(.SEG,1,1) ;Set ZEL-1.
  1.  ;
  1.  ; -- Set Primary Eligibility Code to ZEL-2
  1.  N ELIGSTAT S ELIGSTAT=$P($G(VAEL(8)),U)
  1.  D:ELIGSTAT'="" SET^HLOAPI(.SEG,ELIGSTAT,2)
  1.  ;
  1.  ; -- Set Eligibility Status to ZEL-4
  1.  S ELIGSTAT=$P($G(VAEL(8)),U,2)
  1.  D:ELIGSTAT'="" SET^HLOAPI(.SEG,ELIGSTAT,4)
  1.  ;
  1.  ; -- Set Ineligible date to ZEL-11 (Fileman Date) and ZEL-12 (HL7 date)
  1.  N IELIGDT S IELIGDT=$P($G(VAEL(5,1)),U)
  1.  I IELIGDT'="" D
  1.  . D SET^HLOAPI(.SEG,IELIGDT,11)
  1.  . D SETDT^HLOAPI4(.SEG,IELIGDT,12)
  1.  ;
  1.  QUIT
  1.  ;
  1. ZMT(VAEL,SEG) ; -- generate ZMT segment (VA Means Test)
  1.  ;
  1.  ;Description:
  1.  ; Builds the ZMT segment for the Mean Test using the HLO segment building APIs. 
  1.  ;
  1.  ; The fields included in the segment are:
  1.  ;  ZMT-1   Always set to '1'
  1.  ;  ZMT-3  Mean Test Status
  1.  ;
  1.  ;Input:
  1.  ;  DFN (required) The IEN of the record in the PATIENT file (#2).
  1.  ;
  1.  ;Output:
  1.  ;  SEG (pass-by-reference) Will return an array containing the segment.
  1.  ;    The ADDSEG^HLOAPI API must be called to move the segment into
  1.  ;    the message. 
  1.  ;
  1.  K SEG S SEG="" ;The segment should start off blank.
  1.  ;
  1.  ; -- Use the HLO APIs to set the data into the segment.
  1.  D SET^HLOAPI(.SEG,"ZMT",0) ;Set the segment type.
  1.  D SET^HLOAPI(.SEG,1,1) ;Set ZMT-1.
  1.  ;
  1.  ; -- Set means test status to ZMT-3
  1.  N MTS S MTS=$P($G(VAEL(9)),U,2)
  1.  D:MTS'="" SET^HLOAPI(.SEG,MTS,3)
  1.  ;
  1.  QUIT
  1.  ;
  1. IN1(DFN,SEG) ; -- generate IN1 segment (Insurance Information)
  1.  ;
  1.  ;Description:
  1.  ; Builds the IN1 segment for the Insurance information using the HLO segment building APIs. 
  1.  ;
  1.  ; The fields included in the segment are:
  1.  ;  IN1-1   Always set to '1'
  1.  ;  IN1-2   Patient Insured (Y or N)
  1.  ;
  1.  ;Input:
  1.  ;  DFN (required) The IEN of the record in the PATIENT file (#2).
  1.  ;
  1.  ;Output:
  1.  ;  SEG (pass-by-reference) Will return an array containing the segment.
  1.  ;    The ADDSEG^HLOAPI API must be called to move the segment into
  1.  ;    the message. 
  1.  ;
  1.  K SEG S SEG="" ;The segment should start off blank.
  1.  ;
  1.  ; -- Use the HLO APIs to set the data into the segment.
  1.  D SET^HLOAPI(.SEG,"IN1",0) ;Set the segment type.
  1.  D SET^HLOAPI(.SEG,1,1) ;Set IN1-1.
  1.  ;
  1.  ; -- Set Insurance (true/false) to IN1-2
  1.  K VPSARR D IBB^VPSRPC26(.VPSARR,DFN) ; Insurance Info
  1.  N INS S INS=$P($G(VPSARR(1)),U,4)
  1.  S INS=$S(INS'="":"Y",1:"N")
  1.  D SET^HLOAPI(.SEG,INS,2)
  1.  ;
  1.  QUIT
  1.  ;
  1. NAMPARSE(VNAME) ;  return name components for standard VistA name
  1.  ;Return LastName^FirstName^Middle^Suffix/Title
  1.  ;       on error - return ""
  1.  QUIT:$G(VNAME)="" ""
  1.  D STDNAME^XLFNAME(.VNAME,"CF")
  1.  N RET S RET=""
  1.  N FLD F FLD="FAMILY","GIVEN","MIDDLE" S RET=RET_$G(VNAME(FLD))_U
  1.  S:$L(RET) RET=$E(RET,1,$L(RET)-1)
  1.  QUIT RET