| 1 | IBCNRZPB ;DAOU/DMK - Receive HL7 e-Pharmacy ZPB 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 ZPB Segment
|
|---|
| 8 | ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File Update
|
|---|
| 9 | ;
|
|---|
| 10 | ; Called by IBCNRHLT
|
|---|
| 11 | ;
|
|---|
| 12 | ; Entry point
|
|---|
| 13 | ;
|
|---|
| 14 | 1000 ; Control ZPB Segment processing
|
|---|
| 15 | D INIT
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | INIT ; Initialize ZPB Segment variables
|
|---|
| 19 | ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
|
|---|
| 20 | ;
|
|---|
| 21 | N NAME
|
|---|
| 22 | ;
|
|---|
| 23 | ; .01 = NAME
|
|---|
| 24 | S DATA(.01)=$G(IBSEG(4))
|
|---|
| 25 | ;
|
|---|
| 26 | ; Error?
|
|---|
| 27 | ; V305 = Pharmacy Benefits Manager (PBM) Name Missing
|
|---|
| 28 | I $TR(DATA(.01)," ","")="" S ERROR="V305" Q
|
|---|
| 29 | ;
|
|---|
| 30 | ; .02 = DATE/TIME CREATED
|
|---|
| 31 | ; MAD = Add
|
|---|
| 32 | I IBCNACT="MAD",IEN=-1 S DATA(.02)=DATE("NOW")
|
|---|
| 33 | ;
|
|---|
| 34 | ; Initialize primary contact name variables
|
|---|
| 35 | S NAME=$G(IBSEG(5))
|
|---|
| 36 | D NAME
|
|---|
| 37 | ;
|
|---|
| 38 | ; 1.01 = PRIMARY CONTACT NAME
|
|---|
| 39 | S DATA(1.01)=NAME("NAME")
|
|---|
| 40 | ;
|
|---|
| 41 | ; 1.02 = PRIMARY CONTACT PREFIX
|
|---|
| 42 | S DATA(1.02)=NAME("PREFIX")
|
|---|
| 43 | ;
|
|---|
| 44 | ; 1.03 = PRIMARY CONTACT DEGREE
|
|---|
| 45 | S DATA(1.03)=NAME("DEGREE")
|
|---|
| 46 | ;
|
|---|
| 47 | ; Initialize alternate contact name variables
|
|---|
| 48 | S NAME=$G(IBSEG(6))
|
|---|
| 49 | D NAME
|
|---|
| 50 | ;
|
|---|
| 51 | ; 1.04 = ALTERNATE CONTACT NAME
|
|---|
| 52 | S DATA(1.04)=NAME("NAME")
|
|---|
| 53 | ;
|
|---|
| 54 | ; 1.05 = ALETRNATE CONTACT PREFIX
|
|---|
| 55 | S DATA(1.05)=NAME("PREFIX")
|
|---|
| 56 | ;
|
|---|
| 57 | ; 1.06 = ALTERNATE CONTACT DEGREE
|
|---|
| 58 | S DATA(1.06)=NAME("DEGREE")
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | NAME ; Initialize name variables from NAME string
|
|---|
| 62 | S NAME("SURNAME")=$P($P(NAME,$E(HLECH,1),1),$E(HLECH,4),1)
|
|---|
| 63 | S NAME("SURNAME PREFIX")=$P($P(NAME,$E(HLECH,1),1),$E(HLECH,4),2)
|
|---|
| 64 | S NAME("FAMILY")=$S(NAME("SURNAME PREFIX")]"":NAME("SURNAME PREFIX")_" ",1:"")_NAME("SURNAME")
|
|---|
| 65 | S NAME("GIVEN")=$P(NAME,$E(HLECH,1),2)
|
|---|
| 66 | S NAME("MIDDLE")=$P(NAME,$E(HLECH,1),3)
|
|---|
| 67 | S NAME("SUFFIX")=$P(NAME,$E(HLECH,1),4)
|
|---|
| 68 | S NAME("NAME")=""
|
|---|
| 69 | I NAME("FAMILY")]"" S NAME("NAME")=NAME("FAMILY")_","_NAME("GIVEN")_$S(NAME("MIDDLE")]"":" "_$E(NAME("MIDDLE"),1),1:"")_$S(NAME("SUFFIX")]"":" "_NAME("SUFFIX"),1:"")
|
|---|
| 70 | S NAME("PREFIX")=$P(NAME,$E(HLECH,1),5)
|
|---|
| 71 | S NAME("DEGREE")=$P(NAME,$E(HLECH,1),6)
|
|---|
| 72 | Q
|
|---|
