[613] | 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
|
---|