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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1IBECUS1 ;RLM/DVAMC - TRICARE PHARMACY BILLING ENGINES ; 14-AUG-96
2 ;;2.0;INTEGRATED BILLING;**52,88,240,274**;21-MAR-94
3 ;
4BILLS ; Tasked entry point: Secondary Billing engine.
5 ;
6 I $D(^%ZOSF("TRAP")) S X="ERRS^IBECUS1",@^("TRAP")
7 ;
8 ; - main idling loop
9 F H 100 Q:'$P($G(^IBE(350.9,1,9)),"^",4)
10 ;
11 I $P($G(^IBE(350.9,1,9)),"^",10) S $P(^IBE(350.9,1,9),"^",5)="" G BILLQ
12 ;
13 ; - drop into Primary Billing task...
14 ;
15 ;
16BILLP ; Tasked entry point: Primary Billing engine.
17 ;
18 I $D(^%ZOSF("TRAP")) S X="ERRP^IBECUS1",@^("TRAP")
19 ;
20 ; - open the port
21 D CALL^%ZISTCP(IBCHAN,IBBPORT) I POP G BILLC
22 ;
23 ; - start secondary job
24 D SECB
25 ;
26 ; - send alert notifying that the billing engine has started
27 D NOW^%DTC S $P(^IBE(350.9,1,9),"^",8)=%,Y=% X ^DD("DD")
28 S XQA("G.IB CHAMP RX START")="",XQAMSG="IPS Billing Process Started "_Y
29 D SETUP^XQALERT
30 ;
31 ; - main processing loop
32 F R IBX:50 D SND,UPD I $P($G(^IBE(350.9,1,9)),"^",10) Q
33 ;
34BILLC D CLOSE^%ZISTCP
35 ;
36 ; - delete the primary task
37 S $P(^IBE(350.9,1,9),"^",4)=""
38 ;
39BILLQ Q
40 ;
41 ;
42SND ; Process all prescriptions queued for billing.
43 F R *IBI:0 Q:IBI=-1 ; bleed queue
44 S IBKEY="" F S IBKEY=$O(^IBA(351.5,"APOST",IBKEY)) Q:'IBKEY S IBKEYD=$G(^(IBKEY)),IBROU="^IBECUS"_$S(IBKEYD["REVERSE":3,1:2) D @IBROU
45 Q
46 ;
47 ;
48UPD ; Update the last run date/time.
49 D NOW^%DTC
50 S $P(^IBE(350.9,1,9),"^",9)=%
51 Q
52 ;
53 ;
54ERRP ; Primary billing task error trap
55 D CLOSE^%ZISTCP
56 S $P(^IBE(350.9,1,9),"^",4)=""
57 G ^%ZTER
58 ;
59ERRS ; Secondary billing task error trap
60 D SECB
61 G ^%ZTER
62 ;
63SECB ; Start the secondary billing task.
64 S ZTRTN="BILLS^IBECUS1",ZTDTH=$H,ZTIO=""
65 S ZTDESC="IB - TRICARE Secondary Billing Task"
66 I IBVOL]"" S ZTCPU=IBVOL
67 F I="IBBPORT","IBCHAN","IBCHSET","IBPRESCR","IBVOL" S ZTSAVE(I)=""
68 D ^%ZTLOAD
69 ;
70 S $P(^IBE(350.9,1,9),"^",5)=$G(ZTSK)
71 ;
72 K ZTRTN,ZTDTH,ZTIO,ZTSK,ZTCPU,ZTSAVE
73 Q
74 ;
75 ;
76 ;
77AWPS ; Tasked entry point: Secondary AWP Update engine.
78 ;
79 I $D(^%ZOSF("TRAP")) S X="ERRAS^IBECUS1",@^("TRAP")
80 ;
81 ; - main idling loop
82 F H 100 Q:'$P($G(^IBE(350.9,1,9)),"^",6)
83 ;
84 I $P($G(^IBE(350.9,1,9)),"^",10) S $P(^IBE(350.9,1,9),"^",7)="" G AWPPQ
85 ;
86 ; - drop into Primary AWP Update task...
87 ;
88 ;
89AWPP ; Tasked Entry Point: Primary AWP Update Engine
90 ;
91 I $D(^%ZOSF("TRAP")) S X="ERRAP^IBECUS1",@^("TRAP")
92 ;
93 ; - open the port
94 D CALL^%ZISTCP(IBCHAN,IBAPORT) I POP G AWPPC
95 ;
96 ; - start secondary job
97 D SECA
98 ;
99 ; - main processing loop
100 S IBUPD=0 F R IBX:30 D I $P($G(^IBE(350.9,1,9)),"^",10) Q
101 .;
102 .; - if no response, sent alert if necessary
103 .I IBX="" D:IBUPD Q
104 ..D NOW^%DTC S Y=% X ^DD("DD")
105 ..S XQA("G.IB CHAMP RX START")=""
106 ..S XQAMSG="AWP update completed on "_Y_". "_IBUPD_" new rates were added."
107 ..D SETUP^XQALERT
108 ..S IBUPD=0
109 .;
110 .; - respond if record is not in the anticipated format
111 .I IBX'?36N W "N" Q
112 .I IBX?36"9" Q
113 .;
114 .; - pull data from the transmitted record
115 .S IBNDCO=$E(IBX,1,11),IBNDCN=$E(IBX,12,22),IBAWP=$E(IBX,23,29)
116 .S IBAWP=$E(IBAWP,1,3)_"."_$E(IBAWP,4,7)
117 .S IBNDC=$S(IBNDCN:IBNDCN,1:IBNDCO)
118 .S IBNDC=$E(IBNDC,1,5)_"-"_$E(IBNDC,6,9)_"-"_$E(IBNDC,10,11)
119 .;
120 .; - find/build billable item and file the new charge item
121 .N DIQUIET S DIQUIET=1,IBG=0 D DT^DICRW
122 .S IBITEM=+$$ADDBI^IBCREF("NDC",IBNDC)
123 .I IBITEM,$$ADDCI^IBCREF(IBCHSET,IBITEM,DT,IBAWP) S IBG=1
124 .;
125 .; - respond and update the counter
126 .W "Y",!
127 .S:IBG IBUPD=IBUPD+1
128 ;
129AWPPC D CLOSE^%ZISTCP
130 ;
131 ; - delete the primary task
132 S $P(^IBE(350.9,1,9),"^",6)=""
133 ;
134AWPPQ Q
135 ;
136 ;
137SECA ; Start the secondary AWP Update task.
138 S ZTRTN="AWPS^IBECUS1",ZTDTH=$H,ZTIO=""
139 S ZTDESC="IB - TRICARE Secondary AWP Update Task"
140 I IBVOL]"" S ZTCPU=IBVOL
141 F I="IBAPORT","IBCHAN","IBCHSET","IBVOL" S ZTSAVE(I)=""
142 D ^%ZTLOAD
143 ;
144 S $P(^IBE(350.9,1,9),"^",7)=$G(ZTSK)
145 ;
146 K ZTRTN,ZTDTH,ZTIO,ZTSK,ZTCPU,ZTSAVE
147 Q
148 ;
149ERRAP ; Primary billing task error trap
150 D CLOSE^%ZISTCP
151 S $P(^IBE(350.9,1,9),"^",6)=""
152 G ^%ZTER
153 ;
154ERRAS ; Secondary billing task error trap
155 D SECA
156 G ^%ZTER
Note: See TracBrowser for help on using the repository browser.