IBCCC.m

IBCCC	;ALB/AAS - CANCEL AND CLONE A BILL ;25-JAN-90

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

	;MAP TO DGCRCC

	;

	;STEP 1 - cancel bill

	;STEP 1.5 - entry to clone previously cancelled bill.  (must be cancel)

	;STEP 2 - build array of IBIDS call screen that asks ok

	;STEP 3 - pass stub entry to ar

	;STEP 4 - store stub data in MCCR then x-ref

	;STEP 5 - get remainder of data to move and store in MCCR then x-ref

	;STEP 6 - go to screens, come out to IBB1 

EN	;

	;***

	;I $D(XRT0) S:'$D(XRTN) XRTN="IBCCC" D T1^%ZOSV ;stop rt clock

	;S XRTL=$ZU(0),XRTN="IBCCC-1" D T0^%ZOSV ;start rt clock

	;

STEP1	S IBCAN=2,IBQUIT=0,IBAC=6,IBU="UNSPECIFIED" D ASK^IBCC

	G:IBQUIT END1

	I 'IBCCCC!('$D(IBIFN)) G STEP1

EN1	;

STEP1P5	I '$D(IBIFN) S IBCAN=2,IBQUIT=0,IBAC=6 W !,"Copy Previously Cancelled Bill.",!! S DIC="^DGCR(399,",DIC("S")="I $P(^(0),U,13)=7",DIC(0)="AEMQZ",DIC("A")="Enter BILL NUMBER or Patient NAME: " D ^DIC G:Y<1 END S IBIFN=+Y

	;

	S IBIDS(.15)=IBIFN K IBIFN

STEP2	S IBND0=^DGCR(399,IBIDS(.15),0) I $D(^("U")) S IBNDU=^("U")

	F I=2:1:12 S:$P(IBND0,"^",I)]"" IBIDS(I/100)=$P(IBND0,"^",I)

	F I=16:1:19 S:$P(IBND0,"^",I)]"" IBIDS(I/100)=$P(IBND0,"^",I)

	F I=151,152,155 S IBIDS(I)=$P(IBNDU,"^",(I-150))

	D HOME^%ZIS

	S DFN=IBIDS(.02) D DEM^VADPT,^IBCA1

ASK	S IBYN=0 W !!,"IS THE ABOVE INFORMATION CORRECT AS SHOWN" S %=1 D YN^DICN G END:%=2,STEP3:%=1 I % G END

	W !!?4,"YES - If this information is correct as shown and you wish to file the bill.",!?4,"NO  - If you wish to change this information prior to filing."

	W !?4,"'^' - Enter the up-arrow character to DELETE this Bill at this time." G ASK

	;

STEP3	;

	S PRCASV("SER")=$P($G(^IBE(350.9,1,1)),"^",14)

	S PRCASV("SITE")=$P($$SITE^VASITE,"^",3),IBNWBL=""

	W !,"Passing bill to Accounts Receivable Module..." D SETUP^PRCASVC3 I $S($P(PRCASV("ARREC"),"^")=-1:1,$P(PRCASV("ARBIL"),"^")=-1:1,1:0) W *7,"  ",$P(PRCASV("ARREC"),"^",2),$P(PRCASV("ARBIL"),"^",2) G END

	S IBIDS(.01)=$P(PRCASV("ARBIL"),"-",2),IBIDS(.17)=$S($D(IBIDS(.17)):IBIDS(.17),1:PRCASV("ARREC"))

	W !,"Billing Record #",IBIDS(.01)," being established for '",VADM(1),"'..." S IBIDS(.02)=DFN

	G ^IBCCC1 ;go to step4

	Q

END	W !!,"No Billing Record Set up.  You must manually enter the bill."

END1	K %,%DT,IBCAN,IBAC,IBND0,IBNDU,IBYN,IBCCCC,IBIFN,IB,IBA,IBNWBL,IBBT,IBIDS,IBU,I,J,VA,VADM,X,X1,X2,X3,X4,Y,D G STEP1:'IBQUIT

	K IBQUIT

	;***

	;I $D(XRT0) S:'$D(XRTN) XRTN="IBCCC" D T1^%ZOSV ;stop rt clock

	Q

IBCCC     ;ALB/AAS - CANCEL AND CLONE A BILL ;25-JAN-90

 +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 DGCRCC

 +5       ;

 +6       ;STEP 1 - cancel bill

 +7       ;STEP 1.5 - entry to clone previously cancelled bill.  (must be cancel)

 +8       ;STEP 2 - build array of IBIDS call screen that asks ok

 +9       ;STEP 3 - pass stub entry to ar

 +10      ;STEP 4 - store stub data in MCCR then x-ref

 +11      ;STEP 5 - get remainder of data to move and store in MCCR then x-ref

 +12      ;STEP 6 - go to screens, come out to IBB1 

