- IBCC ;ALB/MJB - CANCEL UB-82 THIRD PARTY BILL ;14 JUN 88 10:12
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;MAP TO DGCRC
- ;
- ;I '$D(IBCAN) W !!,?3,"***** BILLS MAY ONLY BE CANCELLED THROUGH 'CANCEL BILL' OPTION!! *****",!,?5,"***** PLEASE SEE YOUR SUPERVISOR IF YOU REQUIRE ASSISTANCE!! *****" Q
- I '$D(IBCAN) S IBCAN=1
- ASK ;
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
- ;S XRTL=$ZU(0),XRTN="IBCC-1" D T0^%ZOSV ;start rt clock
- ;
- D Q S DIC="^DGCR(399,",DIC(0)="AEMQZ",DIC("A")="Enter BILL NUMBER or Patient NAME: " W !! D ^DIC I Y<1 S IBQUIT=1 G Q1
- NOPTF S IBIFN=+Y I IBCAN>1 D NOPTF^IBCB2 I 'IBAC1 D NOPTF1^IBCB2 G ASK
- F I=0,"S","U1" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
- I IBCAN=2,IB("S")]"",+$P(IB("S"),U,16),$P(IB("S"),U,17)]"" W !!,"This bill was cancelled on " S Y=$P(IB("S"),U,17) X ^DD("DD") W Y," by ",$S($P(IB("S"),U,18)']"":IBU,$D(^VA(200,$P(IB("S"),U,18),0)):$P(^(0),U,1),1:IBU),"." G 1
- S IBSTAT=$P(IB(0),"^",13)
- CHK W !!,"ARE YOU SURE YOU WANT TO CANCEL THIS BILL" S %=2 D YN^DICN G:%=0 HELP I %'=1 S IBCCCC=0 G NO
- S IBCCCC=0 W !!,"LAST CHANCE TO CHANGE YOUR MIND..." S DIE("NO^")="",DIE="^DGCR(399,",DA=IBIFN,DR="16;S:'X Y=0;19;S IBCCCC=1;" D ^DIE K DIE,DR
- NO I 'IBCCCC W !!,"<NO ACTION TAKEN>",*7 G ASK:IBCAN<2,Q
- W !!,"...Bill has been cancelled..." D BULL^IBCBULL,BSTAT^IBCDC(IBIFN)
- F I="S","U1" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
- S PRCASV("ARREC")=IBIFN,PRCASV("AMT")=$S(IB("U1")']"":0,$P(IB("U1"),"^",1)]"":$P(IB("U1"),"^",1),1:0),PRCASV("DATE")=$P(IB("S"),"^",17),PRCASV("BY")=$P(IB("S"),"^",18)
- S PRCASV("COMMENT")=$S('$D(^IBE(350.9,1,2)):"BILL CANCELLED IN MAS",$P(^IBE(350.9,1,2),"^",7)]"":$P(^(2),"^",7),1:"BILL CANCELLED IN MAS")
- ;
- ; Cancel the Accounts Receivable record if the A/R status is equal to
- ; 104 - NEW BILL
- ; 201 - BILL INCOMPLETE
- ; 220 - RETURNED FROM AR (NEW)
- ; Otherwise, the A/R record should be amended.
- D @($S(("^104^201^220^")[("^"_+$$STA^PRCAFN(IBIFN)_"^"):"CANCEL",1:"AMEND")_"^PRCASVC1") G ASK:IBCAN<2,Q
- ;
- HELP W !,?3,"Answer 'YES' or 'Y' if you wish to cancel this bill.",!,?3,"Answer 'NO' or 'N' if you want to abort." G CHK
- Q
- 1 I $P(IB(0),U,13)=1 W !,"This record was re-opened on " S Y=$P(IB(0),U,14) X ^DD("DD") W Y,"." G CHK
- G ASK
- Q1 K:IBCAN=1 IBQUIT K IBCAN
- Q K %,IBEPAR,IBSTAT,IBARST,IBAC1,IB,DFN,IBX,IBZ,DIC,DIE,DR,PRCASV,PRCASVC,X,Y,IBCCCC
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
- Q
- ;IBCC
- IBCC ;ALB/MJB - CANCEL UB-82 THIRD PARTY BILL ;14 JUN 88 10:12
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRC
- +5 ;
- +6 ;I '$D(IBCAN) W !!,?3,"***** BILLS MAY ONLY BE CANCELLED THROUGH 'CANCEL BILL' OPTION!! *****",!,?5,"***** PLEASE SEE YOUR SUPERVISOR IF YOU REQUIRE ASSISTANCE!! *****" Q
- +7 IF '$DATA(IBCAN)
- SET IBCAN=1
- ASK ;
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
- +3 ;S XRTL=$ZU(0),XRTN="IBCC-1" D T0^%ZOSV ;start rt clock
- +4 ;
- +5 DO Q
- SET DIC="^DGCR(399,"
- SET DIC(0)="AEMQZ"
- SET DIC("A")="Enter BILL NUMBER or Patient NAME: "
- WRITE !!
- DO ^DIC
- IF Y<1
- SET IBQUIT=1
- GOTO Q1
- NOPTF SET IBIFN=+Y
- IF IBCAN>1
- DO NOPTF^IBCB2
- IF 'IBAC1
- DO NOPTF1^IBCB2
- GOTO ASK
- +1 FOR I=0,"S","U1"
- SET IB(I)=$SELECT($DATA(^DGCR(399,IBIFN,I)):^(I),1:"")
- +2 IF IBCAN=2
- IF IB("S")]""
- IF +$PIECE(IB("S"),U,16)
- IF $PIECE(IB("S"),U,17)]""
- WRITE !!,"This bill was cancelled on "
- SET Y=$PIECE(IB("S"),U,17)
- XECUTE ^DD("DD")
- WRITE Y," by ",$SELECT($PIECE(IB("S"),U,18)']"":IBU,$DATA(^VA(200,$PIECE(IB("S"),U,18),0)):$PIECE(^(0),U,1),1:IBU),"."
- GOTO 1
- +3 SET IBSTAT=$PIECE(IB(0),"^",13)
- CHK WRITE !!,"ARE YOU SURE YOU WANT TO CANCEL THIS BILL"
- SET %=2
- DO YN^DICN
- IF %=0
- GOTO HELP
- IF %'=1
- SET IBCCCC=0
- GOTO NO
- +1 SET IBCCCC=0
- WRITE !!,"LAST CHANCE TO CHANGE YOUR MIND..."
- SET DIE("NO^")=""
- SET DIE="^DGCR(399,"
- SET DA=IBIFN
- SET DR="16;S:'X Y=0;19;S IBCCCC=1;"
- DO ^DIE
- KILL DIE,DR
- NO IF 'IBCCCC
- WRITE !!,"<NO ACTION TAKEN>",*7
- IF IBCAN<2
- GOTO ASK
- GOTO Q
- +1 WRITE !!,"...Bill has been cancelled..."
- DO BULL^IBCBULL
- DO BSTAT^IBCDC(IBIFN)
- +2 FOR I="S","U1"
- SET IB(I)=$SELECT($DATA(^DGCR(399,IBIFN,I)):^(I),1:"")
- +3 SET PRCASV("ARREC")=IBIFN
- SET PRCASV("AMT")=$SELECT(IB("U1")']"":0,$PIECE(IB("U1"),"^",1)]"":$PIECE(IB("U1"),"^",1),1:0)
- SET PRCASV("DATE")=$PIECE(IB("S"),"^",17)
- SET PRCASV("BY")=$PIECE(IB("S"),"^",18)
- +4 SET PRCASV("COMMENT")=$SELECT('$DATA(^IBE(350.9,1,2)):"BILL CANCELLED IN MAS",$PIECE(^IBE(350.9,1,2),"^",7)]"":$PIECE(^(2),"^",7),1:"BILL CANCELLED IN MAS")
- +5 ;
- +6 ; Cancel the Accounts Receivable record if the A/R status is equal to
- +7 ; 104 - NEW BILL
- +8 ; 201 - BILL INCOMPLETE
- +9 ; 220 - RETURNED FROM AR (NEW)
- +10 ; Otherwise, the A/R record should be amended.
- +11 DO @($SELECT(("^104^201^220^")[("^"_+$$STA^PRCAFN(IBIFN)_"^"):"CANCEL",1:"AMEND")_"^PRCASVC1")
- IF IBCAN<2
- GOTO ASK
- GOTO Q
- +12 ;
- HELP WRITE !,?3,"Answer 'YES' or 'Y' if you wish to cancel this bill.",!,?3,"Answer 'NO' or 'N' if you want to abort."
- GOTO CHK
- +1 QUIT
- 1 IF $PIECE(IB(0),U,13)=1
- WRITE !,"This record was re-opened on "
- SET Y=$PIECE(IB(0),U,14)
- XECUTE ^DD("DD")
- WRITE Y,"."
- GOTO CHK
- +1 GOTO ASK
- Q1 IF IBCAN=1
- KILL IBQUIT
- KILL IBCAN
- Q KILL %,IBEPAR,IBSTAT,IBARST,IBAC1,IB,DFN,IBX,IBZ,DIC,DIE,DR,PRCASV,PRCASVC,X,Y,IBCCCC
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
- +3 QUIT
- +4 ;IBCC
