| 1 | IBCNRZCM ;DAOU/DMK - Receive HL7 e-Pharmacy ZCM Segment ;23-OCT-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; Description
|
|---|
| 6 | ;
|
|---|
| 7 | ; Receive HL7 e-Pharmacy ZCM Segment
|
|---|
| 8 | ; (Various Files) CONTACT MEANS Subfiles Update
|
|---|
| 9 | ; (Various Files) CONTACT MEANS Subfiles listed below (INIT section)
|
|---|
| 10 | ;
|
|---|
| 11 | ; Entry point
|
|---|
| 12 | ;
|
|---|
| 13 | 1000 ; Control ZCM Segment processing
|
|---|
| 14 | ;
|
|---|
| 15 | ; Error?
|
|---|
| 16 | ; V200 = NCPDP Processor Name Undefined
|
|---|
| 17 | ; V300 = Pharmacy Benefits Manager (PBM) Name Undefined
|
|---|
| 18 | ; V400 = Plan ID Undefined
|
|---|
| 19 | ; V500 = Plan ID Undefined
|
|---|
| 20 | I '$D(DATA),IEN=-1 D Q
|
|---|
| 21 | . S ERROR=$S(FILENO=366.01:"V200",FILENO=366.02:"V300",FILENO=366.03:"V400")
|
|---|
| 22 | . I FILE["Pharmacy" S ERROR="V500"
|
|---|
| 23 | ;
|
|---|
| 24 | D INIT
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | INIT ; Initialize ZCM Segment variables
|
|---|
| 28 | ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
|
|---|
| 29 | ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
|
|---|
| 30 | ; 366.032 PLAN CONTACT MEANS Subfile
|
|---|
| 31 | ; 366.0312 PLAN RX CONTACT MEANS Subfile
|
|---|
| 32 | ;
|
|---|
| 33 | ; Update only CONTACT MEANS Subfile?
|
|---|
| 34 | I '$D(DATA) K DATAAP
|
|---|
| 35 | ;
|
|---|
| 36 | N S
|
|---|
| 37 | ;
|
|---|
| 38 | S FIELDNO=$S(FILE["Pharmacy"&FILENO=366.03:12,1:2)
|
|---|
| 39 | ;
|
|---|
| 40 | ; .01 = PKEY
|
|---|
| 41 | S DATACM(.01)=$G(IBSEG(3))
|
|---|
| 42 | I DATACM(.01)[$E(HLECH,3) S DATACM(.01)=$$TRAN1^IBCNRHLU(DATACM(.01))
|
|---|
| 43 | I IEN'=-1 S CMIEN=$$LOOKUP2^IBCNRFM1(FILENO,IEN,FIELDNO,DATACM(.01))
|
|---|
| 44 | I IEN=-1 S CMIEN=-1
|
|---|
| 45 | ;
|
|---|
| 46 | ; .02 = TYPE
|
|---|
| 47 | S DATACM(.02)=$G(IBSEG(4))
|
|---|
| 48 | ;
|
|---|
| 49 | S S=$G(IBSEG(5))
|
|---|
| 50 | ;
|
|---|
| 51 | ; .03 = TELECOMMUNICATION USE
|
|---|
| 52 | S DATACM(.03)=$P(S,$E(HLECH,1),2)
|
|---|
| 53 | ;
|
|---|
| 54 | ; .04 = TELECOMMUNICATION EQUIPMENT
|
|---|
| 55 | S DATACM(.04)=$P(S,$E(HLECH,1),3)
|
|---|
| 56 | ;
|
|---|
| 57 | ; .05 = EMAIL ADDRESS
|
|---|
| 58 | S DATACM(.05)=$P(S,$E(HLECH,1),4)
|
|---|
| 59 | ;
|
|---|
| 60 | ; .06 = TELEPHONE NUMBER
|
|---|
| 61 | 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:"")
|
|---|
| 62 | I DATACM(.06)="() -" S DATACM(.06)=""
|
|---|
| 63 | ;
|
|---|
| 64 | ; .07 = COMMENT
|
|---|
| 65 | S DATACM(.07)=$P(S,$E(HLECH,1),9)
|
|---|
| 66 | Q
|
|---|
