IBAREP ;ALB/AAS - INTEGRATED BILLING - REPOST IB ACTION TO FILER ; 1-APR-91
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBAREP" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="IBAREP-1" D T0^%ZOSV ;start rt clock
;
S DIC="^IB(",DIC(0)="AEQMN" D ^DIC G:Y<1 END S IBN=+Y
D CHK G %
;
CHK S IBND=$S($D(^IB(IBN,0)):^(0),1:"") I 'IBND W !,"ZEROTH NODE MISSING" D CANT Q
I $P(IBND,"^",12) W !,"Transaction number already assigned" D CANT Q
I $P(IBND,"^",5)>2&($P(IBND,"^",5)'=9) W !,"Status indicates it's complete" D CANT Q
S DIR(0)="Y",DIR("A")="Are You SURE: ",DIR("B")="NO" D ^DIR K DIR I 'Y D CANT Q
D POST
Q
;
POST ;
S IBND=^IB(IBN,0),DFN=$P(IBND,"^",2),IBATYP=$P(IBND,"^",3)
S IBSEQNO=$S('IBATYP:"",$D(^IBE(350.1,IBATYP,0)):$P(^(0),"^",5),1:"")
D NOW^%DTC S IBNOW=%
S IBDUZ=DUZ
S IBNOS=IBN
I DFN,IBSEQNO,DUZ,IBNOS D ^IBAFIL W !,"Attempting to Repass!",!! Q
E W !,"Not enough data to repost"
Q
;
CANT W !,"Nothing Passed!",!! Q
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
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBAREP" D T1^%ZOSV ;stop rt clock
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAREP 1329 printed Dec 13, 2024@02:06:53 Page 2
IBAREP ;ALB/AAS - INTEGRATED BILLING - REPOST IB ACTION TO FILER ; 1-APR-91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAREP" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="IBAREP-1" D T0^%ZOSV ;start rt clock
+4 ;
+5 SET DIC="^IB("
SET DIC(0)="AEQMN"
DO ^DIC
if Y<1
GOTO END
SET IBN=+Y
+6 DO CHK
GOTO %
+7 ;
CHK SET IBND=$SELECT($DATA(^IB(IBN,0)):^(0),1:"")
IF 'IBND
WRITE !,"ZEROTH NODE MISSING"
DO CANT
QUIT
+1 IF $PIECE(IBND,"^",12)
WRITE !,"Transaction number already assigned"
DO CANT
QUIT
+2 IF $PIECE(IBND,"^",5)>2&($PIECE(IBND,"^",5)'=9)
WRITE !,"Status indicates it's complete"
DO CANT
QUIT
+3 SET DIR(0)="Y"
SET DIR("A")="Are You SURE: "
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF 'Y
DO CANT
QUIT
+4 DO POST
+5 QUIT
+6 ;
POST ;
+1 SET IBND=^IB(IBN,0)
SET DFN=$PIECE(IBND,"^",2)
SET IBATYP=$PIECE(IBND,"^",3)
+2 SET IBSEQNO=$SELECT('IBATYP:"",$DATA(^IBE(350.1,IBATYP,0)):$PIECE(^(0),"^",5),1:"")
+3 DO NOW^%DTC
SET IBNOW=%
+4 SET IBDUZ=DUZ
+5 SET IBNOS=IBN
+6 IF DFN
IF IBSEQNO
IF DUZ
IF IBNOS
DO ^IBAFIL
WRITE !,"Attempting to Repass!",!!
QUIT
+7 IF '$TEST
WRITE !,"Not enough data to repost"
+8 QUIT
+9 ;
CANT WRITE !,"Nothing Passed!",!!
QUIT
END KILL %,%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 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAREP" D T1^%ZOSV ;stop rt clock
+3 QUIT
