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

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

initial load of WorldVistAEHR

File size: 4.0 KB
RevLine 
[613]1IBECEAU ;ALB/CPM - Cancel/Edit/Add... Utilities ;11-MAR-93
2 ;;2.0;INTEGRATED BILLING;**91,249**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CHECK(TALK) ; Retrieve the institution and MAS Service pointer.
6 ; Input: TALK -- 1 : do i/o (writes)
7 ; 0 : no i/o
8 N IBY,Y S (IBY,Y)=1
9 D SITE^IBAUTL I Y<1 S IBY=Y W:$G(TALK) !!,"You must define your facility in the IB SITE PARAMETER file before proceeding!",!
10 I IBY>0 D SERV^IBAUTL2 I IBY<1 W:$G(TALK) !!,"You must define the MAS Service Pointer in the IB SITE PARAMETER file",!,"before proceeding!",!
11 Q IBY>0
12 ;
13PAUSE ; Go to end of page to pause.
14 N DIR,DIRUT,DUOUT,DTOUT,X,Y
15 W ! F Y=$Y:1:21 W !
16 S DIR("A")="Press RETURN to process the next charge or to return to the list"
17 S DIR(0)="E" D ^DIR K DIR
18 Q
19 ;
20INPT(DAYS) ; Return a description for Billing Clock days.
21 ; Input: DAYS -- Number of days in a billing clock
22 ; Output: "1st", "2nd", "3rd", "4th"
23 Q $S(DAYS>270:"4th",DAYS>180:"3rd",DAYS>90:"2nd",1:"1st")
24 ;
25LAST(PAR) ; Find last action filed for any parent action.
26 ; Input: PAR -- Parent IB Action
27 ; Output: Last action filed for parent (or parent if none)
28 N IBL,IBLDT,IBLAST
29 S IBLAST="",IBLDT=$O(^IB("APDT",PAR,"")) I +IBLDT S IBL=0 F S IBL=$O(^IB("APDT",PAR,IBLDT,IBL)) Q:'IBL S IBLAST=IBL
30 Q $S(IBLAST:IBLAST,1:PAR)
31 ;
32BFO(DFN,DATE) ; Patient Billed For OPT Copay on a specified date?
33 ; Input: DFN -- Pointer to the patient in file #2
34 ; DATE -- Date of the Outpatient Visit
35 ; Output: 0 -- Not billed the OPT copay on the visit date
36 ; >0 -- Pointer to charge in file #350 that was billed
37 N IBATYP,IBATYPN,IBL,IBND,IBN,Y
38 I '$G(DFN)!'$G(DATE) G BFOQ
39 S IBN=0 F S IBN=$O(^IB("AFDT",DFN,-DATE,IBN)) Q:'IBN D I $P(IBATYPN,"^",11)=4,"^1^3^"[("^"_$P(IBATYP,"^",5)_"^"),"^1^2^3^4^8^20^"[("^"_+$P(IBND,"^",5)_"^") S Y=IBL Q
40 .S IBL=$$LAST(+$P($G(^IB(IBN,0)),"^",9)),IBND=$G(^IB(IBL,0))
41 .S IBATYP=$G(^IBE(350.1,+$P(IBND,"^",3),0))
42 .S IBATYPN=$G(^IBE(350.1,+$P(IBATYP,"^",9),0))
43BFOQ Q +$G(Y)
44 ;
45CNP(DFN,DATE) ; Did the patient have a C&P Exam on a specified date?
46 ; Input: DFN -- Pointer to the patient in file #2
47 ; DATE -- Date of the Outpatient Visit
48 ; Output: 0 -- Patient did not have a C&P Exam on the visit date
49 ; 1 -- Patient had a C&P Exam on the visit date
50 N I,IBD,IBSD,Y,IBVAL,IBCBK,IBFILTER,IBCNP,Z
51 I '$G(DFN)!'$G(DATE) G CNPQ
52 ; - check appts, stop codes
53 S IBVAL("DFN")=DFN,IBVAL("BDT")=DATE,IBVAL("EDT")=DATE+.9999
54 ; Only parent appt or add/edit encounters
55 S IBFILTER=""
56 S IBCBK="I '$P(Y0,U,6),$P(Y0,U,8)<3 N Z S Z=$P(Y0,U,8) I $S(Z=1:$P(Y0,U,10)=1&($P(Y0,U,12)<3),Z=2:$P(Y0,U,10)=1,1:0) S (IBCNP,SDSTOP)=1"
57 S IBCNP=0
58 D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
59 I IBCNP S Y=1
60CNPQ Q +$G(Y)
61 ;
62HDR(OPT) ; Display the header for an action
63 ; Input: OPT -- Action Header
64 N ADD,HDR S ADD=OPT="A D D"
65 D CLEAR^VALM1 S IBY=1,HDR=OPT_" A C H A R G E"
66 I 'ADD S IBIDX=$G(^TMP("IBACMIDX",$J,IBNBR)),IBN=+$P(IBIDX,"^",4),IBND=$G(^IB(IBN,0))
67 W !?(80-$L(HDR)\2),HDR W:'ADD !?29,"Processing Charge #",IBNBR
68 W !,$$LINE,!?3,"Name: ",$P(IBNAM,"^") W:'ADD ?41,"Type: ",$P(IBIDX,"^",3)
69 I ADD W ?41,"** " W:'IBCLDA "NO " W "ACTIVE BILLING CLOCK **"
70 W !?5,"ID: ",$P(IBNAM,"^",2) W:'ADD ?42,"Amt:",$P(IBIDX,"^",5)," (",$P(IBIDX,"^",6),")"
71 I ADD,IBCLDA W ?44,"Clock Begin Date: ",$$DAT1^IBOUTL(IBCLDT)
72 W !,$$LINE,!
73 Q
74 ;
75LINE() ; Write a line.
76 Q $TR($J("",80)," ","-")
77 ;
78CLOCK(IBDOL,IBDAYPR,IBDAY) ; Display and update clock data.
79 ; Input: IBDOL -- Dollar amount to add or subtract
80 ; IBDAYPR -- Existing number of inpatient days
81 ; IBDAY -- Inpatient days to add or subtract
82 ; Also assumes that IBCLST,IBNAM, IBCLDA, and IBXA are defined.
83 D CLDSP^IBECEAU1(IBCLST,IBNAM) I $P(IBCLST,"^",4)'=1 W !,"** Please note that an active billing clock was not selected for updating **"
84 I IBXA=1!(IBXA=2) D CLAMT^IBECEAU1(IBCLST,IBDOL,IBCLDA)
85 I IBXA=3 D CLINP^IBECEAU1(IBDAYPR,IBDAY,IBCLDA)
86 Q
Note: See TracBrowser for help on using the repository browser.