- 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
