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

IBCNRMFK.m

Go to the documentation of this file.
  1. IBCNRMFK ;DAOU/DMK - Send HL7 e-Pharmacy MFK Message ;23-OCT-2003
  1. ;;2.0;INTEGRATED BILLING;**251,550**;21-MAR-94;Build 25
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Description
  1. ;
  1. ; Send HL7 e-Pharmacy MFK Message
  1. ; (Application Acknowledgement)
  1. ;
  1. ; Required segments listed in order
  1. ; MSH (Message Header Segment)
  1. ; MSA (Message Acknowledgement Segment)
  1. ; MFI (Master File Identifier Segment)
  1. ; MFA (Master File Acknowledgement)
  1. ;
  1. ; Called by IBCNRHLU if all of the following are true:
  1. ; * File # (MFI Segment) = 366.01, 366.02, or 366.03
  1. ; * Segment ID (every segment) = MFE, ZCM, ZPB, ZPL, ZPP, or ZPT
  1. ;
  1. ; Entry point
  1. ;
  1. 1000 ; Control MFK Message processing
  1. ;
  1. ; Possible future use
  1. ; Quit if no error to report
  1. ;I '$D(DATAMFK("ERROR")) Q
  1. ;
  1. N ERROR,MESSAGE
  1. K HLA("HLA")
  1. ;
  1. D MSA
  1. D MFI
  1. D MFA
  1. ;
  1. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.ERROR)
  1. ;
  1. ; Error?
  1. I $D(ERROR) D ERROR
  1. ;
  1. K HLA("HLA")
  1. Q
  1. ;
  1. ERROR ; Process error
  1. S MESSAGE(1)="Outgoing HL7 ePharmacy Application Acknowledgment Message error"
  1. S MESSAGE(2)=ERROR
  1. D MESSAGE
  1. Q
  1. ;
  1. MESSAGE ; Send message
  1. Q
  1. ;
  1. MFA ; Create MFA Segment
  1. N SEGMENT
  1. ;
  1. ; Segment ID
  1. S $P(SEGMENT,HLFS,1)="MFA"
  1. ;
  1. ; MFE-1 Record-Level Event Code (from MFN Message)
  1. ; MAC = Activate
  1. ; MAD = Add
  1. ; MDC = Deactivate
  1. ; MDL = Delete
  1. ; MUP = Update
  1. S $P(SEGMENT,HLFS,2)=DATAMFK("MFE-1")
  1. ;
  1. ; Record-Level Error Return (relative to MFN Message)
  1. ; Piece 1 = ID
  1. ; S = Saved
  1. ; P = Previous (not saved)
  1. ; U = Undefined (not saved)
  1. ; and
  1. ; Piece 2 = Error Code (optional - if error)
  1. ; Format = "V"NNN where N = number (e.g. V128)
  1. I '$D(DATAMFK("ERROR")) S $P(SEGMENT,HLFS,5)="S"
  1. I $D(DATAMFK("ERROR")) S $P(SEGMENT,HLFS,5)=$S(DATAMFK("IEN")=-1:"U",1:"P")_$E(HLECH,1)_DATAMFK("ERROR")
  1. ;
  1. ; MFE-4 Primary Key Value (from MFN Message)
  1. S $P(SEGMENT,HLFS,6)=DATAMFK("MFE-4")
  1. ;
  1. ; MFE-5 Primary Key Value Type (from MFN Message)
  1. S $P(SEGMENT,HLFS,7)=DATAMFK("MFE-5")
  1. ;
  1. S HLA("HLA",3)=SEGMENT
  1. Q
  1. ;
  1. MFI ; Create MFI Segment
  1. N SEGMENT
  1. ;
  1. ; Segment ID
  1. S $P(SEGMENT,HLFS,1)="MFI"
  1. ;
  1. ; MFI-1 Master File Identifier (from MFN Message)
  1. S $P(SEGMENT,HLFS,2)=DATAMFK("MFI-1")
  1. ;
  1. ; MFI-3 File-Level Event Code (from MFN Message)
  1. S $P(SEGMENT,HLFS,4)=DATAMFK("MFI-3")
  1. ;
  1. ; Response-Level Code
  1. ; NE = Never (send response Application Acknowledgement Message)
  1. S $P(SEGMENT,HLFS,7)="NE"
  1. ;
  1. S HLA("HLA",2)=SEGMENT
  1. Q
  1. ;
  1. MSA ; Create MSA Segment
  1. N SEGMENT
  1. ;
  1. ; Segment ID
  1. S $P(SEGMENT,HLFS,1)="MSA"
  1. ;
  1. ; Acknowledgment Code (relative to MFN Message)
  1. ; AA = application acknowledgement accept
  1. ; AR = application acknowledgement reject
  1. S $P(SEGMENT,HLFS,2)=$S($D(DATAMFK("ERROR")):"AR",1:"AA")
  1. ;
  1. ; MSH-10 Message Control ID (from MFN Message)
  1. S $P(SEGMENT,HLFS,3)=HL("MID")
  1. ;
  1. S HLA("HLA",1)=SEGMENT
  1. Q