EN        ;

 +1       ;***

 +2       ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCCC" D T1^%ZOSV ;stop rt clock

 +3       ;S XRTL=$ZU(0),XRTN="IBCCC-1" D T0^%ZOSV ;start rt clock

 +4       ;

STEP1      SET IBCAN=2

           SET IBQUIT=0

           SET IBAC=6

           SET IBU="UNSPECIFIED"

           DO ASK^IBCC

 +1        IF IBQUIT

               GOTO END1

 +2        IF 'IBCCCC!('$DATA(IBIFN))

               GOTO STEP1

EN1       ;

STEP1P5    IF '$DATA(IBIFN)

               SET IBCAN=2

               SET IBQUIT=0

               SET IBAC=6

               WRITE !,"Copy Previously Cancelled Bill.",!!

               SET DIC="^DGCR(399,"

               SET DIC("S")="I $P(^(0),U,13)=7"

               SET DIC(0)="AEMQZ"

               SET DIC("A")="Enter BILL NUMBER or Patient NAME: "

               DO ^DIC

               IF Y<1

                   GOTO END

               SET IBIFN=+Y

 +1       ;

 +2        SET IBIDS(.15)=IBIFN

           KILL IBIFN

STEP2      SET IBND0=^DGCR(399,IBIDS(.15),0)

           IF $DATA(^("U"))

               SET IBNDU=^("U")

 +1        FOR I=2:1:12

               IF $PIECE(IBND0,"^",I)]""

                   SET IBIDS(I/100)=$PIECE(IBND0,"^",I)

 +2        FOR I=16:1:19

               IF $PIECE(IBND0,"^",I)]""

                   SET IBIDS(I/100)=$PIECE(IBND0,"^",I)

 +3        FOR I=151,152,155

               SET IBIDS(I)=$PIECE(IBNDU,"^",(I-150))

 +4        DO HOME^%ZIS

 +5        SET DFN=IBIDS(.02)

           DO DEM^VADPT

           DO ^IBCA1

ASK        SET IBYN=0

           WRITE !!,"IS THE ABOVE INFORMATION CORRECT AS SHOWN"

           SET %=1

           DO YN^DICN

           IF %=2

               GOTO END

           IF %=1

               GOTO STEP3

           IF %

               GOTO END

 +1        WRITE !!?4,"YES - If this information is correct as shown and you wish to file the bill.",!?4,"NO  - If you wish to change this information prior to filing."

 +2        WRITE !?4,"'^' - Enter the up-arrow character to DELETE this Bill at this time."

           GOTO ASK

 +3       ;

STEP3     ;

 +1        SET PRCASV("SER")=$PIECE($GET(^IBE(350.9,1,1)),"^",14)

 +2        SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)

           SET IBNWBL=""

 +3        WRITE !,"Passing bill to Accounts Receivable Module..."

           DO SETUP^PRCASVC3

           IF $SELECT($PIECE(PRCASV("ARREC"),"^")=-1:1,$PIECE(PRCASV("ARBIL"),"^")=-1:1,1:0)

               WRITE *7,"  ",$PIECE(PRCASV("ARREC"),"^",2),$PIECE(PRCASV("ARBIL"),"^",2)

               GOTO END

 +4        SET IBIDS(.01)=$PIECE(PRCASV("ARBIL"),"-",2)

           SET IBIDS(.17)=$SELECT($DATA(IBIDS(.17)):IBIDS(.17),1:PRCASV("ARREC"))

 +5        WRITE !,"Billing Record #",IBIDS(.01)," being established for '",VADM(1),"'..."

           SET IBIDS(.02)=DFN

 +6       ;go to step4

           GOTO ^IBCCC1

 +7        QUIT 

END        WRITE !!,"No Billing Record Set up.  You must manually enter the bill."

END1       KILL %,%DT,IBCAN,IBAC,IBND0,IBNDU,IBYN,IBCCCC,IBIFN,IB,IBA,IBNWBL,IBBT,IBIDS,IBU,I,J,VA,VADM,X,X1,X2,X3,X4,Y,D

           IF 'IBQUIT

               GOTO STEP1

 +1        KILL IBQUIT

 +2       ;***

 +3       ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCCC" D T1^%ZOSV ;stop rt clock

 +4        QUIT