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

IBCNEHLK.m

Go to the documentation of this file.
  1. IBCNEHLK ;DAOU/ALA - HL7 Acknowledgement Messages ;08-OCT-2002
  1. ;;2.0;INTEGRATED BILLING;**184,300,601**;21-MAR-94;Build 14
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. MFK ; MFN Acknowledgement
  1. S HCT=1
  1. ; Loop through the message and find each segment for processing
  1. F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D
  1. . D SPAR^IBCNEHLU
  1. . S SEG=$G(IBSEG(1))
  1. . ;
  1. . I SEG="MSA" D
  1. .. S ACK=$G(IBSEG(2)),MSGID=$G(IBSEG(3))
  1. .. ;
  1. .. I ACK="AE" S VMFN(350.9,"1,",51.22)=0
  1. .. I ACK="AA" S VMFN(350.9,"1,",51.22)=1
  1. ;
  1. D FILE^DIE("I","VMFN")
  1. ;
  1. K IBSEG,SEG,HCT,ACK,EVENT,HL,IBPRTCL,IDUZ,MSGID,SEGMT,TAG,VMFN
  1. Q
  1. ; IB*2.0*601 - Added new logic for ACK tag.
  1. ACK ; ACK Acknowledgement
  1. N IBCNHLP,HCT,MSA,MFI,MFA,CONTROL,HLFS
  1. K ^TMP("HLA",$J)
  1. S HCT=0
  1. S HLFS="|"
  1. ;
  1. D MSA S HCT=HCT+1,^TMP("HLA",$J,HCT)=$TR(MSA,"*","")
  1. D MFI S HCT=HCT+1,^TMP("HLA",$J,HCT)=$TR(MFI,"*","")
  1. D MFA S HCT=HCT+1,^TMP("HLA",$J,HCT)=$TR(MFA,"*","")
  1. ;
  1. D GENACK^HLMA1($$FIND1^DIC(101,,,"IBCNE IIV MFN IN","B"),HLMTIENS,$$FIND1^DIC(101,,,"IBCNE IIV TABLE","B"),"GM",1,.ERROR)
  1. K ^TMP("HLA",$J),HL,ERROR
  1. ;
  1. Q
  1. MSA ; MSA Segment
  1. N DATA,CONTROL
  1. S CONTROL=$P($G(^TMP($J,"IBCNEHLI",1,0)),"|",10) ; Table Update Message Control ID
  1. S MSA="MSA"_HLFS_$G(IBACK)_HLFS_CONTROL
  1. Q
  1. ;
  1. MFI ; MFI Segment
  1. S MFI=$G(^TMP($J,"IBCNEHLI",2,0)) ; Return this segment.
  1. S $P(MFI,HLFS,7)="NE"
  1. Q
  1. MFA ; MFA Segment
  1. N I,ECODE,DATA,IDMFA
  1. S ECODE="",IDMFA=""
  1. F I=1:1 Q:'$D(^TMP($J,"IBCNEHLI",I,0)) D Q:ECODE'=""
  1. .S DATA=^TMP($J,"IBCNEHLI",I,0)
  1. .I $P(DATA,"|")="MFE" S ECODE=$P(DATA,"|",2),IDMFA=$P(DATA,"|",5)
  1. S MFA="MFA"_HLFS_ECODE_HLFS_HLFS_HLFS_$S(IBACK="AA":"S",1:"U")_HLFS_IDMFA_HLFS_"CE"
  1. Q
  1. MLMN ; MailMan Message
  1. D TXT^IBCNEUT7("MSG")
  1. S MGRP=$$MGRP^IBCNEUT5()
  1. S XMSUB="IBCNE IIV MFN IN"
  1. D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
  1. K XMSUB,XMY,MSG,XMZ,XMDUZ
  1. Q