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

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1IBECEA21 ;ALB/CPM-Cancel/Edit/Add... Edit Prompts;19-APR-93
2 ;;2.0;INTEGRATED BILLING;**7,57,167,183,202,312**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Issue appropriate prompts for each charge type. If the charge
6 ; being edited has not been billed, handle that charge before
7 ; returning to IBECEA2.
8 ;
9 N IBSTOPDA,IBTYPE,IBGMT
10 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
11 S IBGMT=0
12 ;
13 ; Handle Outpatient Charges
14 I IBXA=4 D G END
15 .S (IBFR,IBTO,IBDT)=$P(IBND,"^",14),IBUNIT=IBUNITP
16 .W !,"Re-calculating the OPT copay charge for ",$$DAT1^IBOUTL(IBFR)," ..."
17 .;
18 .; need to look up stop info to populate IBTYPE *167
19 .S IBSTOPDA=$S($P($P(IBND,"^",4),":")=350:$P(IBND,"^",20),1:$$GETSC^IBEMTSCU($P(IBND,"^",4),$P(IBND,"^",17)))
20 .S IBTYPE=$S(IBSTOPDA>0:$P($G(^IBE(352.5,+$G(IBSTOPDA),0)),"^",3),1:1)
21 .;
22 .S IBX="O" D TYPE^IBAUTL2 Q:IBY<0 W " $",IBCHG
23 .I 'IBH,IBCHG=IBCHGP W !,"This equals the billed amount - this charge cannot be edited." S IBY=-1 Q
24 .I IBCHG=IBCHGP W !,"This charge is ready to be billed." D PASS^IBECEA22 S IBY=-1 Q
25 .I IBH D UPCHG^IBECEA22(IBCHG) S IBY=-1 Q
26 .S IBCRES=$O(^IBE(350.3,"B","MT CHARGE EDITED",0)) S:'IBCRES IBCRES=19
27 .W !!,"The original charge will be cancelled and re-billed for $",IBCHG,"."
28 ;
29 ; Handle Pharmacy Copay Charges
30 I IBXA=5 D G END
31 .D UNIT^IBECEAU2(IBUNITP) Q:IBY<0
32 .I 'IBH,IBUNIT=IBUNITP W !!,"No change was made!" S IBY=-1 Q
33 .I IBH D UPCHG^IBECEA22(IBCHG,IBUNIT) S IBY=-1 Q
34 .W !!,"The original charge will be cancelled and re-billed for $",$J(IBCHG,"",2),"."
35 ;
36 ; Handle all Inpatient Charges
37 S IBFRP=+$P(IBND,"^",14),IBTOP=+$P(IBND,"^",15),IBLIM=$S(IBXA=3:DT,1:$$FMADD^XLFDT(DT,-1))
38 S IBGMT=$$ISGMTPT^IBAGMT(DFN,IBFRP) ;Check GMT Copayment Status
39 D CLSTR^IBECEAU1(DFN,IBFRP)
40 I 'IBCLDA W !!,"I cannot find a billing clock that was effective on ",$$DAT1^IBOUTL(IBFRP),"!",!,"Please adjust this patient's billing clocks before editing this charge." S IBY=-1 Q
41 D CLDATA^IBAUTL3,DED^IBAUTL3 G:IBY<0 END
42 ;For GMT Patients reduce Medicare Deductible to 20%
43 I IBGMT>0 S IBMED=$$REDUCE^IBAGMT(IBMED) W !,"Medicare Deductible reduced due to GMT Copayment Status."
44 S:IBXA=2 IBBS=$O(^DGCR(399.1,"AC",IBATYP,0))
45 I IBXA=2,$P($G(^IBE(350.1,IBATYP,0)),"^",8)'["NHCU",IBCLDAY>90,IBCHGP'>IBCLDOL S IBMED=IBMED/2
46 I IBXA=1,IBCLDAY>90 D MED^IBECEA34 G:IBY<0 END
47 W !!," ** ",$S($P(IBCLST,"^",4)=1:"Active",1:"Closed")," Billing Clock **"
48 W !?2,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY," ",$$INPT^IBECEAU(IBCLDAY)," 90 days: $",IBCLDOL,!
49 S:IBXA=3 IBDAYP=IBCLDAY-IBUNITP
50 I IBXA=1!(IBXA=2) S IBDOLP=IBCLDOL-IBCHGP S:IBDOLP<0 IBDOLP=0
51 ;
52 ; - ask for 'Bill From' date
53FR D FR^IBECEAU2(IBFRP) G:IBY<0 END
54 I +IBSWINFO,(IBFR+1)>$P(IBSWINFO,"^",2) D G FR ;IB*2.0*312
55 .W !!,"The 'Bill From' date cannot be on or AFTER "
56 .W "the PFSS Effective Date: ",$$FMTE^XLFDT($P(IBSWINFO,"^",2))
57 ;
58 I IBFR<IBCLDT W !!,"The 'Bill From' date cannot preceed the Billing Clock Begin Date.",! G FR
59 S IBGMTR=0,IBGMT=$$ISGMTPT^IBAGMT(DFN,IBFR) ; GMT Status may change
60 I IBXA=3 S IBDT=IBFR D COST^IBAUTL2 S:IBGMT>0 IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) I 'IBCHG W !!,"Unable to determine the per diem rate. Please check your rate table." S IBY=-1 G END
61 I IBXA=2 S IBDT=IBFR D COPAY^IBAUTL2 G:IBY<0 END S:IBGMT>0 IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) I IBCHG+IBDOLP<IBMED W *7," ($",IBCHG,"/day)" W:IBGMTR " GMT Rate" G TO
62 I IBXA=2,IBCHG=IBCHGP D CTBB^IBECEAU3 W !!,"No change was made!" S IBY=-1 G END
63 ;
64 ; - ask for 'Bill To' date
65TO D TO^IBECEAU2(IBTOP) G:IBY<0 END
66 I +IBSWINFO,(IBTO+1)>$P(IBSWINFO,"^",2) D G TO ;IB*2.0*312
67 .W !!,"The 'Bill To' date cannot be on or AFTER "
68 .W "the PFSS Effective Date: ",$$FMTE^XLFDT($P(IBSWINFO,"^",2))
69 ;
70 I $P(IBCLST,"^",10),IBTO>$P(IBCLST,"^",10) W !!,"The 'Bill To' date cannot exceed the Billing Clock End Date (",$$DAT1^IBOUTL($P(IBCLST,"^",10)),")." G TO
71 S IBUNIT=$$FMDIFF^XLFDT(IBTO,IBFR)
72 I $$FMDIFF^XLFDT(IBTOP,IBFRP)<IBUNITP!(IBFR=IBTO) S IBUNIT=IBUNIT+1
73 I IBTO'=IBFR,IBXA>0,IBXA<4,$$ISGMTPT^IBAGMT(DFN,IBTO)'=$$ISGMTPT^IBAGMT(DFN,IBFR) W !!,"The patient changed GMT Copayment status during the specified period!",! G TO
74 I IBXA>1 D G END
75 . S IBCHG=IBUNIT*IBCHG S:IBXA=2 IBCHG=$S(IBDOLP+IBCHG>IBMED:IBMED-IBDOLP,1:IBCHG)
76 . I IBCHG=IBCHGP D CTBB^IBECEAU3 W !!,"No change was made!" S IBY=-1 Q
77 . S:IBXA=2 IBDOLA=IBDOLP+IBCHG,IBDAYA=0 S:IBXA=3 IBDAYA=IBDAYP+IBUNIT,IBDOLA=0
78 . W !!,"New charge to be billed" W:IBGMTR "(GMT Rate)" W ": $",$J(IBCHG,"",2),!
79 . I IBH D CHCL^IBECEA22
80 ;
81 ; - ask for 'Fee Amount'
82 S IBCLDOLO=IBCLDOL,IBCLDOL=IBCLDOL-IBCHGP S:IBCLDOL<0 IBCLDOL=0
83 I IBGMT>0 S IBGMTR=1 W !,"The patient has GMT Copayment Status! GMT rate must be applied.",!
84 D FEE^IBECEAU2(IBCHGP) G:IBY<0 END
85 I IBCHG=IBCHGP W !!,"No change was made!" S IBY=-1 G END
86 S IBCLDOL=IBCLDOLO,IBDOLA=IBDOLP+IBCHG,IBDAYA=0
87 I IBH D CHCL^IBECEA22
88 ;
89END Q
Note: See TracBrowser for help on using the repository browser.