IBEF ;ALB/AAS - BACKGROUND FILER FOR INTEGRATED BILLING ;12-FEB-91
;;2.0;INTEGRATED BILLING;**158**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; -main background filer routine
; - for pharmacy copay call ^ibefcop to process
;
DQ ; - entry point for ib background filer
;***
;I $D(ZTQUEUED) S XRTL=$ZU(0),XRTN="IBEF-2" D T0^%ZOSV ;start rt clock
;
; -- lock symbolic reference (not real), if already locked, quit.
L +^IB("IBEF"):5 I '$T G END
I $S('$D(^IBE(350.9,1,0)):1,'$P(^(0),"^",3):1,$P(^(0),"^",4):1,1:0) G END
;I $D(^%ZOSF("PRIORITY")) S X=10 X ^%ZOSF("PRIORITY")
;I $D(^%ZOSF("TRAP")) S X="^%ET",@^("TRAP")
;
% ; -set start time, delete stop time, queued = no
S DIE="^IBE(350.9,",DA=1,DR=".04///NOW;.05///@;.1////0" D ^DIE K DIC,DIE,DR,DA
;
; - retention time = 2000 x hang time
; - if data is found ibht is reset to 1
S IBHANG=$S($P(^IBE(350.9,1,0),"^",8):$P(^(0),"^",8),1:2)
F IBHT=1:1:2000 D:$D(^IB("APOST")) ^IBEFCOP H IBHANG I $D(^IBE(350.9,1,0)),'$P(^(0),"^",3) Q
G END
Q
;
END ;
; - delete start time, set stop time
S DIE="^IBE(350.9,",DA=1,DR=".04///@;.05///NOW" D ^DIE K DIC,DIE,DR,DA
L -^IB("IBEF")
;***
;I $D(ZTQUEUED),$D(XRT0) S:'$D(XRTN) XRTN="IBEF" D T1^%ZOSV ;stop rt clock
Q
;
ZTSK ; - que background filer if not running
N ZTSK,Y
; -set queued flag to prevent multiple queued filers
L +^IBE(350.9,0):2 Q:'$T ;somebody else is queueing off a filer at the same time
S DIE="^IBE(350.9,",DA=1,DR=".1////1" D ^DIE K DIE,DA,DR S Y=1
;
S ZTRTN="^IBEF",ZTDTH=$H,ZTIO="",ZTDESC="IB Background"
K ZTCPU I $D(^IBE(350.9,1,0)) S X=$P(^(0),"^",7) I X'="" S ZTCPU=$P(X,",",2)
D ^%ZTLOAD
S Y=$S($D(ZTSK):1,1:"-1^IB019")
L -^IBE(350.9,0)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEF 1792 printed Oct 16, 2024@18:22:31 Page 2
IBEF ;ALB/AAS - BACKGROUND FILER FOR INTEGRATED BILLING ;12-FEB-91
+1 ;;2.0;INTEGRATED BILLING;**158**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; -main background filer routine
+5 ; - for pharmacy copay call ^ibefcop to process
+6 ;
DQ ; - entry point for ib background filer
+1 ;***
+2 ;I $D(ZTQUEUED) S XRTL=$ZU(0),XRTN="IBEF-2" D T0^%ZOSV ;start rt clock
+3 ;
+4 ; -- lock symbolic reference (not real), if already locked, quit.
+5 LOCK +^IB("IBEF"):5
IF '$TEST
GOTO END
+6 IF $SELECT('$DATA(^IBE(350.9,1,0)):1,'$PIECE(^(0),"^",3):1,$PIECE(^(0),"^",4):1,1:0)
GOTO END
+7 ;I $D(^%ZOSF("PRIORITY")) S X=10 X ^%ZOSF("PRIORITY")
+8 ;I $D(^%ZOSF("TRAP")) S X="^%ET",@^("TRAP")
+9 ;
% ; -set start time, delete stop time, queued = no
+1 SET DIE="^IBE(350.9,"
SET DA=1
SET DR=".04///NOW;.05///@;.1////0"
DO ^DIE
KILL DIC,DIE,DR,DA
+2 ;
+3 ; - retention time = 2000 x hang time
+4 ; - if data is found ibht is reset to 1
+5 SET IBHANG=$SELECT($PIECE(^IBE(350.9,1,0),"^",8):$PIECE(^(0),"^",8),1:2)
+6 FOR IBHT=1:1:2000
if $DATA(^IB("APOST"))
DO ^IBEFCOP
HANG IBHANG
IF $DATA(^IBE(350.9,1,0))
IF '$PIECE(^(0),"^",3)
QUIT
+7 GOTO END
+8 QUIT
+9 ;
END ;
+1 ; - delete start time, set stop time
+2 SET DIE="^IBE(350.9,"
SET DA=1
SET DR=".04///@;.05///NOW"
DO ^DIE
KILL DIC,DIE,DR,DA
+3 LOCK -^IB("IBEF")
+4 ;***
+5 ;I $D(ZTQUEUED),$D(XRT0) S:'$D(XRTN) XRTN="IBEF" D T1^%ZOSV ;stop rt clock
+6 QUIT
+7 ;
ZTSK ; - que background filer if not running
+1 NEW ZTSK,Y
+2 ; -set queued flag to prevent multiple queued filers
+3 ;somebody else is queueing off a filer at the same time
LOCK +^IBE(350.9,0):2
if '$TEST
QUIT
+4 SET DIE="^IBE(350.9,"
SET DA=1
SET DR=".1////1"
DO ^DIE
KILL DIE,DA,DR
SET Y=1
+5 ;
+6 SET ZTRTN="^IBEF"
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTDESC="IB Background"
+7 KILL ZTCPU
IF $DATA(^IBE(350.9,1,0))
SET X=$PIECE(^(0),"^",7)
IF X'=""
SET ZTCPU=$PIECE(X,",",2)
+8 DO ^%ZTLOAD
+9 SET Y=$SELECT($DATA(ZTSK):1,1:"-1^IB019")
+10 LOCK -^IBE(350.9,0)
+11 ;
+12 QUIT
