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

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

initial load of WorldVistAEHR

File size: 4.0 KB
RevLine 
[613]1IBECEAU1 ;ALB/CPM - Cancel/Edit/Add... Clock Utilities ; 12-MAR-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**57**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CLSTR(DFN,DATE) ; Find the billing clock in effect on DATE.
6 ; Input: DFN -- Pointer to the patient in file #2
7 ; DATE -- The date which is covered by the clock
8 ; Output: IBCLDA -- Pointer to the clock in file #351
9 ; (or null if there is none)
10 ; IBCLST -- Zeroth node of clock pointed to by
11 ; IBCLDA [OPTIONAL]
12 N X,Y
13 K IBCLST S IBCLDA=""
14 I '$G(DATE)!'$G(DFN) G CLSTRQ
15 S X="" F S X=$O(^IBE(351,"AIVDT",DFN,X)) Q:'X S IBCLDA=0 F S IBCLDA=$O(^IBE(351,"AIVDT",DFN,X,IBCLDA)) Q:'IBCLDA S Y=$G(^IBE(351,IBCLDA,0)) I Y,$P(Y,"^",4)'=3,$P(Y,"^",3)'>DATE S IBCLST=Y G CLSTRQ
16CLSTRQ Q
17 ;
18CLDSP(X,NAM) ; Display Billing Clock data for NAM.
19 ; Input: X -- Zeroth node of clock in file #351
20 ; NAM -- Patient name^short id^long id
21 I '$G(X)!($G(NAM)="") G CLDSPQ
22 W !!,"Means Test Billing Clock information for ",$P(NAM,"^")," (",$P(NAM,"^",3),")"
23 W !,$TR($J("",80)," ","-")
24 W !?2,"Clock Start Date: ",$$DAT1^IBOUTL($P(X,"^",3)),?42,"Clock End Date: ",$S($P(X,"^",10):$$DAT1^IBOUTL($P(X,"^",10)),1:"N/A")
25 W !?6,"Clock Status: ",$S($P(X,"^",4)=1:"CURRENT",$P(X,"^",4)=2:"CLOSED",1:"UNKNOWN"),?42,"Inpatient Days: ",+$P(X,"^",9)
26 W !!?2,"Medicare Deductible Co-payments:"
27 W !?15,"1st 90 days: $",+$P(X,"^",5),?45,"3rd 90 days: $",+$P(X,"^",7)
28 W !?15,"2nd 90 days: $",+$P(X,"^",6),?45,"4th 90 days: $",+$P(X,"^",8)
29 W !,$TR($J("",80)," ","-")
30CLDSPQ Q
31 ;
32CLINP(BEG,DIF,IBCLDA) ; Update Billing Clock Inpatient Days
33 ; Input: BEG -- Existing number of inpatient days
34 ; DIF -- Days to add to clock (could be negative)
35 ; IBCLDA -- Pointer to clock in file #351
36 N DAYS,DIR,DIRUT,DUOUT,DTOUT,DIE,DA,DR,I,IBF
37 I $G(BEG)=""!'$G(DIF)!'$G(IBCLDA) G CLINPQ1
38 S DAYS=BEG+DIF
39 I DAYS<0!(DAYS>365) W !!,"Can't update the clock to reflect ",DAYS," inpatient days.",!,"Please review this patient's clock and use the Clock Maintenance option",!,"to make any changes, if necessary." G CLINPQ1
40 W ! S DIR(0)="Y",DIR("?")="Enter 'Y' or 'YES' to update the clock, or 'N', 'NO', or '^' to stop.",DIR("A")="Update the number of inpatient days from "_BEG_" to "_DAYS D ^DIR
41 I 'Y!($D(DIRUT))!($D(DUOUT)) W !,"The billing clock has not been updated." G CLINPQ
42 S DIE="^IBE(351,",DA=IBCLDA,DR=".09////"_DAYS_";13////"_DUZ_";14///NOW" D ^DIE
43 W !,"The clock has been updated."
44CLINPQ S IBF=0 F I=90,180,270 I BEG'>I,DAYS>I S IBF=1 Q
45 I IBF W !!,*7," ** Please review to see if this patient requires a new copay charge. **"
46CLINPQ1 Q
47 ;
48CLAMT(STR,AMT,IBCLDA) ; Update Billing Clock Medicare Deductible co-payments
49 ; Input: STR -- Zeroth node of clock in file #351
50 ; AMT -- Dollar Amt to add to clock (could be negative)
51 ; IBCLDA -- Pointer to clock in file #351
52 N DAYS,DIR,DIRUT,DUOUT,DTOUT,DIE,DA,DR,IBMED,IBCLDT,NEWAMT,PTR
53 I $G(STR)=""!'$G(AMT)!'$G(IBCLDA) G CLAMTQ
54 S DAYS=+$P(STR,"^",9),PTR=$S(DAYS<91:5,DAYS<181:6,DAYS<271:7,1:8)
55 S IBCLDT=+$P(STR,"^",3) D DED^IBAUTL3
56 S NEWAMT=+$P(STR,"^",PTR)+AMT
57 I NEWAMT<0 W !!,"Can't update the clock to reflect a copayment of -$",-NEWAMT,".",!,"Please review this patient's clock and use the Clock Maintenance option",!,"to make any changes, if necessary." G CLAMTQ
58 I NEWAMT>IBMED W !!,"Note that the effective Medicare Deductible for this billing clock is $",IBMED,".",!,"Please note that $",NEWAMT," is beyond this limit."
59 W ! S DIR(0)="Y",DIR("?")="Enter 'Y' or 'YES' to update the clock, or 'N', 'NO', or '^' to stop.",DIR("A")="Update the "_$$INPT^IBECEAU(DAYS)_" 90 days copayment from $"_+$P(STR,"^",PTR)_" to $"_NEWAMT D ^DIR
60 I 'Y!($D(DIRUT))!($D(DUOUT)) W !,"The billing clock has not been updated." G CLAMTQ
61 S DIE="^IBE(351,",DA=IBCLDA,DR=".0"_PTR_"////"_NEWAMT_";13////"_DUZ_";14///NOW" D ^DIE
62 W !,"The clock has been updated."
63CLAMTQ Q
Note: See TracBrowser for help on using the repository browser.