IBCNRZCM.m

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 ---IBCNRZCM   1945     printed  Mar 13, 2025@21:21:35                                                                                                                                                                                                    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