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

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

revised back to 6/30/08 version

File size: 1.6 KB
Line 
1IBATER ;LL/ELZ - TRANSFER PRICING PROSTHETICS DRIVER ; 7-APR-2000
2 ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine is called by the nightly back ground job. It will go
6 ; through the prosthetics file (660) and look for transfer pricing
7 ; transactions that it has not previously found. It looks for T-30
8 ; through T based upon the delivery date. File 660 - dbia #373
9 ;
10EN ;
11 I '$P($G(^IBE(350.9,1,10)),"^",5) Q ; transfer pricing turned off
12 ;
13 N IBDT,IBDA
14 ;
15 ; date range t-30 to t
16 S IBDT=$$FMADD^XLFDT(DT,-30)
17 ;
18 F S IBDT=$O(^RMPR(660,"CT",IBDT)) Q:'IBDT!(IBDT>DT) S IBDA="" F S IBDA=$O(^RMPR(660,"CT",IBDT,IBDA)) Q:'IBDA D CHECK
19 ;
20 Q
21 ;
22CHECK ; check if transfer pricing and not already added
23 ;
24 N IBDATA,IBDFN
25 ;
26 ; already in file
27 I $O(^IBAT(351.61,"AD",(IBDA_";RMPR(660,"),0)) Q
28 ;
29 ; valid tp patient
30 S IBDATA=$G(^RMPR(660,+IBDA,0)) Q:IBDATA=""
31 S IBDFN=$P(IBDATA,"^",2) Q:'IBDFN Q:'$$TPP^IBATUTL(IBDFN)
32 ;
33 ; checks from RMPRBIL copied 4/7/2000 with mod for patient type removed
34 I $S('$D(^RMPR(660,IBDA,"AM")):1,$P(IBDATA,"^",9)="":1,$P(IBDATA,"^",12)="":1,$P(IBDATA,"^",6)="":1,$P(IBDATA,"^",14)="V":1,$P(IBDATA,"^",15)="*":1,1:0) Q
35 ;
36 ; now if inpt, must be in 351.67
37 I $P(^RMPR(660,IBDA,"AM"),"^",3)'=1,$P(^("AM"),"^",3)'=4,'$D(^IBAT(351.67,"B",$P(IBDATA,"^",6))) Q
38 ;
39 Q:'$P(IBDATA,"^",16) ; no total cost, at least yet
40 ;
41FILE ; ok transaction needs to be filled in tp files
42 ;
43 S IBDATA=$$RMPR^IBATFILE(IBDFN,IBDT,$$PPF^IBATUTL(IBDFN),(IBDA_";RMPR(660,"),$P(IBDATA,"^",6),$P(IBDATA,"^",16))
44 ;
45 Q
Note: See TracBrowser for help on using the repository browser.