| [613] | 1 | IBAREP ;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 | ;
|
|---|
| 13 | CHK 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 | ;
|
|---|
| 20 | POST ;
|
|---|
| 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 | ;
|
|---|
| 30 | CANT W !,"Nothing Passed!",!! Q
|
|---|
| 31 | END 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
|
|---|
