source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNRZPB.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IBCNRZPB ;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 ;
141000 ; Control ZPB Segment processing
15 D INIT
16 Q
17 ;
18INIT ; 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 ;
61NAME ; 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
Note: See TracBrowser for help on using the repository browser.