Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBEF

IBEF.m

Go to the documentation of this file.
  1. IBEF ;ALB/AAS - BACKGROUND FILER FOR INTEGRATED BILLING ; 12-FEB-91
  1. ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; -main background filer routine
  1. ; - for pharmacy copay call ^ibefcop to process
  1. ;
  1. DQ ; - entry point for ib background filer
  1. ;***
  1. ;I $D(ZTQUEUED) S XRTL=$ZU(0),XRTN="IBEF-2" D T0^%ZOSV ;start rt clock
  1. ;
  1. ; -- lock symbolic reference (not real), if already locked, quit.
  1. L +^IB("IBEF"):5 I '$T G END
  1. I $S('$D(^IBE(350.9,1,0)):1,'$P(^(0),"^",3):1,$P(^(0),"^",4):1,1:0) G END
  1. I $D(^%ZOSF("PRIORITY")) S X=10 X ^%ZOSF("PRIORITY")
  1. I $D(^%ZOSF("TRAP")) S X="^%ET",@^("TRAP")
  1. ;
  1. % ; -set start time, delete stop time, queued = no
  1. S DIE="^IBE(350.9,",DA=1,DR=".04///NOW;.05///@;.1////0" D ^DIE K DIC,DIE,DR,DA
  1. ;
  1. ; - retention time = 2000 x hang time
  1. ; - if data is found ibht is reset to 1
  1. S IBHANG=$S($P(^IBE(350.9,1,0),"^",8):$P(^(0),"^",8),1:2)
  1. F IBHT=1:1:2000 D:$D(^IB("APOST")) ^IBEFCOP H IBHANG I $D(^IBE(350.9,1,0)),'$P(^(0),"^",3) Q
  1. G END
  1. Q
  1. ;
  1. END ;
  1. ; - delete start time, set stop time
  1. S DIE="^IBE(350.9,",DA=1,DR=".04///@;.05///NOW" D ^DIE K DIC,DIE,DR,DA
  1. L -^IB("IBEF")
  1. ;***
  1. ;I $D(ZTQUEUED),$D(XRT0) S:'$D(XRTN) XRTN="IBEF" D T1^%ZOSV ;stop rt clock
  1. Q
  1. ;
  1. ZTSK ; - que background filer if not running
  1. N ZTSK,Y
  1. ; -set queued flag to prevent multiple queued filers
  1. L +^IBE(350.9,0):2 Q:'$T ;somebody else is queueing off a filer at the same time
  1. S DIE="^IBE(350.9,",DA=1,DR=".1////1" D ^DIE K DIE,DA,DR S Y=1
  1. ;
  1. S ZTRTN="^IBEF",ZTDTH=$H,ZTIO="",ZTDESC="Integrated Billing background Delivery to A/R"
  1. K ZTCPU I $D(^IBE(350.9,1,0)) S X=$P(^(0),"^",7) I X'="" S ZTCPU=$P(X,",",2)
  1. D ^%ZTLOAD
  1. S Y=$S($D(ZTSK):1,1:"-1^IB019")
  1. L -^IBE(350.9,0)
  1. ;
  1. Q