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

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1IBCCR ;ALB/EJK - CLAIM CANCEL AND RESUBMIT INFORMATION ;23-FEB-2005
2 ;;2.0;INTEGRATED BILLING;**320**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;This routine can be invoked from any function that displays
6 ;or reviews claim information. Using the current IBIFN,
7 ;cancelled bill information and new bill information is returned.
8 ;
9 ;OUTPUT:
10 ; IBCCR array (pass by reference)
11 ; IBCCR(FM date cloned,bill#) [1] FM date cloned
12 ; [2] external claim#
13 ; [3] user who cloned (external)
14 ; [4] reason cloned
15 ; old bill and new bill information is returned.
16 ; As much as possible in both directions.
17 ;
18EN(IBIFN,IBCCR) ;
19 N IBOB,IBUSER,IBBCT,IBRSN,IBXDATA,IBDBC
20 KILL IBCCR
21 S IBXDATA("S1")=$G(^DGCR(399,IBIFN,"S1"))
22 I $P($G(IBXDATA("S1")),U,2)'="" S IBOB=$P($G(IBXDATA("S1")),U,2) D OBINFO ;THIS BILL IS A CLONE.
23 I $P($G(IBXDATA("S1")),U,1)'="" S IBBCT=$P($G(^DGCR(399,IBIFN,"S1")),U,1) D CLONE ;GET CLONE INFO.
24 Q
25 ;
26OBINFO ;This claim is a clone of an old one.
27 ;Per E-Claims+ Iteration II requirement 3.2.12
28 ;we want to find and return the entire cloning history as far back
29 ;as we can go.
30 ;
31 S IBDBC=$P($G(^DGCR(399,IBOB,"S1")),U,3)
32 S IBUSER=+$P($G(^DGCR(399,IBOB,"S1")),U,4)
33 S IBUSER=$P($G(^VA(200,IBUSER,0)),U,1)
34 S IBRSN=$P($G(^DGCR(399,IBOB,"S1")),U,5)
35 S IBCCR(+IBDBC,IBOB)=IBDBC_U_$P($G(^DGCR(399,IBOB,0)),U,1)_U_IBUSER_U_IBRSN
36 I $P($G(^DGCR(399,IBOB,"S1")),U,2) S IBOB=$P($G(^DGCR(399,IBOB,"S1")),U,2) G OBINFO ;THIS BILL IS A CLONE.
37 Q
38 ;
39CLONE ;This claim has been cancelled and cloned to a newer claim.
40 ;This function gets all pertinent data of who, why and when the
41 ;current claim was cancelled, then jumps forward to the next claim
42 ;to see if that was copy/cancelled as well.
43 ;
44 S IBDBC=$P($G(^DGCR(399,IBIFN,"S1")),U,3)
45 S IBUSER=+$P($G(^DGCR(399,IBIFN,"S1")),U,4)
46 S IBUSER=$P($G(^VA(200,IBUSER,0)),U,1)
47 S IBRSN=$P($G(^DGCR(399,IBIFN,"S1")),U,5)
48 S IBCCR(+IBDBC,IBBCT)=IBDBC_U_$P($G(^DGCR(399,IBBCT,0)),U,1)_U_IBUSER_U_IBRSN
49 S IBIFN=IBBCT
50 S IBBCT=$P($G(^DGCR(399,IBIFN,"S1")),U,1)
51 I IBIFN<IBBCT G CLONE
52 Q
53 ;
Note: See TracBrowser for help on using the repository browser.