[613] | 1 | IBAMTI1 ;ALB/CPM - SPECIAL INPATIENT BILLING CASES (CON'T.) ; 11-AUG-93
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,132,156,199,234,339**;21-MAR-94;Build 2
|
---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | DISP ; Manually disposition a case record.
|
---|
| 6 | W !!,"This option is used to disposition case records for special inpatient"
|
---|
| 7 | W !,"episodes of care which are not to be billed. (AO/IR/SWA/SC/MST/HNC/CV/SHAD)"
|
---|
| 8 | W !,"After identifying the case, please enter the reason (up to 80 characters)"
|
---|
| 9 | W !,"for non-billing."
|
---|
| 10 | ;
|
---|
| 11 | ; - main processing loop
|
---|
| 12 | S IBQ=0 F W ! D SEL Q:IBQ
|
---|
| 13 | K IBQ
|
---|
| 14 | Q
|
---|
| 15 | ;
|
---|
| 16 | SEL ; Select an inpatient billing case and enter the reason for non-billing.
|
---|
| 17 | S DIC="^IBE(351.2,",DIC(0)="QEAMZ",DIC("A")="Select PATIENT: "
|
---|
| 18 | N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
|
---|
| 19 | D ^DIC S IBC=+Y I Y<0 S IBQ=1 G SELQ
|
---|
| 20 | I $P(Y(0),"^",5)=1 W !!,"You must wait until this patient has been discharged to disposition the case." G SELQ
|
---|
| 21 | I $P(Y(0),"^",4) S IBBILLED=1 W !!,"Please note that it appears as if this case has been billed."
|
---|
| 22 | I $P(Y(0),"^",8) W !!,"Please note that this case has already been dispositioned."
|
---|
| 23 | ;
|
---|
| 24 | ; - display case record
|
---|
| 25 | W ! D DSPL(IBC)
|
---|
| 26 | ;
|
---|
| 27 | ; - allow user update of record
|
---|
| 28 | S IBHC=$P(Y(0),"^",7),IBHR=$G(^IBE(351.2,IBC,1))
|
---|
| 29 | S DIE="^IBE(351.2,",DA=IBC,DR=$S($G(IBBILLED):".07;",1:"")_1 D ^DIE
|
---|
| 30 | ;
|
---|
| 31 | S IBNC=$P(^IBE(351.2,IBC,0),"^",7),IBNR=$G(^IBE(351.2,IBC,1))
|
---|
| 32 | I IBHC=IBNC,IBHR=IBNR W !!,"No changes made to the case record!" G SELQ
|
---|
| 33 | I IBNR]"" W !!,"This case record will be dispositioned."
|
---|
| 34 | S DR="2.03////"_DUZ_";2.04///NOW"
|
---|
| 35 | I IBNR]"" S DR=".07////1;.08////1;"_DR
|
---|
| 36 | S DIE="^IBE(351.2,",DA=IBC D ^DIE
|
---|
| 37 | SELQ K DA,DIC,DIE,DR,IBC,IBHC,IBHR,IBNC,IBNR,IBBILLED
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | CEA(IBPM,IBEVT) ; Automatically disposition the case from Cancel/Edit/Add.
|
---|
| 41 | ; Input: IBPM -- Pointer to the adm movement in file #405
|
---|
| 42 | ; IBEVT -- Pointer to the billing event record in file #350
|
---|
| 43 | I '$G(IBEVT) G CEAQ
|
---|
| 44 | N DA,DIE,DR,IBC
|
---|
| 45 | S IBC=$O(^IBE(351.2,"AC",+$G(IBPM),0)) I IBC D UPD(0)
|
---|
| 46 | CEAQ Q
|
---|
| 47 | ;
|
---|
| 48 | CHK(IBC,IBEVT) ; Review the case after adding a charge from Cancel/Edit/Add.
|
---|
| 49 | ; Input: IBC -- Pointer to the case in file #351.2
|
---|
| 50 | ; IBEVT -- Pointer to the billing event record in file #350
|
---|
| 51 | I '$G(IBC)!'$G(IBEVT) G CHKQ
|
---|
| 52 | N DA,DIE,DR,IBCD,IBCD1
|
---|
| 53 | S IBCD=$G(^IBE(351.2,IBC,0)),IBCD1=$G(^(1))
|
---|
| 54 | I $P(IBCD,"^",7)!'$P(IBCD,"^",8)!(IBCD1]"") D UPD(1)
|
---|
| 55 | CHKQ Q
|
---|
| 56 | ;
|
---|
| 57 | UPD(IND) ; Disposition the case record.
|
---|
| 58 | ; Input: IND -- 0 = dispositioning | 1 = reviewing
|
---|
| 59 | ; variables -- IBC => ptr to case record
|
---|
| 60 | ; IBEVT => ptr to event record in #350
|
---|
| 61 | W !,"Dispositioning the special inpatient billing case record"
|
---|
| 62 | W:$G(IND) " (as billable)" W "..."
|
---|
| 63 | K ^IBE(351.2,IBC,1)
|
---|
| 64 | S DR=".04////"_IBEVT_";.07////0;.08////1;2.03////"_DUZ_";2.04///NOW"
|
---|
| 65 | S DIE="^IBE(351.2,",DA=IBC D ^DIE W " done."
|
---|
| 66 | Q
|
---|
| 67 | ;
|
---|
| 68 | DSPL(IBC) ; Display a case record.
|
---|
| 69 | ; Input: IBC -- Pointer to the case record in file #351.2
|
---|
| 70 | I '$G(IBC) G DSPLQ
|
---|
| 71 | N DFN,IBCD,IBC1,IBC2,IBATYP,IBPT,IBDIS,IBCL,IBEVT,IBN,IBND,Y
|
---|
| 72 | S IBCD=$G(^IBE(351.2,IBC,0)),IBC1=$G(^(1)),IBC2=$G(^(2))
|
---|
| 73 | S DFN=+IBCD,IBPT=$$PT^IBEFUNC(DFN),IBCL=$P(IBCD,"^",3)
|
---|
| 74 | W !,$$DASH(),!?1,"Pt. Name: ",$E($P(IBPT,"^"),1,17)," (",$P(IBPT,"^",3),")"
|
---|
| 75 | W ?38,"Care related to ",$$PATTYAB^IBACV(IBCL),": ",$S($P(IBCD,"^",7):"YES",$P(IBCD,"^",7)=0:"NO",1:"UNANSWERED")
|
---|
| 76 | W !?5,"Type: ",$$UCCL^IBAMTI(IBCL),?39,"Case Dispositioned: ",$S($P(IBCD,"^",8):"YES",1:"NO")
|
---|
| 77 | W !?1,"Adm Date: ",$$DAT1^IBOUTL(+$G(^DGPM(+$P(IBCD,"^",2),0)),1),?41,"Date Last Edited: ",$$DAT1^IBOUTL(+$P(IBC2,"^",4),1)
|
---|
| 78 | S IBDIS=+$G(^DGPM(+$P($G(^DGPM(+$P(IBCD,"^",2),0)),"^",17),0))
|
---|
| 79 | W !,"Disc Date: ",$S(IBDIS:$$DAT1^IBOUTL(IBDIS,1),1:"Still Admitted"),?43,"Last Edited By: ",$E($P($G(^VA(200,+$P(IBC2,"^",3),0)),"^"),1,20),!,$$DASH()
|
---|
| 80 | ;
|
---|
| 81 | S IBEVT=+$P(IBCD,"^",4)
|
---|
| 82 | I $O(^IB("AF",IBEVT,IBEVT)) W !?1,"Charges Billed:" D
|
---|
| 83 | .S IBN=0 F S IBN=$O(^IB("AF",IBEVT,IBN)) Q:'IBN I IBN'=IBEVT D
|
---|
| 84 | ..S IBND=$G(^IB(IBN,0))
|
---|
| 85 | ..S IBATYP=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")
|
---|
| 86 | ..S:$E(IBATYP,1,2)="DG" IBATYP=$E(IBATYP,4,99)
|
---|
| 87 | ..W !?5,IBATYP,?35,$$DAT1^IBOUTL($P(IBND,"^",14)),?46,$$DAT1^IBOUTL($P(IBND,"^",15))
|
---|
| 88 | ..W ?57,"$",$P(IBND,"^",7),?64,$P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",2)
|
---|
| 89 | .W !,$$DASH()
|
---|
| 90 | ;
|
---|
| 91 | I IBC1]"" W !?1,"Reason for Non-Billing:",!,IBC1,!,$$DASH(),!
|
---|
| 92 | DSPLQ Q
|
---|
| 93 | ;
|
---|
| 94 | DASH() ; Return a dashed line.
|
---|
| 95 | Q $TR($J("",80)," ","-")
|
---|