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

IBECEA32.m

Go to the documentation of this file. 
  1. IBECEA32 ;ALB/CPM-Cancel/Edit/Add... Add Utilities ; Aug 09, 2023
  1.  ;;2.0;INTEGRATED BILLING ;**57,188,704**; 21-MAR-94;Build 49
  1.  ;Per VA Directive 6402, this routine should not be modified
  1.  ;
  1. CLUPD ; Handle the updating of the billing clock when adding a charge.
  1.  I IBXA=5!(IBCLDA&(IBXA=4)) G CLOCKQ
  1.  ;
  1.  ; - charge not covered by a clock
  1.  I 'IBCLDA D ADD G CLOCKQ
  1.  ;
  1.  ; - update existing clock
  1.  S IBCLST=^IBE(351,IBCLDA,0)
  1.  D CLOCK^IBECEAU(IBCHG,+$P(IBCLST,"^",9),IBUNIT)
  1. CLOCKQ K IBCLST
  1.  Q
  1.  ;
  1. CHMPVA ; Process the CHAMPVA inpatient subsistence charge.
  1.  I '$$ON^IBACVA2() W !!,"Sorry!  The CHAMPVA billing module is not yet fully installed.  You will need",!,"to generate a claim to bill this patient the inpatient subsistence charge." G CHMPVAQ
  1. CHMPEN S IBPM=$$ADSEL^IBECEA31(DFN) I IBPM=-1 G CHMPVAQ
  1.  I 'IBPM W !!,"This patient has no admissions on file!",!,"You cannot bill the CHAMPVA inpatient subsistence charge at this time." G CHMPVAQ
  1.  S IBSL=+IBPM,IBCVA=$P(IBPM,"^",2),IBPMD=$P(IBPM,"^",3)
  1.  I 'IBPMD W !!,"You can only bill admissions which have been discharged!" G CHMPEN
  1.  I $$PREV^IBACVA1(DFN,IBCVA,IBSL) W !!,"This admission has already been billed the CHAMPVA inpatient subsistence charge."  G CHMPEN
  1.  ;
  1.  ; - set input parameters and automatically calculate the charge
  1.  S IBBDT=$$FMTH^XLFDT(IBCVA,1),IBEDT=$$FMTH^XLFDT(+$G(^DGPM(IBPMD,0))\1,1)
  1.  D BILL^IBACVA1
  1. CHMPVAQ K IBPM,IBSL,IBCVA
  1.  Q
  1.  ;
  1. ADD ; Prompt user to add a new billing clock.
  1.  N DIE,DA,DR,DIR,DIRUT,DUOUT,DTOUT,X,Y,IBCCUPDF
  1.  W !!,"Since this patient has no active clock to cover this charge, I would like to",!,"set up an active clock as follows:"
  1.  W !!?5,"Clock Begin Date: ",$$DAT1^IBOUTL(IBFR),! W:IBXA=1!(IBXA=2) ?4,"1st 90 days copay: $",IBCHG,! W:IBXA=3 ?5,"# Inpatient days: ",IBUNIT,!
  1.  S DIR(0)="Y",DIR("A")="Is it okay to set up a new clock with "_$S(IBXA=4:"this",1:"these")_" value"_$E("s",IBXA'=4),DIR("?")="Enter 'Y' or 'YES' to create a new clock, or 'N', 'NO', or '^' to quit."
  1.  D ^DIR I 'Y!($D(DIRUT))!($D(DUOUT)) W !,"A new clock will not be established.  Be sure this patient's clock is correct." Q
  1.  W !!,"Creating a new, active billing clock...  "
  1.  S IBCLDT=IBFR,IBCCUPDF=1 D CLADD^IBAUTL3 Q:IBY<0
  1.  I IBXA'=4 S DIE="^IBE(351,",DA=IBCLDA,DR=$S(IBXA=3:.09,1:.05)_"////"_$S(IBXA=3:IBUNIT,1:IBCHG)_";13////"_DUZ_";14///NOW;16///1" D ^DIE
  1.  W "done."
  1.  D EN^IBECECU1(DFN,IBCLDA)
  1.  Q
  1.  ;
  1. FEPR ; Issue prompts for Inpatient Fee Services
  1.  N DIR,DIRUT,DUOUT,DTOUT,IBCLDT,X,Y
  1.  S IBDESC=$S(IBXA=1:"FEE SERVICE (INPT)",1:$P($G(^IBE(350.1,+$G(IBATYP),0)),"^",8))
  1.  D FEE^IBECEAU2(0) I IBY>0 D CTBB^IBECEAU3
  1.  Q
  1.  ;
  1. HFEV ; Help for Fee Event Date
  1.  W !!,"Please enter the Event Date for this Fee Service (which should be the"
  1.  W !,"admission date, and not exceed the Bill From date [",$$DAT1^IBOUTL(IBFR),"]), or '^' to quit."
  1.  Q
  1.  ;
  1. SPEC(X,Y) ; Display messages for special inpatient billing cases.
  1.  ;  Input:  X -- has two values:
  1.  ;                1 --> entering after selecting an admission
  1.  ;                      (will need to set IBSIBC)
  1.  ;                0 --> billing event record exists
  1.  ;          Y -- Pointer to special inpatient billing case in
  1.  ;               file #351.2 (quit if not positive)
  1.  Q:'$G(Y)
  1.  I $G(X),'$P($G(^IBE(351.2,Y,0)),"^",8) D  Q
  1.  .S IBSIBC=+IBDG
  1.  .W !,"This is a special inpatient billing case!  The case will be dispositioned."
  1.  W !,*7,"Please note that you are creating a charge for a special inpatient case!!"
  1.  S IBSIBC1=Y D DSPL^IBAMTI1(Y)
  1.  Q