- 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 Jan 18, 2025@03:43:58 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