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

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IBCEXTR2 ;ALB/JEH - IB EXTRACT STATUS MANAGEMENT ;01/14/00
2 ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;This routine contains the action items to cancel,clone and authorize
5 ;claims held in a ready for extract statue due to EDI/MRA parameters
6 ;being turned off.
7 ;
8CANCEL ;Cancel bill
9 N IBIFN,IBDA,IB364,IBCEAUTO
10 S IBCEAUTO=1
11 ;
12 ; Check for security key
13 I '$$KCHK^XUSRB("IB AUTHORIZE") D G CANCELQ
14 . D FULL^VALM1
15 . W !!?5,"You don't hold the proper security key to access this function."
16 . W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
17 . D PAUSE^VALM1
18 . Q
19 ;
20 D SEL(.IBDA,1)
21 S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IB364=$P($G(IBDA(+IBDA)),U,2)
22 I 'IBIFN G CANCELQ
23 D CANCEL^IBCEM3(.IBDA,IBIFN,IB364)
24 D PAUSE^VALM1
25CANCELQ S VALMBCK="R"
26 I $G(IBDA)'="" D BLD^IBCEXTR1
27 Q
28 ;
29CPYCLN ;Cancel/clone/authorize bill
30 N IBIFN,IBDA,IB364,IBCEAUTO,IBNIEN,IBYY
31 S IBCEAUTO=1
32 ;
33 ; Check for security key
34 I '$$KCHK^XUSRB("IB AUTHORIZE") D G CPYCLNQ
35 . D FULL^VALM1
36 . W !!?5,"You don't hold the proper security key to access this function."
37 . W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
38 . D PAUSE^VALM1
39 . Q
40 ;
41 D SEL(.IBDA,1)
42 S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IB364=$P($G(IBDA(+IBDA)),U,2)
43 I 'IBIFN G CPYCLNQ
44 D COPYCLON^IBCECOB2(IBIFN,IB364,.IBDA) ;Cancel/copy bill
45 I '$G(IBNIEN) D PAUSE^VALM1 G CPYCLNQ
46 S IBIFN=IBNIEN
47 S DIE="^DGCR(399,",DA=IBIFN,DR="[IB STATUS]",IBYY="@902" D ^DIE K DIE,DA,DR,IBNIEN ;Authorize bill quietly
48 W !,"Authorizing bill..."
49 D ARONLY^IBCB1(IBIFN) ;Pass to AR as new bill
50 D PAUSE^VALM1
51 ;
52CPYCLNQ ;
53 S VALMBCK="R"
54 K IBCEAUTO
55 Q
56 ;
57SEL(IBDA,ONE) ;Select entry from List Manager
58 ;D FULL^VALM1
59 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
60 S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=$P($G(^TMP("IBCERP61",$J,IBDA)),U,2,3)
61 Q
Note: See TracBrowser for help on using the repository browser.