- 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 Feb 18, 2025@23:35:28 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 ;