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

IVMPREC3.m

Go to the documentation of this file. 
  1. IVMPREC3 ;ALB/KCL/CKN,TDM,HM - PROCESS INCOMING (Z04 EVENT TYPE) HL7 MESSAGES ;8/15/08 10:21am
  1.  ;;2.0;INCOME VERIFICATION MATCH;**3,17,34,111,115,172**;21-OCT-94;Build 27
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ;
  1.  ; This routine will process batch ORU insurance(event type Z04) HL7
  1.  ; messages received from the IVM center.  Format of batch:
  1.  ;       BHS
  1.  ;       {MSH
  1.  ;        PID
  1.  ;        IN1    could be a continuation of IN1
  1.  ;        ZIV
  1.  ;       }
  1.  ;       BTS
  1.  ;
  1. EN ; - entry point to process insurance messages
  1.  ;
  1.  N IVMPID,PIDSTR,COMP,CNTR,NOPID,TMPARY,PID3ARY,ICN,DFN,CNTR2,IVMZIV,IVMIDOB ;IVM*2.0*172 HM
  1.  F IVMDA=1:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA  S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D
  1.  .K HLERR
  1.  .;
  1.  .; - message control id from MSH segment
  1.  .S MSGID=$P(IVMSEG,HLFS,10)
  1.  .;
  1.  .; - get message segments from (#772) file
  1.  .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="PID" D  Q
  1.  ..S HLERR="Missing PID segment" D ACK^IVMPREC
  1.  .S CNTR=1,NOPID=0,PIDSTR(CNTR)=$P(IVMSEG,HLFS,2,999)
  1.  .;Handle wrapped PID segment
  1.  .F I=1:1 D  Q:NOPID
  1.  ..S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0))
  1.  ..I $E(IVMSEG,1,4)="IN1^" S NOPID=1,IVMDA=IVMDA-1 Q
  1.  ..S CNTR=CNTR+1,PIDSTR(CNTR)=IVMSEG
  1.  .D BLDPID^IVMPREC6(.PIDSTR,.IVMPID)  ;Create IVMPID subscripted by seq #
  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)=HLQ S IVMPID(CNTR)=""
  1.  .M TMPARY(3)=IVMPID(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) S HLERR=ERRMSG D ACK^IVMPREC Q
  1.  .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="IN1" D  Q
  1.  ..S HLERR="Missing IN1 segment" D ACK^IVMPREC
  1.  .S IVMSEG1=$$CLEARF^IVMPRECA($P(IVMSEG,HLFS,2,999),HLFS,",5,")
  1.  .S $P(IVMSEG1,HLFS,5)=$$CLEARF^IVMPRECA($P(IVMSEG1,HLFS,5),$E(HLECH))
  1.  .I $P(IVMSEG1,HLFS,4)']"" D  Q
  1.  ..S HLERR="Missing insurance company name" D ACK^IVMPREC
  1.  .I $P(IVMSEG1,HLFS,8)']"",($P(IVMSEG1,HLFS,9)']"") D  Q
  1.  ..S HLERR=$S($P(IVMSEG1,HLFS,7)']"":"Missing group number",1:"Missing group name") D ACK^IVMPREC
  1.  .I $P(IVMSEG1,HLFS,17)']"" D  Q
  1.  ..S HLERR="Missing insured's relation to patient" D ACK^IVMPREC
  1.  .I $P(IVMSEG1,HLFS,17)'="v",($P(IVMSEG1,HLFS,16)']"") D  Q
  1.  ..S HLERR="Missing name of insured" D ACK^IVMPREC
  1.  .I $P(IVMSEG1,HLFS,17)'="v",($P(IVMSEG1,HLFS,18)="") D  Q
  1.  ..S HLERR="Missing Insured's Date of Birth" D ACK^IVMPREC
  1.  .; - IVM Insured's Date of Birth IVM*2.0*172 HM
  1.  .I $P(IVMSEG1,HLFS,17)'="v",($P(IVMSEG1,HLFS,18)]"") S IVMIDOB=$$FMDATE^HLFNC($P(IVMSEG1,HLFS,18))
  1.  .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="ZIV",$L(IVMSEG1)'=241 D  Q
  1.  ..S HLERR="Missing ZIV segment" D ACK^IVMPREC
  1.  .S IVMSEG=$$CLEARF^IVMPRECA(IVMSEG,HLFS)
  1.  .I $P(IVMSEG,HLFS,10)']"" D  Q
  1.  ..S HLERR="Missing IVM internal entry number" D ACK^IVMPREC
  1.  .I $L(IVMSEG1)=241 D  Q:$D(IVMERR)
  1.  ..K IVMERR
  1.  ..S IVMSEG3=IVMSEG
  1.  ..S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$$CLEARF^IVMPRECA($G(^(+IVMDA,0)),HLFS)
  1.  ..I $E(IVMSEG,1,3)'="ZIV" S HLERR="Missing ZIV segment",IVMERR="" D ACK^IVMPREC
  1.  .;S IVMSEG2=$P(IVMSEG,"^",10)
  1.  .; - set IVM ZIV segment data IVM*2.0*172 HM
  1.  .I $E(IVMSEG,1,3)="ZIV" S IVMZIV=IVMSEG
  1.  .;
  1.  .; - check for date of death from IVM
  1.  .I $P(IVMSEG,"^",13)]"" S $P(IVMSEG,"^",13)=$$FMDATE^HLFNC($P(IVMSEG,"^",13))
  1.  .;
  1.  .; - ivm ien/fm date of death
  1.  .S IVMSEG2=$S($P(IVMSEG,"^",13)']"":$P(IVMSEG,"^",10),1:$P(IVMSEG,"^",10)_"/"_$P(IVMSEG,"^",13))
  1.  .S IVMDOD=IVMSEG2
  1.  .;
  1.  .; - IVM Source of Information IVM*2.0*172 HM
  1.  .N IVMSOI
  1.  .S IVMSOI=$P(IVMSEG,"^",14)
  1.  .I IVMSOI'=3&(IVMSOI'=14) D  Q
  1.  ..S HLERR="Invalid Source of Information code expecting 3 or 14" D ACK^IVMPREC
  1.  .;
  1.  .; - if no error encountered - store insurance fields in VistA
  1.  .I '$D(HLERR) D
  1.  ..N IVMRTN,IVMDA
  1.  ..D STORE
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. STORE ; - store IN1 segment fields in (#301.5) file and in buffer file
  1.  ;  (remove data from 301.5 'ASEG' xref on successful buffer file filing)
  1.  ;
  1.  N IVMI,IVMJ,IVMIN1,IVMADD
  1.  S DA(1)=$O(^IVM(301.5,"B",DFN,0)),X=$$IEN^IVMUFNC4("IN1")
  1.  I DA(1)']"" S HLERR="patient missing from IVM PATIENT file" D ACK^IVMPREC Q
  1.  I X<0 S HLERR="IN1 segment not in HL7 SEGMENT NAME file" D ACK^IVMPREC Q
  1.  I $G(^IVM(301.5,DA(1),"IN",0))']"" S ^(0)="^301.501PA^^"
  1.  S DIC="^IVM(301.5,"_DA(1)_",""IN"",",DIC(0)="L"
  1.  S DIC("DR")=".03///NOW;.07////^S X=IVMSEG2;10////^S X=IVMSEG1",DLAYGO=301.501
  1.  S:$D(IVMSEG3) DIC("DR")=".03///NOW;.07////^S X=IVMSEG2;10////^S X=IVMSEG1;11////^S X=IVMSEG3"
  1.  K DD,DO D FILE^DICN K DIC,DLAYGO
  1.  Q:Y'>0
  1.  S IVMI=DA(1),IVMJ=+Y
  1.  ; Patch IVMB*2*111 automatically files the record into the buffer file
  1.  ; and removes the notification bulletin to IVM and the segment from
  1.  ; file 301.501
  1.  K DA,X,Y
  1.  S IVMIN1=$$GETIN1^IVMLINS1(IVMI,IVMJ),IVMADD=$P(IVMIN1,U,5)
  1.  D TRANSFER^IVMLINS3(1),IVMQ^IVMLINS1
  1.  Q
  1.  ;