Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBAREP

IBAREP.m

Go to the documentation of this file.
  1. IBAREP ;ALB/AAS - INTEGRATED BILLING - REPOST IB ACTION TO FILER ; 1-APR-91
  1. ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. % ;
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAREP" D T1^%ZOSV ;stop rt clock
  1. ;S XRTL=$ZU(0),XRTN="IBAREP-1" D T0^%ZOSV ;start rt clock
  1. ;
  1. S DIC="^IB(",DIC(0)="AEQMN" D ^DIC G:Y<1 END S IBN=+Y
  1. D CHK G %
  1. ;
  1. CHK S IBND=$S($D(^IB(IBN,0)):^(0),1:"") I 'IBND W !,"ZEROTH NODE MISSING" D CANT Q
  1. I $P(IBND,"^",12) W !,"Transaction number already assigned" D CANT Q
  1. I $P(IBND,"^",5)>2&($P(IBND,"^",5)'=9) W !,"Status indicates it's complete" D CANT Q
  1. S DIR(0)="Y",DIR("A")="Are You SURE: ",DIR("B")="NO" D ^DIR K DIR I 'Y D CANT Q
  1. D POST
  1. Q
  1. ;
  1. POST ;
  1. S IBND=^IB(IBN,0),DFN=$P(IBND,"^",2),IBATYP=$P(IBND,"^",3)
  1. S IBSEQNO=$S('IBATYP:"",$D(^IBE(350.1,IBATYP,0)):$P(^(0),"^",5),1:"")
  1. D NOW^%DTC S IBNOW=%
  1. S IBDUZ=DUZ
  1. S IBNOS=IBN
  1. I DFN,IBSEQNO,DUZ,IBNOS D ^IBAFIL W !,"Attempting to Repass!",!! Q
  1. E W !,"Not enough data to repost"
  1. Q
  1. ;
  1. CANT W !,"Nothing Passed!",!! Q
  1. 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
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAREP" D T1^%ZOSV ;stop rt clock
  1. Q