IBAFIL ;ALB/AAS - INTEGRATED BILLING, PASS OFF TO BE FILED ; 25-FEB-91
;;Version 2.0 ; INTEGRATED BILLING ;**40**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% I '$G(DFN) S Y="-1^IB002" Q ; Invalid patient pointer
I '$G(IBSEQNO) S Y="-1^IB017" Q ; Sequence number is missing
I '$G(IBDUZ) S Y="-1^IB007" Q ; Invalid user ID
I '$D(^IBE(350.9,1,0)) D ^IBR Q ; no site parameters - file in foreground
;
I '$P(^IBE(350.9,1,0),"^",3) N Y D ^IBR Q ; file in foreground
;Patch 40 looks for a space to set "APOST" x-ref if finds then lock.
F IBNOW=IBNOW:.000001 I '$D(^IB("APOST",IBNOW)) L +^IB("APOST",IBNOW):0 Q:$T
S ^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ)=IBNOS
L -^IB("APOST",IBNOW)
;
; - if filer not started, start it.
I $P(^IBE(350.9,1,0),"^",4)="",'$P(^(0),"^",10) D ZTSK^IBEF Q
;
;check to see if not running, wait 2 seconds, test again
;before restarting (time to deque)
D EN^IBECK I IBFLAG[3 H 2 D EN^IBECK I IBFLAG[3 D S1^IBEFUTL
K IBFLAG
Q
;
REPASS ; -called from IB INCOMPLETE print template
D NOW^%DTC S IBNOW=%
S DFN=$P(^IB(D0,0),"^",2),IBATYP=$P(^(0),"^",3),IBSEQNO=$P(^IBE(350.1,IBATYP,0),"^",5),IBDUZ=DUZ,IBNOS=D0
D IBAFIL
K IBN,IBNOW,DFN,IBDUZ,IBSEQNO,IBATYP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAFIL 1270 printed Dec 13, 2024@02:06:16 Page 2
IBAFIL ;ALB/AAS - INTEGRATED BILLING, PASS OFF TO BE FILED ; 25-FEB-91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**40**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ; Invalid patient pointer
IF '$GET(DFN)
SET Y="-1^IB002"
QUIT
+1 ; Sequence number is missing
IF '$GET(IBSEQNO)
SET Y="-1^IB017"
QUIT
+2 ; Invalid user ID
IF '$GET(IBDUZ)
SET Y="-1^IB007"
QUIT
+3 ; no site parameters - file in foreground
IF '$DATA(^IBE(350.9,1,0))
DO ^IBR
QUIT
+4 ;
+5 ; file in foreground
IF '$PIECE(^IBE(350.9,1,0),"^",3)
NEW Y
DO ^IBR
QUIT
+6 ;Patch 40 looks for a space to set "APOST" x-ref if finds then lock.
+7 FOR IBNOW=IBNOW:.000001
IF '$DATA(^IB("APOST",IBNOW))
LOCK +^IB("APOST",IBNOW):0
if $TEST
QUIT
+8 SET ^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ)=IBNOS
+9 LOCK -^IB("APOST",IBNOW)
+10 ;
+11 ; - if filer not started, start it.
+12 IF $PIECE(^IBE(350.9,1,0),"^",4)=""
IF '$PIECE(^(0),"^",10)
DO ZTSK^IBEF
QUIT
+13 ;
+14 ;check to see if not running, wait 2 seconds, test again
+15 ;before restarting (time to deque)
+16 DO EN^IBECK
IF IBFLAG[3
HANG 2
DO EN^IBECK
IF IBFLAG[3
DO S1^IBEFUTL
+17 KILL IBFLAG
+18 QUIT
+19 ;
REPASS ; -called from IB INCOMPLETE print template
+1 DO NOW^%DTC
SET IBNOW=%
+2 SET DFN=$PIECE(^IB(D0,0),"^",2)
SET IBATYP=$PIECE(^(0),"^",3)
SET IBSEQNO=$PIECE(^IBE(350.1,IBATYP,0),"^",5)
SET IBDUZ=DUZ
SET IBNOS=D0
+3 DO IBAFIL
+4 KILL IBN,IBNOW,DFN,IBDUZ,IBSEQNO,IBATYP
+5 QUIT
