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

DGENUPL.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;Phase II Moved Z11 to DGENUPL7
  1. ORUZ11(MSGIEN,ERRCOUNT) ;
  1. ;Description: This procedure is used to process a batch of ORU~Z11
  1. ;messages or a single ORU~Z11 message. The processing consists of
  1. ;uploading the patient enrollment and eligibility data.
  1. ;
  1. ;Input:
  1. ; MSGIEN - the ien of the HL7 message in the HL7 MESSAGE TEXT file
  1. ;Output:
  1. ; ERRCOUNT - count of messages that were not processed due to
  1. ; errors encountered (pass by reference)
  1. ;
  1. N CURLINE,SSN,DOB,SEX,SEG,MSGID,DFN,ERRMSG,TMPARRY,ICN
  1. ;
  1. K ^TMP("IVM","HLS",$J)
  1. ;
  1. ;initialize HL7 variable
  1. S HLSDT="IVMQ" ;location of error message
  1. ;
  1. S CURLINE=1
  1. D ADVANCE(MSGIEN,.CURLINE)
  1. Q:'CURLINE
  1. F Q:'CURLINE D D ADVANCE(MSGIEN,.CURLINE)
  1. .D GETSEG(MSGIEN,CURLINE,.SEG)
  1. .S MSHDT=SEG(7)
  1. .S MSGID=SEG(10)
  1. .D NXTSEG(MSGIEN,CURLINE,.SEG)
  1. .I SEG("TYPE")'="PID" D ADDERROR(MSGID,,"PID SEGMENT MISSING",.ERRCOUNT) Q
  1. .;S DFN=$$LOOKUP^DGENPTA(SEG(19),$$FMDATE^HLFNC(SEG(7)),SEG(8),.ERRMSG)
  1. .M TMPARY(3)=SEG(3) D PARSPID3^IVMUFNC(.TMPARY,.PID3ARY)
  1. .S DFN=$G(PID3ARY("PI")),ICN=$G(PID3ARY("NI"))
  1. .K TMPARY,PID3ARY
  1. .I '$$MATCH^IVMUFNC(DFN,ICN,"","","I",.ERRMSG) D ADDERROR(MSGID,SEG(19),ERRMSG,.ERRCOUNT) Q
  1. .;I 'DFN D ADDERROR(MSGID,SEG(19),ERRMSG,.ERRCOUNT) Q
  1. .D Z11^DGENUPL7(MSGIEN,MSGID,.CURLINE,DFN,.ERRCOUNT)
  1. S HLEVN=+$G(ERRCOUNT) ;# of events included in the reply
  1. M ^TMP("HLS",$J)=^TMP("IVM","HLS",$J) ;DG*5.3*472
  1. K ^TMP("IVM","HLS",$J)
  1. Q
  1. ;
  1. ORFZ11(MSGIEN,MSGID) ;
  1. ;Description: This procedure is used to process an ORF~Z11 message
  1. ;It uploads the patient enrollment and eligibility data.
  1. ;An acknowledgment is returned.
  1. ;
  1. ;Input:
  1. ; MSGIEN - the internal entry number of the HL7 message in the HL7 MESSAGE TEXT file (772)
  1. ; MSGID - the message control id from the MSH segment
  1. ;
  1. ;Output: none
  1. ;
  1. N CURLINE,DFN,QUERYIEN,QARRAY,QRYMSGID,ERRCOUNT,HECERROR,SEG,DGRESENT
  1. N TMPARRY,PID3ARRY,ICN
  1. ;CURLINE tracks current line in the message
  1. ;QUERYIEN the ien of query in the ENROLLMENT QUERY LOG
  1. ;QRYMSGID the Message Control ID of the query
  1. ;QARRAY array containing the ENROLLMENT QUERY LOG record
  1. ;HECERROR error message returned by HEC in response to query
  1. ;DGRESENT flag=1 if query was resent
  1. ;
  1. S (QUERYIEN,ERRCOUNT)=0
  1. ;
  1. ;initialize HL7 variable
  1. S HLSDT="IVMQ" ;subscript in ^TMP( global for ACK message
  1. ;
  1. K ^TMP("IVM","HLS",$J)
  1. ;
  1. S CURLINE=1
  1. S HECERROR=""
  1. D GETSEG(MSGIEN,CURLINE,.SEG) ; DG*5.3*871
  1. S MSHDT=SEG(7) ; DG*5.3*871
  1. S MSGID=SEG(10) ; DG*5.3*871
  1. ;
  1. D ;drops out on error
  1. .D NXTSEG(MSGIEN,.CURLINE,.SEG)
  1. .I SEG("TYPE")'="MSA" D ADDERROR(MSGID,,"MISSING MSA SEGMENT",.ERRCOUNT) Q
  1. .;trace the reply back to the query
  1. .S QRYMSGID=SEG(2)
  1. .S QUERYIEN=$$FINDMSG^DGENQRY(QRYMSGID)
  1. .I 'QUERYIEN D ADDERROR(MSGID,,"NO RECORD OF QUERY",.ERRCOUNT) Q
  1. .I QUERYIEN,'$$GET^DGENQRY(QUERYIEN,.QARRAY) D ADDERROR(MSGID,,"NO RECORD OF QUERY",.ERRCOUNT) Q
  1. .S DFN=QARRAY("DFN")
  1. .I (SEG(1)="AR")!(SEG(1)="AE") D Q
  1. ..;HEC was unable to reply to the query. If due to incorrect patient
  1. ..;info, then resend the query, otherwise just log it as unsuccessful
  1. ..N SSN,DOB,SEX,DGPAT,HECMSG
  1. ..S HECMSG=SEG(3)
  1. ..D NXTSEG(MSGIEN,.CURLINE,.SEG)
  1. ..Q:(SEG("TYPE")'="QRD")
  1. ..S SSN=SEG(8)
  1. ..D NXTSEG(MSGIEN,.CURLINE,.SEG)
  1. ..Q:(SEG("TYPE")'="QRF")
  1. ..S DOB=$$FMDATE^HLFNC(SEG(4))
  1. ..S SEX=SEG(5)
  1. ..;if patient id info incorrect, resend the query
  1. ..I $$GET^DGENPTA(DFN,.DGPAT),((DOB'=DGPAT("DOB"))!(SEX'=DGPAT("SEX"))) I $$RESEND^DGENQRY1(QUERYIEN) S DGRESENT=1 Q
  1. ..S HECERROR="HEC UNABLE TO RESPOND TO QUERY- "_HECMSG Q
  1. .;
  1. .F SEG="QRD","QRF" D NXTSEG(MSGIEN,.CURLINE,.SEG) I SEG("TYPE")'=SEG D ADDERROR(MSGID,,SEG_" SEGMENT MISSING",.ERRCOUNT) Q
  1. .S SEG="PID" D NXTSEG(MSGIEN,CURLINE,.SEG) I SEG("TYPE")'=SEG D ADDERROR(MSGID,,SEG_" SEGMENT MISSING",.ERRCOUNT) Q
  1. .;S CURLINE=CURLINE-1 ;should point to line before PID
  1. .;I $$SSN^DGENPTA(DFN)'=SEG(19) D ADDERROR(MSGID,,"SSN DOES NOT MATCH",.ERRCOUNT) Q
  1. .M TMPARY(3)=SEG(3) D PARSPID3^IVMUFNC(.TMPARY,.PID3ARY)
  1. .S DFN=$G(PID3ARY("PI")),ICN=$G(PID3ARY("NI"))
  1. .K TMPARY,PID3ARY
  1. .I '$$MATCH^IVMUFNC(DFN,ICN,"","","I",.ERRMSG) D ADDERROR(MSGID,,ERRMSG,.ERRCOUNT) Q
  1. .D Z11^DGENUPL7(MSGIEN,MSGID,.CURLINE,DFN,.ERRCOUNT)
  1. ;
  1. ;update the query log
  1. I $G(HECERROR)="",ERRCOUNT S HECERROR="UPLOAD FAILED DUE TO CONSISTENCY CHECKS"
  1. I '$G(DGRESENT),$$RECEIVE^DGENQRY1(QUERYIEN,HECERROR,MSGID)
  1. ;
  1. S HLEVN=+$G(ERRCOUNT) ;# of events included in the reply
  1. ;
  1. ;if there was no error, create an 'AA' ack
  1. ;I 'ERRCOUNT D ACCEPT^DGENUPL1(MSGID) ;DG*5.3*472
  1. ;D MVERRORS^DGENUPL1 ;DG*5.3*472
  1. ;transmit the ack
  1. ;********************************************************
  1. ;7.12.01;KSD; COMMENTED OUT. DON'T SEND ACK TO ORF
  1. ;I $D(HLTRANS) S HLARYTYP="GB",HLFORMAT=1 D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,.HLRESLTA,HLMTIEN)
  1. ;
  1. Q
  1. ;
  1. ADDERROR(MSGID,SSN,ERRMSG,ERRCOUNT) ;
  1. ;Description - writes an error message to a global. It will be
  1. ;transmitted in the ack later.
  1. ;
  1. ;Inputs:
  1. ; MSGID -message control id of HL7 msg in the MSH segment
  1. ; SSN - patient social security number
  1. ; ERRMSG - the error message
  1. ; ERRCOUNT - count of errors written so far
  1. ;
  1. ;Outputs: none
  1. ;
  1. S ERRCOUNT=+$G(ERRCOUNT)
  1. ;
  1. I (ERRCOUNT*2)+1=1 D
  1. . K HL,HLMID,HLMTIEN,HLDT,HLDT1
  1. . D INIT^HLFNC2(HLEID,.HL)
  1. . D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
  1. K HLRES
  1. S MID=HLMID_"-"_((ERRCOUNT*2)+1)
  1. D MSH^HLFNC2(.HL,MID,.HLRES)
  1. S ^TMP("IVM","HLS",$J,(ERRCOUNT*2)+1)=HLRES
  1. S ^TMP("IVM","HLS",$J,(ERRCOUNT*2)+2)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_ERRMSG_" - SSN "_$S($L($G(SSN)):SSN,1:"NOT FOUND")
  1. S ERRCOUNT=ERRCOUNT+1
  1. ;Put in error message in HECERROR to be included in the NOTIFY message for a solicited query
  1. I $D(HECERROR) S HECERROR=ERRMSG
  1. Q
  1. ;
  1. NXTSEG(MSGIEN,CURLINE,SEG) ;
  1. ;Description: Returns the next segment
  1. ;
  1. ;Input:
  1. ; MSGIEN - ien in HL7 MESSAGE TEXT file
  1. ; CURLINE - subscript of the current segment
  1. ;
  1. ;Output:
  1. ; SEG - an array with the fields of the segment (pass by reference)
  1. ; CURLINE - upon exiting, will be the subscript of the next segment
  1. ;
  1. S CURLINE=CURLINE+1
  1. D GETSEG(MSGIEN,.CURLINE,.SEG)
  1. Q
  1. ;
  1. GETSEG(MSGIEN,CURLINE,SEG) ;
  1. ;returns the current segment
  1. ;
  1. ;Input:
  1. ; MSGIEN - ien in HL7 MESSAGE TEXT file
  1. ; CURLINE - subscript of the current segment
  1. ;
  1. ;Output:
  1. ; SEG - an array with the fields of the segment (pass by reference)
  1. ;
  1. N SEGMENT,I,CNTR,NOPID,PIDSTR,IVMPID,SEGHLD,CNTR2
  1. I $G(SEG)'="" S SEGHLD=SEG
  1. K SEG
  1. S SEG=$G(SEGHLD)
  1. S CNTR=1,NOPID=0
  1. S:$G(HLFS)="" HLFS=$G(HL("FS")) S:HLFS="" HLFS="^"
  1. S SEGMENT=$G(^TMP($J,IVMRTN,CURLINE,0))
  1. S SEG("TYPE")=$E(SEGMENT,1,3)
  1. ;Strip double quotes from the following segments. DG*5.3*688
  1. I SEG("TYPE")="ZRD" D
  1. .S SEGMENT=$$CLEARF^IVMPRECA(SEGMENT,HLFS)
  1. I SEG("TYPE")="PID" D Q
  1. .S PIDSTR(CNTR)=$P(SEGMENT,HLFS,2,99)
  1. .F I=1:1 D Q:NOPID
  1. ..S CURLINE=CURLINE+1,SEGMENT=$G(^TMP($J,IVMRTN,CURLINE,0))
  1. ..I $E(SEGMENT,1,4)="ZPD^" S NOPID=1,CURLINE=CURLINE-1 Q
  1. ..S CNTR=CNTR+1,PIDSTR(CNTR)=SEGMENT
  1. .D BLDPID^IVMPREC6(.PIDSTR,.IVMPID)
  1. .;convert "" to null for PID segment
  1. .S CNTR="" F S CNTR=$O(IVMPID(CNTR)) Q:CNTR="" D
  1. ..I $O(IVMPID(CNTR,"")) D Q
  1. ...S CNTR2="" F S CNTR2=$O(IVMPID(CNTR,CNTR2)) Q:CNTR2="" D
  1. ....S IVMPID(CNTR,CNTR2)=$$CLEARF^IVMPRECA(IVMPID(CNTR,CNTR2),$E(HLECH))
  1. ..I IVMPID(CNTR)="""""" S IVMPID(CNTR)=""
  1. .M SEG=IVMPID
  1. ;
  1. ;the MSH & BHS segs contain as their first piece the field separator, which makes breaking the segment into fields a bit different
  1. I (SEG("TYPE")="MSH")!(SEG("TYPE")="BHS") D
  1. .S SEG(1)=$E(SEGMENT,4)
  1. .F I=2:1:30 S SEG(I)=$P(SEGMENT,HLFS,I)
  1. E D
  1. .; Expanded to 48 from 45 to allow for OTH fields DG*5.3*952
  1. .;DG*5.3*1103 - Expand to allow Sequence #48 of ZEL segment
  1. .;F I=2:1:48 S SEG(I-1)=$P(SEGMENT,HLFS,I)
  1. .;DG*5.3*1121 - Expand to allow Persian Gulf Indicator (Seq #49) and Persian Gulf Change date/time (Seq #50) of ZEL segment
  1. .;F I=2:1:49 S SEG(I-1)=$P(SEGMENT,HLFS,I)
  1. .F I=2:1:51 S SEG(I-1)=$P(SEGMENT,HLFS,I)
  1. Q
  1. ;
  1. ADVANCE(MSGIEN,CURLINE) ;
  1. ;Description: Used to find the beginning of the next message in the batch.
  1. ;
  1. ;Input:
  1. ; MSGIEN - ien of message in the HL7 MESSAGE TEXT file.
  1. ; CURLINE - current position in the message
  1. ;Output:
  1. ; CURLINE - starting position of next message in the batch, or 0 if
  1. ; the end of the message is reached
  1. ;
  1. Q:'CURLINE
  1. F S CURLINE=$O(^TMP($J,IVMRTN,CURLINE)) Q:'CURLINE Q:$E($G(^TMP($J,IVMRTN,CURLINE,0)),1,3)="MSH"
  1. S CURLINE=+CURLINE
  1. Q