- 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 Jan 18, 2025@03:08:07 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