|
Last change
on this file since 1200 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
819 bytes
|
| Line | |
|---|
| 1 | IBEFCOP ;ALB/AAS - INTEGRATED BILLING BACKGROUND FILER FOR RX COPAY ;26-FEB-91
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**150**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | COPAY ; - find pharmacy copay entries to process
|
|---|
| 6 | ;
|
|---|
| 7 | S IBHT=1
|
|---|
| 8 | S IBNOW="" F S IBNOW=$O(^IB("APOST",IBNOW)) Q:'IBNOW L +^IB("APOST",IBNOW):0 I $T S DFN=$O(^IB("APOST",IBNOW,"")) Q:'DFN D C1 L -^IB("APOST",IBNOW)
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | C1 S IBSEQNO=$O(^IB("APOST",IBNOW,DFN,"")) Q:'IBSEQNO S IBDUZ=$O(^IB("APOST",IBNOW,DFN,IBSEQNO,"")) Q:'IBDUZ D C2
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | C2 D CHKDT S IBNOS=^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ) K ^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ) D FILER^IBARXMA(+IBNOS),^IBR
|
|---|
| 15 | D LAST
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | LAST S DIE="^IBE(350.9,",DA=1,DR=".06///NOW" D ^DIE K DIE,DA,DR
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | CHKDT ; -- update dt if not the same
|
|---|
| 22 | N X,%
|
|---|
| 23 | D NOW^%DTC
|
|---|
| 24 | S:X'=DT DT=X
|
|---|
| 25 | Q
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
