| 1 | IBAECU5 ;WOIFO/SS-LTC PHASE 2 UTILITIES ; 20-FEB-02
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**171,176**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;check if there is LTC in ^TMP of INPINFO^IBAECU2
|
|---|
| 5 | ISLTC(IBDFN,IBLBL) ;
|
|---|
| 6 | N IBFL5,IBVA,IBVT,IBVD
|
|---|
| 7 | S (IBFL5,IBVA)=0
|
|---|
| 8 | F S IBVA=$O(^TMP($J,IBLBL,IBDFN,IBVA)) Q:IBVA=""!(IBFL5>0) D
|
|---|
| 9 | . S IBVT=0
|
|---|
| 10 | . F S IBVT=$O(^TMP($J,IBLBL,IBDFN,IBVA,IBVT)) Q:IBVT=""!(IBFL5>0) D
|
|---|
| 11 | . . S IBVD=0
|
|---|
| 12 | . . F S IBVD=$O(^TMP($J,IBLBL,IBDFN,IBVA,IBVT,IBVD)) Q:IBVD=""!(IBFL5>0) D
|
|---|
| 13 | . . . S:$P($G(^TMP($J,IBLBL,IBDFN,IBVA,IBVT,IBVD)),"^",1)="L" IBFL5=IBVD
|
|---|
| 14 | Q IBFL5
|
|---|
| 15 | ;
|
|---|
| 16 | ;is C&P exam this date
|
|---|
| 17 | ;IBDFN1 - patient's ien #2
|
|---|
| 18 | ;IBDT1 -date
|
|---|
| 19 | ;returns
|
|---|
| 20 | ; 1 - YES, 0 -NO
|
|---|
| 21 | ISCOMPEN(IBDFN1,IBDT1) ;
|
|---|
| 22 | Q $$CNP^IBECEAU(IBDFN1,IBDT1)
|
|---|
| 23 | ;
|
|---|
| 24 | ;checks if charge for outpatient visit and then cancels it
|
|---|
| 25 | ;IBDFN - Pointer to patient in file #2
|
|---|
| 26 | ;IBDATE - Date to check for OPT charges
|
|---|
| 27 | CANCVIS(IBDFN,IBDATE) ;
|
|---|
| 28 | N IBN,IBCRES,IBDUZ
|
|---|
| 29 | S IBDUZ=+$G(DUZ)
|
|---|
| 30 | S IBN=$$BFO^IBECEAU(IBDFN,IBDATE)
|
|---|
| 31 | Q:'IBN
|
|---|
| 32 | S IBCRES=$O(^IBE(350.3,"B","BILLED LTC CHARGE",0))
|
|---|
| 33 | S:'IBCRES IBCRES=4 S IBWHER=""
|
|---|
| 34 | D CANCH^IBECEAU4(IBN,IBCRES,0)
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;prepares error messages
|
|---|
| 38 | ;IBDFN - patient's ien
|
|---|
| 39 | ;IBIEN - ien of applicable file
|
|---|
| 40 | ;IBACT - action
|
|---|
| 41 | ;IBMESS - error message
|
|---|
| 42 | ERRLOG(IBDFN,IBIEN,IBACT,IBMESS) ;
|
|---|
| 43 | Q:+IBDFN=0!(+IBIEN=0)!(IBACT="")
|
|---|
| 44 | N VADM,VA,VAERR,DFN,IBCNT
|
|---|
| 45 | S DFN=IBDFN
|
|---|
| 46 | D DEM^VADPT
|
|---|
| 47 | S ^TMP($J,"IBMJERR")=$G(^TMP($J,"IBMJERR"))+1
|
|---|
| 48 | S IBCNT=$G(^TMP($J,"IBMJERR"))
|
|---|
| 49 | S ^TMP($J,"IBMJERR",IBCNT,1)=" "
|
|---|
| 50 | S ^TMP($J,"IBMJERR",IBCNT,2)="*********************************"
|
|---|
| 51 | S ^TMP($J,"IBMJERR",IBCNT,3)=" "_$G(IBMESS)
|
|---|
| 52 | S ^TMP($J,"IBMJERR",IBCNT,4)=" Action : "_$G(IBACT)
|
|---|
| 53 | S ^TMP($J,"IBMJERR",IBCNT,5)=" Applicable IEN : "_$G(IBIEN)
|
|---|
| 54 | S ^TMP($J,"IBMJERR",IBCNT,6)=" Patient : "_$G(VADM(1))
|
|---|
| 55 | S ^TMP($J,"IBMJERR",IBCNT,7)=" SSN : "_$P($G(VADM(2)),"^",2)
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ;sends all errors in TMP($J,"IBMJERR" to IB ERROR mail group
|
|---|
| 59 | SENDERR ;
|
|---|
| 60 | N XMSUB,XMTEXT,XMY,XMZ,XMMG,IBL,IBT,XMDUZ,IBV1,IBV2,IBV3
|
|---|
| 61 | N IBMAXLN S IBMAXLN=200
|
|---|
| 62 | N XMGROUP S XMGROUP=$$GET1^DIQ(350.9,"1,",.09)
|
|---|
| 63 | Q:XMGROUP=""
|
|---|
| 64 | S XMGROUP="G."_XMGROUP
|
|---|
| 65 | S XMSUB="LTC Monthly Job error report",XMY(XMGROUP)=""
|
|---|
| 66 | S XMTEXT="IBT(",XMDUZ="INTEGRATED BILLING PACKAGE"
|
|---|
| 67 | S IBV1=0,IBV3=1
|
|---|
| 68 | F S IBV1=$O(^TMP($J,"IBMJERR",IBV1)) Q:+IBV1=0!(IBV3>IBMAXLN) D
|
|---|
| 69 | . S IBV2=0
|
|---|
| 70 | . F S IBV2=$O(^TMP($J,"IBMJERR",IBV1,IBV2)) Q:+IBV2=0 D
|
|---|
| 71 | . . S IBT(IBV3,0)=$G(^TMP($J,"IBMJERR",IBV1,IBV2)),IBV3=IBV3+1
|
|---|
| 72 | S:IBV3>IBMAXLN IBT(IBV3,0)="******* Too many errors! *******"
|
|---|
| 73 | D ^XMD
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | ;sends message to user group if there is no 1010EC form forthe patient
|
|---|
| 77 | MESS10EC(DFN,IBDT) ;
|
|---|
| 78 | D XMNOEC^IBAECU(DFN,IBDT)
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | ;Creates charge, sends amount to AR
|
|---|
| 82 | ;IBPATDFN - patient DFN
|
|---|
| 83 | ;.IBAMOUNT - array with all amounts for each day
|
|---|
| 84 | ;array IBMNTH - month info
|
|---|
| 85 | ;.IBMNTH - number of days
|
|---|
| 86 | ;IBMNTH(0)- first day (in FM format)
|
|---|
| 87 | ;IBMNTH(1)- last day (in FM format)
|
|---|
| 88 | ;IBMNTH(2)- year_month (like 30201)
|
|---|
| 89 | ;IBMONCAP - maximum monthly copay (180 days stuff)
|
|---|
| 90 | SEND2AR(IBPATDFN,IBAMOUNT,IBMNTH,IBMONCAP) ;
|
|---|
| 91 | ;arrays
|
|---|
| 92 | N IBPAYS,IBRCHRGS
|
|---|
| 93 | ;vars
|
|---|
| 94 | N IBADM,IB350P,IBDD,IBRES,IBTOT,IBV1,IBNOS,IBAMNT
|
|---|
| 95 | N IBDAY,IB350,IBRATE,IBTP,IBDT,IBSL,IBPRDAY,IBV1
|
|---|
| 96 | N IBINPDS,IBFDAY,IBLDAY,IBEPSSUM,IBFRD,IBTOD
|
|---|
| 97 | S IBDAY=0,IBPAYS=0,IBRCHRGS=0
|
|---|
| 98 | ;1.outpatient visit charges
|
|---|
| 99 | F S IBDAY=$O(IBAMOUNT("A",IBDAY)) Q:+IBDAY=0 I +$G(IBAMOUNT("A",IBDAY,"T"))=1 D
|
|---|
| 100 | . S IBRATE=+$G(IBAMOUNT("A",IBDAY,"R"))
|
|---|
| 101 | . S IBTP=$P($G(IBAMOUNT("A",IBDAY,"R")),"^",2)
|
|---|
| 102 | . S IBDT=$$MKDATE^IBAECU4(IBMNTH(2),IBDAY)
|
|---|
| 103 | . S IBSL="409.68:"_$P($G(IBAMOUNT("A",IBDAY,"T")),"^",2)
|
|---|
| 104 | . S IBPAYS=$G(IBPAYS)+1,IBPAYS(IBDAY)=IBPATDFN_"^"_IBTP_"^1^"_IBRATE_"^"_IBDT_"^"_IBDT_"^"_IBSL_"^^*^"_IBDT
|
|---|
| 105 | ;2.inpatient stay charges
|
|---|
| 106 | S IBFDAY=0 ;first day of episode
|
|---|
| 107 | S IBLDAY=0 ;last day of episode
|
|---|
| 108 | S IBINPDS=0 ;length of each episode (Exmpl. Jan3-Jan5=2days, Jan21-Jan31=10 days)
|
|---|
| 109 | S IBEPSSUM=0 ;total for episode
|
|---|
| 110 | S IBDAY=0
|
|---|
| 111 | F S IBDAY=$O(IBAMOUNT("A",IBDAY)) Q:+IBDAY=0 I +$G(IBAMOUNT("A",IBDAY,"T"))=2 D
|
|---|
| 112 | . S:IBFDAY=0 IBFDAY=IBDAY ;set first day
|
|---|
| 113 | . S IBINPDS=IBINPDS+1 ;count days
|
|---|
| 114 | . S IBRATE=+$G(IBAMOUNT("A",IBDAY,"R"))
|
|---|
| 115 | . S IBEPSSUM=IBEPSSUM+IBRATE ;total
|
|---|
| 116 | . S IBV1=+$O(IBAMOUNT("A",IBDAY)) ;check the next day
|
|---|
| 117 | . ;if next "is the end" OR "if AA/ASIH gap" OR "if another admission"
|
|---|
| 118 | . I (IBV1=0)!((IBV1-IBDAY)>1)!($P($G(IBAMOUNT("A",IBDAY,"T")),"^",2)'=$P($G(IBAMOUNT("A",IBV1,"T")),"^",2)) D
|
|---|
| 119 | . . S IBLDAY=IBDAY ; set last day
|
|---|
| 120 | . . S IBTP=$P($G(IBAMOUNT("A",IBDAY,"R")),"^",2) ;action type
|
|---|
| 121 | . . S IBFRD=$$MKDATE^IBAECU4(IBMNTH(2),IBFDAY) ;from
|
|---|
| 122 | . . S IBTOD=$$MKDATE^IBAECU4(IBMNTH(2),IBLDAY) ;to
|
|---|
| 123 | . . S IBADM=$P($G(IBAMOUNT("A",IBDAY,"T")),"^",2) ;admission
|
|---|
| 124 | . . S IBDT=+$P($G(IBAMOUNT("A",IBDAY,"T")),"^",3) ;default is admission date
|
|---|
| 125 | . . I IBDT<IBMNTH(0) S IBDT=IBMNTH(0) ;if admission date < begining of month
|
|---|
| 126 | . . S IB350P=+$$FIND350^IBAECN1(IBPATDFN,IBFRD+0.9,IBADM,1) ;find INCOMLETE parent event
|
|---|
| 127 | . . I IB350P=0 D
|
|---|
| 128 | . . . N VAIP,IB350PCL,DFN
|
|---|
| 129 | . . . S DFN=IBPATDFN,VAIP("D")=IBFRD_.2359 D IN5^VADPT
|
|---|
| 130 | . . . I '$$ASIH^IBAUTL5($G(^DGPM(+VAIP(1),0))) D Q
|
|---|
| 131 | . . . . ;find "completed" - ASIH could complete event entry
|
|---|
| 132 | . . . . S IB350PCL=+$$FIND350^IBAECN1(IBPATDFN,IBFRD+0.9,+IBADM,2)
|
|---|
| 133 | . . . . I IB350PCL>0 S IB350P=IB350PCL
|
|---|
| 134 | . . . S IB350P=+$$FIND350^IBAECN1(IBPATDFN,IBFRD+0.9,+VAIP(1),1)
|
|---|
| 135 | . . . S IBADM=+VAIP(1),IBDT=+$G(^DGPM(VAIP(1),0))\1
|
|---|
| 136 | . . ;if not found - create new one with LTC type
|
|---|
| 137 | . . I IB350P=0 S IB350P=$$CREV350^IBAECN1(IBPATDFN,+IBADM,IBDT,93)
|
|---|
| 138 | . . S IBSL="405:"_IBADM ;soft link
|
|---|
| 139 | . . S IBPAYS=$G(IBPAYS)+1
|
|---|
| 140 | . . I $D(IBPAYS(IBDAY)) D ERRLOG(+$G(IBPATDFN),+$G(IB350P),"SEND2AR: charges","Attempt to create more than one charge a day ")
|
|---|
| 141 | . . S IBPAYS(IBDAY)=IBPATDFN_"^"_IBTP_"^"_IBINPDS_"^"_IBEPSSUM_"^"_IBFRD_"^"_IBTOD_"^"_IBSL_"^^"_IB350P_"^"_IBDT
|
|---|
| 142 | . . S (IBFDAY,IBLDAY,IBINPDS,IBEPSSUM)=0
|
|---|
| 143 | ;3. make charges until it less than monthly cap
|
|---|
| 144 | ;
|
|---|
| 145 | S (IBTOT,IBFL,IBDD)=0
|
|---|
| 146 | F S IBDD=$O(IBPAYS(IBDD)) Q:+IBDD=0!(IBFL=1) D
|
|---|
| 147 | . S IBRES=$G(IBPAYS(IBDD))
|
|---|
| 148 | . S IBAMNT=0
|
|---|
| 149 | . I IBTOT'<IBMONCAP S IBFL=1 Q ;don't charge anymore
|
|---|
| 150 | . I (IBTOT+$P(IBRES,"^",4))'>IBMONCAP D ;charge whole amount
|
|---|
| 151 | . . S IBAMNT=$P(IBRES,"^",4)
|
|---|
| 152 | . E S IBAMNT=IBMONCAP-IBTOT ;charge a rest
|
|---|
| 153 | . S IBTOT=IBTOT+IBAMNT
|
|---|
| 154 | . 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))
|
|---|
| 155 | . I IB350>0 S IBRCHRGS=IBRCHRGS+1,IBRCHRGS(IBRCHRGS)=IB350
|
|---|
| 156 | . ;Edit parent event in #350 V 11F
|
|---|
| 157 | . I +$P(IBRES,"^",9)>0 D STAT350^IBAECN1(+$P(IBRES,"^",9),IBMNTH(1),+$P($P(IBRES,"^",7),":",2))
|
|---|
| 158 | ;4. Send to AR
|
|---|
| 159 | S IBV1=0,IBNOS=""
|
|---|
| 160 | F S IBV1=$O(IBRCHRGS(IBV1)) Q:+IBV1=0 D
|
|---|
| 161 | . S:IBNOS'="" IBNOS=IBNOS_"^"_IBRCHRGS(IBV1)
|
|---|
| 162 | . S:IBNOS="" IBNOS=IBRCHRGS(IBV1)
|
|---|
| 163 | . I (IBV1#5)=0 S IBRES=$$TOAR(IBPATDFN,1,IBNOS,+$G(DUZ)),IBNOS=""
|
|---|
| 164 | I IBNOS'="" S IBRES=$$TOAR(IBPATDFN,1,IBNOS,+$G(DUZ)),IBNOS=""
|
|---|
| 165 | Q
|
|---|
| 166 | ;call ^IBR
|
|---|
| 167 | TOAR(DFN,IBSEQNO,IBNOS,IBDUZ) ;
|
|---|
| 168 | ;
|
|---|
| 169 | N Y,IBERR,IBIL
|
|---|
| 170 | D ^IBR
|
|---|
| 171 | Q Y
|
|---|
| 172 | ;
|
|---|
| 173 | ;create outppatient charge
|
|---|
| 174 | ; Input:
|
|---|
| 175 | ; DFN -- Pointer to patient in file #2
|
|---|
| 176 | ; IBATYP -- Pointer to Action Type in file #350.1
|
|---|
| 177 | ; IBUNIT -- Number of units of charge (1 day for outpatient, 1 or more for inpatients)
|
|---|
| 178 | ; IBCHG -- $$ amount of charge
|
|---|
| 179 | ; IBFR -- Bill From date
|
|---|
| 180 | ; inpatient: first day of episode
|
|---|
| 181 | ; outpatient: date of service
|
|---|
| 182 | ; IBTO -- Bill To date
|
|---|
| 183 | ; inpatient: last day of episode
|
|---|
| 184 | ; outpatient: date of service
|
|---|
| 185 | ; IBSL -- Softlink 405:IEN or 409.68:IEN
|
|---|
| 186 | ; IBPAR -- placeholder for IBPARNT (see below)
|
|---|
| 187 | ; IBEVDA -- Pointer to parent event in #350 for inpatients,
|
|---|
| 188 | ; or "*" for outpatients to set ibevda=ibn
|
|---|
| 189 | ; IBEVDT -- for outpatient: Event Date
|
|---|
| 190 | ; for inpatient:admission date or begining of month if admission began
|
|---|
| 191 | ; before the begining of the month
|
|---|
| 192 | CHARGE(DFN,IBATYP,IBUNIT,IBCHG,IBFR,IBTO,IBSL,IBPAR,IBEVDA,IBEVDT) ;
|
|---|
| 193 | ;
|
|---|
| 194 | N IBN,IBDESC,IBSITE,IBFAC,IBXA
|
|---|
| 195 | D SITE^IBAUTL
|
|---|
| 196 | S IBDESC=$P($G(^IBE(350.1,+$G(IBATYP),0)),"^",8)
|
|---|
| 197 | I IBDESC="" S IBDESC=$$ACTNM(+$G(IBATYP)) D ERRLOG(+$G(DFN),+$G(IBATYP),"CHARGE","No USER LOOKUP NAME in #350.1")
|
|---|
| 198 | S IBN=0
|
|---|
| 199 | ;IBPARNT -- Pointer to parent entry in #350 [OPTIONAL], i.e. to previous record(s)
|
|---|
| 200 | ; for the same charge, that were edited or cancelled
|
|---|
| 201 | ; Here IBPARNT must be undefined, because we always create "NEW" charges
|
|---|
| 202 | N IBPARNT ;undefined
|
|---|
| 203 | D ADD^IBECEAU3
|
|---|
| 204 | Q IBN
|
|---|
| 205 | ;
|
|---|
| 206 | ACTNM(X) ;X -input pointer to action type file (350.1)
|
|---|
| 207 | S Y=$P($G(^IBE(350.1,+X,0)),"^",9) ;new action type
|
|---|
| 208 | 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)),"^"))
|
|---|
| 209 | ;
|
|---|
