IBCC.m

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