| 1 | IBAMTD1 ;ALB/CPM-MOVEMENT EVENT DRIVER INTERFACE (CON'T) ;21-OCT-91
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**45,153,179,183,202**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; Create charges for one-day admissions
|
|---|
| 6 | ; Input: DFN, DGPMA, IBDT, IBBS, IBCLDA
|
|---|
| 7 | ; IBCLCT/IBCLDAY/IBCLDOL/IBCLDT (if IBCLDA'=0)
|
|---|
| 8 | ;
|
|---|
| 9 | ; - quit if patient is not a Means Test patient at discharge
|
|---|
| 10 | G:'$$BIL^DGMTUB(DFN,+DGPMA) END
|
|---|
| 11 | N IBGMT,IBGMTR,IBGMTEFD
|
|---|
| 12 | S IBGMT=$$ISGMTPT^IBAGMT(DFN,+DGPMA),IBGMTR=0
|
|---|
| 13 | S IBGMTEFD=$$GMTEFD^IBAGMT()
|
|---|
| 14 | ; - handle clock
|
|---|
| 15 | I $D(IBCLDT),IBCLDT>IBDT S IBY="-1^IB034" G END
|
|---|
| 16 | I IBCLDA D COUNT^IBAMTD S IBCLCT=IBCLCT+1 I IBCLCT>365 S IBWHER=2 D CLOCKCL^IBAUTL3 G:IBY<1 END S IBCLDA=0
|
|---|
| 17 | I 'IBCLDA S IBCLDT=IBDT,IBWHER=7 D CLADD^IBAUTL3 G:IBY<1 END S IBCLCT=1,(IBCLDAY,IBCLDOL)=0
|
|---|
| 18 | ; - build event
|
|---|
| 19 | S IBNH=$P($G(^DGCR(399.1,IBBS,0)),"^")["NURSING",IBSL="405:"_$P(DGPMA,"^",14),IBEVDT=IBDT,IBWHER=6
|
|---|
| 20 | D EVADD^IBAUTL3 G:IBY<1 END
|
|---|
| 21 | S IBCLDAY=IBCLDAY+1
|
|---|
| 22 | ; - cancel any OPT charges
|
|---|
| 23 | D OPT(DFN,IBDT)
|
|---|
| 24 | ; - process per diem
|
|---|
| 25 | G:IBDT<$$DIEM^IBAUTL5 COPAY
|
|---|
| 26 | S IBX="P",IBWHER=8 D TYPE^IBAUTL2 G:IBY<1 END
|
|---|
| 27 | ;If the patient has GMT Status, and the Action Type is MT Inpt (must be), then reduce the charge
|
|---|
| 28 | S IBGMTR=0 I IBGMT>0,DGPMA'<IBGMTEFD,$$ISGMTTYP^IBAGMT(IBATYP) S IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) ;GMT Charge Adjustment
|
|---|
| 29 | S IBWHER=13 D CHADD^IBAUTL2 G:IBY<1 END
|
|---|
| 30 | S IBNOS=IBN,IBWHER=26 D FILER^IBAUTL5 G:IBY<1 END
|
|---|
| 31 | COPAY ; - process co-payment
|
|---|
| 32 | G:IBCLDAY>360 LAST
|
|---|
| 33 | I IBCLDAY>1,IBCLDAY#90=1 S IBCLDOL=0
|
|---|
| 34 | S IBMAX=IBMED
|
|---|
| 35 | I IBGMT>0,DGPMA'<IBGMTEFD S IBMAX=$$REDUCE^IBAGMT(IBMAX) ;GMT Adjustment of Medicare Deductible
|
|---|
| 36 | I IBCLDAY>90,'IBNH S IBMAX=IBMAX/2
|
|---|
| 37 | G:IBCLDOL'<IBMAX LAST
|
|---|
| 38 | S IBWHER=14 D COPAY^IBAUTL2 G:IBY<1 END
|
|---|
| 39 | ;If the patient has GMT Status, then reduce the charge
|
|---|
| 40 | S IBGMTR=0 I IBGMT>0,DGPMA'<IBGMTEFD S IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG)
|
|---|
| 41 | S IBCHARG=IBMAX-IBCLDOL I IBCHG<IBCHARG S IBCHARG=IBCHG
|
|---|
| 42 | S IBCHG=IBCHARG S:IBCHG<0 IBCHG=0
|
|---|
| 43 | S IBCLDOL=IBCLDOL+IBCHG
|
|---|
| 44 | S IBWHER=18 D CHADD^IBAUTL2 G:IBY<1 END
|
|---|
| 45 | S IBNOS=IBN,IBWHER=27 D FILER^IBAUTL5 G:IBY<1 END
|
|---|
| 46 | LAST ; - close event, update billing clock
|
|---|
| 47 | S IBWHER=23,IBEVCLD=IBDT D EVCLOSE^IBAUTL3,CLUPD^IBAUTL3,CLOCKCL^IBAUTL3:IBCLCT>364
|
|---|
| 48 | END Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | UNFLAG ; Unflag continuous patient, if not transferring from the facility.
|
|---|
| 52 | N TRAN S TRAN=$P(DGPMA,"^",18)=10
|
|---|
| 53 | I 'TRAN!(IBASIH) W:'$G(DGQUIET) !,"Unflagging patient as continuous since 7/1/86..." D
|
|---|
| 54 | . D NOW^%DTC S DIE="^IBE(351.1,",DA=+$O(^IBE(351.1,"B",DFN,0))
|
|---|
| 55 | . S DR=".02////"_$P(+DGPMA,".")_";.05////"_DUZ_";.06////"_% D ^DIE K DIE,DA,DR
|
|---|
| 56 | . W:'$G(DGQUIET) "completed."
|
|---|
| 57 | ; - send bulletin to Means Test Billing mailgroup, if patient did not die.
|
|---|
| 58 | I $P($G(^DG(405.1,+$P(DGPMA,"^",4),0)),"^")'["DEATH" D CTPT^IBAMTBU
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | OPT(DFN,IBDATE) ; Cancel any OPT charges on days billed for inpatient care.
|
|---|
| 62 | ; Input: DFN -- Pointer to patient in file #2
|
|---|
| 63 | ; IBDATE -- Date to check for OPT charges
|
|---|
| 64 | N IBN,IBCRES,IBDUZ S IBDUZ=DUZ
|
|---|
| 65 | S IBN=$$BFO^IBECEAU(DFN,IBDATE) I 'IBN G OPTQ
|
|---|
| 66 | S IBCRES=$O(^IBE(350.3,"B","RECD INPATIENT CARE",0))
|
|---|
| 67 | S:'IBCRES IBCRES=25
|
|---|
| 68 | D CANCH^IBECEAU4(IBN,IBCRES)
|
|---|
| 69 | OPTQ Q
|
|---|
