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

IVMPREC.m

Go to the documentation of this file.
  1. IVMPREC ;ALB/MLI/ESD,BAJ - PROCESS INCOMING HL7 (QRY) MESSAGES ; 8/17/06 2:37pm
  1. ;;2.0;INCOME VERIFICATION MATCH;**1,9,11,15,18,24,34,105**;JUL 8,1996;Build 2
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; This routine will process (QRY) HL7 messages received from HEC
  1. ; At present, the (QRY) message queries for updated information
  1. ; for a single patient.
  1. ;
  1. ;
  1. QRY ; - Receive Query Message requesting further information
  1. ;
  1. S (HLEVN,IVMCT,IVMERROR,IVMFLAG)=0
  1. ;
  1. K IVMQUERY("LTD"),IVMQUERY("OVIS") ;Variables needed to open/close last visit date and outpt visit QUERIES
  1. S IVMRTN="IVMPREC"
  1. K ^TMP($J,IVMRTN),^TMP("HLS",$J),^TMP("HLA",$J)
  1. F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. .S CNT=0
  1. .S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE
  1. .F S CNT=$O(HLNODE(CNT)) Q:'CNT D
  1. ..S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
  1. ;
  1. ; INITIALIZE HL7 VARIABLES
  1. S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORF-Z07 SERVER"
  1. S HLEID=$O(^ORD(101,"B",HLEID,0))
  1. D INIT^HLFNC2(HLEID,.HL)
  1. S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
  1. ;
  1. ; IVM*2.0*105 BAJ 11/02/2005 Temp global for Consistency Checks
  1. K ^TMP($J,"CC")
  1. ;
  1. F IVMDA=0:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="QRD"!($E(IVMSEG,1,3)="MSH") D
  1. .I $E(IVMSEG,1,3)="MSH" S IVMMSHID=$P(IVMSEG,HLFS,10),MSGID=$P(IVMSEG,HLFS,10),HLMID=MSGID Q
  1. .K HLERR S IVMFLAG=1
  1. .S IVMSEG=$P(IVMSEG,HLFS,2,999) ; strip off segment name
  1. .S IVMQLR=$P(IVMSEG,HLFS,7),DFN=$P(IVMSEG,HLFS,8),IVMIY=$P(IVMSEG,HLFS,10)
  1. .D ERRCK
  1. .I $D(HLERR) D ACK
  1. .I '$D(HLERR) D
  1. ..N EVENTS
  1. ..; - if master query - create entry in (#301.9) file
  1. ..I IVMQLR>1,'DFN D Q
  1. ...S IVMSEG1="QRD"_HLFS_IVMSEG
  1. ...S:'$D(^IVM(301.9,1,10,0)) ^(0)="^301.9001DA^"
  1. ...S DA(1)=1,DIC="^IVM(301.9,1,10,",DIC(0)=""
  1. ...S X=IVMIY
  1. ...K DO,DD D FILE^DICN
  1. ...S DA=+Y,DA(1)=1,DIE="^IVM(301.9,1,10,"
  1. ...S DR=".02///NOW;.04////^S X=IVMMSHID;10////^S X=IVMSEG1" D ^DIE
  1. ..;
  1. ..; Send AE if veteran has a Pseudo SSN and eligibility is not verified
  1. ..; Removed with IVM*2*105
  1. ..; I '$$SNDPSSN^IVMPTRN7(DFN) S HLERR="Pseudo SSN must be verified" D ACK Q
  1. ..;
  1. ..; - prepare (ACK) message
  1. ..D:'$D(HLERR) MSGHDR ;header (MSH)
  1. ..D ACK ;message (MSA)
  1. ..;
  1. ..; - set up local HL7 event type code in MSH
  1. ..S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)="QRD"_HLFS_IVMSEG ; copy of incoming QRD
  1. ..;
  1. ..; - build 'FULL' transmission (note: without MSH segment)
  1. ..S IVMMTDT=$E(IVMIY,1,3)+1_"1231.9999"
  1. ..D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,1,,.IVMQUERY)
  1. ;
  1. ; IVM*2.0*105 BAJ 11/02/2005
  1. ; send AE if inconsistencies found.
  1. I ^TMP($J,"CC",0) S HLERR="Message not sent. Inconsistencies in Record" D ACK
  1. K ^TMP($J,"CC")
  1. ;
  1. F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
  1. I 'IVMFLAG S HLERR="Invalid Message Format" D ACK
  1. S HLMTN="ORF"
  1. S HLMTIENA=HLMTIEN
  1. K ^TMP("HLA",$J) M ^TMP("HLA",$J)=^TMP("HLS",$J) K ^TMP("HLS",$J)
  1. D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,"GB",1,.HLRESLTA,HLMTIENA,.HLP)
  1. ;
  1. QRYQ K DFN,DR,HLEVN,IVMCT,IVMDA,IVMERROR,IVMFLAG,IVMIY,IVMMTDT,IVMSEG,IVMSEG1,IVMQLR,IVMMSHID,MSGID,MSHID
  1. K ^TMP("HLA",$J),^TMP("HLS",$J),^TMP($J,IVMRTN)
  1. Q
  1. ;
  1. ;
  1. ERRCK ; Perform error checks on HL7 (QRD) segment
  1. I ('DFN!(DFN'=+DFN)) S:IVMQLR'>1 HLERR="Invalid DFN"
  1. I '$D(HLERR) S IVMIY=$$FMDATE^HLFNC(IVMIY) I $E(IVMIY,4,7)'="0000"!($E(IVMIY,1,3)<292) S HLERR="Invalid Income Year"
  1. I '$D(HLERR),$P(IVMSEG,HLFS,2)'="R" S HLERR="Invalid Query Format Code"
  1. I '$D(HLERR),$P(IVMSEG,HLFS,3)'="I",($P(IVMSEG,HLFS,3)'="D") S HLERR="Invalid Query Priority"
  1. I '$D(HLERR),$P(IVMSEG,HLFS,9)'="DEM" S HLERR="Invalid Query Subject Filter"
  1. I '$D(HLERR),$P(IVMSEG,HLFS,12)'="T" S HLERR="Invalid Query Results Level"
  1. ;
  1. Q
  1. ;
  1. MSGHDR ; prepare header MSH segment in batch of 100 message events
  1. ; input variables:
  1. ; IVMCT record counter
  1. ; HLEVN event number
  1. ; MSHID outgoing message id
  1. ; HL array for protocol
  1. ;
  1. N MID,HLRES
  1. S HLEVN=$G(HLEVN)+1
  1. D:(HLEVN#100)=1
  1. .K MSHID,HLDT,HLDT1,HLMTIEN
  1. .D INIT^HLFNC2(HLEID,.HL)
  1. .D CREATE^HLTF(.MSHID,.HLMTIEN,.HLDT,.HLDT1)
  1. S MID=MSHID_"-"_HLEVN
  1. D MSH^HLFNC2(.HL,MID,.HLRES)
  1. S IVMCT=$G(IVMCT)+1
  1. S ^TMP("HLS",$J,IVMCT)=HLRES
  1. Q
  1. ;
  1. ACK ; prepare positive and negative acknowledgement (ACK) message
  1. ; (positive acknowledgement: MSA segment with no MSH segment)
  1. ; (negative acknowledgement: MSA segment with MSH segment)
  1. N MID,HLRES
  1. S IVMCT=$G(IVMCT)+1
  1. D:$D(HLERR)
  1. .S IVMERROR=1
  1. .S HLEVN=HLEVN+1
  1. .D:(HLEVN#100)=1
  1. ..K HLMID,HLMTIEN,HLDT,HLDT1 ; set up batch
  1. ..D INIT^HLFNC2(HLEID,.HL)
  1. ..D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
  1. .S MID=HLMID_"-"_HLEVN
  1. .D MSH^HLFNC2(.HL,MID,.HLRES)
  1. .S ^TMP("HLS",$J,IVMCT)=HLRES
  1. .S IVMCT=IVMCT+1
  1. .S ^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_HLERR_"- SSN "_$S($G(DFN):$P($$PT^IVMUFNC4(DFN),"^",2),1:"NOT FOUND")
  1. I '$D(HLERR) S ^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AA"_HLFS_HLMID
  1. ;
  1. Q
  1. ;