source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAFIL.m@ 699

Last change on this file since 699 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1IBAFIL ;ALB/AAS - INTEGRATED BILLING, PASS OFF TO BE FILED ; 25-FEB-91
2 ;;Version 2.0 ; INTEGRATED BILLING ;**40**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% I '$G(DFN) S Y="-1^IB002" Q ; Invalid patient pointer
6 I '$G(IBSEQNO) S Y="-1^IB017" Q ; Sequence number is missing
7 I '$G(IBDUZ) S Y="-1^IB007" Q ; Invalid user ID
8 I '$D(^IBE(350.9,1,0)) D ^IBR Q ; no site parameters - file in foreground
9 ;
10 I '$P(^IBE(350.9,1,0),"^",3) N Y D ^IBR Q ; file in foreground
11 ;Patch 40 looks for a space to set "APOST" x-ref if finds then lock.
12 F IBNOW=IBNOW:.000001 I '$D(^IB("APOST",IBNOW)) L +^IB("APOST",IBNOW):0 Q:$T
13 S ^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ)=IBNOS
14 L -^IB("APOST",IBNOW)
15 ;
16 ; - if filer not started, start it.
17 I $P(^IBE(350.9,1,0),"^",4)="",'$P(^(0),"^",10) D ZTSK^IBEF Q
18 ;
19 ;check to see if not running, wait 2 seconds, test again
20 ;before restarting (time to deque)
21 D EN^IBECK I IBFLAG[3 H 2 D EN^IBECK I IBFLAG[3 D S1^IBEFUTL
22 K IBFLAG
23 Q
24 ;
25REPASS ; -called from IB INCOMPLETE print template
26 D NOW^%DTC S IBNOW=%
27 S DFN=$P(^IB(D0,0),"^",2),IBATYP=$P(^(0),"^",3),IBSEQNO=$P(^IBE(350.1,IBATYP,0),"^",5),IBDUZ=DUZ,IBNOS=D0
28 D IBAFIL
29 K IBN,IBNOW,DFN,IBDUZ,IBSEQNO,IBATYP
30 Q
Note: See TracBrowser for help on using the repository browser.