- 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 Jan 18, 2025@03:07:29 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