- IBCNRHLT ;DAOU/DMK - Receive HL7 e-Pharmacy MFN Message ;23-OCT-2003
- ;;2.0;INTEGRATED BILLING;**251,435,550**;21-MAR-94;Build 25
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; Description
- ;
- ; Receive HL7 e-Pharmacy MFN Message
- ; Table Update
- ;
- ; Control processing of segments
- ;
- ; Required segments listed in order
- ; MSH (Message Header Segment)
- ; MFI (Master File Identifier Segment)
- ; MFE (Master File Entry Segment)
- ;
- ; Optional segments listed by file
- ;
- ; ZPT (366.01 NCPDP PROCESSOR File Update Segment)
- ; ZCM (366.012 NCPDP PROCESSOR CONTACT MEANS Subfile Update Segment)
- ;
- ; ZPB (366.02 PHARMACY BENEFITS MANAGER (PBM) File Update Segment)
- ; ZCM (366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
- ; Update Segment)
- ;
- ; ZPL (366.03 PLAN File Update Segment)
- ; ZCM (366.032 PLAN CONTACT MEANS Subfile Update Segment)
- ;
- ; ZPP (366.03 PLAN File (Pharmacy) Update Segment)
- ; ZCM (366.0312 PLAN RX CONTACT MEANS Subfile Update Segment)
- ;
- ; * 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 processing
- I $D(ERROR) Q
- D @SEG
- ;
- ; Initialize MFK Message (Application Acknowledgement) variables
- I $D(ERROR) D Q
- . S DATAMFK("ERROR")=ERROR
- . S DATAMFK("IEN")=IEN
- ;
- ; Quit if more segments
- I $O(^TMP($J,"BPSJHLI",HCT))]"" Q
- ;
- ; Update File?
- I $D(DATA) D
- . S FIELDNO="" F S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
- .. ;
- .. ; Convert "" to "@" to delete field value if necessary
- .. I IEN'=-1,DATA(FIELDNO)="" S DATA(FIELDNO)="@"
- .. ;
- .. ; Convert HL7 special characters if necessary
- .. I DATA(FIELDNO)[$E(HLECH,3) S DATA(FIELDNO)=$$TRAN1^IBCNRHLU(DATA(FIELDNO))
- . D FILE
- ;
- ; Update APPLICATION Subfile?
- I $D(DATAAP) D
- . S FIELDNO="" F S FIELDNO=$O(DATAAP(FIELDNO)) Q:FIELDNO="" D
- .. ;
- .. ; Convert "" to "@" to delete field value if necessary
- .. I APIEN'=-1,DATAAP(FIELDNO)="" S DATAAP(FIELDNO)="@"
- .. ;
- .. ; Convert HL7 special characters if necessary
- .. I DATAAP(FIELDNO)[$E(HLECH,3) S DATAAP(FIELDNO)=$$TRAN1^IBCNRHLU(DATAAP(FIELDNO))
- . S FIELDNO=3
- . D FILEAP
- ;
- ; Update CONTACT MEANS Subfile?
- I $D(DATACM) D
- . S FIELDNO="" F S FIELDNO=$O(DATACM(FIELDNO)) Q:FIELDNO="" D
- .. ;
- .. ; Convert "" to "@" to delete field value if necessary
- .. I CMIEN'=-1,DATACM(FIELDNO)="" S DATACM(FIELDNO)="@"
- .. ;
- .. ; Convert HL7 special characters if necessary
- .. I DATACM(FIELDNO)[$E(HLECH,3) S DATACM(FIELDNO)=$$TRAN1^IBCNRHLU(DATACM(FIELDNO))
- . S FIELDNO=$S(FILE["Pharmacy"&(FILENO=366.03):12,1:2)
- . I IBCNACT="MDL" D DELETECM Q
- . D FILECM
- Q
- ;
- ADD ; Add File entry
- ; 366.01 NCPDP PROCESSOR File
- ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
- ; 366.03 PLAN File
- ;
- S IEN=$$ADD1^IBCNRFM1(FILENO,DATA(.01))
- Q
- ;
- ADDAP ; Add APPLICATION Subfile entry
- ; 366.013 NCPDP PROCESSOR APPLICATION File
- ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile
- ; 366.033 PLAN APPLICATION Subfile
- ;
- S APIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,AIEN)
- Q
- ;
- ADDCM ; Add CONTACT MEANS Subfile entry
- ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
- ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
- ; 366.032 PLAN CONTACT MEANS Subfile
- ; 366.0312 PLAN RX CONTACT MEANS Subfile
- ;
- S CMIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,DATACM(.01))
- Q
- ;
- DELETECM ; Delete CONTACT MEANS Subfile entry
- ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
- ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
- ; 366.032 PLAN CONTACT MEANS Subfile
- ; 366.0312 PLAN RX CONTACT MEANS Subfile
- ;
- D DELETE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN)
- Q
- ;
- FILE ; File data
- ; 366.01 NCPDP PROCESSOR File
- ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
- ; 366.03 PLAN File
- ;
- ; Add?
- I IEN=-1 D ADD
- ;
- ; Update
- D FILE1^IBCNRFM1(FILENO,IEN,.DATA)
- Q
- ;
- FILEAP ; File APPLICATION Subfile data
- ; 366.013 NCPDP PROCESSOR APPLICATION Subfile
- ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile
- ; 366.033 PLAN APPLICATION Subfile
- ;
- ; Add?
- I APIEN=-1 D ADDAP
- ;
- ; Update
- D FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,APIEN,.DATAAP)
- Q
- ;
- FILECM ; File CONTACT MEANS Subfile data
- ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
- ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
- ; 366.032 PLAN CONTACT MEANS Subfile
- ; 366.0312 PLAN RX CONTACT MEANS Subfile
- ;
- ; Add?
- I CMIEN=-1 D ADDCM
- ;
- ; Update
- D FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN,.DATACM)
- Q
- ;
- MFE ; Process MFE Segment
- D ^IBCNRMFE
- Q
- ;
- ZCM ; Process ZCM Segment
- D ^IBCNRZCM
- Q
- ;
- ZPB ; Process ZPB Segment
- D ^IBCNRZPB
- Q
- ;
- ZPL ; Process ZPL Segment
- D ^IBCNRZPL
- Q
- ;
- ZPP ; Process ZPP Segment
- D ^IBCNRZPP
- Q
- ;
- ZPT ; Process ZPT Segment
- D ^IBCNRZPT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRHLT 4928 printed Feb 18, 2025@23:42:40 Page 2
- IBCNRHLT ;DAOU/DMK - Receive HL7 e-Pharmacy MFN Message ;23-OCT-2003
- +1 ;;2.0;INTEGRATED BILLING;**251,435,550**;21-MAR-94;Build 25
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; Description
- +5 ;
- +6 ; Receive HL7 e-Pharmacy MFN Message
- +7 ; Table Update
- +8 ;
- +9 ; Control processing of segments
- +10 ;
- +11 ; Required segments listed in order
- +12 ; MSH (Message Header Segment)
- +13 ; MFI (Master File Identifier Segment)
- +14 ; MFE (Master File Entry Segment)
- +15 ;
- +16 ; Optional segments listed by file
- +17 ;
- +18 ; ZPT (366.01 NCPDP PROCESSOR File Update Segment)
- +19 ; ZCM (366.012 NCPDP PROCESSOR CONTACT MEANS Subfile Update Segment)
- +20 ;
- +21 ; ZPB (366.02 PHARMACY BENEFITS MANAGER (PBM) File Update Segment)
- +22 ; ZCM (366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
- +23 ; Update Segment)
- +24 ;
- +25 ; ZPL (366.03 PLAN File Update Segment)
- +26 ; ZCM (366.032 PLAN CONTACT MEANS Subfile Update Segment)
- +27 ;
- +28 ; ZPP (366.03 PLAN File (Pharmacy) Update Segment)
- +29 ; ZCM (366.0312 PLAN RX CONTACT MEANS Subfile Update Segment)
- +30 ;
- +31 ; * File # (MFI Segment) = 366.01, 366.02, or 366.03
- +32 ; * Segment ID (every segment) = MFE, ZCM, ZPB, ZPL, ZPP, or ZPT
- +33 ;
- +34 ; Entry point
- +35 ;
- 1000 ; Control processing
- +1 IF $DATA(ERROR)
- QUIT
- +2 DO @SEG
- +3 ;
- +4 ; Initialize MFK Message (Application Acknowledgement) variables
- +5 IF $DATA(ERROR)
- Begin DoDot:1
- +6 SET DATAMFK("ERROR")=ERROR
- +7 SET DATAMFK("IEN")=IEN
- End DoDot:1
- QUIT
- +8 ;
- +9 ; Quit if more segments
- +10 IF $ORDER(^TMP($JOB,"BPSJHLI",HCT))]""
- QUIT
- +11 ;
- +12 ; Update File?
- +13 IF $DATA(DATA)
- Begin DoDot:1
- +14 SET FIELDNO=""
- FOR
- SET FIELDNO=$ORDER(DATA(FIELDNO))
- if FIELDNO=""
- QUIT
- Begin DoDot:2
- +15 ;
- +16 ; Convert "" to "@" to delete field value if necessary
- +17 IF IEN'=-1
- IF DATA(FIELDNO)=""
- SET DATA(FIELDNO)="@"
- +18 ;
- +19 ; Convert HL7 special characters if necessary
- +20 IF DATA(FIELDNO)[$EXTRACT(HLECH,3)
- SET DATA(FIELDNO)=$$TRAN1^IBCNRHLU(DATA(FIELDNO))
- End DoDot:2
- +21 DO FILE
- End DoDot:1
- +22 ;
- +23 ; Update APPLICATION Subfile?
- +24 IF $DATA(DATAAP)
- Begin DoDot:1
- +25 SET FIELDNO=""
- FOR
- SET FIELDNO=$ORDER(DATAAP(FIELDNO))
- if FIELDNO=""
- QUIT
- Begin DoDot:2
- +26 ;
- +27 ; Convert "" to "@" to delete field value if necessary
- +28 IF APIEN'=-1
- IF DATAAP(FIELDNO)=""
- SET DATAAP(FIELDNO)="@"
- +29 ;
- +30 ; Convert HL7 special characters if necessary
- +31 IF DATAAP(FIELDNO)[$EXTRACT(HLECH,3)
- SET DATAAP(FIELDNO)=$$TRAN1^IBCNRHLU(DATAAP(FIELDNO))
- End DoDot:2
- +32 SET FIELDNO=3
- +33 DO FILEAP
- End DoDot:1
- +34 ;
- +35 ; Update CONTACT MEANS Subfile?
- +36 IF $DATA(DATACM)
- Begin DoDot:1
- +37 SET FIELDNO=""
- FOR
- SET FIELDNO=$ORDER(DATACM(FIELDNO))
- if FIELDNO=""
- QUIT
- Begin DoDot:2
- +38 ;
- +39 ; Convert "" to "@" to delete field value if necessary
- +40 IF CMIEN'=-1
- IF DATACM(FIELDNO)=""
- SET DATACM(FIELDNO)="@"
- +41 ;
- +42 ; Convert HL7 special characters if necessary
- +43 IF DATACM(FIELDNO)[$EXTRACT(HLECH,3)
- SET DATACM(FIELDNO)=$$TRAN1^IBCNRHLU(DATACM(FIELDNO))
- End DoDot:2
- +44 SET FIELDNO=$SELECT(FILE["Pharmacy"&(FILENO=366.03):12,1:2)
- +45 IF IBCNACT="MDL"
- DO DELETECM
- QUIT
- +46 DO FILECM
- End DoDot:1
- +47 QUIT
- +48 ;
- ADD ; Add File entry
- +1 ; 366.01 NCPDP PROCESSOR File
- +2 ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
- +3 ; 366.03 PLAN File
- +4 ;
- +5 SET IEN=$$ADD1^IBCNRFM1(FILENO,DATA(.01))
- +6 QUIT
- +7 ;
- ADDAP ; Add APPLICATION Subfile entry
- +1 ; 366.013 NCPDP PROCESSOR APPLICATION File
- +2 ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile
- +3 ; 366.033 PLAN APPLICATION Subfile
- +4 ;
- +5 SET APIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,AIEN)
- +6 QUIT
- +7 ;
- ADDCM ; Add CONTACT MEANS Subfile entry
- +1 ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
- +2 ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
- +3 ; 366.032 PLAN CONTACT MEANS Subfile
- +4 ; 366.0312 PLAN RX CONTACT MEANS Subfile
- +5 ;
- +6 SET CMIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,DATACM(.01))
- +7 QUIT
- +8 ;
- DELETECM ; Delete CONTACT MEANS Subfile entry
- +1 ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
- +2 ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
- +3 ; 366.032 PLAN CONTACT MEANS Subfile
- +4 ; 366.0312 PLAN RX CONTACT MEANS Subfile
- +5 ;
- +6 DO DELETE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN)
- +7 QUIT
- +8 ;
- FILE ; File data
- +1 ; 366.01 NCPDP PROCESSOR File
- +2 ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
- +3 ; 366.03 PLAN File
- +4 ;
- +5 ; Add?
- +6 IF IEN=-1
- DO ADD
- +7 ;
- +8 ; Update
- +9 DO FILE1^IBCNRFM1(FILENO,IEN,.DATA)
- +10 QUIT
- +11 ;
- FILEAP ; File APPLICATION Subfile data
- +1 ; 366.013 NCPDP PROCESSOR APPLICATION Subfile
- +2 ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile
- +3 ; 366.033 PLAN APPLICATION Subfile
- +4 ;
- +5 ; Add?
- +6 IF APIEN=-1
- DO ADDAP
- +7 ;
- +8 ; Update
- +9 DO FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,APIEN,.DATAAP)
- +10 QUIT
- +11 ;
- FILECM ; File CONTACT MEANS Subfile data
- +1 ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
- +2 ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
- +3 ; 366.032 PLAN CONTACT MEANS Subfile
- +4 ; 366.0312 PLAN RX CONTACT MEANS Subfile
- +5 ;
- +6 ; Add?
- +7 IF CMIEN=-1
- DO ADDCM
- +8 ;
- +9 ; Update
- +10 DO FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN,.DATACM)
- +11 QUIT
- +12 ;
- MFE ; Process MFE Segment
- +1 DO ^IBCNRMFE
- +2 QUIT
- +3 ;
- ZCM ; Process ZCM Segment
- +1 DO ^IBCNRZCM
- +2 QUIT
- +3 ;
- ZPB ; Process ZPB Segment
- +1 DO ^IBCNRZPB
- +2 QUIT
- +3 ;
- ZPL ; Process ZPL Segment
- +1 DO ^IBCNRZPL
- +2 QUIT
- +3 ;
- ZPP ; Process ZPP Segment
- +1 DO ^IBCNRZPP
- +2 QUIT
- +3 ;
- ZPT ; Process ZPT Segment
- +1 DO ^IBCNRZPT
- +2 QUIT