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 Oct 16, 2024@18:16:56 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
