DGENUPL ;ALB/CJM,ISA,KWP,TDM,CKN,BAJ,LMD,KUM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;7/15/24 12:40PM
;;5.3;REGISTRATION;**147,222,232,363,472,497,564,677,672,688,871,909,952,1103,1121**;Aug 13,1993;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
;Phase II Moved Z11 to DGENUPL7
ORUZ11(MSGIEN,ERRCOUNT) ;
;Description: This procedure is used to process a batch of ORU~Z11
;messages or a single ORU~Z11 message. The processing consists of
;uploading the patient enrollment and eligibility data.
;
;Input:
; MSGIEN - the ien of the HL7 message in the HL7 MESSAGE TEXT file
;Output:
; ERRCOUNT - count of messages that were not processed due to
; errors encountered (pass by reference)
;
N CURLINE,SSN,DOB,SEX,SEG,MSGID,DFN,ERRMSG,TMPARRY,ICN
;
K ^TMP("IVM","HLS",$J)
;
;initialize HL7 variable
S HLSDT="IVMQ" ;location of error message
;
S CURLINE=1
D ADVANCE(MSGIEN,.CURLINE)
Q:'CURLINE
F Q:'CURLINE D D ADVANCE(MSGIEN,.CURLINE)
.D GETSEG(MSGIEN,CURLINE,.SEG)
.S MSHDT=SEG(7)
.S MSGID=SEG(10)
.D NXTSEG(MSGIEN,CURLINE,.SEG)
.I SEG("TYPE")'="PID" D ADDERROR(MSGID,,"PID SEGMENT MISSING",.ERRCOUNT) Q
.;S DFN=$$LOOKUP^DGENPTA(SEG(19),$$FMDATE^HLFNC(SEG(7)),SEG(8),.ERRMSG)
.M TMPARY(3)=SEG(3) D PARSPID3^IVMUFNC(.TMPARY,.PID3ARY)
.S DFN=$G(PID3ARY("PI")),ICN=$G(PID3ARY("NI"))
.K TMPARY,PID3ARY
.I '$$MATCH^IVMUFNC(DFN,ICN,"","","I",.ERRMSG) D ADDERROR(MSGID,SEG(19),ERRMSG,.ERRCOUNT) Q
.;I 'DFN D ADDERROR(MSGID,SEG(19),ERRMSG,.ERRCOUNT) Q
.D Z11^DGENUPL7(MSGIEN,MSGID,.CURLINE,DFN,.ERRCOUNT)
S HLEVN=+$G(ERRCOUNT) ;# of events included in the reply
M ^TMP("HLS",$J)=^TMP("IVM","HLS",$J) ;DG*5.3*472
K ^TMP("IVM","HLS",$J)
Q
;
ORFZ11(MSGIEN,MSGID) ;
;Description: This procedure is used to process an ORF~Z11 message
;It uploads the patient enrollment and eligibility data.
;An acknowledgment is returned.
;
;Input:
; MSGIEN - the internal entry number of the HL7 message in the HL7 MESSAGE TEXT file (772)
; MSGID - the message control id from the MSH segment
;
;Output: none
;
N CURLINE,DFN,QUERYIEN,QARRAY,QRYMSGID,ERRCOUNT,HECERROR,SEG,DGRESENT
N TMPARRY,PID3ARRY,ICN
;CURLINE tracks current line in the message
;QUERYIEN the ien of query in the ENROLLMENT QUERY LOG
;QRYMSGID the Message Control ID of the query
;QARRAY array containing the ENROLLMENT QUERY LOG record
;HECERROR error message returned by HEC in response to query
;DGRESENT flag=1 if query was resent
;
S (QUERYIEN,ERRCOUNT)=0
;
;initialize HL7 variable
S HLSDT="IVMQ" ;subscript in ^TMP( global for ACK message
;
K ^TMP("IVM","HLS",$J)
;
S CURLINE=1
S HECERROR=""
D GETSEG(MSGIEN,CURLINE,.SEG) ; DG*5.3*871
S MSHDT=SEG(7) ; DG*5.3*871
S MSGID=SEG(10) ; DG*5.3*871
;
D ;drops out on error
.D NXTSEG(MSGIEN,.CURLINE,.SEG)
.I SEG("TYPE")'="MSA" D ADDERROR(MSGID,,"MISSING MSA SEGMENT",.ERRCOUNT) Q
.;trace the reply back to the query
.S QRYMSGID=SEG(2)
.S QUERYIEN=$$FINDMSG^DGENQRY(QRYMSGID)
.I 'QUERYIEN D ADDERROR(MSGID,,"NO RECORD OF QUERY",.ERRCOUNT) Q
.I QUERYIEN,'$$GET^DGENQRY(QUERYIEN,.QARRAY) D ADDERROR(MSGID,,"NO RECORD OF QUERY",.ERRCOUNT) Q
.S DFN=QARRAY("DFN")
.I (SEG(1)="AR")!(SEG(1)="AE") D Q
..;HEC was unable to reply to the query. If due to incorrect patient
..;info, then resend the query, otherwise just log it as unsuccessful
..N SSN,DOB,SEX,DGPAT,HECMSG
..S HECMSG=SEG(3)
..D NXTSEG(MSGIEN,.CURLINE,.SEG)
..Q:(SEG("TYPE")'="QRD")
..S SSN=SEG(8)
..D NXTSEG(MSGIEN,.CURLINE,.SEG)
..Q:(SEG("TYPE")'="QRF")
..S DOB=$$FMDATE^HLFNC(SEG(4))
..S SEX=SEG(5)
..;if patient id info incorrect, resend the query
..I $$GET^DGENPTA(DFN,.DGPAT),((DOB'=DGPAT("DOB"))!(SEX'=DGPAT("SEX"))) I $$RESEND^DGENQRY1(QUERYIEN) S DGRESENT=1 Q
..S HECERROR="HEC UNABLE TO RESPOND TO QUERY- "_HECMSG Q
.;
.F SEG="QRD","QRF" D NXTSEG(MSGIEN,.CURLINE,.SEG) I SEG("TYPE")'=SEG D ADDERROR(MSGID,,SEG_" SEGMENT MISSING",.ERRCOUNT) Q
.S SEG="PID" D NXTSEG(MSGIEN,CURLINE,.SEG) I SEG("TYPE")'=SEG D ADDERROR(MSGID,,SEG_" SEGMENT MISSING",.ERRCOUNT) Q
.;S CURLINE=CURLINE-1 ;should point to line before PID
.;I $$SSN^DGENPTA(DFN)'=SEG(19) D ADDERROR(MSGID,,"SSN DOES NOT MATCH",.ERRCOUNT) Q
.M TMPARY(3)=SEG(3) D PARSPID3^IVMUFNC(.TMPARY,.PID3ARY)
.S DFN=$G(PID3ARY("PI")),ICN=$G(PID3ARY("NI"))
.K TMPARY,PID3ARY
.I '$$MATCH^IVMUFNC(DFN,ICN,"","","I",.ERRMSG) D ADDERROR(MSGID,,ERRMSG,.ERRCOUNT) Q
.D Z11^DGENUPL7(MSGIEN,MSGID,.CURLINE,DFN,.ERRCOUNT)
;
;update the query log
I $G(HECERROR)="",ERRCOUNT S HECERROR="UPLOAD FAILED DUE TO CONSISTENCY CHECKS"
I '$G(DGRESENT),$$RECEIVE^DGENQRY1(QUERYIEN,HECERROR,MSGID)
;
S HLEVN=+$G(ERRCOUNT) ;# of events included in the reply
;
;if there was no error, create an 'AA' ack
;I 'ERRCOUNT D ACCEPT^DGENUPL1(MSGID) ;DG*5.3*472
;D MVERRORS^DGENUPL1 ;DG*5.3*472
;transmit the ack
;********************************************************
;7.12.01;KSD; COMMENTED OUT. DON'T SEND ACK TO ORF
;I $D(HLTRANS) S HLARYTYP="GB",HLFORMAT=1 D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,.HLRESLTA,HLMTIEN)
;
Q
;
ADDERROR(MSGID,SSN,ERRMSG,ERRCOUNT) ;
;Description - writes an error message to a global. It will be
;transmitted in the ack later.
;
;Inputs:
; MSGID -message control id of HL7 msg in the MSH segment
; SSN - patient social security number
; ERRMSG - the error message
; ERRCOUNT - count of errors written so far
;
;Outputs: none
;
S ERRCOUNT=+$G(ERRCOUNT)
;
I (ERRCOUNT*2)+1=1 D
. K HL,HLMID,HLMTIEN,HLDT,HLDT1
. D INIT^HLFNC2(HLEID,.HL)
. D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
K HLRES
S MID=HLMID_"-"_((ERRCOUNT*2)+1)
D MSH^HLFNC2(.HL,MID,.HLRES)
S ^TMP("IVM","HLS",$J,(ERRCOUNT*2)+1)=HLRES
S ^TMP("IVM","HLS",$J,(ERRCOUNT*2)+2)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_ERRMSG_" - SSN "_$S($L($G(SSN)):SSN,1:"NOT FOUND")
S ERRCOUNT=ERRCOUNT+1
;Put in error message in HECERROR to be included in the NOTIFY message for a solicited query
I $D(HECERROR) S HECERROR=ERRMSG
Q
;
NXTSEG(MSGIEN,CURLINE,SEG) ;
;Description: Returns the next segment
;
;Input:
; MSGIEN - ien in HL7 MESSAGE TEXT file
; CURLINE - subscript of the current segment
;
;Output:
; SEG - an array with the fields of the segment (pass by reference)
; CURLINE - upon exiting, will be the subscript of the next segment
;
S CURLINE=CURLINE+1
D GETSEG(MSGIEN,.CURLINE,.SEG)
Q
;
GETSEG(MSGIEN,CURLINE,SEG) ;
;returns the current segment
;
;Input:
; MSGIEN - ien in HL7 MESSAGE TEXT file
; CURLINE - subscript of the current segment
;
;Output:
; SEG - an array with the fields of the segment (pass by reference)
;
N SEGMENT,I,CNTR,NOPID,PIDSTR,IVMPID,SEGHLD,CNTR2
I $G(SEG)'="" S SEGHLD=SEG
K SEG
S SEG=$G(SEGHLD)
S CNTR=1,NOPID=0
S:$G(HLFS)="" HLFS=$G(HL("FS")) S:HLFS="" HLFS="^"
S SEGMENT=$G(^TMP($J,IVMRTN,CURLINE,0))
S SEG("TYPE")=$E(SEGMENT,1,3)
;Strip double quotes from the following segments. DG*5.3*688
I SEG("TYPE")="ZRD" D
.S SEGMENT=$$CLEARF^IVMPRECA(SEGMENT,HLFS)
I SEG("TYPE")="PID" D Q
.S PIDSTR(CNTR)=$P(SEGMENT,HLFS,2,99)
.F I=1:1 D Q:NOPID
..S CURLINE=CURLINE+1,SEGMENT=$G(^TMP($J,IVMRTN,CURLINE,0))
..I $E(SEGMENT,1,4)="ZPD^" S NOPID=1,CURLINE=CURLINE-1 Q
..S CNTR=CNTR+1,PIDSTR(CNTR)=SEGMENT
.D BLDPID^IVMPREC6(.PIDSTR,.IVMPID)
.;convert "" to null for PID segment
.S CNTR="" F S CNTR=$O(IVMPID(CNTR)) Q:CNTR="" D
..I $O(IVMPID(CNTR,"")) D Q
...S CNTR2="" F S CNTR2=$O(IVMPID(CNTR,CNTR2)) Q:CNTR2="" D
....S IVMPID(CNTR,CNTR2)=$$CLEARF^IVMPRECA(IVMPID(CNTR,CNTR2),$E(HLECH))
..I IVMPID(CNTR)="""""" S IVMPID(CNTR)=""
.M SEG=IVMPID
;
;the MSH & BHS segs contain as their first piece the field separator, which makes breaking the segment into fields a bit different
I (SEG("TYPE")="MSH")!(SEG("TYPE")="BHS") D
.S SEG(1)=$E(SEGMENT,4)
.F I=2:1:30 S SEG(I)=$P(SEGMENT,HLFS,I)
E D
.; Expanded to 48 from 45 to allow for OTH fields DG*5.3*952
.;DG*5.3*1103 - Expand to allow Sequence #48 of ZEL segment
.;F I=2:1:48 S SEG(I-1)=$P(SEGMENT,HLFS,I)
.;DG*5.3*1121 - Expand to allow Persian Gulf Indicator (Seq #49) and Persian Gulf Change date/time (Seq #50) of ZEL segment
.;F I=2:1:49 S SEG(I-1)=$P(SEGMENT,HLFS,I)
.F I=2:1:51 S SEG(I-1)=$P(SEGMENT,HLFS,I)
Q
;
ADVANCE(MSGIEN,CURLINE) ;
;Description: Used to find the beginning of the next message in the batch.
;
;Input:
; MSGIEN - ien of message in the HL7 MESSAGE TEXT file.
; CURLINE - current position in the message
;Output:
; CURLINE - starting position of next message in the batch, or 0 if
; the end of the message is reached
;
Q:'CURLINE
F S CURLINE=$O(^TMP($J,IVMRTN,CURLINE)) Q:'CURLINE Q:$E($G(^TMP($J,IVMRTN,CURLINE,0)),1,3)="MSH"
S CURLINE=+CURLINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENUPL 9046 printed Sep 23, 2025@20:19:08 Page 2
DGENUPL ;ALB/CJM,ISA,KWP,TDM,CKN,BAJ,LMD,KUM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;7/15/24 12:40PM
+1 ;;5.3;REGISTRATION;**147,222,232,363,472,497,564,677,672,688,871,909,952,1103,1121**;Aug 13,1993;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;Phase II Moved Z11 to DGENUPL7
ORUZ11(MSGIEN,ERRCOUNT) ;
+1 ;Description: This procedure is used to process a batch of ORU~Z11
+2 ;messages or a single ORU~Z11 message. The processing consists of
+3 ;uploading the patient enrollment and eligibility data.
+4 ;
+5 ;Input:
+6 ; MSGIEN - the ien of the HL7 message in the HL7 MESSAGE TEXT file
+7 ;Output:
+8 ; ERRCOUNT - count of messages that were not processed due to
+9 ; errors encountered (pass by reference)
+10 ;
+11 NEW CURLINE,SSN,DOB,SEX,SEG,MSGID,DFN,ERRMSG,TMPARRY,ICN
+12 ;
+13 KILL ^TMP("IVM","HLS",$JOB)
+14 ;
+15 ;initialize HL7 variable
+16 ;location of error message
SET HLSDT="IVMQ"
+17 ;
+18 SET CURLINE=1
+19 DO ADVANCE(MSGIEN,.CURLINE)
+20 if 'CURLINE
QUIT
+21 FOR
if 'CURLINE
QUIT
Begin DoDot:1
+22 DO GETSEG(MSGIEN,CURLINE,.SEG)
+23 SET MSHDT=SEG(7)
+24 SET MSGID=SEG(10)
+25 DO NXTSEG(MSGIEN,CURLINE,.SEG)
+26 IF SEG("TYPE")'="PID"
DO ADDERROR(MSGID,,"PID SEGMENT MISSING",.ERRCOUNT)
QUIT
+27 ;S DFN=$$LOOKUP^DGENPTA(SEG(19),$$FMDATE^HLFNC(SEG(7)),SEG(8),.ERRMSG)
+28 MERGE TMPARY(3)=SEG(3)
DO PARSPID3^IVMUFNC(.TMPARY,.PID3ARY)
+29 SET DFN=$GET(PID3ARY("PI"))
SET ICN=$GET(PID3ARY("NI"))
+30 KILL TMPARY,PID3ARY
+31 IF '$$MATCH^IVMUFNC(DFN,ICN,"","","I",.ERRMSG)
DO ADDERROR(MSGID,SEG(19),ERRMSG,.ERRCOUNT)
QUIT
+32 ;I 'DFN D ADDERROR(MSGID,SEG(19),ERRMSG,.ERRCOUNT) Q
+33 DO Z11^DGENUPL7(MSGIEN,MSGID,.CURLINE,DFN,.ERRCOUNT)
End DoDot:1
DO ADVANCE(MSGIEN,.CURLINE)
+34 ;# of events included in the reply
SET HLEVN=+$GET(ERRCOUNT)
+35 ;DG*5.3*472
MERGE ^TMP("HLS",$JOB)=^TMP("IVM","HLS",$JOB)
+36 KILL ^TMP("IVM","HLS",$JOB)
+37 QUIT
+38 ;
ORFZ11(MSGIEN,MSGID) ;
+1 ;Description: This procedure is used to process an ORF~Z11 message
+2 ;It uploads the patient enrollment and eligibility data.
+3 ;An acknowledgment is returned.
+4 ;
+5 ;Input:
+6 ; MSGIEN - the internal entry number of the HL7 message in the HL7 MESSAGE TEXT file (772)
+7 ; MSGID - the message control id from the MSH segment
+8 ;
+9 ;Output: none
+10 ;
+11 NEW CURLINE,DFN,QUERYIEN,QARRAY,QRYMSGID,ERRCOUNT,HECERROR,SEG,DGRESENT
+12 NEW TMPARRY,PID3ARRY,ICN
+13 ;CURLINE tracks current line in the message
+14 ;QUERYIEN the ien of query in the ENROLLMENT QUERY LOG
+15 ;QRYMSGID the Message Control ID of the query
+16 ;QARRAY array containing the ENROLLMENT QUERY LOG record
+17 ;HECERROR error message returned by HEC in response to query
+18 ;DGRESENT flag=1 if query was resent
+19 ;
+20 SET (QUERYIEN,ERRCOUNT)=0
+21 ;
+22 ;initialize HL7 variable
+23 ;subscript in ^TMP( global for ACK message
SET HLSDT="IVMQ"
+24 ;
+25 KILL ^TMP("IVM","HLS",$JOB)
+26 ;
+27 SET CURLINE=1
+28 SET HECERROR=""
+29 ; DG*5.3*871
DO GETSEG(MSGIEN,CURLINE,.SEG)
+30 ; DG*5.3*871
SET MSHDT=SEG(7)
+31 ; DG*5.3*871
SET MSGID=SEG(10)
+32 ;
+33 ;drops out on error
Begin DoDot:1
+34 DO NXTSEG(MSGIEN,.CURLINE,.SEG)
+35 IF SEG("TYPE")'="MSA"
DO ADDERROR(MSGID,,"MISSING MSA SEGMENT",.ERRCOUNT)
QUIT
+36 ;trace the reply back to the query
+37 SET QRYMSGID=SEG(2)
+38 SET QUERYIEN=$$FINDMSG^DGENQRY(QRYMSGID)
+39 IF 'QUERYIEN
DO ADDERROR(MSGID,,"NO RECORD OF QUERY",.ERRCOUNT)
QUIT
+40 IF QUERYIEN
IF '$$GET^DGENQRY(QUERYIEN,.QARRAY)
DO ADDERROR(MSGID,,"NO RECORD OF QUERY",.ERRCOUNT)
QUIT
+41 SET DFN=QARRAY("DFN")
+42 IF (SEG(1)="AR")!(SEG(1)="AE")
Begin DoDot:2
+43 ;HEC was unable to reply to the query. If due to incorrect patient
+44 ;info, then resend the query, otherwise just log it as unsuccessful
+45 NEW SSN,DOB,SEX,DGPAT,HECMSG
+46 SET HECMSG=SEG(3)
+47 DO NXTSEG(MSGIEN,.CURLINE,.SEG)
+48 if (SEG("TYPE")'="QRD")
QUIT
+49 SET SSN=SEG(8)
+50 DO NXTSEG(MSGIEN,.CURLINE,.SEG)
+51 if (SEG("TYPE")'="QRF")
QUIT
+52 SET DOB=$$FMDATE^HLFNC(SEG(4))
+53 SET SEX=SEG(5)
+54 ;if patient id info incorrect, resend the query
+55 IF $$GET^DGENPTA(DFN,.DGPAT)
IF ((DOB'=DGPAT("DOB"))!(SEX'=DGPAT("SEX")))
IF $$RESEND^DGENQRY1(QUERYIEN)
SET DGRESENT=1
QUIT
+56 SET HECERROR="HEC UNABLE TO RESPOND TO QUERY- "_HECMSG
QUIT
End DoDot:2
QUIT
+57 ;
+58 FOR SEG="QRD","QRF"
DO NXTSEG(MSGIEN,.CURLINE,.SEG)
IF SEG("TYPE")'=SEG
DO ADDERROR(MSGID,,SEG_" SEGMENT MISSING",.ERRCOUNT)
QUIT
+59 SET SEG="PID"
DO NXTSEG(MSGIEN,CURLINE,.SEG)
IF SEG("TYPE")'=SEG
DO ADDERROR(MSGID,,SEG_" SEGMENT MISSING",.ERRCOUNT)
QUIT
+60 ;S CURLINE=CURLINE-1 ;should point to line before PID
+61 ;I $$SSN^DGENPTA(DFN)'=SEG(19) D ADDERROR(MSGID,,"SSN DOES NOT MATCH",.ERRCOUNT) Q
+62 MERGE TMPARY(3)=SEG(3)
DO PARSPID3^IVMUFNC(.TMPARY,.PID3ARY)
+63 SET DFN=$GET(PID3ARY("PI"))
SET ICN=$GET(PID3ARY("NI"))
+64 KILL TMPARY,PID3ARY
+65 IF '$$MATCH^IVMUFNC(DFN,ICN,"","","I",.ERRMSG)
DO ADDERROR(MSGID,,ERRMSG,.ERRCOUNT)
QUIT
+66 DO Z11^DGENUPL7(MSGIEN,MSGID,.CURLINE,DFN,.ERRCOUNT)
End DoDot:1
+67 ;
+68 ;update the query log
+69 IF $GET(HECERROR)=""
IF ERRCOUNT
SET HECERROR="UPLOAD FAILED DUE TO CONSISTENCY CHECKS"
+70 IF '$GET(DGRESENT)
IF $$RECEIVE^DGENQRY1(QUERYIEN,HECERROR,MSGID)
+71 ;
+72 ;# of events included in the reply
SET HLEVN=+$GET(ERRCOUNT)
+73 ;
+74 ;if there was no error, create an 'AA' ack
+75 ;I 'ERRCOUNT D ACCEPT^DGENUPL1(MSGID) ;DG*5.3*472
+76 ;D MVERRORS^DGENUPL1 ;DG*5.3*472
+77 ;transmit the ack
+78 ;********************************************************
+79 ;7.12.01;KSD; COMMENTED OUT. DON'T SEND ACK TO ORF
+80 ;I $D(HLTRANS) S HLARYTYP="GB",HLFORMAT=1 D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,.HLRESLTA,HLMTIEN)
+81 ;
+82 QUIT
+83 ;
ADDERROR(MSGID,SSN,ERRMSG,ERRCOUNT) ;
+1 ;Description - writes an error message to a global. It will be
+2 ;transmitted in the ack later.
+3 ;
+4 ;Inputs:
+5 ; MSGID -message control id of HL7 msg in the MSH segment
+6 ; SSN - patient social security number
+7 ; ERRMSG - the error message
+8 ; ERRCOUNT - count of errors written so far
+9 ;
+10 ;Outputs: none
+11 ;
+12 SET ERRCOUNT=+$GET(ERRCOUNT)
+13 ;
+14 IF (ERRCOUNT*2)+1=1
Begin DoDot:1
+15 KILL HL,HLMID,HLMTIEN,HLDT,HLDT1
+16 DO INIT^HLFNC2(HLEID,.HL)
+17 DO CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
End DoDot:1
+18 KILL HLRES
+19 SET MID=HLMID_"-"_((ERRCOUNT*2)+1)
+20 DO MSH^HLFNC2(.HL,MID,.HLRES)
+21 SET ^TMP("IVM","HLS",$JOB,(ERRCOUNT*2)+1)=HLRES
+22 SET ^TMP("IVM","HLS",$JOB,(ERRCOUNT*2)+2)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_ERRMSG_" - SSN "_$SELECT($LENGTH($GET(SSN)):SSN,1:"NOT FOUND")
+23 SET ERRCOUNT=ERRCOUNT+1
+24 ;Put in error message in HECERROR to be included in the NOTIFY message for a solicited query
+25 IF $DATA(HECERROR)
SET HECERROR=ERRMSG
+26 QUIT
+27 ;
NXTSEG(MSGIEN,CURLINE,SEG) ;
+1 ;Description: Returns the next segment
+2 ;
+3 ;Input:
+4 ; MSGIEN - ien in HL7 MESSAGE TEXT file
+5 ; CURLINE - subscript of the current segment
+6 ;
+7 ;Output:
+8 ; SEG - an array with the fields of the segment (pass by reference)
+9 ; CURLINE - upon exiting, will be the subscript of the next segment
+10 ;
+11 SET CURLINE=CURLINE+1
+12 DO GETSEG(MSGIEN,.CURLINE,.SEG)
+13 QUIT
+14 ;
GETSEG(MSGIEN,CURLINE,SEG) ;
+1 ;returns the current segment
+2 ;
+3 ;Input:
+4 ; MSGIEN - ien in HL7 MESSAGE TEXT file
+5 ; CURLINE - subscript of the current segment
+6 ;
+7 ;Output:
+8 ; SEG - an array with the fields of the segment (pass by reference)
+9 ;
+10 NEW SEGMENT,I,CNTR,NOPID,PIDSTR,IVMPID,SEGHLD,CNTR2
+11 IF $GET(SEG)'=""
SET SEGHLD=SEG
+12 KILL SEG
+13 SET SEG=$GET(SEGHLD)
+14 SET CNTR=1
SET NOPID=0
+15 if $GET(HLFS)=""
SET HLFS=$GET(HL("FS"))
if HLFS=""
SET HLFS="^"
+16 SET SEGMENT=$GET(^TMP($JOB,IVMRTN,CURLINE,0))
+17 SET SEG("TYPE")=$EXTRACT(SEGMENT,1,3)
+18 ;Strip double quotes from the following segments. DG*5.3*688
+19 IF SEG("TYPE")="ZRD"
Begin DoDot:1
+20 SET SEGMENT=$$CLEARF^IVMPRECA(SEGMENT,HLFS)
End DoDot:1
+21 IF SEG("TYPE")="PID"
Begin DoDot:1
+22 SET PIDSTR(CNTR)=$PIECE(SEGMENT,HLFS,2,99)
+23 FOR I=1:1
Begin DoDot:2
+24 SET CURLINE=CURLINE+1
SET SEGMENT=$GET(^TMP($JOB,IVMRTN,CURLINE,0))
+25 IF $EXTRACT(SEGMENT,1,4)="ZPD^"
SET NOPID=1
SET CURLINE=CURLINE-1
QUIT
+26 SET CNTR=CNTR+1
SET PIDSTR(CNTR)=SEGMENT
End DoDot:2
if NOPID
QUIT
+27 DO BLDPID^IVMPREC6(.PIDSTR,.IVMPID)
+28 ;convert "" to null for PID segment
+29 SET CNTR=""
FOR
SET CNTR=$ORDER(IVMPID(CNTR))
if CNTR=""
QUIT
Begin DoDot:2
+30 IF $ORDER(IVMPID(CNTR,""))
Begin DoDot:3
+31 SET CNTR2=""
FOR
SET CNTR2=$ORDER(IVMPID(CNTR,CNTR2))
if CNTR2=""
QUIT
Begin DoDot:4
+32 SET IVMPID(CNTR,CNTR2)=$$CLEARF^IVMPRECA(IVMPID(CNTR,CNTR2),$EXTRACT(HLECH))
End DoDot:4
End DoDot:3
QUIT
+33 IF IVMPID(CNTR)=""""""
SET IVMPID(CNTR)=""
End DoDot:2
+34 MERGE SEG=IVMPID
End DoDot:1
QUIT
+35 ;
+36 ;the MSH & BHS segs contain as their first piece the field separator, which makes breaking the segment into fields a bit different
+37 IF (SEG("TYPE")="MSH")!(SEG("TYPE")="BHS")
Begin DoDot:1
+38 SET SEG(1)=$EXTRACT(SEGMENT,4)
+39 FOR I=2:1:30
SET SEG(I)=$PIECE(SEGMENT,HLFS,I)
End DoDot:1
+40 IF '$TEST
Begin DoDot:1
+41 ; Expanded to 48 from 45 to allow for OTH fields DG*5.3*952
+42 ;DG*5.3*1103 - Expand to allow Sequence #48 of ZEL segment
+43 ;F I=2:1:48 S SEG(I-1)=$P(SEGMENT,HLFS,I)
+44 ;DG*5.3*1121 - Expand to allow Persian Gulf Indicator (Seq #49) and Persian Gulf Change date/time (Seq #50) of ZEL segment
+45 ;F I=2:1:49 S SEG(I-1)=$P(SEGMENT,HLFS,I)
+46 FOR I=2:1:51
SET SEG(I-1)=$PIECE(SEGMENT,HLFS,I)
End DoDot:1
+47 QUIT
+48 ;
ADVANCE(MSGIEN,CURLINE) ;
+1 ;Description: Used to find the beginning of the next message in the batch.
+2 ;
+3 ;Input:
+4 ; MSGIEN - ien of message in the HL7 MESSAGE TEXT file.
+5 ; CURLINE - current position in the message
+6 ;Output:
+7 ; CURLINE - starting position of next message in the batch, or 0 if
+8 ; the end of the message is reached
+9 ;
+10 if 'CURLINE
QUIT
+11 FOR
SET CURLINE=$ORDER(^TMP($JOB,IVMRTN,CURLINE))
if 'CURLINE
QUIT
if $EXTRACT($GET(^TMP($JOB,IVMRTN,CURLINE,0)),1,3)="MSH"
QUIT
+12 SET CURLINE=+CURLINE
+13 QUIT
