IBECEAU.m

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