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

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1IBECEA ;ALB/RLW - Cancel/Edit/Add Patient Charges ;12-JUN-92
2 ;;2.0; INTEGRATED BILLING ;**199,135**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; Cancel/Edit/Add Patient Charges -- invoke the List Manager.
6 K XQORS,VALMEVL
7EN1 ; Entrypoint to avoid killing XQORS
8 I '$$CHECK^IBECEAU(1) G ENQ
9 D EN^VALM("IB CHARGES")
10ENQ K IBSITE,IBFAC,IBSERV
11 Q
12 ;
13EN1AR ; AR entry for charge maintenance
14 N DIR,X,Y
15 D EN1
16 S DIR(0)="EA",DIR("A")="PRESS RETURN TO CONTINUE. "
17 W ! D ^DIR K DIR
18 Q
19 ;
20INIT ; List Manager (IB CHARGES) main entry point.
21 S IBJOB=4,IBWHER="IBECEA",IBDUZ=DUZ
22 S IBACMAR="^TMP(""IBACM"",$J)",IBACMIDX="^TMP(""IBACMIDX"",$J)",VALMIDX="^TMP(""IBCMLIDX"",$J)"
23 I '$$SLPT S VALMQUIT="" D FNL G INITQ
24 I $$SLDT S VALMQUIT="" D FNL G INITQ
25 I $$SLRX S VALMQUIT="" D FNL G INITQ
26 D ARRAY^IBECEA0
27INITQ Q
28 ;
29PAT ; 'Change Patient' protocol entry action.
30 N IBDFN S IBDFN=DFN
31 I '$$SLPT D MSG S DFN=IBDFN G PATQ
32DATE ; 'Change Date' protocol entry action.
33 N IBDT1,IBDT2,IBRXXX S IBDT1=IBABEG,IBDT2=IBAEND,IBRXXX=IBRX
34 I $$SLDT D MSG S IBABEG=IBDT1,IBAEND=IBDT2 S:$D(IBDFN) DFN=IBDFN G PATQ
35 I $$SLRX D MSG S IBABEG=IBDT1,IBAEND=IBDT2,IBRX=IBRXXX S:$D(IBDFN) DFN=IBDFN G PATQ
36 D ARRAY^IBECEA0,HDR S VALMBCK="R"
37PATQ Q
38 ;
39MSG ; Quick message display.
40 N DIR,DIRUT,DUOUT,DTOUT,X,Y
41 W !!,*7,"No changes were made!",!
42 S DIR(0)="E" D ^DIR S VALMBCK=""
43 Q
44 ;
45HDR ; Build screen header.
46 S IBNAM=$$PT^IBEFUNC(DFN)
47 S VALMHDR(1)=$$SETSTR^VALM1($$FDATE^VALM1(IBABEG)_" THRU "_$$FDATE^VALM1(IBAEND),"Cancel/Edit/Add Charges",59,22)
48 S VALMHDR(2)=$E("Patient: "_$P(IBNAM,"^"),1,25)_" "_$E(IBNAM)_$P(IBNAM,"^",3)
49 Q
50 ;
51SLPT() ; Select a patient.
52 N DIC,X,Y
53 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
54 S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC S DFN=+Y
55 Q Y>0
56 ;
57SLDT() ; Select Charge dates.
58 N DIR,DIRUT,DUOUT,DTOUT,X,Y
59 S DIR(0)="DA^2860101:NOW:EX",DIR("A")="Search for CHARGES from: ",DIR("B")=$$DAT2^IBOUTL($$FMADD^XLFDT(DT,-365)) D ^DIR S IBABEG=+Y G:'Y SLDTQ
60 S DIR(0)="DA^"_+Y_":NOW:EX",DIR("A")=" to: ",DIR("B")=$$DAT2^IBOUTL(DT) D ^DIR S IBAEND=+Y+.999999
61SLDTQ Q $D(DIRUT)!($D(DUOUT))
62 ;
63SLRX() ; Include Rx copay charges?
64 N DIR,DIRUT,DUOUT,DTOUT,X,Y
65 S DIR(0)="Y",DIR("A")="Include RX COPAY charges",DIR("B")="NO" D ^DIR S IBRX=Y
66 Q $D(DIRUT)!($D(DUOUT))
67 ;
68FNL ; List Manager (IB CHARGES) exit action.
69 K:$D(IBACMAR) @IBACMAR,IBACMAR K:$D(IBACMIDX) @IBACMIDX,IBACMIDX K:$D(VALMIDX) @VALMIDX,VALMIDX
70 K IBABEG,IBAEND,DFN,IBAT,IBAX,IBY,VA,IBRX,IBWHER,X,^TMP("IBECEA",$J),^TMP("IBCMLIDX",$J),DFN,IBSAVY,IBARTYP,IBPRNT,IBDUZ,IBJOB,IBXA,IBNOW,IBLDT,IBL,IBIL,IBNAM
71 Q
72 ;
73EXIT Q
Note: See TracBrowser for help on using the repository browser.