IBCNRMFK ;DAOU/DMK - Send HL7 e-Pharmacy MFK Message ;23-OCT-2003
;;2.0;INTEGRATED BILLING;**251,550**;21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
; Description
;
; Send HL7 e-Pharmacy MFK Message
; (Application Acknowledgement)
;
; Required segments listed in order
; MSH (Message Header Segment)
; MSA (Message Acknowledgement Segment)
; MFI (Master File Identifier Segment)
; MFA (Master File Acknowledgement)
;
; Called by IBCNRHLU if all of the following are true:
; * File # (MFI Segment) = 366.01, 366.02, or 366.03
; * Segment ID (every segment) = MFE, ZCM, ZPB, ZPL, ZPP, or ZPT
;
; Entry point
;
1000 ; Control MFK Message processing
;
; Possible future use
; Quit if no error to report
;I '$D(DATAMFK("ERROR")) Q
;
N ERROR,MESSAGE
K HLA("HLA")
;
D MSA
D MFI
D MFA
;
D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.ERROR)
;
; Error?
I $D(ERROR) D ERROR
;
K HLA("HLA")
Q
;
ERROR ; Process error
S MESSAGE(1)="Outgoing HL7 ePharmacy Application Acknowledgment Message error"
S MESSAGE(2)=ERROR
D MESSAGE
Q
;
MESSAGE ; Send message
Q
;
MFA ; Create MFA Segment
N SEGMENT
;
; Segment ID
S $P(SEGMENT,HLFS,1)="MFA"
;
; MFE-1 Record-Level Event Code (from MFN Message)
; MAC = Activate
; MAD = Add
; MDC = Deactivate
; MDL = Delete
; MUP = Update
S $P(SEGMENT,HLFS,2)=DATAMFK("MFE-1")
;
; Record-Level Error Return (relative to MFN Message)
; Piece 1 = ID
; S = Saved
; P = Previous (not saved)
; U = Undefined (not saved)
; and
; Piece 2 = Error Code (optional - if error)
; Format = "V"NNN where N = number (e.g. V128)
I '$D(DATAMFK("ERROR")) S $P(SEGMENT,HLFS,5)="S"
I $D(DATAMFK("ERROR")) S $P(SEGMENT,HLFS,5)=$S(DATAMFK("IEN")=-1:"U",1:"P")_$E(HLECH,1)_DATAMFK("ERROR")
;
; MFE-4 Primary Key Value (from MFN Message)
S $P(SEGMENT,HLFS,6)=DATAMFK("MFE-4")
;
; MFE-5 Primary Key Value Type (from MFN Message)
S $P(SEGMENT,HLFS,7)=DATAMFK("MFE-5")
;
S HLA("HLA",3)=SEGMENT
Q
;
MFI ; Create MFI Segment
N SEGMENT
;
; Segment ID
S $P(SEGMENT,HLFS,1)="MFI"
;
; MFI-1 Master File Identifier (from MFN Message)
S $P(SEGMENT,HLFS,2)=DATAMFK("MFI-1")
;
; MFI-3 File-Level Event Code (from MFN Message)
S $P(SEGMENT,HLFS,4)=DATAMFK("MFI-3")
;
; Response-Level Code
; NE = Never (send response Application Acknowledgement Message)
S $P(SEGMENT,HLFS,7)="NE"
;
S HLA("HLA",2)=SEGMENT
Q
;
MSA ; Create MSA Segment
N SEGMENT
;
; Segment ID
S $P(SEGMENT,HLFS,1)="MSA"
;
; Acknowledgment Code (relative to MFN Message)
; AA = application acknowledgement accept
; AR = application acknowledgement reject
S $P(SEGMENT,HLFS,2)=$S($D(DATAMFK("ERROR")):"AR",1:"AA")
;
; MSH-10 Message Control ID (from MFN Message)
S $P(SEGMENT,HLFS,3)=HL("MID")
;
S HLA("HLA",1)=SEGMENT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRMFK 2937 printed Dec 13, 2024@02:16:19 Page 2
IBCNRMFK ;DAOU/DMK - Send HL7 e-Pharmacy MFK Message ;23-OCT-2003
+1 ;;2.0;INTEGRATED BILLING;**251,550**;21-MAR-94;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Description
+5 ;
+6 ; Send HL7 e-Pharmacy MFK Message
+7 ; (Application Acknowledgement)
+8 ;
+9 ; Required segments listed in order
+10 ; MSH (Message Header Segment)
+11 ; MSA (Message Acknowledgement Segment)
+12 ; MFI (Master File Identifier Segment)
+13 ; MFA (Master File Acknowledgement)
+14 ;
+15 ; Called by IBCNRHLU if all of the following are true:
+16 ; * File # (MFI Segment) = 366.01, 366.02, or 366.03
+17 ; * Segment ID (every segment) = MFE, ZCM, ZPB, ZPL, ZPP, or ZPT
+18 ;
+19 ; Entry point
+20 ;
1000 ; Control MFK Message processing
+1 ;
+2 ; Possible future use
+3 ; Quit if no error to report
+4 ;I '$D(DATAMFK("ERROR")) Q
+5 ;
+6 NEW ERROR,MESSAGE
+7 KILL HLA("HLA")
+8 ;
+9 DO MSA
+10 DO MFI
+11 DO MFA
+12 ;
+13 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.ERROR)
+14 ;
+15 ; Error?
+16 IF $DATA(ERROR)
DO ERROR
+17 ;
+18 KILL HLA("HLA")
+19 QUIT
+20 ;
ERROR ; Process error
+1 SET MESSAGE(1)="Outgoing HL7 ePharmacy Application Acknowledgment Message error"
+2 SET MESSAGE(2)=ERROR
+3 DO MESSAGE
+4 QUIT
+5 ;
MESSAGE ; Send message
+1 QUIT
+2 ;
MFA ; Create MFA Segment
+1 NEW SEGMENT
+2 ;
+3 ; Segment ID
+4 SET $PIECE(SEGMENT,HLFS,1)="MFA"
+5 ;
+6 ; MFE-1 Record-Level Event Code (from MFN Message)
+7 ; MAC = Activate
+8 ; MAD = Add
+9 ; MDC = Deactivate
+10 ; MDL = Delete
+11 ; MUP = Update
+12 SET $PIECE(SEGMENT,HLFS,2)=DATAMFK("MFE-1")
+13 ;
+14 ; Record-Level Error Return (relative to MFN Message)
+15 ; Piece 1 = ID
+16 ; S = Saved
+17 ; P = Previous (not saved)
+18 ; U = Undefined (not saved)
+19 ; and
+20 ; Piece 2 = Error Code (optional - if error)
+21 ; Format = "V"NNN where N = number (e.g. V128)
+22 IF '$DATA(DATAMFK("ERROR"))
SET $PIECE(SEGMENT,HLFS,5)="S"
+23 IF $DATA(DATAMFK("ERROR"))
SET $PIECE(SEGMENT,HLFS,5)=$SELECT(DATAMFK("IEN")=-1:"U",1:"P")_$EXTRACT(HLECH,1)_DATAMFK("ERROR")
+24 ;
+25 ; MFE-4 Primary Key Value (from MFN Message)
+26 SET $PIECE(SEGMENT,HLFS,6)=DATAMFK("MFE-4")
+27 ;
+28 ; MFE-5 Primary Key Value Type (from MFN Message)
+29 SET $PIECE(SEGMENT,HLFS,7)=DATAMFK("MFE-5")
+30 ;
+31 SET HLA("HLA",3)=SEGMENT
+32 QUIT
+33 ;
MFI ; Create MFI Segment
+1 NEW SEGMENT
+2 ;
+3 ; Segment ID
+4 SET $PIECE(SEGMENT,HLFS,1)="MFI"
+5 ;
+6 ; MFI-1 Master File Identifier (from MFN Message)
+7 SET $PIECE(SEGMENT,HLFS,2)=DATAMFK("MFI-1")
+8 ;
+9 ; MFI-3 File-Level Event Code (from MFN Message)
+10 SET $PIECE(SEGMENT,HLFS,4)=DATAMFK("MFI-3")
+11 ;
+12 ; Response-Level Code
+13 ; NE = Never (send response Application Acknowledgement Message)
+14 SET $PIECE(SEGMENT,HLFS,7)="NE"
+15 ;
+16 SET HLA("HLA",2)=SEGMENT
+17 QUIT
+18 ;
MSA ; Create MSA Segment
+1 NEW SEGMENT
+2 ;
+3 ; Segment ID
+4 SET $PIECE(SEGMENT,HLFS,1)="MSA"
+5 ;
+6 ; Acknowledgment Code (relative to MFN Message)
+7 ; AA = application acknowledgement accept
+8 ; AR = application acknowledgement reject
+9 SET $PIECE(SEGMENT,HLFS,2)=$SELECT($DATA(DATAMFK("ERROR")):"AR",1:"AA")
+10 ;
+11 ; MSH-10 Message Control ID (from MFN Message)
+12 SET $PIECE(SEGMENT,HLFS,3)=HL("MID")
+13 ;
+14 SET HLA("HLA",1)=SEGMENT
+15 QUIT
