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