IBAFIL.m

IBAFIL	;ALB/AAS - INTEGRATED BILLING, PASS OFF TO BE FILED ; 25-FEB-91

	;;Version 2.0 ; INTEGRATED BILLING ;; 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

	;

	F IBNOW=IBNOW:.000001 L +^IB("APOST",IBNOW):0 I $T,'$D(^IB("APOST",IBNOW)) Q

	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

IBAFIL    ;ALB/AAS - INTEGRATED BILLING, PASS OFF TO BE FILED ; 25-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       ;

%         ; 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       ;

 +7        FOR IBNOW=IBNOW:.000001

               LOCK +^IB("APOST",IBNOW):0

               IF $TEST

                   IF '$DATA(^IB("APOST",IBNOW))

                       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