source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTD1.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBAMTD1 ;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 ;
5EN ; 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
31COPAY ; - 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
46LAST ; - close event, update billing clock
47 S IBWHER=23,IBEVCLD=IBDT D EVCLOSE^IBAUTL3,CLUPD^IBAUTL3,CLOCKCL^IBAUTL3:IBCLCT>364
48END Q
49 ;
50 ;
51UNFLAG ; 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 ;
61OPT(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)
69OPTQ Q
Note: See TracBrowser for help on using the repository browser.