Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCCC

IBCCC.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRCC
  1. ;
  1. ;STEP 1 - cancel bill
  1. ;STEP 1.5 - entry to clone previously cancelled bill. (must be cancel)
  1. ;STEP 2 - build array of IBIDS call screen that asks ok
  1. ;STEP 3 - pass stub entry to ar
  1. ;STEP 4 - store stub data in MCCR then x-ref
  1. ;STEP 4.5 - store claim clone info on "S1" node.
  1. ;STEP 5 - get remainder of data to move and store in MCCR then x-ref
  1. ;STEP 6 - go to screens, come out to IBB1
  1. EN ;
  1. N IBBCF,IBBCT,IBBCB,IBCCR,IBDBC,IBCNCOPY,IBNOCALC
  1. S IBDBC=DT ;date claim was cloned
  1. S IBBCB=DUZ ;user-id of person cloning the claim.
  1. S IBCNCOPY=1 ; flag indicating this function is entered as the copy/cancel option
  1. ;
  1. ; MRD;IB*2.0*516 - Added the flag IBNOCALC. This flag is set here and
  1. ; below. When charges are recalculated in BILL^IBCRBC, the first time
  1. ; that procedure is entered for the new claim, if the IBNOCALC flag is
  1. ; set, it will reset the flag and quit out. That is, it does not re-
  1. ; calculate the charges the first time it otherwise would if the user
  1. ; is doing either a CRD or CLON.
  1. ;
  1. S IBNOCALC=1
  1. ;
  1. STEP1 I $G(IBCE("EDI"))>1 G END1
  1. S IBCAN=2,IBQUIT=0,IBAC=6,IBU="UNSPECIFIED"
  1. I '$G(IBCE("EDI")) D ASK^IBCC
  1. I $G(IBCE("EDI"))=1 S IB364="" D NOPTF^IBCC
  1. G:IBQUIT END1
  1. ;IB*2.0*592 JRA use $G to prevent <UNDEF> error when/if IBCCCC is not defined
  1. ;I 'IBCCCC!('$D(IBIFN)) G STEP1:'$G(IBCE("EDI")),END1 ;IB*2.0*592 JRA ';'
  1. I '$G(IBCCCC)!('$D(IBIFN)) G STEP1:'$G(IBCE("EDI")),END1 ;IB*2.0*592 JRA add $G for IBCCCC
  1. I $G(IBCE("EDI")) S IBCE("EDI")=2
  1. EN1 ;
  1. 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
  1. ;
  1. S IBBCF=IBIFN ;this is the claim we are copying FROM
  1. S IBIDS(.15)=IBIFN K IBIFN
  1. STEP2 S IBND0=^DGCR(399,IBIDS(.15),0) I $D(^("U")) S IBNDU=^("U")
  1. ; *** Note - all these fields should also be included in WHERE^IBCCC1
  1. ; IB*2.0*432 added check of variable IBSILENT to allow COB copy in background mode
  1. F I=2:1:12 S:$P(IBND0,"^",I)]"" IBIDS(I/100)=$P(IBND0,"^",I)
  1. F I=16:1:19,21:1:28 S:$P(IBND0,"^",I)]"" IBIDS(I/100)=$P(IBND0,"^",I) ; IB*2.0*714
  1. F I=151,152,155 S IBIDS(I)=$P(IBNDU,"^",(I-150))
  1. S IBIDS(159.5)=$P(IBNDU,U,20)
  1. ; ***
  1. D:$G(IBSILENT)="" HOME^%ZIS
  1. S DFN=IBIDS(.02) D DEM^VADPT
  1. I +$G(IBCTCOPY)!$G(IBCE("EDI")) G STEP3
  1. D ^IBCA1
  1. 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
  1. 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."
  1. W !?4,"'^' - Enter the up-arrow character to DELETE this Bill at this time." G ASK
  1. ;
  1. STEP3 ;
  1. S PRCASV("SER")=$P($G(^IBE(350.9,1,1)),"^",14)
  1. S PRCASV("SITE")=$P($$SITE^VASITE,"^",3),IBNWBL="",PRCASV("ARCRD")=$G(IBCNCRD)
  1. ; IA#386 & 1992 If user came from CRD option, need to pass old bill # and claim ien, as well as new iteration number
  1. I $G(IBCNCRD)=1 D CRD^IBCC(IBBCF) S PRCASV("ARREC")=IBBCF,PRCASV("ARBIL")=PRCASV("SITE")_"-"_$P(IBITN,"-"),PRCASV("ARITN")=PRCASV("SITE")_"-"_IBITN
  1. 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
  1. S IBIDS(.01)=$P(PRCASV("ARBIL"),"-",2),IBIDS(.17)=$S($D(IBIDS(.17)):IBIDS(.17),1:PRCASV("ARREC"))
  1. 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)))
  1. G ^IBCCC1 ;go to step4
  1. Q
  1. ;
  1. END W:$G(IBSILENT)="" !!,"No Billing Record Set up. You must manually enter the bill."
  1. 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
  1. ;I '$G(IBQUIT),$S(+$G(IBCNCOPY):1,1:'$G(IBCE("EDI"))) G STEP1
  1. I '$G(IBQUIT),$S(+$G(IBCNCOPY)!(+$G(IBCNCRD)):1,1:'$G(IBCE("EDI"))) G STEP1
  1. K IBQUIT,IBCNCOPY,IBCNCRD,IBNOCALC,IBCCCC ;IB*2.0*592 JRA Added IBCCCC to KILL
  1. Q
  1. ;
  1. ITN(IBX) ; determine iteration # for rejected or denied claim
  1. N IBCF,IBCL
  1. S IBCF=$P($G(^DGCR(399,IBX,"S1")),U,2)
  1. ; if this claim has never been cloned, iteration # is -01
  1. Q:IBCF="" $P($G(^DGCR(399,IBX,0)),U)_"-01"
  1. S IBCL=$P($G(^DGCR(399,IBCF,0)),U)
  1. ; if claim was a CLON 1st and now a CORRECT, this is the 1st iteration
  1. I $P(IBCL,"-")'=$P($P($G(^DGCR(399,IBX,0)),U),"-") Q $P($G(^DGCR(399,IBX,0)),U)_"-01"
  1. ; to determine iteration#, need to incriment from claim that was cloned from
  1. S IBITN=$P(IBCL,"-",2),IBITN=IBITN+1 I $L(IBITN)=1 S IBITN="0"_IBITN
  1. Q $P(IBCL,"-")_"-"_IBITN
  1. ;
  1. CRD ; new entry point if user comes from CRD option instead of CLON
  1. N IBBCF,IBBCT,IBBCB,IBCCR,IBDBC,IBCNCRD,IBITN,IBNOCALC
  1. S IBDBC=DT ;date claim was cloned
  1. S IBBCB=DUZ ;user-id of person cloning the claim.
  1. S IBCNCRD=1 ; flag indicating this function is entered as the CRD option
  1. ;
  1. ; MRD;IB*2.0*516 - Added the flag IBNOCALC. This flag is set here and
  1. ; above. When charges are recalculated in BILL^IBCRBC, the first time
  1. ; that procedure is entered for the new claim, if the IBNOCALC flag is
  1. ; set, it will reset the flag and quit out. That is, it does not re-
  1. ; calculate the charges the first time it otherwise would if the user
  1. ; is doing either a CRD or CLON.
  1. ;
  1. S IBNOCALC=1
  1. ;
  1. G STEP1
  1. Q
  1. ;