[613] | 1 | IBEF ;ALB/AAS - BACKGROUND FILER FOR INTEGRATED BILLING ;12-FEB-91
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**158**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | ; -main background filer routine
|
---|
| 6 | ; - for pharmacy copay call ^ibefcop to process
|
---|
| 7 | ;
|
---|
| 8 | DQ ; - entry point for ib background filer
|
---|
| 9 | ;***
|
---|
| 10 | ;I $D(ZTQUEUED) S XRTL=$ZU(0),XRTN="IBEF-2" D T0^%ZOSV ;start rt clock
|
---|
| 11 | ;
|
---|
| 12 | ; -- lock symbolic reference (not real), if already locked, quit.
|
---|
| 13 | L +^IB("IBEF"):5 I '$T G END
|
---|
| 14 | I $S('$D(^IBE(350.9,1,0)):1,'$P(^(0),"^",3):1,$P(^(0),"^",4):1,1:0) G END
|
---|
| 15 | ;I $D(^%ZOSF("PRIORITY")) S X=10 X ^%ZOSF("PRIORITY")
|
---|
| 16 | ;I $D(^%ZOSF("TRAP")) S X="^%ET",@^("TRAP")
|
---|
| 17 | ;
|
---|
| 18 | % ; -set start time, delete stop time, queued = no
|
---|
| 19 | S DIE="^IBE(350.9,",DA=1,DR=".04///NOW;.05///@;.1////0" D ^DIE K DIC,DIE,DR,DA
|
---|
| 20 | ;
|
---|
| 21 | ; - retention time = 2000 x hang time
|
---|
| 22 | ; - if data is found ibht is reset to 1
|
---|
| 23 | S IBHANG=$S($P(^IBE(350.9,1,0),"^",8):$P(^(0),"^",8),1:2)
|
---|
| 24 | F IBHT=1:1:2000 D:$D(^IB("APOST")) ^IBEFCOP H IBHANG I $D(^IBE(350.9,1,0)),'$P(^(0),"^",3) Q
|
---|
| 25 | G END
|
---|
| 26 | Q
|
---|
| 27 | ;
|
---|
| 28 | END ;
|
---|
| 29 | ; - delete start time, set stop time
|
---|
| 30 | S DIE="^IBE(350.9,",DA=1,DR=".04///@;.05///NOW" D ^DIE K DIC,DIE,DR,DA
|
---|
| 31 | L -^IB("IBEF")
|
---|
| 32 | ;***
|
---|
| 33 | ;I $D(ZTQUEUED),$D(XRT0) S:'$D(XRTN) XRTN="IBEF" D T1^%ZOSV ;stop rt clock
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|
| 36 | ZTSK ; - que background filer if not running
|
---|
| 37 | N ZTSK,Y
|
---|
| 38 | ; -set queued flag to prevent multiple queued filers
|
---|
| 39 | L +^IBE(350.9,0):2 Q:'$T ;somebody else is queueing off a filer at the same time
|
---|
| 40 | S DIE="^IBE(350.9,",DA=1,DR=".1////1" D ^DIE K DIE,DA,DR S Y=1
|
---|
| 41 | ;
|
---|
| 42 | S ZTRTN="^IBEF",ZTDTH=$H,ZTIO="",ZTDESC="IB Background"
|
---|
| 43 | K ZTCPU I $D(^IBE(350.9,1,0)) S X=$P(^(0),"^",7) I X'="" S ZTCPU=$P(X,",",2)
|
---|
| 44 | D ^%ZTLOAD
|
---|
| 45 | S Y=$S($D(ZTSK):1,1:"-1^IB019")
|
---|
| 46 | L -^IBE(350.9,0)
|
---|
| 47 | ;
|
---|
| 48 | Q
|
---|