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

IBAMTI1.m

Go to the documentation of this file.
  1. IBAMTI1 ;ALB/CPM - SPECIAL INPATIENT BILLING CASES (CON'T.) ; 11-AUG-93
  1. ;;2.0;INTEGRATED BILLING;**52,132,156,199,234,339**;21-MAR-94;Build 2
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. DISP ; Manually disposition a case record.
  1. W !!,"This option is used to disposition case records for special inpatient"
  1. W !,"episodes of care which are not to be billed. (AO/IR/SWA/SC/MST/HNC/CV/SHAD)"
  1. W !,"After identifying the case, please enter the reason (up to 80 characters)"
  1. W !,"for non-billing."
  1. ;
  1. ; - main processing loop
  1. S IBQ=0 F W ! D SEL Q:IBQ
  1. K IBQ
  1. Q
  1. ;
  1. SEL ; Select an inpatient billing case and enter the reason for non-billing.
  1. S DIC="^IBE(351.2,",DIC(0)="QEAMZ",DIC("A")="Select PATIENT: "
  1. N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
  1. D ^DIC S IBC=+Y I Y<0 S IBQ=1 G SELQ
  1. I $P(Y(0),"^",5)=1 W !!,"You must wait until this patient has been discharged to disposition the case." G SELQ
  1. I $P(Y(0),"^",4) S IBBILLED=1 W !!,"Please note that it appears as if this case has been billed."
  1. I $P(Y(0),"^",8) W !!,"Please note that this case has already been dispositioned."
  1. ;
  1. ; - display case record
  1. W ! D DSPL(IBC)
  1. ;
  1. ; - allow user update of record
  1. S IBHC=$P(Y(0),"^",7),IBHR=$G(^IBE(351.2,IBC,1))
  1. S DIE="^IBE(351.2,",DA=IBC,DR=$S($G(IBBILLED):".07;",1:"")_1 D ^DIE
  1. ;
  1. S IBNC=$P(^IBE(351.2,IBC,0),"^",7),IBNR=$G(^IBE(351.2,IBC,1))
  1. I IBHC=IBNC,IBHR=IBNR W !!,"No changes made to the case record!" G SELQ
  1. I IBNR]"" W !!,"This case record will be dispositioned."
  1. S DR="2.03////"_DUZ_";2.04///NOW"
  1. I IBNR]"" S DR=".07////1;.08////1;"_DR
  1. S DIE="^IBE(351.2,",DA=IBC D ^DIE
  1. SELQ K DA,DIC,DIE,DR,IBC,IBHC,IBHR,IBNC,IBNR,IBBILLED
  1. Q
  1. ;
  1. CEA(IBPM,IBEVT) ; Automatically disposition the case from Cancel/Edit/Add.
  1. ; Input: IBPM -- Pointer to the adm movement in file #405
  1. ; IBEVT -- Pointer to the billing event record in file #350
  1. I '$G(IBEVT) G CEAQ
  1. N DA,DIE,DR,IBC
  1. S IBC=$O(^IBE(351.2,"AC",+$G(IBPM),0)) I IBC D UPD(0)
  1. CEAQ Q
  1. ;
  1. CHK(IBC,IBEVT) ; Review the case after adding a charge from Cancel/Edit/Add.
  1. ; Input: IBC -- Pointer to the case in file #351.2
  1. ; IBEVT -- Pointer to the billing event record in file #350
  1. I '$G(IBC)!'$G(IBEVT) G CHKQ
  1. N DA,DIE,DR,IBCD,IBCD1
  1. S IBCD=$G(^IBE(351.2,IBC,0)),IBCD1=$G(^(1))
  1. I $P(IBCD,"^",7)!'$P(IBCD,"^",8)!(IBCD1]"") D UPD(1)
  1. CHKQ Q
  1. ;
  1. UPD(IND) ; Disposition the case record.
  1. ; Input: IND -- 0 = dispositioning | 1 = reviewing
  1. ; variables -- IBC => ptr to case record
  1. ; IBEVT => ptr to event record in #350
  1. W !,"Dispositioning the special inpatient billing case record"
  1. W:$G(IND) " (as billable)" W "..."
  1. K ^IBE(351.2,IBC,1)
  1. S DR=".04////"_IBEVT_";.07////0;.08////1;2.03////"_DUZ_";2.04///NOW"
  1. S DIE="^IBE(351.2,",DA=IBC D ^DIE W " done."
  1. Q
  1. ;
  1. DSPL(IBC) ; Display a case record.
  1. ; Input: IBC -- Pointer to the case record in file #351.2
  1. I '$G(IBC) G DSPLQ
  1. N DFN,IBCD,IBC1,IBC2,IBATYP,IBPT,IBDIS,IBCL,IBEVT,IBN,IBND,Y
  1. S IBCD=$G(^IBE(351.2,IBC,0)),IBC1=$G(^(1)),IBC2=$G(^(2))
  1. S DFN=+IBCD,IBPT=$$PT^IBEFUNC(DFN),IBCL=$P(IBCD,"^",3)
  1. W !,$$DASH(),!?1,"Pt. Name: ",$E($P(IBPT,"^"),1,17)," (",$P(IBPT,"^",3),")"
  1. W ?38,"Care related to ",$$PATTYAB^IBACV(IBCL),": ",$S($P(IBCD,"^",7):"YES",$P(IBCD,"^",7)=0:"NO",1:"UNANSWERED")
  1. W !?5,"Type: ",$$UCCL^IBAMTI(IBCL),?39,"Case Dispositioned: ",$S($P(IBCD,"^",8):"YES",1:"NO")
  1. W !?1,"Adm Date: ",$$DAT1^IBOUTL(+$G(^DGPM(+$P(IBCD,"^",2),0)),1),?41,"Date Last Edited: ",$$DAT1^IBOUTL(+$P(IBC2,"^",4),1)
  1. S IBDIS=+$G(^DGPM(+$P($G(^DGPM(+$P(IBCD,"^",2),0)),"^",17),0))
  1. 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()
  1. ;
  1. S IBEVT=+$P(IBCD,"^",4)
  1. I $O(^IB("AF",IBEVT,IBEVT)) W !?1,"Charges Billed:" D
  1. .S IBN=0 F S IBN=$O(^IB("AF",IBEVT,IBN)) Q:'IBN I IBN'=IBEVT D
  1. ..S IBND=$G(^IB(IBN,0))
  1. ..S IBATYP=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")
  1. ..S:$E(IBATYP,1,2)="DG" IBATYP=$E(IBATYP,4,99)
  1. ..W !?5,IBATYP,?35,$$DAT1^IBOUTL($P(IBND,"^",14)),?46,$$DAT1^IBOUTL($P(IBND,"^",15))
  1. ..W ?57,"$",$P(IBND,"^",7),?64,$P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",2)
  1. .W !,$$DASH()
  1. ;
  1. I IBC1]"" W !?1,"Reason for Non-Billing:",!,IBC1,!,$$DASH(),!
  1. DSPLQ Q
  1. ;
  1. DASH() ; Return a dashed line.
  1. Q $TR($J("",80)," ","-")