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

IBECEA35.m

Go to the documentation of this file. 
  1. IBECEA35 ;ALB/CPM - Cancel/Edit/Add... TRICARE Support ; 09-AUG-96
  1.  ;;2.0;INTEGRATED BILLING;**52,240,361,715**;21-MAR-94;Build 25
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. CUS ; Process all TRICARE copayment charges.
  1.  ;
  1.  N X,IBCS,IBINS,IBPLAN,IBATYPN
  1.  N IBDESC,IBDG,IBEVDA  ; IB*2.0*715
  1.  ;
  1.  ; - display TRICARE coverage
  1.  S IBCS=$$CUS^IBACUS(DFN,DT)
  1.  D DISP(DFN,IBCS)
  1.  ;
  1.  ; - collect parameters needed to create the charge
  1.  ; IB*2.0*715
  1.  S IBATYPN=$P($G(^IBE(350.1,IBATYP,0)),U),IBUNIT=1
  1.  I IBATYPN["RX" D  G GO
  1.  .S IBLIM=DT D FR^IBECEAU2(0),AMT^IBECEAU2:IBY>0
  1.  .S IBDESC="TRICARE RX COPAY",(IBEVDT,IBEFDT)=IBFR
  1.  .Q
  1.  ;
  1.  I IBATYPN["OPT" D  G GO
  1.  .S IBLIM=DT D FR^IBECEAU2(0),AMT^IBECEAU2:IBY>0
  1.  .S IBDESC="TRICARE OPT COPAY",(IBEVDT,IBTO)=IBFR,IBEVDA="*"
  1.  I IBATYPN["INPT" D  G GO
  1.  .; IB*2.0*715
  1.  .S IBLIM=DT,IBDG=0 D FR^IBECEAU2(0) S IBTO=IBFR
  1.  .S IBEVDA=$$EVF^IBECEA31(DFN,IBFR,IBTO,IBNH) S:IBEVDA>0 IBSL=$P($G(^IB(+IBEVDA,0)),U,4),(IBEVDT,IBFR)=$P($G(^IB(+IBEVDA,0)),U,17)
  1.  .I IBEVDA'>0 D  Q:IBY'>0  S IBEVDA="*"
  1.  ..D NOEV^IBECEA31
  1.  ..I 'IBDG D
  1.  ...W !!,"An admission was not available or not selected."
  1.  ...W !,"This transaction has been cancelled."
  1.  ...S IBY=-1
  1.  ...Q
  1.  ..S IBSL="405:"_+IBDG,(IBEVDT,IBFR)=$P(IBDG,U,2)
  1.  ..Q
  1.  .S IBDESC="TRICARE INPT COPAY"
  1.  .D AMT^IBECEAU2 Q:IBY'>0
  1.  .S IBTO=$$DIS^IBECEA31(IBSL),IBTO=$S(IBTO>DT:DT,1:IBTO)
  1.  .Q
  1.  ;
  1. GO ; - bill the charge
  1.  N IBATIEN,IBDUPARY,IBDUPIEN,IBDUPNM,Z
  1.  I IBY<0 G CUSQ
  1.  ; check for duplicates  IB*2.0*715
  1.  I IBATYPN'["RX" S Z=$$BFCHK(DFN,IBFR,$S($G(IBTO)>0:IBTO,1:""),.IBDUPARY) D:Z
  1.  .S IBY=0  ; duplicates found
  1.  .W !!!,"TRICARE cost shares has already been billed for this patient during the",!," selected date range." ; print warning message
  1.  .I $$DISPDUP(.IBDUPARY) S IBY=1  ; user wishes to continue
  1.  .Q
  1.  I IBY'>0 G CUSQ
  1.  ;
  1.  ; - okay to proceed?
  1.  D PROC^IBECEAU4("add") I IBY<0 G CUSQ
  1.  ;
  1.  ; - create charge and pass to AR
  1.  W !,"Billing the TRICARE patient copayment charge..."
  1.  D ADD^IBECEAU3,AR^IBR:IBY>0 I IBY<0 G CUSQ
  1.  ;
  1.  S IBCOMMIT=1 W "completed."
  1.  ;
  1. CUSQ K IBCS
  1.  Q
  1.  ;
  1. DISP(DFN,INS) ; Display TRICARE beneficiary insurance information.
  1.  ;  Input:    DFN  --  Pointer to the patient in file #2
  1.  ;            INS  --  Pointer to the patient policy in file #2.312
  1.  ;
  1.  I '$G(INS) W *7,!!,"Please note that this patient does not have active TRICARE coverage!",! G DISPQ
  1.  ;
  1.  N IBINS,IBINS3,IBPLAN,IBS S IBS=0
  1.  S IBINS=$G(^DPT(DFN,.312,INS,0)),IBINS3=$G(^(3))
  1.  S IBPLAN=$G(^IBA(355.3,+$P(IBINS,"^",18),0))
  1.  W !!," TRICARE coverage for ",$P($G(^DPT(DFN,0)),"^"),":"
  1.  W !!," Insured Person: ",$E($P(IBINS,"^",17),1,20)
  1.  W ?42,"Company: ",$P($G(^DIC(36,+IBINS,0)),"^")
  1.  W !," Effective Date: ",$$DAT1^IBOUTL($P(IBINS,"^",8))
  1.  W ?40,"Plan Name: ",$P(IBPLAN,"^",3)
  1.  W !,"Expiration Date: ",$$DAT1^IBOUTL($P(IBINS,"^",4))
  1.  W ?38,"Plan Number: ",$P(IBPLAN,"^",4),!
  1.  I $P(IBINS3,"^",2)]"" S IBS=1 W " Service Branch: ",$P($G(^DIC(23,+$P(IBINS3,"^",2),0)),"^")
  1.  I $P(IBINS3,"^",3)]"" S IBS=1 W ?37,"Service Rank: ",$P(IBINS3,"^",3)
  1.  W:IBS !
  1. DISPQ Q
  1.  ;
  1. BFCHK(DFN,SDATE,EDATE,IBRES) ; check for duplicates  IB*2.0*715
  1.  ;
  1.  ; DFN   - patient DFN
  1.  ; SDATE - Start Date of the Patient Visit (inpatient or outpatient)
  1.  ; EDATE - (Optional) End Date of the Patient Visit (inpatient only)
  1.  ; IBRES - array of results (passed by reference).
  1.  ;           format is IBRES(ien)="", where ien is file 350 ien of a duplicate, populated only if at least one duplicate was found.
  1.  ;
  1.  ; returns: 0 if no duplicates were found, 1 otherwise
  1.  ;
  1.  N IBATYP,IBATYPN,IBATYPNM,IBGRP,IBFDT,IBL,IBLPDT,IBN,IBND,IBTDT
  1.  I '$G(DFN)!'$G(SDATE) Q 0
  1.  I $G(EDATE)="" S EDATE=SDATE  ; if no end date, assume 1 day length
  1.  S IBLPDT=-$$FMADD^XLFDT(EDATE,,,,1)  ; set starting point for the lookup
  1.  F  S IBLPDT=$O(^IB("AFDT",DFN,IBLPDT)) Q:'IBLPDT!(-IBLPDT<SDATE)  D
  1.  .S IBN=0 F  S IBN=$O(^IB("AFDT",DFN,IBLPDT,IBN)) Q:'IBN  D
  1.  ..S IBL=$$LAST^IBECEAU(+$P($G(^IB(IBN,0)),U,9)),IBND=$G(^IB(IBL,0)),IBFDT=$P(IBND,U,14),IBTDT=$P(IBND,U,15)
  1.  ..I IBFDT="",IBTDT="" Q  ; this is a parent Admission VA/CC/LTC Record.  Does not Dup check.
  1.  ..I EDATE<IBFDT Q        ; start date of the bill is after the end date of the copay being entered.
  1.  ..I SDATE>IBTDT Q        ; start date of the copay being entered is after the end date of the bill.
  1.  ..S IBATYP=$G(^IBE(350.1,+$P(IBND,U,3),0))     ; action type for the bill
  1.  ..S IBATYPN=$G(^IBE(350.1,+$P(IBATYP,U,9),0))  ; associated new action type for the bill
  1.  ..S IBATYPNM=$P(IBATYPN,U) ; new action type name
  1.  ..S IBGRP=$P(IBATYPN,U,11) ; billing group for the bill (IBXA = billing group for copay being entered)
  1.  ..; check for Tricare duplicates
  1.  ..I IBXA=7 Q:IBGRP'=IBXA!(IBATYPNM["RX")  ; non-Tricare charge and Tricare RX are not duplicates
  1.  ..I "^1^3^"[(U_$P(IBATYP,U,5)_U),"^1^2^3^4^8^20^"[(U_+$P(IBND,U,5)_U) S IBRES(IBN)=""
  1.  ..Q
  1.  .Q
  1.  Q $S($D(IBRES):1,1:0)
  1.  ;
  1. DISPDUP(IBARY) ; Display list of duplicates and ask if the user wishes to continue.  IB*2.0*715
  1.  ;
  1.  ; IBARY - Array of duplicate iens in file 350. Format: IBARY(ien)="".
  1.  ;
  1.  ; returns: 1 if user wishes to continue with adding the copay, 0 otherwise
  1.  ;
  1.  N IBACTY,IBBLNM,IBCHRG,IBCNRSLT,IBFRDT,IBI,IBN,IBTODT,IENS
  1.  N DIR,DIRUT,DUOUT,X,Y
  1.  ;Display Duplicate Copays
  1.  W !,"BILL",?10,"BILL",?45,"BILL",!,"FROM",?10," TO",?21,"CHARGE TYPE",?45,"NUMBER",?70,"CHARGE",!
  1.  F IBI=1:1:80 W "-"
  1.  S IBN=0 F  S IBN=$O(IBARY(IBN)) Q:'IBN  D
  1.  .;Get the info
  1.  .S IENS=IBN_","
  1.  .S IBFRDT=$$FMTE^XLFDT($$GET1^DIQ(350,IENS,.14,"I"),"2Z")
  1.  .S IBTODT=$$FMTE^XLFDT($$GET1^DIQ(350,IENS,.15,"I"),"2Z")
  1.  .S IBACTY=$$GET1^DIQ(350,IENS,.03,"E")
  1.  .S IBBLNM=$$GET1^DIQ(350,IENS,.11,"E")
  1.  .S IBCHRG=$$GET1^DIQ(350,IENS,.07,"E")
  1.  .W !,IBFRDT,?10,IBTODT,?21,$E(IBACTY,1,17),?45,IBBLNM,?70,IBCHRG
  1.  .Q
  1.  ;
  1.  W !
  1.  S DIR(0)="YA"
  1.  S DIR("A")="Do you wish to continue processing this cost share as well (Y/N) ? "
  1.  D ^DIR
  1.  Q $S(+Y>0:1,1:0)