| [613] | 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 | 
|---|