| 1 | IBCCC ;ALB/AAS - CANCEL AND CLONE A BILL ;25-JAN-90
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**80,109,106,51,320**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRCC
|
|---|
| 6 | ;
|
|---|
| 7 | ;STEP 1 - cancel bill
|
|---|
| 8 | ;STEP 1.5 - entry to clone previously cancelled bill. (must be cancel)
|
|---|
| 9 | ;STEP 2 - build array of IBIDS call screen that asks ok
|
|---|
| 10 | ;STEP 3 - pass stub entry to ar
|
|---|
| 11 | ;STEP 4 - store stub data in MCCR then x-ref
|
|---|
| 12 | ;STEP 4.5 - store claim clone info on "S1" node.
|
|---|
| 13 | ;STEP 5 - get remainder of data to move and store in MCCR then x-ref
|
|---|
| 14 | ;STEP 6 - go to screens, come out to IBB1
|
|---|
| 15 | EN ;
|
|---|
| 16 | N IBBCF,IBBCT,IBBCB,IBCCR,IBDBC
|
|---|
| 17 | S IBDBC=DT ;date claim was cloned
|
|---|
| 18 | S IBBCB=DUZ ;user-id of person cloning the claim.
|
|---|
| 19 | S IBCNCOPY=1 ; flag indicating this function is entered as the copy/cancel option
|
|---|
| 20 | ;
|
|---|
| 21 | STEP1 I $G(IBCE("EDI"))>1 G END1
|
|---|
| 22 | S IBCAN=2,IBQUIT=0,IBAC=6,IBU="UNSPECIFIED"
|
|---|
| 23 | I '$G(IBCE("EDI")) D ASK^IBCC
|
|---|
| 24 | I $G(IBCE("EDI"))=1 S IB364="" D NOPTF^IBCC
|
|---|
| 25 | G:IBQUIT END1
|
|---|
| 26 | I 'IBCCCC!('$D(IBIFN)) G STEP1:'$G(IBCE("EDI")),END1
|
|---|
| 27 | I $G(IBCE("EDI")) S IBCE("EDI")=2
|
|---|
| 28 | EN1 ;
|
|---|
| 29 | 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
|
|---|
| 30 | ;
|
|---|
| 31 | S IBBCF=IBIFN ;this is the claim we are copying FROM
|
|---|
| 32 | S IBIDS(.15)=IBIFN K IBIFN
|
|---|
| 33 | STEP2 S IBND0=^DGCR(399,IBIDS(.15),0) I $D(^("U")) S IBNDU=^("U")
|
|---|
| 34 | ; *** Note - all these fields should also be included in WHERE^IBCCC1
|
|---|
| 35 | F I=2:1:12 S:$P(IBND0,"^",I)]"" IBIDS(I/100)=$P(IBND0,"^",I)
|
|---|
| 36 | F I=16:1:19,21:1:27 S:$P(IBND0,"^",I)]"" IBIDS(I/100)=$P(IBND0,"^",I)
|
|---|
| 37 | F I=151,152,155 S IBIDS(I)=$P(IBNDU,"^",(I-150))
|
|---|
| 38 | S IBIDS(159.5)=$P(IBNDU,U,20)
|
|---|
| 39 | ; ***
|
|---|
| 40 | D HOME^%ZIS
|
|---|
| 41 | S DFN=IBIDS(.02) D DEM^VADPT
|
|---|
| 42 | I +$G(IBCTCOPY)!$G(IBCE("EDI")) G STEP3
|
|---|
| 43 | D ^IBCA1
|
|---|
| 44 | 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
|
|---|
| 45 | 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."
|
|---|
| 46 | W !?4,"'^' - Enter the up-arrow character to DELETE this Bill at this time." G ASK
|
|---|
| 47 | ;
|
|---|
| 48 | STEP3 ;
|
|---|
| 49 | S PRCASV("SER")=$P($G(^IBE(350.9,1,1)),"^",14)
|
|---|
| 50 | S PRCASV("SITE")=$P($$SITE^VASITE,"^",3),IBNWBL=""
|
|---|
| 51 | 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
|
|---|
| 52 | S IBIDS(.01)=$P(PRCASV("ARBIL"),"-",2),IBIDS(.17)=$S($D(IBIDS(.17)):IBIDS(.17),1:PRCASV("ARREC"))
|
|---|
| 53 | I '$G(IBCE("EDI")) W !,"Billing Record #",IBIDS(.01)," being established for '",VADM(1),"'..." S IBIDS(.02)=DFN,IBHV("IBIFN")=$S($G(IBIFN):IBIFN,1:$G(IBIDS(.15)))
|
|---|
| 54 | G ^IBCCC1 ;go to step4
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | END W !!,"No Billing Record Set up. You must manually enter the bill."
|
|---|
| 58 | 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,D,Y
|
|---|
| 59 | I '$G(IBQUIT),$S(+$G(IBCNCOPY):1,1:'$G(IBCE("EDI"))) G STEP1
|
|---|
| 60 | K IBQUIT,IBCNCOPY
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
