IBECEAU ;ALB/CPM - Cancel/Edit/Add... Utilities ; 11-MAR-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
CHECK(TALK) ; Retrieve the institution and MAS Service pointer.
; Input: TALK -- 1 : do i/o (writes)
; 0 : no i/o
N IBY,Y S (IBY,Y)=1
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!",!
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!",!
Q IBY>0
;
PAUSE ; Go to end of page to pause.
N DIR,DIRUT,DUOUT,DTOUT,X,Y
W ! F Y=$Y:1:21 W !
S DIR("A")="Press RETURN to process the next charge or to return to the list"
S DIR(0)="E" D ^DIR K DIR
Q
;
INPT(DAYS) ; Return a description for Billing Clock days.
; Input: DAYS -- Number of days in a billing clock
; Output: "1st", "2nd", "3rd", "4th"
Q $S(DAYS>270:"4th",DAYS>180:"3rd",DAYS>90:"2nd",1:"1st")
;
LAST(PAR) ; Find last action filed for any parent action.
; Input: PAR -- Parent IB Action
; Output: Last action filed for parent (or parent if none)
N IBL,IBLDT,IBLAST
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
Q $S(IBLAST:IBLAST,1:PAR)
;
BFO(DFN,DATE) ; Patient Billed For OPT Copay on a specified date?
; Input: DFN -- Pointer to the patient in file #2
; DATE -- Date of the Outpatient Visit
; Output: 0 -- Not billed the OPT copay on the visit date
; >0 -- Pointer to charge in file #350 that was billed
N IBATYP,IBATYPN,IBL,IBND,IBN,Y
I '$G(DFN)!'$G(DATE) G BFOQ
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
.S IBL=$$LAST(+$P($G(^IB(IBN,0)),"^",9)),IBND=$G(^IB(IBL,0))
.S IBATYP=$G(^IBE(350.1,+$P(IBND,"^",3),0))
.S IBATYPN=$G(^IBE(350.1,+$P(IBATYP,"^",9),0))
BFOQ Q +$G(Y)
;
CNP(DFN,DATE) ; Did the patient have a C&P Exam on a specified date?
; Input: DFN -- Pointer to the patient in file #2
; DATE -- Date of the Outpatient Visit
; Output: 0 -- Patient did not have a C&P Exam on the visit date
; 1 -- Patient had a C&P Exam on the visit date
N I,IBD,IBSD,Y
I '$G(DFN)!'$G(DATE) G CNPQ
; - check scheduled appointments
S IBD=DATE F S IBD=$O(^DPT(DFN,"S",IBD)) Q:IBD=""!(IBD>(DATE+.9999)) S IBSD=$G(^(IBD,0)) I IBSD,$P(IBSD,"^",16)=1,$P($$STATUS^SDAM1(DFN,IBD,+IBSD,IBSD),";")<3 S Y=1 G CNPQ
; - check stop codes
S IBD=$G(^SDV("ADT",DFN,DATE)) G:'IBD CNPQ
S I=0 F S I=$O(^SDV(IBD,"CS",I)) Q:'I I $P($G(^(I,0)),"^",5)=1 S Y=1 Q
CNPQ Q +$G(Y)
;
HDR(OPT) ; Display the header for an action
; Input: OPT -- Action Header
N ADD,HDR S ADD=OPT="A D D"
D CLEAR^VALM1 S IBY=1,HDR=OPT_" A C H A R G E"
I 'ADD S IBIDX=$G(^TMP("IBACMIDX",$J,IBNBR)),IBN=+$P(IBIDX,"^",4),IBND=$G(^IB(IBN,0))
W !?(80-$L(HDR)\2),HDR W:'ADD !?29,"Processing Charge #",IBNBR
W !,$$LINE,!?3,"Name: ",$P(IBNAM,"^") W:'ADD ?41,"Type: ",$P(IBIDX,"^",3)
I ADD W ?41,"** " W:'IBCLDA "NO " W "ACTIVE BILLING CLOCK **"
W !?5,"ID: ",$P(IBNAM,"^",2) W:'ADD ?42,"Amt:",$P(IBIDX,"^",5)," (",$P(IBIDX,"^",6),")"
I ADD,IBCLDA W ?44,"Clock Begin Date: ",$$DAT1^IBOUTL(IBCLDT)
W !,$$LINE,!
Q
;
LINE() ; Write a line.
Q $TR($J("",80)," ","-")
;
CLOCK(IBDOL,IBDAYPR,IBDAY) ; Display and update clock data.
; Input: IBDOL -- Dollar amount to add or subtract
; IBDAYPR -- Existing number of inpatient days
; IBDAY -- Inpatient days to add or subtract
; Also assumes that IBCLST,IBNAM, IBCLDA, and IBXA are defined.
D CLDSP^IBECEAU1(IBCLST,IBNAM) I $P(IBCLST,"^",4)'=1 W !,"** Please note that an active billing clock was not selected for updating **"
I IBXA=1!(IBXA=2) D CLAMT^IBECEAU1(IBCLST,IBDOL,IBCLDA)
I IBXA=3 D CLINP^IBECEAU1(IBDAYPR,IBDAY,IBCLDA)
Q
IBECEAU ;ALB/CPM - Cancel/Edit/Add... Utilities ; 11-MAR-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
CHECK(TALK) ; Retrieve the institution and MAS Service pointer.
+1 ; Input: TALK -- 1 : do i/o (writes)
+2 ; 0 : no i/o
+3 NEW IBY,Y
SET (IBY,Y)=1
+4 DO SITE^IBAUTL
IF Y<1
SET IBY=Y
IF $GET(TALK)
WRITE !!,"You must define your facility in the IB SITE PARAMETER file before proceeding!",!
+5 IF IBY>0
DO SERV^IBAUTL2
IF IBY<1
IF $GET(TALK)
WRITE !!,"You must define the MAS Service Pointer in the IB SITE PARAMETER file",!,"before proceeding!",!
+6 QUIT IBY>0
+7 ;
PAUSE ; Go to end of page to pause.
+1 NEW DIR,DIRUT,DUOUT,DTOUT,X,Y
+2 WRITE !
FOR Y=$Y:1:21
WRITE !
+3 SET DIR("A")="Press RETURN to process the next charge or to return to the list"
+4 SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 QUIT
+6 ;
INPT(DAYS) ; Return a description for Billing Clock days.
+1 ; Input: DAYS -- Number of days in a billing clock
+2 ; Output: "1st", "2nd", "3rd", "4th"
+3 QUIT $SELECT(DAYS>270:"4th",DAYS>180:"3rd",DAYS>90:"2nd",1:"1st")
+4 ;
LAST(PAR) ; Find last action filed for any parent action.
+1 ; Input: PAR -- Parent IB Action
+2 ; Output: Last action filed for parent (or parent if none)
+3 NEW IBL,IBLDT,IBLAST
+4 SET IBLAST=""
SET IBLDT=$ORDER(^IB("APDT",PAR,""))
IF +IBLDT
SET IBL=0
FOR
SET IBL=$ORDER(^IB("APDT",PAR,IBLDT,IBL))
IF 'IBL
QUIT
SET IBLAST=IBL
+5 QUIT $SELECT(IBLAST:IBLAST,1:PAR)
+6 ;
BFO(DFN,DATE) ; Patient Billed For OPT Copay on a specified date?
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; DATE -- Date of the Outpatient Visit
+3 ; Output: 0 -- Not billed the OPT copay on the visit date
+4 ; >0 -- Pointer to charge in file #350 that was billed
+5 NEW IBATYP,IBATYPN,IBL,IBND,IBN,Y
+6 IF '$GET(DFN)!'$GET(DATE)
GOTO BFOQ
+7 SET IBN=0
FOR
SET IBN=$ORDER(^IB("AFDT",DFN,-DATE,IBN))
IF 'IBN
QUIT
Begin DoDot:1
+8 SET IBL=$$LAST(+$PIECE($GET(^IB(IBN,0)),"^",9))
SET IBND=$GET(^IB(IBL,0))
+9 SET IBATYP=$GET(^IBE(350.1,+$PIECE(IBND,"^",3),0))
+10 SET IBATYPN=$GET(^IBE(350.1,+$PIECE(IBATYP,"^",9),0))
End DoDot:1
IF $PIECE(IBATYPN,"^",11)=4
IF "^1^3^"[("^"_$PIECE(IBATYP,"^",5)_"^")
IF "^1^2^3^4^8^20^"[("^"_+$PIECE(IBND,"^",5)_"^")
SET Y=IBL
QUIT
BFOQ QUIT +$GET(Y)
+1 ;
CNP(DFN,DATE) ; Did the patient have a C&P Exam on a specified date?
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; DATE -- Date of the Outpatient Visit
+3 ; Output: 0 -- Patient did not have a C&P Exam on the visit date
+4 ; 1 -- Patient had a C&P Exam on the visit date
+5 NEW I,IBD,IBSD,Y
+6 IF '$GET(DFN)!'$GET(DATE)
GOTO CNPQ
+7 ; - check scheduled appointments
+8 SET IBD=DATE
FOR
SET IBD=$ORDER(^DPT(DFN,"S",IBD))
IF IBD=""!(IBD>(DATE+.9999))
QUIT
SET IBSD=$GET(^(IBD,0))
IF IBSD
IF $PIECE(IBSD,"^",16)=1
IF $PIECE($$STATUS^SDAM1(DFN,IBD,+IBSD,IBSD),";")<3
SET Y=1
GOTO CNPQ
+9 ; - check stop codes
+10 SET IBD=$GET(^SDV("ADT",DFN,DATE))
IF 'IBD
GOTO CNPQ
+11 SET I=0
FOR
SET I=$ORDER(^SDV(IBD,"CS",I))
IF 'I
QUIT
IF $PIECE($GET(^(I,0)),"^",5)=1
SET Y=1
QUIT
CNPQ QUIT +$GET(Y)
+1 ;
HDR(OPT) ; Display the header for an action
+1 ; Input: OPT -- Action Header
+2 NEW ADD,HDR
SET ADD=OPT="A D D"
+3 DO CLEAR^VALM1
SET IBY=1
SET HDR=OPT_" A C H A R G E"
+4 IF 'ADD
SET IBIDX=$GET(^TMP("IBACMIDX",$JOB,IBNBR))
SET IBN=+$PIECE(IBIDX,"^",4)
SET IBND=$GET(^IB(IBN,0))
+5 WRITE !?(80-$LENGTH(HDR)\2),HDR
IF 'ADD
WRITE !?29,"Processing Charge #",IBNBR
+6 WRITE !,$$LINE,!?3,"Name: ",$PIECE(IBNAM,"^")
IF 'ADD
WRITE ?41,"Type: ",$PIECE(IBIDX,"^",3)
+7 IF ADD
WRITE ?41,"** "
IF 'IBCLDA
WRITE "NO "
WRITE "ACTIVE BILLING CLOCK **"
+8 WRITE !?5,"ID: ",$PIECE(IBNAM,"^",2)
IF 'ADD
WRITE ?42,"Amt:",$PIECE(IBIDX,"^",5)," (",$PIECE(IBIDX,"^",6),")"
+9 IF ADD
IF IBCLDA
WRITE ?44,"Clock Begin Date: ",$$DAT1^IBOUTL(IBCLDT)
+10 WRITE !,$$LINE,!
+11 QUIT
+12 ;
LINE() ; Write a line.
+1 QUIT $TRANSLATE($JUSTIFY("",80)," ","-")
+2 ;
CLOCK(IBDOL,IBDAYPR,IBDAY) ; Display and update clock data.
+1 ; Input: IBDOL -- Dollar amount to add or subtract
+2 ; IBDAYPR -- Existing number of inpatient days
+3 ; IBDAY -- Inpatient days to add or subtract
+4 ; Also assumes that IBCLST,IBNAM, IBCLDA, and IBXA are defined.
+5 DO CLDSP^IBECEAU1(IBCLST,IBNAM)
IF $PIECE(IBCLST,"^",4)'=1
WRITE !,"** Please note that an active billing clock was not selected for updating **"
+6 IF IBXA=1!(IBXA=2)
DO CLAMT^IBECEAU1(IBCLST,IBDOL,IBCLDA)
+7 IF IBXA=3
DO CLINP^IBECEAU1(IBDAYPR,IBDAY,IBCLDA)
+8 QUIT
