source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNRZRX.m@ 1803

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

initial load of FOIAVistA 6/30/08 version
File size: 3.9 KB
Line 
1IBCNRZRX ;DAOU/DMK - Receive HL7 e-Pharmacy ZRX 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 ZRX Segment
8 ; 366.03 PLAN File Update (Pharmacy)
9 ;
10 ; Called by IBCNRHLT
11 ;
12 ; Entry point
13 ;
141000 ; Control ZRX Segment processing
15 D INIT
16 I $D(ERROR) Q
17 D INITBPS
18 Q
19 ;
20INIT ; Initialize ZRX Segment variables
21 ; 366.03 PLAN File
22 ;
23 N NAME
24 ;
25 ; Error?
26 ; V505 = Plan ID Missing
27 I $TR($G(IBSEG(3))," ","") S ERROR="V505" Q
28 ;
29 ; 10.01 = PHARMACY BENEFITS MANAGER NAME (pointer - 366.02)
30 S DATA(10.01)=$G(IBSEG(4))
31 I DATA(10.01)]"" S DATA(10.01)=$$LOOKUP1^IBCNRFM1(366.02,DATA(10.01))
32 ;
33 ; Error?
34 ; V510 = Pharmacy Benefits Manager (PBM) Undefined
35 I DATA(10.01)=-1 S ERROR="V510" Q
36 ;
37 ; 10.02 = BANKING IDENTIFICATION NUMBER
38 S DATA(10.02)=$G(IBSEG(5))
39 ;
40 ; Error?
41 ; V515 = Plan BIN Missing
42 I $TR(DATA(10.02)," ","")="" S ERROR="V515" Q
43 ;
44 ; 10.03 = PROCESSOR CONTROL NUMBER (PCN)
45 S DATA(10.03)=$G(IBSEG(6))
46 ;
47 ; 10.04 = NCPDP PROCESSOR NAME (pointer - 366.01)
48 S DATA(10.04)=$G(IBSEG(7))
49 I DATA(10.04)]"" S DATA(10.04)=$$LOOKUP1^IBCNRFM1(366.01,DATA(10.04))
50 ;
51 ; Error?
52 ; V520 = NCPDP Processor Name Undefined
53 I DATA(10.04)=-1 S ERROR="V520" Q
54 ;
55 ; 10.05 = ENABLED?
56 S DATA(10.05)=$S($G(IBSEG(8))="Y":1,1:0)
57 ;
58 ; Error?
59 ; V525 = Plan Enabled? Missing
60 I $TR(DATA(10.05)," ","")="" S ERROR="V525" Q
61 ;
62 ; 10.06 = SOFTWARE VENDOR ID
63 S DATA(10.06)=$G(IBSEG(9))
64 ;
65 ; 10.07 = BILLING PAYER SHEET NAME (pointer - 9002313.92)
66 S DATA(10.07)=$G(IBSEG(10))
67 I DATA(10.07)]"" S DATA(10.07)=$$LOOKUP1^IBCNRFM1(9002313.92,DATA(10.07))
68 ;
69 ; Error?
70 ; V530 = Billing Payer Sheet Name Undefined
71 I DATA(10.07)=-1 S ERROR="V530" Q
72 ;
73 ; 10.08 = REVERSAL PAYER SHEET NAME (pointer - 9002313.92)
74 S DATA(10.08)=$G(IBSEG(11))
75 I DATA(10.08)]"" S DATA(10.08)=$$LOOKUP1^IBCNRFM1(9002313.92,DATA(10.08))
76 ;
77 ; Error?
78 ; V535 = Reversal Payer Sheet Name Undefined
79 I DATA(10.08)=-1 S ERROR="V535" Q
80 ;
81 ; 10.09 = REBILL PAYER SHEET NAME (pointer - 9002313.92)
82 S DATA(10.09)=$G(IBSEG(12))
83 I DATA(10.09)]"" S DATA(10.09)=$$LOOKUP1^IBCNRFM1(9002313.92,DATA(10.09))
84 ;
85 ; Error?
86 ; V540 = Rebill Payer Sheet Name Undefined
87 I DATA(10.09)=-1 S ERROR="V540" Q
88 ;
89 ; 10.1 = MAXIMUM NCPDP TRANSACTIONS
90 S DATA(10.1)=$G(IBSEG(13))
91 ;
92 ; Initialize RX primary contact name variables
93 S NAME=$G(IBSEG(14))
94 D NAME
95 ;
96 ; 11.01 = RX PRIMARY CONTACT NAME
97 S DATA(11.01)=NAME("NAME")
98 ;
99 ; 11.02 = RX PRIMARY CONTACT PREFIX
100 S DATA(11.02)=NAME("PREFIX")
101 ;
102 ; 11.03 = RX PRIMARY CONTACT DEGREE
103 S DATA(11.03)=NAME("DEGREE")
104 ;
105 ; Initialize RX alternate contact name variables
106 S NAME=$G(IBSEG(15))
107 D NAME
108 ;
109 ; 11.04 = RX ALTERNATE CONTACT NAME
110 S DATA(11.04)=NAME("NAME")
111 ;
112 ; 11.05 = RX ALETRNATE CONTACT PREFIX
113 S DATA(11.05)=NAME("PREFIX")
114 ;
115 ; 11.06 = RX ALTERNATE CONTACT DEGREE
116 S DATA(11.06)=NAME("DEGREE")
117 Q
118 ;
119INITBPS ; Initialize variables from ZRX Segment variables
120 ; 90002313.92 BPS NCPDP FORMATS File
121 ;
122 ; 1.03 = Maximum RX's Per Claim
123 S DATABPS(1.03)=DATA(10.1)
124 I DATABPS(1.03)'?1.N S DATABPS(1.03)=1
125 ;
126 ; 1.07 = Is A Reversal Format
127 S DATABPS(1.07)=0
128 ;
129 ; 1.13 = SOFTWARE VENDOR/CERT ID
130 S DATABPS(1.13)=DATA(10.06)
131 ;
132 ; 1001 = Reversal Format
133 S DATABPS(1001)=DATA(10.08)
134 Q
135 ;
136NAME ; Initialize name variables from NAME string
137 S NAME("SURNAME")=$P($P(NAME,$E(HLECH,1),1),$E(HLECH,4),1)
138 S NAME("SURNAME PREFIX")=$P($P(NAME,$E(HLECH,1),1),$E(HLECH,4),2)
139 S NAME("FAMILY")=$S(NAME("SURNAME PREFIX")]"":NAME("SURNAME PREFIX")_" ",1:"")_NAME("SURNAME")
140 S NAME("GIVEN")=$P(NAME,$E(HLECH,1),2)
141 S NAME("MIDDLE")=$P(NAME,$E(HLECH,1),3)
142 S NAME("SUFFIX")=$P(NAME,$E(HLECH,1),4)
143 S NAME("NAME")=""
144 I NAME("FAMILY")]"" S NAME("NAME")=NAME("FAMILY")_","_NAME("GIVEN")_$S(NAME("MIDDLE")]"":" "_$E(NAME("MIDDLE"),1),1:"")_$S(NAME("SUFFIX")]"":" "_NAME("SUFFIX"),1:"")
145 S NAME("PREFIX")=$P(NAME,$E(HLECH,1),5)
146 S NAME("DEGREE")=$P(NAME,$E(HLECH,1),6)
147 Q
Note: See TracBrowser for help on using the repository browser.