- IBCNEHLK ;DAOU/ALA - HL7 Acknowledgement Messages ;08-OCT-2002
- ;;2.0;INTEGRATED BILLING;**184,300,601**;21-MAR-94;Build 14
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- MFK ; MFN Acknowledgement
- S HCT=1
- ; Loop through the message and find each segment for processing
- F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D
- . D SPAR^IBCNEHLU
- . S SEG=$G(IBSEG(1))
- . ;
- . I SEG="MSA" D
- .. S ACK=$G(IBSEG(2)),MSGID=$G(IBSEG(3))
- .. ;
- .. I ACK="AE" S VMFN(350.9,"1,",51.22)=0
- .. I ACK="AA" S VMFN(350.9,"1,",51.22)=1
- ;
- D FILE^DIE("I","VMFN")
- ;
- K IBSEG,SEG,HCT,ACK,EVENT,HL,IBPRTCL,IDUZ,MSGID,SEGMT,TAG,VMFN
- Q
- ; IB*2.0*601 - Added new logic for ACK tag.
- ACK ; ACK Acknowledgement
- N IBCNHLP,HCT,MSA,MFI,MFA,CONTROL,HLFS
- K ^TMP("HLA",$J)
- S HCT=0
- S HLFS="|"
- ;
- D MSA S HCT=HCT+1,^TMP("HLA",$J,HCT)=$TR(MSA,"*","")
- D MFI S HCT=HCT+1,^TMP("HLA",$J,HCT)=$TR(MFI,"*","")
- D MFA S HCT=HCT+1,^TMP("HLA",$J,HCT)=$TR(MFA,"*","")
- ;
- D GENACK^HLMA1($$FIND1^DIC(101,,,"IBCNE IIV MFN IN","B"),HLMTIENS,$$FIND1^DIC(101,,,"IBCNE IIV TABLE","B"),"GM",1,.ERROR)
- K ^TMP("HLA",$J),HL,ERROR
- ;
- Q
- MSA ; MSA Segment
- N DATA,CONTROL
- S CONTROL=$P($G(^TMP($J,"IBCNEHLI",1,0)),"|",10) ; Table Update Message Control ID
- S MSA="MSA"_HLFS_$G(IBACK)_HLFS_CONTROL
- Q
- ;
- MFI ; MFI Segment
- S MFI=$G(^TMP($J,"IBCNEHLI",2,0)) ; Return this segment.
- S $P(MFI,HLFS,7)="NE"
- Q
- MFA ; MFA Segment
- N I,ECODE,DATA,IDMFA
- S ECODE="",IDMFA=""
- F I=1:1 Q:'$D(^TMP($J,"IBCNEHLI",I,0)) D Q:ECODE'=""
- .S DATA=^TMP($J,"IBCNEHLI",I,0)
- .I $P(DATA,"|")="MFE" S ECODE=$P(DATA,"|",2),IDMFA=$P(DATA,"|",5)
- S MFA="MFA"_HLFS_ECODE_HLFS_HLFS_HLFS_$S(IBACK="AA":"S",1:"U")_HLFS_IDMFA_HLFS_"CE"
- Q
- MLMN ; MailMan Message
- D TXT^IBCNEUT7("MSG")
- S MGRP=$$MGRP^IBCNEUT5()
- S XMSUB="IBCNE IIV MFN IN"
- D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
- K XMSUB,XMY,MSG,XMZ,XMDUZ
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEHLK 1907 printed Feb 18, 2025@23:41:07 Page 2
- IBCNEHLK ;DAOU/ALA - HL7 Acknowledgement Messages ;08-OCT-2002
- +1 ;;2.0;INTEGRATED BILLING;**184,300,601**;21-MAR-94;Build 14
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- MFK ; MFN Acknowledgement
- +1 SET HCT=1
- +2 ; Loop through the message and find each segment for processing
- +3 FOR
- SET HCT=$ORDER(^TMP($JOB,"IBCNEHLI",HCT))
- if HCT=""
- QUIT
- Begin DoDot:1
- +4 DO SPAR^IBCNEHLU
- +5 SET SEG=$GET(IBSEG(1))
- +6 ;
- +7 IF SEG="MSA"
- Begin DoDot:2
- +8 SET ACK=$GET(IBSEG(2))
- SET MSGID=$GET(IBSEG(3))
- +9 ;
- +10 IF ACK="AE"
- SET VMFN(350.9,"1,",51.22)=0
- +11 IF ACK="AA"
- SET VMFN(350.9,"1,",51.22)=1
- End DoDot:2
- End DoDot:1
- +12 ;
- +13 DO FILE^DIE("I","VMFN")
- +14 ;
- +15 KILL IBSEG,SEG,HCT,ACK,EVENT,HL,IBPRTCL,IDUZ,MSGID,SEGMT,TAG,VMFN
- +16 QUIT
- +17 ; IB*2.0*601 - Added new logic for ACK tag.
- ACK ; ACK Acknowledgement
- +1 NEW IBCNHLP,HCT,MSA,MFI,MFA,CONTROL,HLFS
- +2 KILL ^TMP("HLA",$JOB)
- +3 SET HCT=0
- +4 SET HLFS="|"
- +5 ;
- +6 DO MSA
- SET HCT=HCT+1
- SET ^TMP("HLA",$JOB,HCT)=$TRANSLATE(MSA,"*","")
- +7 DO MFI
- SET HCT=HCT+1
- SET ^TMP("HLA",$JOB,HCT)=$TRANSLATE(MFI,"*","")
- +8 DO MFA
- SET HCT=HCT+1
- SET ^TMP("HLA",$JOB,HCT)=$TRANSLATE(MFA,"*","")
- +9 ;
- +10 DO GENACK^HLMA1($$FIND1^DIC(101,,,"IBCNE IIV MFN IN","B"),HLMTIENS,$$FIND1^DIC(101,,,"IBCNE IIV TABLE","B"),"GM",1,.ERROR)
- +11 KILL ^TMP("HLA",$JOB),HL,ERROR
- +12 ;
- +13 QUIT
- MSA ; MSA Segment
- +1 NEW DATA,CONTROL
- +2 ; Table Update Message Control ID
- SET CONTROL=$PIECE($GET(^TMP($JOB,"IBCNEHLI",1,0)),"|",10)
- +3 SET MSA="MSA"_HLFS_$GET(IBACK)_HLFS_CONTROL
- +4 QUIT
- +5 ;
- MFI ; MFI Segment
- +1 ; Return this segment.
- SET MFI=$GET(^TMP($JOB,"IBCNEHLI",2,0))
- +2 SET $PIECE(MFI,HLFS,7)="NE"
- +3 QUIT
- MFA ; MFA Segment
- +1 NEW I,ECODE,DATA,IDMFA
- +2 SET ECODE=""
- SET IDMFA=""
- +3 FOR I=1:1
- if '$DATA(^TMP($JOB,"IBCNEHLI",I,0))
- QUIT
- Begin DoDot:1
- +4 SET DATA=^TMP($JOB,"IBCNEHLI",I,0)
- +5 IF $PIECE(DATA,"|")="MFE"
- SET ECODE=$PIECE(DATA,"|",2)
- SET IDMFA=$PIECE(DATA,"|",5)
- End DoDot:1
- if ECODE'=""
- QUIT
- +6 SET MFA="MFA"_HLFS_ECODE_HLFS_HLFS_HLFS_$SELECT(IBACK="AA":"S",1:"U")_HLFS_IDMFA_HLFS_"CE"
- +7 QUIT
- MLMN ; MailMan Message
- +1 DO TXT^IBCNEUT7("MSG")
- +2 SET MGRP=$$MGRP^IBCNEUT5()
- +3 SET XMSUB="IBCNE IIV MFN IN"
- +4 DO MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
- +5 KILL XMSUB,XMY,MSG,XMZ,XMDUZ
- +6 QUIT