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

AGMPIACK.m

Go to the documentation of this file. 
  1. AGMPIACK ; IHS/SD/TPF - MPI A28/A08 ACK PROCESSOR ; 12/15/2007
  1.  ;;7.2;IHS PATIENT REGISTRATION;**1,3,6**;MAY 20, 2010;Build 23
  1.  ;
  1.  Q
  1.  ;
  1. PROC(HLMSGIEN) ;EP -
  1.  ; 06/7/2013 - DMB - TFS8067 - Use unique variables for the HLA and HLB IENs
  1.  ; 9/01/2017 - GCD - CR 9578 - Added error trap so bad messages will get removed from the queue by the calling routine.
  1.  N $ESTACK,$ETRAP S $ETRAP="D UNWIND^%ZTER"
  1.  N DATA,HLMSTATE,MSGID,MSGSEG,ICNEUID,RETCODE,NEXTSEG,SENDER,HL778IEN,HL777IEN,MCIDACK,MCIDORIG
  1.  D PARSE(.DATA,HLMSGIEN,.HLMSTATE)
  1.  N NXT,ICNEUID,LOCALID,SETICN,SEGIEN,SEGMENT,ACKIEN,SEGTYPE,PICN
  1.  S ACKIEN=HLMSGIEN
  1.  S HL778IEN=$P($G(DATA(1,3,1,1,1))," ",2)  ;MSG ID OF THE MSG THIS ACK IS RESPONDING TO
  1.  I HL778IEN="" D  Q
  1.  .S ERROR="NO ORIGINATING MSG ID FOUND WHERE ACKIEN='"_ACKIEN_"'"
  1.  .D MSGERR("",ACKIEN,ACKIEN,ERROR)
  1.  ; 05/30/2013 - KJH - TFS8073 - Check whether the message we are ACK'ing is an "RPMS-MPI" (since there have been 'overwrite' issues in the past).
  1.  S SENDER=$P($G(^HLB(HL778IEN,1)),HLMSTATE("HDR","FIELD SEPARATOR"),3)
  1.  I SENDER'="RPMS-MPI" D  Q
  1.  .S ERROR="SENDER NOT 'RPMS-MPI'"
  1.  .D MSGERR("",ACKIEN,HL778IEN,ERROR)
  1.  ; 9/01/2017 - GCD - CR 9520 - Verify the message control IDs match.
  1.  S MCIDACK=$G(DATA(1,3,1,1,1)),MCIDORIG=$P($G(^HLB(HL778IEN,2)),HLMSTATE("HDR","FIELD SEPARATOR"),5)
  1.  I MCIDACK'=MCIDORIG D  Q
  1.  .S ERROR="MESSAGE CONTROL ID MISMATCH: "_MCIDACK_" | "_MCIDORIG
  1.  .D MSGERR("",ACKIEN,HL778IEN,ERROR)
  1.  S HL777IEN=$P($G(^HLB(HL778IEN,0)),U,2)   ;GET THE CORRECT ORIGINATING MESSAGE
  1.  I HL777IEN="" D  Q
  1.  .S ERROR="NO ORIGINATING MSG BODY ID FOUND WHERE ACKIEN='"_ACKIEN_"'"
  1.  .D MSGERR("",ACKIEN,HL778IEN,ERROR)
  1.  S MSGSEG=$G(DATA(1,1,1,1,1))
  1.  ; 05/29/2013 - KJH - TFS8073 - Segment 3 must be a PID. Make sure (as far as possible) that we're ACK'ing the right message.
  1.  S SEGTYPE=$E($G(^HLA(HL777IEN,1,3,0)),1,3)
  1.  I SEGTYPE'="PID" D  Q
  1.  .S ERROR="PID SEGMENT NOT FOUND"
  1.  .D MSGERR("",ACKIEN,HL778IEN,ERROR)
  1.  ;05/29/2013 - KJH - TFS8073 - Added $G to line below to correct an UNDEF. Moved NULL check for LOCALID from later in code.
  1.  ;05/30/2013 - KJH - TFS8073 - Also added the FIELD SEPARATOR for consistency.
  1.  S LOCALID=$P($P($P($G(^HLA(HL777IEN,1,3,0)),HLMSTATE("HDR","FIELD SEPARATOR"),4),HLMSTATE("HDR","REPETITION SEPARATOR"),3),HLMSTATE("HDR","COMPONENT SEPARATOR"))
  1.  I LOCALID="" D  Q
  1.  .S ERROR="LOCALID NULL FOR ACK"
  1.  .D MSGERR("",ACKIEN,HL778IEN,ERROR)
  1.  S ACKCODE=$G(DATA(1,2,1,1,1))
  1.  S IFERR=ACKCODE="CE"!(ACKCODE="CR")!(ACKCODE="AE")!(ACKCODE="AR")
  1.  I IFERR D  Q
  1.  .S $P(^HLB(HL778IEN,0),U,20)=""
  1.  .S ERROR=ACKCODE_" "_$G(DATA(2,2,1,4,1))
  1.  .D MSGERR(LOCALID,ACKIEN,HL778IEN,ERROR)
  1.  S ICNEUID=$P($G(DATA(1,7,1,1,1)),"=",2)
  1.  I ICNEUID="" D  Q
  1.  .S ERROR="NO ICNEUID RETURNED"
  1.  .D MSGERR(LOCALID,ACKIEN,HL778IEN,ERROR)
  1.  I '$D(^DPT(LOCALID)) D  Q
  1.  .S ERROR="PATIENT RECORD DOES NOT EXIST"
  1.  .D MSGERR(LOCALID,ACKIEN,HL778IEN,ERROR)
  1.  ;06/07/2013 - DMB - TFS8073 - Update ICN if it has changed
  1.  S PICN=$$GET1^DIQ(2,LOCALID_",",991.01,"E") ;INTEGRATION CONTROL NUMBER
  1.  I ICNEUID]"",ICNEUID'=PICN D ADDICN(ICNEUID,LOCALID) Q
  1.  ;06/07/2013 - DMB - TFS8073 - Call MSGCMPLT if not doing ADDICN (which will do it if there is not an error)
  1.  D MSGCMPLT^AGMPIBGP(ACKIEN)
  1.  D MSGCMPLT^AGMPIBGP(HL778IEN)
  1.  Q
  1.  ;
  1. PARSE(DATA,MIEN,HLMSTATE) ;EP
  1.  N SEG,CNT
  1.  Q:'$$STARTMSG^HLOPRS(.HLMSTATE,MIEN)
  1.  M DATA("HDR")=HLMSTATE("HDR")
  1.  S CNT=0
  1.  F  Q:'$$NEXTSEG^HLOPRS(.HLMSTATE,.SEG)  D
  1.  .S CNT=CNT+1
  1.  .M DATA(CNT)=SEG
  1.  Q
  1.  ;
  1. ADDICN(AGICN,DFN) ;EP - ADD TO 'INTEGRATED CONTROL NUMBER' FIELD
  1.  K DIE,DIC,DA,DR,DIR
  1.  S DIE="^DPT("
  1.  S DA=DFN
  1.  S RGRSICN=1
  1.  S DR="991.01///^S X=AGICN"
  1.  D ^DIE
  1.  I $$GET1^DIQ(2,DFN_",",991.01)="" D  Q
  1.  .S ERROR="FIELD 991.01 DID NOT POPULATE"
  1.  .D MSGERR(DFN,ACKIEN,HL778IEN,ERROR)
  1.  ; 06/07/2013 - DMB - TFS8073 - Remove RESEND variable
  1.  D MSGCMPLT^AGMPIBGP(ACKIEN)
  1.  D MSGCMPLT^AGMPIBGP(HL778IEN)
  1.  Q
  1.  ;
  1. MSGERR(LOCALID,ACKIEN,HL778IEN,ERROR) ;EP - ERROR OCURRED IN A28 ACK
  1.  S AGERROR="MPI ERR ACK IEN "_ACKIEN_" - MSG IEN "_HL778IEN_" :: "_ERROR
  1.  D NOTIF^AGMPIHLO(LOCALID,AGERROR)
  1.  ;06/7/2013 - DMB - TFS8073 - If there is an error, mark it complete so the process can move on to the next ack
  1.  D MSGCMPLT^AGMPIBGP(ACKIEN)
  1.  Q