- IBEF ;ALB/AAS - BACKGROUND FILER FOR INTEGRATED BILLING ; 12-FEB-91
- ;;Version 2.0 ; INTEGRATED BILLING ;; 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="Integrated Billing background Delivery to A/R"
- 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
- IBEF ;ALB/AAS - BACKGROUND FILER FOR INTEGRATED BILLING ; 12-FEB-91
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 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 IF $DATA(^%ZOSF("PRIORITY"))
- SET X=10
- XECUTE ^%ZOSF("PRIORITY")
- +8 IF $DATA(^%ZOSF("TRAP"))
- SET X="^%ET"
- SET @^("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="Integrated Billing background Delivery to A/R"
- +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