IBCCC ;ALB/AAS - CANCEL AND CLONE A BILL ;25-JAN-90
;;2.0;INTEGRATED BILLING;**80,109,106,51,320,433,432,447,516,592,714**;21-MAR-94;Build 8
;;Per VA Directive 6402, 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 4.5 - store claim clone info on "S1" node.
;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 ;
N IBBCF,IBBCT,IBBCB,IBCCR,IBDBC,IBCNCOPY,IBNOCALC
S IBDBC=DT ;date claim was cloned
S IBBCB=DUZ ;user-id of person cloning the claim.
S IBCNCOPY=1 ; flag indicating this function is entered as the copy/cancel option
;
; MRD;IB*2.0*516 - Added the flag IBNOCALC. This flag is set here and
; below. When charges are recalculated in BILL^IBCRBC, the first time
; that procedure is entered for the new claim, if the IBNOCALC flag is
; set, it will reset the flag and quit out. That is, it does not re-
; calculate the charges the first time it otherwise would if the user
; is doing either a CRD or CLON.
;
S IBNOCALC=1
;
STEP1 I $G(IBCE("EDI"))>1 G END1
S IBCAN=2,IBQUIT=0,IBAC=6,IBU="UNSPECIFIED"
I '$G(IBCE("EDI")) D ASK^IBCC
I $G(IBCE("EDI"))=1 S IB364="" D NOPTF^IBCC
G:IBQUIT END1
;IB*2.0*592 JRA use $G to prevent <UNDEF> error when/if IBCCCC is not defined
;I 'IBCCCC!('$D(IBIFN)) G STEP1:'$G(IBCE("EDI")),END1 ;IB*2.0*592 JRA ';'
I '$G(IBCCCC)!('$D(IBIFN)) G STEP1:'$G(IBCE("EDI")),END1 ;IB*2.0*592 JRA add $G for IBCCCC
I $G(IBCE("EDI")) S IBCE("EDI")=2
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 IBBCF=IBIFN ;this is the claim we are copying FROM
S IBIDS(.15)=IBIFN K IBIFN
STEP2 S IBND0=^DGCR(399,IBIDS(.15),0) I $D(^("U")) S IBNDU=^("U")
; *** Note - all these fields should also be included in WHERE^IBCCC1
; IB*2.0*432 added check of variable IBSILENT to allow COB copy in background mode
F I=2:1:12 S:$P(IBND0,"^",I)]"" IBIDS(I/100)=$P(IBND0,"^",I)
F I=16:1:19,21:1:28 S:$P(IBND0,"^",I)]"" IBIDS(I/100)=$P(IBND0,"^",I) ; IB*2.0*714
F I=151,152,155 S IBIDS(I)=$P(IBNDU,"^",(I-150))
S IBIDS(159.5)=$P(IBNDU,U,20)
; ***
D:$G(IBSILENT)="" HOME^%ZIS
S DFN=IBIDS(.02) D DEM^VADPT
I +$G(IBCTCOPY)!$G(IBCE("EDI")) G STEP3
D ^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="",PRCASV("ARCRD")=$G(IBCNCRD)
; IA#386 & 1992 If user came from CRD option, need to pass old bill # and claim ien, as well as new iteration number
I $G(IBCNCRD)=1 D CRD^IBCC(IBBCF) S PRCASV("ARREC")=IBBCF,PRCASV("ARBIL")=PRCASV("SITE")_"-"_$P(IBITN,"-"),PRCASV("ARITN")=PRCASV("SITE")_"-"_IBITN
W:$G(IBSILENT)="" !,"Passing bill to Accounts Receivable Module..." D SETUP^PRCASVC3 I $S($P(PRCASV("ARREC"),"^")=-1:1,$P(PRCASV("ARBIL"),"^")=-1:1,1:0) W:$G(IBSILENT)="" *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"))
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)))
G ^IBCCC1 ;go to step4
Q
;
END W:$G(IBSILENT)="" !!,"No Billing Record Set up. You must manually enter the bill."
END1 K %,%DT,IBCAN,IBAC,IBND0,IBNDU,IBYN,IBIFN,IB,IBA,IBNWBL,IBBT,IBIDS,IBU,I,J,VA,VADM,X,X1,X2,X3,X4,D,Y ;IB*2.0*592 JRA remove IBCCCC from KILL
;I '$G(IBQUIT),$S(+$G(IBCNCOPY):1,1:'$G(IBCE("EDI"))) G STEP1
I '$G(IBQUIT),$S(+$G(IBCNCOPY)!(+$G(IBCNCRD)):1,1:'$G(IBCE("EDI"))) G STEP1
K IBQUIT,IBCNCOPY,IBCNCRD,IBNOCALC,IBCCCC ;IB*2.0*592 JRA Added IBCCCC to KILL
Q
;
ITN(IBX) ; determine iteration # for rejected or denied claim
N IBCF,IBCL
S IBCF=$P($G(^DGCR(399,IBX,"S1")),U,2)
; if this claim has never been cloned, iteration # is -01
Q:IBCF="" $P($G(^DGCR(399,IBX,0)),U)_"-01"
S IBCL=$P($G(^DGCR(399,IBCF,0)),U)
; if claim was a CLON 1st and now a CORRECT, this is the 1st iteration
I $P(IBCL,"-")'=$P($P($G(^DGCR(399,IBX,0)),U),"-") Q $P($G(^DGCR(399,IBX,0)),U)_"-01"
; to determine iteration#, need to incriment from claim that was cloned from
S IBITN=$P(IBCL,"-",2),IBITN=IBITN+1 I $L(IBITN)=1 S IBITN="0"_IBITN
Q $P(IBCL,"-")_"-"_IBITN
;
CRD ; new entry point if user comes from CRD option instead of CLON
N IBBCF,IBBCT,IBBCB,IBCCR,IBDBC,IBCNCRD,IBITN,IBNOCALC
S IBDBC=DT ;date claim was cloned
S IBBCB=DUZ ;user-id of person cloning the claim.
S IBCNCRD=1 ; flag indicating this function is entered as the CRD option
;
; MRD;IB*2.0*516 - Added the flag IBNOCALC. This flag is set here and
; above. When charges are recalculated in BILL^IBCRBC, the first time
; that procedure is entered for the new claim, if the IBNOCALC flag is
; set, it will reset the flag and quit out. That is, it does not re-
; calculate the charges the first time it otherwise would if the user
; is doing either a CRD or CLON.
;
S IBNOCALC=1
;
G STEP1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCCC 5771 printed Oct 16, 2024@18:09:44 Page 2
IBCCC ;ALB/AAS - CANCEL AND CLONE A BILL ;25-JAN-90
+1 ;;2.0;INTEGRATED BILLING;**80,109,106,51,320,433,432,447,516,592,714**;21-MAR-94;Build 8
+2 ;;Per VA Directive 6402, 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 4.5 - store claim clone info on "S1" node.
+12 ;STEP 5 - get remainder of data to move and store in MCCR then x-ref
+13 ;STEP 6 - go to screens, come out to IBB1
EN ;
+1 NEW IBBCF,IBBCT,IBBCB,IBCCR,IBDBC,IBCNCOPY,IBNOCALC
+2 ;date claim was cloned
SET IBDBC=DT
+3 ;user-id of person cloning the claim.
SET IBBCB=DUZ
+4 ; flag indicating this function is entered as the copy/cancel option
SET IBCNCOPY=1
+5 ;
+6 ; MRD;IB*2.0*516 - Added the flag IBNOCALC. This flag is set here and
+7 ; below. When charges are recalculated in BILL^IBCRBC, the first time
+8 ; that procedure is entered for the new claim, if the IBNOCALC flag is
+9 ; set, it will reset the flag and quit out. That is, it does not re-
+10 ; calculate the charges the first time it otherwise would if the user
+11 ; is doing either a CRD or CLON.
+12 ;
+13 SET IBNOCALC=1
+14 ;
STEP1 IF $GET(IBCE("EDI"))>1
GOTO END1
+1 SET IBCAN=2
SET IBQUIT=0
SET IBAC=6
SET IBU="UNSPECIFIED"
+2 IF '$GET(IBCE("EDI"))
DO ASK^IBCC
+3 IF $GET(IBCE("EDI"))=1
SET IB364=""
DO NOPTF^IBCC
+4 if IBQUIT
GOTO END1
+5 ;IB*2.0*592 JRA use $G to prevent <UNDEF> error when/if IBCCCC is not defined
+6 ;I 'IBCCCC!('$D(IBIFN)) G STEP1:'$G(IBCE("EDI")),END1 ;IB*2.0*592 JRA ';'
+7 ;IB*2.0*592 JRA add $G for IBCCCC
IF '$GET(IBCCCC)!('$DATA(IBIFN))
if '$GET(IBCE("EDI"))
GOTO STEP1
GOTO END1
+8 IF $GET(IBCE("EDI"))
SET IBCE("EDI")=2
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 ;this is the claim we are copying FROM
SET IBBCF=IBIFN
+3 SET IBIDS(.15)=IBIFN
KILL IBIFN
STEP2 SET IBND0=^DGCR(399,IBIDS(.15),0)
IF $DATA(^("U"))
SET IBNDU=^("U")
+1 ; *** Note - all these fields should also be included in WHERE^IBCCC1
+2 ; IB*2.0*432 added check of variable IBSILENT to allow COB copy in background mode
+3 FOR I=2:1:12
if $PIECE(IBND0,"^",I)]""
SET IBIDS(I/100)=$PIECE(IBND0,"^",I)
+4 ; IB*2.0*714
FOR I=16:1:19,21:1:28
if $PIECE(IBND0,"^",I)]""
SET IBIDS(I/100)=$PIECE(IBND0,"^",I)
+5 FOR I=151,152,155
SET IBIDS(I)=$PIECE(IBNDU,"^",(I-150))
+6 SET IBIDS(159.5)=$PIECE(IBNDU,U,20)
+7 ; ***
+8 if $GET(IBSILENT)=""
DO HOME^%ZIS
+9 SET DFN=IBIDS(.02)
DO DEM^VADPT
+10 IF +$GET(IBCTCOPY)!$GET(IBCE("EDI"))
GOTO STEP3
+11 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=""
SET PRCASV("ARCRD")=$GET(IBCNCRD)
+3 ; IA#386 & 1992 If user came from CRD option, need to pass old bill # and claim ien, as well as new iteration number
+4 IF $GET(IBCNCRD)=1
DO CRD^IBCC(IBBCF)
SET PRCASV("ARREC")=IBBCF
SET PRCASV("ARBIL")=PRCASV("SITE")_"-"_$PIECE(IBITN,"-")
SET PRCASV("ARITN")=PRCASV("SITE")_"-"_IBITN
+5 if $GET(IBSILENT)=""
WRITE !,"Passing bill to Accounts Receivable Module..."
DO SETUP^PRCASVC3
IF $SELECT($PIECE(PRCASV("ARREC"),"^")=-1:1,$PIECE(PRCASV("ARBIL"),"^")=-1:1,1:0)
if $GET(IBSILENT)=""
WRITE *7," ",$PIECE(PRCASV("ARREC"),"^",2),$PIECE(PRCASV("ARBIL"),"^",2)
GOTO END
+6 SET IBIDS(.01)=$PIECE(PRCASV("ARBIL"),"-",2)
SET IBIDS(.17)=$SELECT($DATA(IBIDS(.17)):IBIDS(.17),1:PRCASV("ARREC"))
+7 IF '$GET(IBCE("EDI"))
WRITE !,"Billing Record #",IBIDS(.01)," being established for '",VADM(1),"'..."
SET IBIDS(.02)=DFN
SET IBHV("IBIFN")=$SELECT($GET(IBIFN):IBIFN,1:$GET(IBIDS(.15)))
+8 ;go to step4
GOTO ^IBCCC1
+9 QUIT
+10 ;
END if $GET(IBSILENT)=""
WRITE !!,"No Billing Record Set up. You must manually enter the bill."
END1 ;IB*2.0*592 JRA remove IBCCCC from KILL
KILL %,%DT,IBCAN,IBAC,IBND0,IBNDU,IBYN,IBIFN,IB,IBA,IBNWBL,IBBT,IBIDS,IBU,I,J,VA,VADM,X,X1,X2,X3,X4,D,Y
+1 ;I '$G(IBQUIT),$S(+$G(IBCNCOPY):1,1:'$G(IBCE("EDI"))) G STEP1
+2 IF '$GET(IBQUIT)
IF $SELECT(+$GET(IBCNCOPY)!(+$GET(IBCNCRD)):1,1:'$GET(IBCE("EDI")))
GOTO STEP1
+3 ;IB*2.0*592 JRA Added IBCCCC to KILL
KILL IBQUIT,IBCNCOPY,IBCNCRD,IBNOCALC,IBCCCC
+4 QUIT
+5 ;
ITN(IBX) ; determine iteration # for rejected or denied claim
+1 NEW IBCF,IBCL
+2 SET IBCF=$PIECE($GET(^DGCR(399,IBX,"S1")),U,2)
+3 ; if this claim has never been cloned, iteration # is -01
+4 if IBCF=""
QUIT $PIECE($GET(^DGCR(399,IBX,0)),U)_"-01"
+5 SET IBCL=$PIECE($GET(^DGCR(399,IBCF,0)),U)
+6 ; if claim was a CLON 1st and now a CORRECT, this is the 1st iteration
+7 IF $PIECE(IBCL,"-")'=$PIECE($PIECE($GET(^DGCR(399,IBX,0)),U),"-")
QUIT $PIECE($GET(^DGCR(399,IBX,0)),U)_"-01"
+8 ; to determine iteration#, need to incriment from claim that was cloned from
+9 SET IBITN=$PIECE(IBCL,"-",2)
SET IBITN=IBITN+1
IF $LENGTH(IBITN)=1
SET IBITN="0"_IBITN
+10 QUIT $PIECE(IBCL,"-")_"-"_IBITN
+11 ;
CRD ; new entry point if user comes from CRD option instead of CLON
+1 NEW IBBCF,IBBCT,IBBCB,IBCCR,IBDBC,IBCNCRD,IBITN,IBNOCALC
+2 ;date claim was cloned
SET IBDBC=DT
+3 ;user-id of person cloning the claim.
SET IBBCB=DUZ
+4 ; flag indicating this function is entered as the CRD option
SET IBCNCRD=1
+5 ;
+6 ; MRD;IB*2.0*516 - Added the flag IBNOCALC. This flag is set here and
+7 ; above. When charges are recalculated in BILL^IBCRBC, the first time
+8 ; that procedure is entered for the new claim, if the IBNOCALC flag is
+9 ; set, it will reset the flag and quit out. That is, it does not re-
+10 ; calculate the charges the first time it otherwise would if the user
+11 ; is doing either a CRD or CLON.
+12 ;
+13 SET IBNOCALC=1
+14 ;
+15 GOTO STEP1
+16 QUIT
+17 ;
