- IBECEA ;ALB/RLW - Cancel/Edit/Add Patient Charges ; 12-JUN-92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN ; Cancel/Edit/Add Patient Charges -- invoke the List Manager.
- I '$$CHECK^IBECEAU(1) G ENQ
- K XQORS,VALMEVL D EN^VALM("IB CHARGES")
- ENQ K IBSITE,IBFAC,IBSERV
- Q
- ;
- INIT ; List Manager (IB CHARGES) main entry point.
- S IBJOB=4,IBWHER="IBECEA",IBDUZ=DUZ
- S IBACMAR="^TMP(""IBACM"",$J)",IBACMIDX="^TMP(""IBACMIDX"",$J)",VALMIDX="^TMP(""IBCMLIDX"",$J)"
- I '$$SLPT S VALMQUIT="" D FNL G INITQ
- I $$SLDT S VALMQUIT="" D FNL G INITQ
- I $$SLRX S VALMQUIT="" D FNL G INITQ
- D ARRAY^IBECEA0
- INITQ Q
- ;
- PAT ; 'Change Patient' protocol entry action.
- N IBDFN S IBDFN=DFN
- I '$$SLPT D MSG S DFN=IBDFN G PATQ
- DATE ; 'Change Date' protocol entry action.
- N IBDT1,IBDT2,IBRXXX S IBDT1=IBABEG,IBDT2=IBAEND,IBRXXX=IBRX
- I $$SLDT D MSG S IBABEG=IBDT1,IBAEND=IBDT2 S:$D(IBDFN) DFN=IBDFN G PATQ
- I $$SLRX D MSG S IBABEG=IBDT1,IBAEND=IBDT2,IBRX=IBRXXX S:$D(IBDFN) DFN=IBDFN G PATQ
- D ARRAY^IBECEA0,HDR S VALMBCK="R"
- PATQ Q
- ;
- MSG ; Quick message display.
- N DIR,DIRUT,DUOUT,DTOUT,X,Y
- W !!,*7,"No changes were made!",!
- S DIR(0)="E" D ^DIR S VALMBCK=""
- Q
- ;
- HDR ; Build screen header.
- S IBNAM=$$PT^IBEFUNC(DFN)
- S VALMHDR(1)=$$SETSTR^VALM1($$FDATE^VALM1(IBABEG)_" THRU "_$$FDATE^VALM1(IBAEND),"Cancel/Edit/Add Charges",59,22)
- S VALMHDR(2)=$E("Patient: "_$P(IBNAM,"^"),1,25)_" "_$E(IBNAM)_$P(IBNAM,"^",3)
- Q
- ;
- SLPT() ; Select a patient.
- N DIC,X,Y
- S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC S DFN=+Y
- Q Y>0
- ;
- SLDT() ; Select Charge dates.
- N DIR,DIRUT,DUOUT,DTOUT,X,Y
- 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
- S DIR(0)="DA^"_+Y_":NOW:EX",DIR("A")=" to: ",DIR("B")=$$DAT2^IBOUTL(DT) D ^DIR S IBAEND=+Y+.999999
- SLDTQ Q $D(DIRUT)!($D(DUOUT))
- ;
- SLRX() ; Include Rx copay charges?
- N DIR,DIRUT,DUOUT,DTOUT,X,Y
- S DIR(0)="Y",DIR("A")="Include RX COPAY charges",DIR("B")="NO" D ^DIR S IBRX=Y
- Q $D(DIRUT)!($D(DUOUT))
- ;
- FNL ; List Manager (IB CHARGES) exit action.
- K:$D(IBACMAR) @IBACMAR,IBACMAR K:$D(IBACMIDX) @IBACMIDX,IBACMIDX K:$D(VALMIDX) @VALMIDX,VALMIDX
- 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
- Q
- ;
- EXIT Q
- IBECEA ;ALB/RLW - Cancel/Edit/Add Patient Charges ; 12-JUN-92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- EN ; Cancel/Edit/Add Patient Charges -- invoke the List Manager.
- +1 IF '$$CHECK^IBECEAU(1)
- GOTO ENQ
- +2 KILL XQORS,VALMEVL
- DO EN^VALM("IB CHARGES")
- ENQ KILL IBSITE,IBFAC,IBSERV
- +1 QUIT
- +2 ;
- INIT ; List Manager (IB CHARGES) main entry point.
- +1 SET IBJOB=4
- SET IBWHER="IBECEA"
- SET IBDUZ=DUZ
- +2 SET IBACMAR="^TMP(""IBACM"",$J)"
- SET IBACMIDX="^TMP(""IBACMIDX"",$J)"
- SET VALMIDX="^TMP(""IBCMLIDX"",$J)"
- +3 IF '$$SLPT
- SET VALMQUIT=""
- DO FNL
- GOTO INITQ
- +4 IF $$SLDT
- SET VALMQUIT=""
- DO FNL
- GOTO INITQ
- +5 IF $$SLRX
- SET VALMQUIT=""
- DO FNL
- GOTO INITQ
- +6 DO ARRAY^IBECEA0
- INITQ QUIT
- +1 ;
- PAT ; 'Change Patient' protocol entry action.
- +1 NEW IBDFN
- SET IBDFN=DFN
- +2 IF '$$SLPT
- DO MSG
- SET DFN=IBDFN
- GOTO PATQ
- DATE ; 'Change Date' protocol entry action.
- +1 NEW IBDT1,IBDT2,IBRXXX
- SET IBDT1=IBABEG
- SET IBDT2=IBAEND
- SET IBRXXX=IBRX
- +2 IF $$SLDT
- DO MSG
- SET IBABEG=IBDT1
- SET IBAEND=IBDT2
- IF $DATA(IBDFN)
- SET DFN=IBDFN
- GOTO PATQ
- +3 IF $$SLRX
- DO MSG
- SET IBABEG=IBDT1
- SET IBAEND=IBDT2
- SET IBRX=IBRXXX
- IF $DATA(IBDFN)
- SET DFN=IBDFN
- GOTO PATQ
- +4 DO ARRAY^IBECEA0
- DO HDR
- SET VALMBCK="R"
- PATQ QUIT
- +1 ;
- MSG ; Quick message display.
- +1 NEW DIR,DIRUT,DUOUT,DTOUT,X,Y
- +2 WRITE !!,*7,"No changes were made!",!
- +3 SET DIR(0)="E"
- DO ^DIR
- SET VALMBCK=""
- +4 QUIT
- +5 ;
- HDR ; Build screen header.
- +1 SET IBNAM=$$PT^IBEFUNC(DFN)
- +2 SET VALMHDR(1)=$$SETSTR^VALM1($$FDATE^VALM1(IBABEG)_" THRU "_$$FDATE^VALM1(IBAEND),"Cancel/Edit/Add Charges",59,22)
- +3 SET VALMHDR(2)=$EXTRACT("Patient: "_$PIECE(IBNAM,"^"),1,25)_" "_$EXTRACT(IBNAM)_$PIECE(IBNAM,"^",3)
- +4 QUIT
- +5 ;
- SLPT() ; Select a patient.
- +1 NEW DIC,X,Y
- +2 SET DIC="^DPT("
- SET DIC(0)="AEMQ"
- DO ^DIC
- SET DFN=+Y
- +3 QUIT Y>0
- +4 ;
- SLDT() ; Select Charge dates.
- +1 NEW DIR,DIRUT,DUOUT,DTOUT,X,Y
- +2 SET DIR(0)="DA^2860101:NOW:EX"
- SET DIR("A")="Search for CHARGES from: "
- SET DIR("B")=$$DAT2^IBOUTL($$FMADD^XLFDT(DT,-365))
- DO ^DIR
- SET IBABEG=+Y
- IF 'Y
- GOTO SLDTQ
- +3 SET DIR(0)="DA^"_+Y_":NOW:EX"
- SET DIR("A")=" to: "
- SET DIR("B")=$$DAT2^IBOUTL(DT)
- DO ^DIR
- SET IBAEND=+Y+.999999
- SLDTQ QUIT $DATA(DIRUT)!($DATA(DUOUT))
- +1 ;
- SLRX() ; Include Rx copay charges?
- +1 NEW DIR,DIRUT,DUOUT,DTOUT,X,Y
- +2 SET DIR(0)="Y"
- SET DIR("A")="Include RX COPAY charges"
- SET DIR("B")="NO"
- DO ^DIR
- SET IBRX=Y
- +3 QUIT $DATA(DIRUT)!($DATA(DUOUT))
- +4 ;
- FNL ; List Manager (IB CHARGES) exit action.
- +1 IF $DATA(IBACMAR)
- KILL @IBACMAR,IBACMAR
- IF $DATA(IBACMIDX)
- KILL @IBACMIDX,IBACMIDX
- IF $DATA(VALMIDX)
- KILL @VALMIDX,VALMIDX
- +2 KILL IBABEG,IBAEND,DFN,IBAT,IBAX,IBY,VA,IBRX,IBWHER,X,^TMP("IBECEA",$JOB),^TMP("IBCMLIDX",$JOB),DFN,IBSAVY,IBARTYP,IBPRNT,IBDUZ,IBJOB,IBXA,IBNOW,IBLDT,IBL,IBIL,IBNAM
- +3 QUIT
- +4 ;
- EXIT QUIT
