IBCNRZCM ;DAOU/DMK - Receive HL7 e-Pharmacy ZCM Segment ;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
;
; Receive HL7 e-Pharmacy ZCM Segment
; (Various Files) CONTACT MEANS Subfiles Update
; (Various Files) CONTACT MEANS Subfiles listed below (INIT section)
;
; Entry point
;
1000 ; Control ZCM Segment processing
;
; Error?
; V200 = NCPDP Processor Name Undefined
; V300 = Pharmacy Benefits Manager (PBM) Name Undefined
; V400 = Plan ID Undefined
; V500 = Plan ID Undefined
I '$D(DATA),IEN=-1 D Q
. S ERROR=$S(FILENO=366.01:"V200",FILENO=366.02:"V300",FILENO=366.03:"V400")
. I FILE["Pharmacy" S ERROR="V500"
;
D INIT
Q
;
INIT ; Initialize ZCM Segment variables
; 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
;
; Update only CONTACT MEANS Subfile?
I '$D(DATA) K DATAAP
;
N S
;
S FIELDNO=$S(FILE["Pharmacy"&(FILENO=366.03):12,1:2)
;
; .01 = PKEY
S DATACM(.01)=$G(IBSEG(3))
I DATACM(.01)[$E(HLECH,3) S DATACM(.01)=$$TRAN1^IBCNRHLU(DATACM(.01))
I IEN'=-1 S CMIEN=$$LOOKUP2^IBCNRFM1(FILENO,IEN,FIELDNO,DATACM(.01))
I IEN=-1 S CMIEN=-1
;
; .02 = TYPE
S DATACM(.02)=$G(IBSEG(4))
;
S S=$G(IBSEG(5))
;
; .03 = TELECOMMUNICATION USE
S DATACM(.03)=$P(S,$E(HLECH,1),2)
;
; .04 = TELECOMMUNICATION EQUIPMENT
S DATACM(.04)=$P(S,$E(HLECH,1),3)
;
; .05 = EMAIL ADDRESS
S DATACM(.05)=$P(S,$E(HLECH,1),4)
;
; .06 = TELEPHONE NUMBER
S DATACM(.06)="("_$E($P(S,$E(HLECH,1),6),1,3)_") "_$E($P(S,$E(HLECH,1),6),4,6)_"-"_$P(S,$E(HLECH,1),7)_$S($P(S,$E(HLECH,1),8)]"":" x"_$P(S,$E(HLECH,1),8),1:"")
I DATACM(.06)="() -" S DATACM(.06)=""
;
; .07 = COMMENT
S DATACM(.07)=$P(S,$E(HLECH,1),9)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRZCM 1945 printed Sep 23, 2025@19:52:50 Page 2
IBCNRZCM ;DAOU/DMK - Receive HL7 e-Pharmacy ZCM Segment ;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 ; Receive HL7 e-Pharmacy ZCM Segment
+7 ; (Various Files) CONTACT MEANS Subfiles Update
+8 ; (Various Files) CONTACT MEANS Subfiles listed below (INIT section)
+9 ;
+10 ; Entry point
+11 ;
1000 ; Control ZCM Segment processing
+1 ;
+2 ; Error?
+3 ; V200 = NCPDP Processor Name Undefined
+4 ; V300 = Pharmacy Benefits Manager (PBM) Name Undefined
+5 ; V400 = Plan ID Undefined
+6 ; V500 = Plan ID Undefined
+7 IF '$DATA(DATA)
IF IEN=-1
Begin DoDot:1
+8 SET ERROR=$SELECT(FILENO=366.01:"V200",FILENO=366.02:"V300",FILENO=366.03:"V400")
+9 IF FILE["Pharmacy"
SET ERROR="V500"
End DoDot:1
QUIT
+10 ;
+11 DO INIT
+12 QUIT
+13 ;
INIT ; Initialize ZCM Segment variables
+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 ; Update only CONTACT MEANS Subfile?
+7 IF '$DATA(DATA)
KILL DATAAP
+8 ;
+9 NEW S
+10 ;
+11 SET FIELDNO=$SELECT(FILE["Pharmacy"&(FILENO=366.03):12,1:2)
+12 ;
+13 ; .01 = PKEY
+14 SET DATACM(.01)=$GET(IBSEG(3))
+15 IF DATACM(.01)[$EXTRACT(HLECH,3)
SET DATACM(.01)=$$TRAN1^IBCNRHLU(DATACM(.01))
+16 IF IEN'=-1
SET CMIEN=$$LOOKUP2^IBCNRFM1(FILENO,IEN,FIELDNO,DATACM(.01))
+17 IF IEN=-1
SET CMIEN=-1
+18 ;
+19 ; .02 = TYPE
+20 SET DATACM(.02)=$GET(IBSEG(4))
+21 ;
+22 SET S=$GET(IBSEG(5))
+23 ;
+24 ; .03 = TELECOMMUNICATION USE
+25 SET DATACM(.03)=$PIECE(S,$EXTRACT(HLECH,1),2)
+26 ;
+27 ; .04 = TELECOMMUNICATION EQUIPMENT
+28 SET DATACM(.04)=$PIECE(S,$EXTRACT(HLECH,1),3)
+29 ;
+30 ; .05 = EMAIL ADDRESS
+31 SET DATACM(.05)=$PIECE(S,$EXTRACT(HLECH,1),4)
+32 ;
+33 ; .06 = TELEPHONE NUMBER
+34 SET DATACM(.06)="("_$EXTRACT($PIECE(S,$EXTRACT(HLECH,1),6),1,3)_") "_$EXTRACT($PIECE(S,$EXTRACT(HLECH,1),6),4,6)_"-"_$PIECE(S,$EXTRACT(HLECH,1),7)_$SELECT($PIECE(S,$EXTRACT(HLECH,1),8)]"":" x"_$PIECE(S,$EXTRACT(HLECH,1),8),1:"")
+35 IF DATACM(.06)="() -"
SET DATACM(.06)=""
+36 ;
+37 ; .07 = COMMENT
+38 SET DATACM(.07)=$PIECE(S,$EXTRACT(HLECH,1),9)
+39 QUIT
