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

IBAECU5.m

Go to the documentation of this file.
  1. IBAECU5 ;WOIFO/SS-LTC PHASE 2 UTILITIES ; 20-FEB-02
  1. ;;2.0;INTEGRATED BILLING;**171,176**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;check if there is LTC in ^TMP of INPINFO^IBAECU2
  1. ISLTC(IBDFN,IBLBL) ;
  1. N IBFL5,IBVA,IBVT,IBVD
  1. S (IBFL5,IBVA)=0
  1. F S IBVA=$O(^TMP($J,IBLBL,IBDFN,IBVA)) Q:IBVA=""!(IBFL5>0) D
  1. . S IBVT=0
  1. . F S IBVT=$O(^TMP($J,IBLBL,IBDFN,IBVA,IBVT)) Q:IBVT=""!(IBFL5>0) D
  1. . . S IBVD=0
  1. . . F S IBVD=$O(^TMP($J,IBLBL,IBDFN,IBVA,IBVT,IBVD)) Q:IBVD=""!(IBFL5>0) D
  1. . . . S:$P($G(^TMP($J,IBLBL,IBDFN,IBVA,IBVT,IBVD)),"^",1)="L" IBFL5=IBVD
  1. Q IBFL5
  1. ;
  1. ;is C&P exam this date
  1. ;IBDFN1 - patient's ien #2
  1. ;IBDT1 -date
  1. ;returns
  1. ; 1 - YES, 0 -NO
  1. ISCOMPEN(IBDFN1,IBDT1) ;
  1. Q $$CNP^IBECEAU(IBDFN1,IBDT1)
  1. ;
  1. ;checks if charge for outpatient visit and then cancels it
  1. ;IBDFN - Pointer to patient in file #2
  1. ;IBDATE - Date to check for OPT charges
  1. CANCVIS(IBDFN,IBDATE) ;
  1. N IBN,IBCRES,IBDUZ
  1. S IBDUZ=+$G(DUZ)
  1. S IBN=$$BFO^IBECEAU(IBDFN,IBDATE)
  1. Q:'IBN
  1. S IBCRES=$O(^IBE(350.3,"B","BILLED LTC CHARGE",0))
  1. S:'IBCRES IBCRES=4 S IBWHER=""
  1. D CANCH^IBECEAU4(IBN,IBCRES,0)
  1. Q
  1. ;
  1. ;prepares error messages
  1. ;IBDFN - patient's ien
  1. ;IBIEN - ien of applicable file
  1. ;IBACT - action
  1. ;IBMESS - error message
  1. ERRLOG(IBDFN,IBIEN,IBACT,IBMESS) ;
  1. Q:+IBDFN=0!(+IBIEN=0)!(IBACT="")
  1. N VADM,VA,VAERR,DFN,IBCNT
  1. S DFN=IBDFN
  1. D DEM^VADPT
  1. S ^TMP($J,"IBMJERR")=$G(^TMP($J,"IBMJERR"))+1
  1. S IBCNT=$G(^TMP($J,"IBMJERR"))
  1. S ^TMP($J,"IBMJERR",IBCNT,1)=" "
  1. S ^TMP($J,"IBMJERR",IBCNT,2)="*********************************"
  1. S ^TMP($J,"IBMJERR",IBCNT,3)=" "_$G(IBMESS)
  1. S ^TMP($J,"IBMJERR",IBCNT,4)=" Action : "_$G(IBACT)
  1. S ^TMP($J,"IBMJERR",IBCNT,5)=" Applicable IEN : "_$G(IBIEN)
  1. S ^TMP($J,"IBMJERR",IBCNT,6)=" Patient : "_$G(VADM(1))
  1. S ^TMP($J,"IBMJERR",IBCNT,7)=" SSN : "_$P($G(VADM(2)),"^",2)
  1. Q
  1. ;
  1. ;sends all errors in TMP($J,"IBMJERR" to IB ERROR mail group
  1. SENDERR ;
  1. N XMSUB,XMTEXT,XMY,XMZ,XMMG,IBL,IBT,XMDUZ,IBV1,IBV2,IBV3
  1. N IBMAXLN S IBMAXLN=200
  1. N XMGROUP S XMGROUP=$$GET1^DIQ(350.9,"1,",.09)
  1. Q:XMGROUP=""
  1. S XMGROUP="G."_XMGROUP
  1. S XMSUB="LTC Monthly Job error report",XMY(XMGROUP)=""
  1. S XMTEXT="IBT(",XMDUZ="INTEGRATED BILLING PACKAGE"
  1. S IBV1=0,IBV3=1
  1. F S IBV1=$O(^TMP($J,"IBMJERR",IBV1)) Q:+IBV1=0!(IBV3>IBMAXLN) D
  1. . S IBV2=0
  1. . F S IBV2=$O(^TMP($J,"IBMJERR",IBV1,IBV2)) Q:+IBV2=0 D
  1. . . S IBT(IBV3,0)=$G(^TMP($J,"IBMJERR",IBV1,IBV2)),IBV3=IBV3+1
  1. S:IBV3>IBMAXLN IBT(IBV3,0)="******* Too many errors! *******"
  1. D ^XMD
  1. Q
  1. ;
  1. ;sends message to user group if there is no 1010EC form forthe patient
  1. MESS10EC(DFN,IBDT) ;
  1. D XMNOEC^IBAECU(DFN,IBDT)
  1. Q
  1. ;
  1. ;Creates charge, sends amount to AR
  1. ;IBPATDFN - patient DFN
  1. ;.IBAMOUNT - array with all amounts for each day
  1. ;array IBMNTH - month info
  1. ;.IBMNTH - number of days
  1. ;IBMNTH(0)- first day (in FM format)
  1. ;IBMNTH(1)- last day (in FM format)
  1. ;IBMNTH(2)- year_month (like 30201)
  1. ;IBMONCAP - maximum monthly copay (180 days stuff)
  1. SEND2AR(IBPATDFN,IBAMOUNT,IBMNTH,IBMONCAP) ;
  1. ;arrays
  1. N IBPAYS,IBRCHRGS
  1. ;vars
  1. N IBADM,IB350P,IBDD,IBRES,IBTOT,IBV1,IBNOS,IBAMNT
  1. N IBDAY,IB350,IBRATE,IBTP,IBDT,IBSL,IBPRDAY,IBV1
  1. N IBINPDS,IBFDAY,IBLDAY,IBEPSSUM,IBFRD,IBTOD
  1. S IBDAY=0,IBPAYS=0,IBRCHRGS=0
  1. ;1.outpatient visit charges
  1. F S IBDAY=$O(IBAMOUNT("A",IBDAY)) Q:+IBDAY=0 I +$G(IBAMOUNT("A",IBDAY,"T"))=1 D
  1. . S IBRATE=+$G(IBAMOUNT("A",IBDAY,"R"))
  1. . S IBTP=$P($G(IBAMOUNT("A",IBDAY,"R")),"^",2)
  1. . S IBDT=$$MKDATE^IBAECU4(IBMNTH(2),IBDAY)
  1. . S IBSL="409.68:"_$P($G(IBAMOUNT("A",IBDAY,"T")),"^",2)
  1. . S IBPAYS=$G(IBPAYS)+1,IBPAYS(IBDAY)=IBPATDFN_"^"_IBTP_"^1^"_IBRATE_"^"_IBDT_"^"_IBDT_"^"_IBSL_"^^*^"_IBDT
  1. ;2.inpatient stay charges
  1. S IBFDAY=0 ;first day of episode
  1. S IBLDAY=0 ;last day of episode
  1. S IBINPDS=0 ;length of each episode (Exmpl. Jan3-Jan5=2days, Jan21-Jan31=10 days)
  1. S IBEPSSUM=0 ;total for episode
  1. S IBDAY=0
  1. F S IBDAY=$O(IBAMOUNT("A",IBDAY)) Q:+IBDAY=0 I +$G(IBAMOUNT("A",IBDAY,"T"))=2 D
  1. . S:IBFDAY=0 IBFDAY=IBDAY ;set first day
  1. . S IBINPDS=IBINPDS+1 ;count days
  1. . S IBRATE=+$G(IBAMOUNT("A",IBDAY,"R"))
  1. . S IBEPSSUM=IBEPSSUM+IBRATE ;total
  1. . S IBV1=+$O(IBAMOUNT("A",IBDAY)) ;check the next day
  1. . ;if next "is the end" OR "if AA/ASIH gap" OR "if another admission"
  1. . I (IBV1=0)!((IBV1-IBDAY)>1)!($P($G(IBAMOUNT("A",IBDAY,"T")),"^",2)'=$P($G(IBAMOUNT("A",IBV1,"T")),"^",2)) D
  1. . . S IBLDAY=IBDAY ; set last day
  1. . . S IBTP=$P($G(IBAMOUNT("A",IBDAY,"R")),"^",2) ;action type
  1. . . S IBFRD=$$MKDATE^IBAECU4(IBMNTH(2),IBFDAY) ;from
  1. . . S IBTOD=$$MKDATE^IBAECU4(IBMNTH(2),IBLDAY) ;to
  1. . . S IBADM=$P($G(IBAMOUNT("A",IBDAY,"T")),"^",2) ;admission
  1. . . S IBDT=+$P($G(IBAMOUNT("A",IBDAY,"T")),"^",3) ;default is admission date
  1. . . I IBDT<IBMNTH(0) S IBDT=IBMNTH(0) ;if admission date < begining of month
  1. . . S IB350P=+$$FIND350^IBAECN1(IBPATDFN,IBFRD+0.9,IBADM,1) ;find INCOMLETE parent event
  1. . . I IB350P=0 D
  1. . . . N VAIP,IB350PCL,DFN
  1. . . . S DFN=IBPATDFN,VAIP("D")=IBFRD_.2359 D IN5^VADPT
  1. . . . I '$$ASIH^IBAUTL5($G(^DGPM(+VAIP(1),0))) D Q
  1. . . . . ;find "completed" - ASIH could complete event entry
  1. . . . . S IB350PCL=+$$FIND350^IBAECN1(IBPATDFN,IBFRD+0.9,+IBADM,2)
  1. . . . . I IB350PCL>0 S IB350P=IB350PCL
  1. . . . S IB350P=+$$FIND350^IBAECN1(IBPATDFN,IBFRD+0.9,+VAIP(1),1)
  1. . . . S IBADM=+VAIP(1),IBDT=+$G(^DGPM(VAIP(1),0))\1
  1. . . ;if not found - create new one with LTC type
  1. . . I IB350P=0 S IB350P=$$CREV350^IBAECN1(IBPATDFN,+IBADM,IBDT,93)
  1. . . S IBSL="405:"_IBADM ;soft link
  1. . . S IBPAYS=$G(IBPAYS)+1
  1. . . I $D(IBPAYS(IBDAY)) D ERRLOG(+$G(IBPATDFN),+$G(IB350P),"SEND2AR: charges","Attempt to create more than one charge a day ")
  1. . . S IBPAYS(IBDAY)=IBPATDFN_"^"_IBTP_"^"_IBINPDS_"^"_IBEPSSUM_"^"_IBFRD_"^"_IBTOD_"^"_IBSL_"^^"_IB350P_"^"_IBDT
  1. . . S (IBFDAY,IBLDAY,IBINPDS,IBEPSSUM)=0
  1. ;3. make charges until it less than monthly cap
  1. ;
  1. S (IBTOT,IBFL,IBDD)=0
  1. F S IBDD=$O(IBPAYS(IBDD)) Q:+IBDD=0!(IBFL=1) D
  1. . S IBRES=$G(IBPAYS(IBDD))
  1. . S IBAMNT=0
  1. . I IBTOT'<IBMONCAP S IBFL=1 Q ;don't charge anymore
  1. . I (IBTOT+$P(IBRES,"^",4))'>IBMONCAP D ;charge whole amount
  1. . . S IBAMNT=$P(IBRES,"^",4)
  1. . E S IBAMNT=IBMONCAP-IBTOT ;charge a rest
  1. . S IBTOT=IBTOT+IBAMNT
  1. . S IB350=$$CHARGE(IBPATDFN,$P(IBRES,"^",2),$P(IBRES,"^",3),IBAMNT,$P(IBRES,"^",5),$P(IBRES,"^",6),$P(IBRES,"^",7),$P(IBRES,"^",8),$P(IBRES,"^",9),$P(IBRES,"^",10))
  1. . I IB350>0 S IBRCHRGS=IBRCHRGS+1,IBRCHRGS(IBRCHRGS)=IB350
  1. . ;Edit parent event in #350 V 11F
  1. . I +$P(IBRES,"^",9)>0 D STAT350^IBAECN1(+$P(IBRES,"^",9),IBMNTH(1),+$P($P(IBRES,"^",7),":",2))
  1. ;4. Send to AR
  1. S IBV1=0,IBNOS=""
  1. F S IBV1=$O(IBRCHRGS(IBV1)) Q:+IBV1=0 D
  1. . S:IBNOS'="" IBNOS=IBNOS_"^"_IBRCHRGS(IBV1)
  1. . S:IBNOS="" IBNOS=IBRCHRGS(IBV1)
  1. . I (IBV1#5)=0 S IBRES=$$TOAR(IBPATDFN,1,IBNOS,+$G(DUZ)),IBNOS=""
  1. I IBNOS'="" S IBRES=$$TOAR(IBPATDFN,1,IBNOS,+$G(DUZ)),IBNOS=""
  1. Q
  1. ;call ^IBR
  1. TOAR(DFN,IBSEQNO,IBNOS,IBDUZ) ;
  1. ;
  1. N Y,IBERR,IBIL
  1. D ^IBR
  1. Q Y
  1. ;
  1. ;create outppatient charge
  1. ; Input:
  1. ; DFN -- Pointer to patient in file #2
  1. ; IBATYP -- Pointer to Action Type in file #350.1
  1. ; IBUNIT -- Number of units of charge (1 day for outpatient, 1 or more for inpatients)
  1. ; IBCHG -- $$ amount of charge
  1. ; IBFR -- Bill From date
  1. ; inpatient: first day of episode
  1. ; outpatient: date of service
  1. ; IBTO -- Bill To date
  1. ; inpatient: last day of episode
  1. ; outpatient: date of service
  1. ; IBSL -- Softlink 405:IEN or 409.68:IEN
  1. ; IBPAR -- placeholder for IBPARNT (see below)
  1. ; IBEVDA -- Pointer to parent event in #350 for inpatients,
  1. ; or "*" for outpatients to set ibevda=ibn
  1. ; IBEVDT -- for outpatient: Event Date
  1. ; for inpatient:admission date or begining of month if admission began
  1. ; before the begining of the month
  1. CHARGE(DFN,IBATYP,IBUNIT,IBCHG,IBFR,IBTO,IBSL,IBPAR,IBEVDA,IBEVDT) ;
  1. ;
  1. N IBN,IBDESC,IBSITE,IBFAC,IBXA
  1. D SITE^IBAUTL
  1. S IBDESC=$P($G(^IBE(350.1,+$G(IBATYP),0)),"^",8)
  1. I IBDESC="" S IBDESC=$$ACTNM(+$G(IBATYP)) D ERRLOG(+$G(DFN),+$G(IBATYP),"CHARGE","No USER LOOKUP NAME in #350.1")
  1. S IBN=0
  1. ;IBPARNT -- Pointer to parent entry in #350 [OPTIONAL], i.e. to previous record(s)
  1. ; for the same charge, that were edited or cancelled
  1. ; Here IBPARNT must be undefined, because we always create "NEW" charges
  1. N IBPARNT ;undefined
  1. D ADD^IBECEAU3
  1. Q IBN
  1. ;
  1. ACTNM(X) ;X -input pointer to action type file (350.1)
  1. S Y=$P($G(^IBE(350.1,+X,0)),"^",9) ;new action type
  1. Q $S($P($G(^IBE(350.1,+Y,0)),"^",8)]"":$P(^(0),"^",8),$P($G(^IBE(350.1,+X,0)),"^",8)]"":$P(^(0),"^",8),1:$P($G(^IBE(350.1,+X,0)),"^"))
  1. ;