source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAREP.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1IBAREP ;ALB/AAS - INTEGRATED BILLING - REPOST IB ACTION TO FILER ; 1-APR-91
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ;
6 ;***
7 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAREP" D T1^%ZOSV ;stop rt clock
8 ;S XRTL=$ZU(0),XRTN="IBAREP-1" D T0^%ZOSV ;start rt clock
9 ;
10 S DIC="^IB(",DIC(0)="AEQMN" D ^DIC G:Y<1 END S IBN=+Y
11 D CHK G %
12 ;
13CHK S IBND=$S($D(^IB(IBN,0)):^(0),1:"") I 'IBND W !,"ZEROTH NODE MISSING" D CANT Q
14 I $P(IBND,"^",12) W !,"Transaction number already assigned" D CANT Q
15 I $P(IBND,"^",5)>2&($P(IBND,"^",5)'=9) W !,"Status indicates it's complete" D CANT Q
16 S DIR(0)="Y",DIR("A")="Are You SURE: ",DIR("B")="NO" D ^DIR K DIR I 'Y D CANT Q
17 D POST
18 Q
19 ;
20POST ;
21 S IBND=^IB(IBN,0),DFN=$P(IBND,"^",2),IBATYP=$P(IBND,"^",3)
22 S IBSEQNO=$S('IBATYP:"",$D(^IBE(350.1,IBATYP,0)):$P(^(0),"^",5),1:"")
23 D NOW^%DTC S IBNOW=%
24 S IBDUZ=DUZ
25 S IBNOS=IBN
26 I DFN,IBSEQNO,DUZ,IBNOS D ^IBAFIL W !,"Attempting to Repass!",!! Q
27 E W !,"Not enough data to repost"
28 Q
29 ;
30CANT W !,"Nothing Passed!",!! Q
31END K %,%I,DFN,DIC,X,Y,I,IBN,IBNOS,IBSEQNO,IBATYP,IBNOD,IBDUZ,IBAFY,IBARTYP,IBFAC,IBIL,IBND,IBNOW,IBSERV,IBSITE,IBTOTL,IBTRAN,IBWHER,DUOUT,DFN,IBHDT,IBOERR
32 ;***
33 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAREP" D T1^%ZOSV ;stop rt clock
34 Q
Note: See TracBrowser for help on using the repository browser.