| [613] | 1 | IBECEA ;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 | ;
|
|---|
| 5 | EN ; Cancel/Edit/Add Patient Charges -- invoke the List Manager.
|
|---|
| 6 | K XQORS,VALMEVL
|
|---|
| 7 | EN1 ; Entrypoint to avoid killing XQORS
|
|---|
| 8 | I '$$CHECK^IBECEAU(1) G ENQ
|
|---|
| 9 | D EN^VALM("IB CHARGES")
|
|---|
| 10 | ENQ K IBSITE,IBFAC,IBSERV
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | EN1AR ; 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 | ;
|
|---|
| 20 | INIT ; 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
|
|---|
| 27 | INITQ Q
|
|---|
| 28 | ;
|
|---|
| 29 | PAT ; 'Change Patient' protocol entry action.
|
|---|
| 30 | N IBDFN S IBDFN=DFN
|
|---|
| 31 | I '$$SLPT D MSG S DFN=IBDFN G PATQ
|
|---|
| 32 | DATE ; '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"
|
|---|
| 37 | PATQ Q
|
|---|
| 38 | ;
|
|---|
| 39 | MSG ; 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 | ;
|
|---|
| 45 | HDR ; 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 | ;
|
|---|
| 51 | SLPT() ; 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 | ;
|
|---|
| 57 | SLDT() ; 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
|
|---|
| 61 | SLDTQ Q $D(DIRUT)!($D(DUOUT))
|
|---|
| 62 | ;
|
|---|
| 63 | SLRX() ; 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 | ;
|
|---|
| 68 | FNL ; 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 | ;
|
|---|
| 73 | EXIT Q
|
|---|
