1 | IBTRED2 ;ALB/AAS - CLAIMS TRACKING EDIT BILLING INFORMATION; 06-JUL-93
|
---|
2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | % I '$D(DT) D DT^DICRW
|
---|
6 | I '$D(IOF) D HOME^%ZIS
|
---|
7 | W @IOF,?15,"Assign Reason Not Billable to Claims Tracking Entry",!!
|
---|
8 | S IBQUIT=0
|
---|
9 | ;
|
---|
10 | PAT ; -- select patient
|
---|
11 | D END Q:IBQUIT
|
---|
12 | D PAT^IBCNSM I '$G(DFN)!($D(VALMQUIT)) G END
|
---|
13 | ;
|
---|
14 | CT ; -- select claims tracking entry
|
---|
15 | D TRAC^IBTRV
|
---|
16 | I +IBY<1 D ADD G:IBQUIT END
|
---|
17 | I '$G(IBTRN) G PAT
|
---|
18 | D EDIT("[IBT BILLING INFO]")
|
---|
19 | W !!
|
---|
20 | G PAT
|
---|
21 | ;
|
---|
22 | END K DFN,VALMQUIT,IBY,IBTRN
|
---|
23 | Q
|
---|
24 | ;
|
---|
25 | EDIT(IBTEMP) ; -- edit without list manager
|
---|
26 | ; -- Input IBTEMP = template name or dr string
|
---|
27 | ;
|
---|
28 | N X,Y,I,J,DA,DR,DIC,DIE
|
---|
29 | G:$G(IBTRN)<1 EDITQ
|
---|
30 | L +^IBT(356,+IBTRN):5 I '$T D LOCKED^IBTRCD1 G EDITQ
|
---|
31 | D SAVE^IBTRED1
|
---|
32 | S DIE="^IBT(356,",DA=IBTRN
|
---|
33 | S DR=IBTEMP
|
---|
34 | D ^DIE
|
---|
35 | D COMP^IBTRED1
|
---|
36 | I IBDIF=1 D UPDATE^IBTRED1
|
---|
37 | L -^IBT(356,+IBTRN)
|
---|
38 | EDITQ K ^TMP($J,"IBT")
|
---|
39 | Q
|
---|
40 | ;
|
---|
41 | ADD ; -- ask if want to add a new tracking id
|
---|
42 | N DIR,IBOK K IBTRN
|
---|
43 | G:'$D(DFN) ADDQ
|
---|
44 | W !
|
---|
45 | S DIR(0)="Y",DIR("A")="Add New Claims Tracking entry",DIR("B")="NO"
|
---|
46 | S DIR("?")="Enter 'YES' if you wish to add a new claims tracking entry so that it can be assigned a reason not billable, answer 'NO' if you do not wish to add a new entry."
|
---|
47 | D ^DIR K DIR S IBOK=Y
|
---|
48 | G:'IBOK ADDQ
|
---|
49 | ;
|
---|
50 | ; -- set up required variable before call
|
---|
51 | S IBTASS=1
|
---|
52 | S IBTBDT=$$FMADD^XLFDT(DT,-720),IBTEDT=$$FMADD^XLFDT(DT,+45)
|
---|
53 | W !
|
---|
54 | D TEST^IBTRE2
|
---|
55 | ADDQ W ! Q
|
---|