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