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

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

initial load of FOIAVistA 6/30/08 version
File size: 3.6 KB
Line 
1IBPF1 ;ALB/CPM - FIND BILLING DATA TO ARCHIVE (CON'T.) ; 20-APR-92
2 ;;2.0;INTEGRATED BILLING;**45,347**;21-MAR-94;Build 24
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5BILL ; Find all UB-82's which may be archived. Check only those bills
6 ; whose First Printed Date is prior to the last date on which a
7 ; bill must have been closed out in Accounts Receivable.
8 ;
9 ; Input: IBEDT -- last valid date on which a bill may be closed out
10 ; IBTMPL -- search template in which to store entries
11 ; Output: IBCNT -- number of IB Actions which may be archived.
12 ;
13 S (IBDT,IBN)="",IBCNT=0
14 F S IBDT=$O(^DGCR(399,"AP",IBDT)) Q:'IBDT!(IBDT>IBEDT) F S IBN=$O(^DGCR(399,"AP",IBDT,IBN)) Q:'IBN I $$ALL(IBN,IBEDT) S IBCNT=IBCNT+1,^DIBT(IBTMPL,1,IBN)=""
15 K IBCLO,IBDT,IBN
16 Q
17 ;
18 ;
19IB ; Find Pharmacy Co-pay IB Actions which may be archived. Check
20 ; only those Pharmacy Co-pay IB Actions which have been added to the
21 ; database prior to the last date on which a bill must have been
22 ; closed out in Accounts Receivable. Only "parent actions" will
23 ; be checked, and if the parent action may be archived, the parent
24 ; and its "children" will all be marked for archiving.
25 ;
26 ; Input: IBEDT -- last valid date on which a bill may be closed out
27 ; IBTMPL -- search template in which to store entries
28 ; Output: IBCNT -- number of IB Actions which may be archived.
29 ;
30 ; - first find all Pharmacy action types.
31 K IBA F I=1:1 S IBATYPN=$P($T(PSO+I),";;",2,99) Q:IBATYPN="" S IBATYP=$O(^IBE(350.1,"B",IBATYPN,0)) I IBATYP S IBA(IBATYP)=""
32 ;
33 ; - locate all Pharmacy Co-pay actions which may be archived.
34 S (IBDT,IBN)="",IBCNT=0
35 F S IBDT=$O(^IB("D",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.3)) D
36 . F S IBN=$O(^IB("D",IBDT,IBN)) Q:'IBN D:$D(^IB("AD",IBN))
37 .. S IBND=$G(^IB(IBN,0)) Q:IBND="" ; 0th node missing
38 .. Q:'$D(IBA(+$P(IBND,"^",3))) ; not a Pharmacy co-pay action
39 .. Q:$$RXFILE(IBND) ; billed prescription has not been archived
40 .. S IBAR=$P(IBND,"^",11) Q:IBAR=""
41 .. S X="RCFN03" X ^%ZOSF("TEST")
42 .. S IBAR=$S($T:$$BIEN^RCFN03(IBAR),1:$O(^PRCA(430,"B",IBAR,0)))
43 .. I IBAR,$$CLO(IBAR,IBEDT) F DA=0:0 S DA=$O(^IB("AD",IBN,DA)) Q:'DA S IBCNT=IBCNT+1,^DIBT(IBTMPL,1,DA)=""
44 ;
45 ; - kill variables and quit.
46 K DA,IBA,IBAR,IBATYP,IBATYPN,IBCLO,IBDT,IBN,IBND,X
47 Q
48 ;
49 ;
50RXFILE(IBND) ; Is the prescription still resident on-line?
51 ; Input: IBND -- zeroth node of IB Action
52 ; Output: 1 -- the rx is still on file
53 ; 0 -- the rx is no longer on file (archived)
54 N IBSL,RXCHK
55 S IBSL=$P(IBND,"^",4) I +IBSL'=52 Q 0
56 S IBSL=$P(IBSL,":",2)
57 S RXCHK=$$FILE^IBRXUTL(+IBSL,.01)
58 I RXCHK'="" Q 1
59 Q 0
60 ;
61ALL(IBN,DATE) ; Are all bills for an episode of care closed before DATE?
62 ; Input: IBN -- ien of bill in file #399
63 ; DATE -- the date by which the bills must be closed
64 ; Output: 1 -- all bills are closed
65 ; 0 -- at least one bill is not closed
66 N I,X
67 S X=$$CLO(IBN,DATE)
68 I X S I=0 F S I=$O(^DGCR(399,"AC",IBN,I)) Q:'I I I'=IBN,'$$CLO(I,DATE) S X=0 Q
69 Q X
70 ;
71CLO(IBN,DATE) ; Is the bill closed before DATE?
72 ; Input: IBN -- ien of bill in file #399
73 ; DATE -- the date by which the bill must be closed
74 ; Output: 1 -- the bill is closed
75 ; 0 -- the bill is not closed
76 N CLO S CLO=$$PUR^PRCAFN(IBN)
77 Q $S(CLO=-2:1,CLO=-1:0,1:CLO'>DATE)
78 ;
79 ;
80PSO ; Pharmacy Co-pay Action Types
81 ;;PSO NSC RX COPAY CANCEL
82 ;;PSO NSC RX COPAY NEW
83 ;;PSO NSC RX COPAY UPDATE
84 ;;PSO SC RX COPAY CANCEL
85 ;;PSO SC RX COPAY NEW
86 ;;PSO SC RX COPAY UPDATE
87 ;
Note: See TracBrowser for help on using the repository browser.