IBECEA1.m

IBECEA1 ;ALB/RLW - Cancel/Edit/Add... Action Entry Points ; Sep 30, 2020@15:16:44

 ;;2.0;INTEGRATED BILLING;**15,27,45,176,312,663,630,784**;21-MAR-94;Build 8

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

PASS ; 'Pass a Charge' Entry Action (added by Jim Moore 4/30/92)

 N C,IBII,IBNOS,IBND,IBMSG,IBY,IBLINE,IBSTAT,IBAFY,IBATYP,IBHLDR,IBERROR

 N IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBNOS2,Y,IBXA,IBVSTIEN,IBEXCOPAY

 N IBATYPE,IBBLNO,IBCDCHK,IBFR,IBMHVST,IBOEEVDT,IBOENC,IBSTOPDA,Z  ; IB*2.0*784

 ;

 S VALMBCK="R" D EN^VALM2($G(XQORNOD(0)))

 I $D(VALMY) I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q

 ;

 ; Start of IB*2.0*630 changes

 N IBDUPCPY S IBDUPCPY="" ; IB*2.0*630

 S IBII="" F  S IBII=$O(VALMY(IBII)) Q:'IBII  D  Q:IBDUPCPY

 . S IBY=1,IBLINE=^TMP("IBACM",$J,IBII,0)

 . S IBNOS2=+$P(^TMP("IBACMIDX",$J,IBII),"^",4)

 . ; Check for duplicate copay

 . S IBDUPCPY=$$DUPCPYCHK^IBECEA1(IBNOS2)

 . ; If duplicate copay exists, display message

 . I IBDUPCPY D  Q

 . . D FULL^VALM1

 . . D CPYDISPLAY^IBECEA1(IBNOS2,IBDUPCPY)

 . . ; Send user back to selection prompt if duplicate copays exist

 . . S VALMBCK="R"

 . . Q

 . Q

 ; If duplicate was found, return user to Action list

 Q:IBDUPCPY

 ; End of IB*2.0*630 changes

 ;

 S IBII="" F  S IBII=$O(VALMY(IBII)) Q:'IBII  D  L -^IB(IBNOS2) D MSG

 .S IBY=1,IBLINE=^TMP("IBACM",$J,IBII,0)

 .S (IBNOS,IBNOS2)=+$P(^TMP("IBACMIDX",$J,IBII),"^",4)

 .;

 .; - perform up-front edits

 .L +^IB(IBNOS2):5 I '$T S IBMSG="was not passed - record not available, please try again" Q

 .S IBND=$G(^IB(IBNOS2,0)) I IBND="" S IBMSG="was not passed - record missing the zeroth node" Q

 .I $P(IBND,"^",12) S IBMSG="was not passed - the charge already has an AR Transaction Number" Q

 .S IBSTAT=+$P(IBND,"^",5) I $P($G(^IBE(350.21,IBSTAT,0)),"^",4) S IBMSG="was not passed - the status indicates that the charge is billed" Q

 .I $P(IBND,"^",7)'>0 S IBMSG="was not passed - there is no charge amount" Q

 .S IBATYPE=+$P(IBND,U,3)  ; IB*2.0*784

 .S IBSEQNO=$P($G(^IBE(350.1,IBATYPE,0)),"^",5) I 'IBSEQNO S IBMSG="was not passed (Bulletin will be generated)",IBY="-1^IB023" Q  ; IB*2.0*784

 .I $P($G(^IBE(350.1,IBATYPE,0)),"^",11)=6 S IBMSG="was not passed - CHAMPVA charges must be cancelled and rebilled" Q  ; IB*2.0*784

 .S IBHLDR=(IBSTAT=21)

 .; - pass charge to AR and update list

 .D ^IBR S IBY=$G(Y)

 .S IBND=$G(^IB(IBNOS2,0))

 .S (IBSTAT,Y)=$P(IBND,"^",5),C=$P($G(^DD(350,.05,0)),"^",2) D Y^DIQ

 .S IBLINE=$$SETSTR^VALM1(Y,IBLINE,+$P(VALMDDF("STATUS"),"^",2),+$P(VALMDDF("STATUS"),"^",3))

 .S IBBLNO=$P(IBND,U,11)  ; IB*2.0*784

 .S IBLINE=$$SETSTR^VALM1($P(IBBLNO,"-",2),IBLINE,+$P(VALMDDF("BILL#"),"^",2),+$P(VALMDDF("BILL#"),"^",3))  ; IB*2.0*784

 .S ^TMP("IBACM",$J,IBII,0)=IBLINE

 .S IBMSG=$S(+IBY=-1:"was not passed -",IBSTAT=8:"has now been placed ON HOLD",1:"has now been passed")

 .S IBFR=$P(IBND,U,14) ;  IB*2.0*784

 .;IB*2.0*663 If charge successfully passed, extract the bill number and update the visit tracking database if this is a CC URGENT CARE Charge

 .I IBBLNO'="",$P($G(^IBE(350.1,IBATYPE,0)),U)["CC URGENT CARE" D  ; IB*2.0*784

 .. ; send update to the Visit Tracking file.

 .. S IBVSTIEN=$$FNDVST^IBECEA4("ON HOLD",IBFR,$P(IBND,U,2))  ; IB*2.0*784

 .. ;ADD THE NOT FOUND MESSAGE HERE?

 .. D:+IBVSTIEN UPDATE^IBECEA38(IBVSTIEN,2,IBBLNO,"",1,.IBERROR)  ; IB*2.0*784

 .; IB*2.0*784

 .S IBSTOPDA=$P(IBND,U,20),IBOEEVDT=$P(IBND,U,17),IBOENC=$P($P(IBND,U,4),";"),IBCDCHK=0

 .I $P($G(^IBE(350.1,IBATYPE,0)),U)["CC MH" S IBCDCHK=1

 .I 'IBCDCHK,$$CDCHK^IBECEAMH($$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E"),IBFR) S IBCDCHK=1

 .I 'IBCDCHK,$$ISCDELIG^IBECEAMH(IBFR) I $P(IBOENC,":")="409.68" S IBCDCHK=$$CHKST44^IBECEAMH($P(IBOENC,":",2))

 .I 'IBCDCHK,$P(IBOENC,":")=409.68 S IBCDCHK=$$OECHK^IBECEAMH($P(IBOENC,":",2),IBOEEVDT)

 .I IBBLNO'="",IBCDCHK D

 ..S IBMHVST=$O(^IBMH(351.83,"D",IBNOS2,"")) Q:'IBMHVST

 ..D MESS2B^IBECEAMH S Z=$$UPDATE^IBECEAMH(0,IBMHVST,2,IBBLNO,"",1,.IBERROR)

 ..Q

 .;

 .; - if there is no active billing clock, add one

 .;   added check for LTC, don't do this for LTC

 .S IBXA=$P($G(^IBE(350.1,IBATYPE,0)),"^",11)  ; IB*2.0*784

 .I $P(IBND,"^",14),'$P($G(^IB(IBNOS2,1)),"^",5),'$D(^IBE(351,"ACT",DFN)),IBXA'=8,IBXA'=9 D

 ..W !,"This patient has no active billing clock.  Adding a new one... "

 ..S IBCLDT=$P(IBND,"^",14)

 ..I '$D(IBSERV) D SERV^IBAUTL2

 ..D CLADD^IBAUTL3 W $S(IBY>0:"done.",1:"error (see msg)")

 .;

 .; - if charge was on hold pending review, pass data to IVM

 .I IBHLDR W !,"Passing billing data to the IVM package...  " D IVM^IBAMTV32(IBND) W "done."

 Q

 ;

MSG ; Display results message.

 Q:+$G(IBDUPCPY)>0  ; IB*2.0*630

 W !,"Charge #"_IBII_" "_IBMSG I +IBY=-1 D ^IBAERR1

 W ! S DIR(0)="E" D ^DIR K DIR W !

 Q

 ;

 ;

ADD ; 'Add a Charge' Entry Action

 I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q                   ;IB*2.0*312

 G ^IBECEA3

 ;

UPD ; 'Edit a Charge' Entry Action

 S IBAUPD=1

 ;

CAN ; 'Cancel a Charge' Entry Action

 D EN^VALM2(IBNOD(0)) I '$O(VALMY(0)) S VALMBCK="" G CANQ

 I $G(IBAUPD) I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q       ;IB*2.0*312

 ;

 S (IBNBR,IBCOMMIT)=0,VALMBCK="R"

 F  S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR  D ^@$S($G(IBAUPD):"IBECEA2",1:"IBECEA4")

 I IBCOMMIT S IBBG=VALMBG W !,"Rebuilding list of charges..." D ARRAY^IBECEA0 S VALMBG=IBBG

 K IBBG,IBNBR,IBAUPD,IBCOMMIT

CANQ Q

 ;

PAUSE ; Keep this around for awhile.

 W ! S DIR(0)="E" D ^DIR K DIR W !

 Q

 ;

 ; Beginning of IB*2.0*630 changes

DUPCPYCHK(IBIENS) ;

 ; Input: IBIENS = A single charge IEN to release or a series of charge IENs separated by commas

 ; Output: 0: No Duplicate Copay exists for the patient/date

 ;         #: IEN of the Duplicate Copay

 ; If the charge currently being released is a Copay charge, then check for duplicates

 ; All charges including ON HOLD Copay charges will be in the ACHDT x-ref

 N IBARY,IBDT,IBDUPCPY,IBIEN,IBPRTY

 ; Initialize Copay check to 0:No duplicate copay for Patient/Date

 S IBDUPCPY=0

 ; Prioritize charges in Y into IBARY array

 D IBARY(IBIENS,.IBARY)

 ; Quit if no entries in IBARY

 Q:'$D(IBARY) 0

 ; Loop through charges in IBARY by Date, Priority and IEN

 S IBDT=""

 F  S IBDT=$O(IBARY(IBDT)) Q:IBDT=""  D  Q:IBDUPCPY

 . S IBPRTY=""

 . F  S IBPRTY=$O(IBARY(IBDT,IBPRTY)) Q:'IBPRTY  D  Q:IBDUPCPY

 . . S IBIEN=""

 . . F  S IBIEN=$O(IBARY(IBDT,IBPRTY,IBIEN)) Q:'IBIEN  D  Q:IBDUPCPY

 . . . ; Check charge in IBARY against any existing charge in AR

 . . . S IBDUPCPY=$$COPAYCHK^IBAUTL8(DFN,IBIEN,1)

 . . . ; If a duplicate copay was found Quit

 . . . Q:IBDUPCPY

 . . Q

 . Q

 Q IBDUPCPY

 ;

IBARY(IBIENS,IBARY) ; Process user selection and save in IBARY ordered by priority

 ; IBARY will only contain the Copay related charges that need to be checked for duplicates.

 ; Input: Y = A single charge IEN to release or a series of charge IENs separated by commas

 ; IBARY = Array name passed by reference for return array.

 ; Output: IBARY(Date of Interest, Priority Index, IEN in "#350)=""

 N IBAT,IBDATA0,IBDT,IBINDX,IBIEN

 ; Loop through selected IENs

 F IBINDX=1:1 S IBIEN=$P(IBIENS,",",IBINDX) Q:IBIEN=""  D

 . S IBDATA0=$G(^IB(IBIEN,0))

 . Q:IBDATA0=""

 . ; Load ACTION TYPE (#.03)

 . S IBAT=$P(IBDATA0,U,3)

 . Q:IBAT=""

 . ; Load EVENT DATE (#.17)

 . S IBDT=$P(IBDATA0,U,17)

 . ; If EVENT DATE not defined, use DATE BILLED FROM (#.14)

 . I IBDT="" S IBAT=$P(IBDATA0,U,14)

 . Q:IBDT=""

 . ; Check prioritization Billing Group #1

 . I IBAT=130 S IBARY(IBDT,1,IBIEN)="" Q

 . ; Billing Group #2

 . I "^16^17^18^19^20^21^22^23^24^"[("^"_IBAT_"^") D  Q

 . . S IBARY(IBDT,2,IBIEN)=""

 . ; Billing Group #3

 . I "^45^48^133^"[("^"_IBAT_"^") D  Q

 . . S IBARY(IBDT,3,IBIEN)=""

 . ; Billing Group #4 - Outpatient Observation Copays have precedence over other copays in Billing Group #3

 . I IBAT=74 S IBARY(IBDT,4,IBIEN)="" Q

 . ; Billing Group #4 - Everything but Outpatient Observation Copays

 . I "^51^136^203^"[("^"_IBAT_"^") D  Q

 . . S IBARY(IBDT,5,IBIEN)=""

 . ; Billing Group #8

 . I "^89^92^95^105^108^"[("^"_IBAT_"^") D  Q

 . . S IBARY(IBDT,6,IBIEN)=""

 Q

 ;  

GETINFO(IBIEN) ; Display Duplicate Copay info to the user.

 ; IBIEN = Existing Copay already charged for Patient/Date

 N IBBIL,IBCSTOP,IBDATE,IBTCH,IBTEXT,IBTRN,IBATYP

 ; Get data in External format for charge being passed to AR

 S IBATYP=$$GET1^DIQ(350,IBIEN_",",".03","E") ; ACTION TYPE

 S IBATYP=$E(IBATYP,1,25)

 S IBTCH=$$GET1^DIQ(350,IBIEN_",",".07","E")  ; TOTAL CHARGE

 S IBBIL=$$GET1^DIQ(350,IBIEN_",",".11","E")  ; AR BILL NUMBER

 S IBTRN=$$GET1^DIQ(350,IBIEN_",",".12","E")  ; AR TRANSACTION NUMBER

 S IBCSTOP=$$GET1^DIQ(350,IBIEN_",",".2","E")  ; CLINIC STOP

 S IBCSTOP=$J(IBCSTOP,3)

 S IBDATE=$$GET1^DIQ(350,IBIEN_",",".17","I")  ; EVENT DATE

 I IBDATE="" S IBDATE=$$GET1^DIQ(350,IBIEN_",",".14","I") ; DATE BILLED FROM

 S IBDATE=$$FMTE^XLFDT(IBDATE,"2Z")

 S IBTEXT=IBDATE,$E(IBTEXT,10)=" "

 S IBTEXT=IBTEXT_IBATYP,$E(IBTEXT,37)=" "

 S IBTEXT=IBTEXT_IBCSTOP,$E(IBTEXT,44)="$"

 S IBTEXT=IBTEXT_$J(IBTCH,9,2),$E(IBTEXT,55)=" "

 S IBTEXT=IBTEXT_IBBIL,$E(IBTEXT,69)=" "

 S IBTEXT=IBTEXT_IBTRN

 Q IBTEXT

 ;

CPYDISPLAY(IBIEN1,IBIEN2) ; Display Duplicate Copay info to the user.

 ; Input: IBIEN1 - IEN of 1st charge - Currently in IB

 ;        IBIEN2 - IEN of 2nd charge - Could be in IB or AR

 ;

 ; Output: Info related to the duplicate charges

 ;

 Q:IBIEN1=""!(IBIEN2="")

 ; Get info to display

 N IBFLAG,IBTEXT1,IBTEXT2,IBTEXT3,IBTRANS

 S IBTEXT1=$$GETINFO^IBECEA1(IBIEN1)

 S IBTEXT2=$$GETINFO^IBECEA1(IBIEN2)

 S IBTEXT3=""

 ; Load AR TRANSACTION NUMBER of Duplicate Copay found

 S IBTRANS=$$GET1^DIQ(350,IBIEN2_",",".12","I")

 S IBFLAG=+IBTRANS

 ; For Inpatient copays, check for an existing Outpatient Observation copays

 ; and display that info if it exists.

 I $P(IBIEN2,U,2) S IBTEXT3=$$GETINFO^IBECEA1($P(IBIEN2,U,2))

 ;

 W !

 ; Display message if both charges are only in IB

 I 'IBFLAG D

 . W !,"There are ",$S(IBTEXT3'="":"three ",1:"two "),"On Hold copay charges in the selection you made for the same"

 . W !,"patient/date."

 . I IBTEXT3'="" D

 . . W !,"Also check the following Outpatient Observation charge."

 . W !!,"Date      Charge Type                Stop      Charge"

 ;

 ; Display message if the duplicate charge has already been passed AR

 I IBFLAG D

 . W !,"There are ",$S(IBTEXT3'="":"three ",1:"two "),"copay charges for this Patient/Date."

 . W !,"The first charge is currently On Hold, the second charge has already been"

 . W !,"passed to AR:"

 . I IBTEXT3'="" D

 . . W !,"Also check the following Outpatient Observation charge."

 . W !!,"Date      Charge Type                Stop      Charge  Bill          Transaction"

 ;

 ; Display info for the charges

 W !,"================================================================================"

 W !,IBTEXT1

 W !,IBTEXT2

 I IBTEXT3'="" W !,IBTEXT3

 ;

 W !!,"Please review these charges and determine what action(s) should be taken."

 D PAUSE

 Q

 ; End of IB*2.0*630 changes

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBECEA1   11097     printed  Feb 18, 2025@23:47:35                                                                                                                                                                                                    Page 2

IBECEA1   ;ALB/RLW - Cancel/Edit/Add... Action Entry Points ; Sep 30, 2020@15:16:44

 +1       ;;2.0;INTEGRATED BILLING;**15,27,45,176,312,663,630,784**;21-MAR-94;Build 8

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

PASS      ; 'Pass a Charge' Entry Action (added by Jim Moore 4/30/92)

 +1        NEW C,IBII,IBNOS,IBND,IBMSG,IBY,IBLINE,IBSTAT,IBAFY,IBATYP,IBHLDR,IBERROR

 +2        NEW IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBNOS2,Y,IBXA,IBVSTIEN,IBEXCOPAY

 +3       ; IB*2.0*784

           NEW IBATYPE,IBBLNO,IBCDCHK,IBFR,IBMHVST,IBOEEVDT,IBOENC,IBSTOPDA,Z

 +4       ;

 +5        SET VALMBCK="R"

           DO EN^VALM2($GET(XQORNOD(0)))

 +6        IF $DATA(VALMY)

               IF '$$PFSSWARN^IBBSHDWN()

                   SET VALMBCK="R"

                   QUIT 

 +7       ;

 +8       ; Start of IB*2.0*630 changes

 +9       ; IB*2.0*630

           NEW IBDUPCPY

           SET IBDUPCPY=""

 +10       SET IBII=""

           FOR 

               SET IBII=$ORDER(VALMY(IBII))

               if 'IBII

                   QUIT 

               Begin DoDot:1

 +11               SET IBY=1

                   SET IBLINE=^TMP("IBACM",$JOB,IBII,0)

 +12               SET IBNOS2=+$PIECE(^TMP("IBACMIDX",$JOB,IBII),"^",4)

 +13      ; Check for duplicate copay

 +14               SET IBDUPCPY=$$DUPCPYCHK^IBECEA1(IBNOS2)

 +15      ; If duplicate copay exists, display message

 +16               IF IBDUPCPY

                       Begin DoDot:2

 +17                       DO FULL^VALM1

 +18                       DO CPYDISPLAY^IBECEA1(IBNOS2,IBDUPCPY)

 +19      ; Send user back to selection prompt if duplicate copays exist

 +20                       SET VALMBCK="R"

 +21                       QUIT 

                       End DoDot:2

                       QUIT 

 +22               QUIT 

               End DoDot:1

               if IBDUPCPY

                   QUIT 

 +23      ; If duplicate was found, return user to Action list

 +24       if IBDUPCPY

               QUIT 

 +25      ; End of IB*2.0*630 changes

 +26      ;

 +27       SET IBII=""

           FOR 

               SET IBII=$ORDER(VALMY(IBII))

               if 'IBII

                   QUIT 

               Begin DoDot:1

 +28               SET IBY=1

                   SET IBLINE=^TMP("IBACM",$JOB,IBII,0)

 +29               SET (IBNOS,IBNOS2)=+$PIECE(^TMP("IBACMIDX",$JOB,IBII),"^",4)

 +30      ;

 +31      ; - perform up-front edits

 +32               LOCK +^IB(IBNOS2):5

                   IF '$TEST

                       SET IBMSG="was not passed - record not available, please try again"

                       QUIT 

 +33               SET IBND=$GET(^IB(IBNOS2,0))

                   IF IBND=""

                       SET IBMSG="was not passed - record missing the zeroth node"

                       QUIT 

 +34               IF $PIECE(IBND,"^",12)

                       SET IBMSG="was not passed - the charge already has an AR Transaction Number"

                       QUIT 

 +35               SET IBSTAT=+$PIECE(IBND,"^",5)

                   IF $PIECE($GET(^IBE(350.21,IBSTAT,0)),"^",4)

                       SET IBMSG="was not passed - the status indicates that the charge is billed"

                       QUIT 

 +36               IF $PIECE(IBND,"^",7)'>0

                       SET IBMSG="was not passed - there is no charge amount"

                       QUIT 

 +37      ; IB*2.0*784

                   SET IBATYPE=+$PIECE(IBND,U,3)

 +38      ; IB*2.0*784

                   SET IBSEQNO=$PIECE($GET(^IBE(350.1,IBATYPE,0)),"^",5)

                   IF 'IBSEQNO

                       SET IBMSG="was not passed (Bulletin will be generated)"

                       SET IBY="-1^IB023"

                       QUIT 

 +39      ; IB*2.0*784

                   IF $PIECE($GET(^IBE(350.1,IBATYPE,0)),"^",11)=6

                       SET IBMSG="was not passed - CHAMPVA charges must be cancelled and rebilled"

                       QUIT 

 +40               SET IBHLDR=(IBSTAT=21)

 +41      ; - pass charge to AR and update list

 +42               DO ^IBR

                   SET IBY=$GET(Y)

 +43               SET IBND=$GET(^IB(IBNOS2,0))

 +44               SET (IBSTAT,Y)=$PIECE(IBND,"^",5)

                   SET C=$PIECE($GET(^DD(350,.05,0)),"^",2)

                   DO Y^DIQ

 +45               SET IBLINE=$$SETSTR^VALM1(Y,IBLINE,+$PIECE(VALMDDF("STATUS"),"^",2),+$PIECE(VALMDDF("STATUS"),"^",3))

 +46      ; IB*2.0*784

                   SET IBBLNO=$PIECE(IBND,U,11)

 +47      ; IB*2.0*784

                   SET IBLINE=$$SETSTR^VALM1($PIECE(IBBLNO,"-",2),IBLINE,+$PIECE(VALMDDF("BILL#"),"^",2),+$PIECE(VALMDDF("BILL#"),"^",3))

 +48               SET ^TMP("IBACM",$JOB,IBII,0)=IBLINE

 +49               SET IBMSG=$SELECT(+IBY=-1:"was not passed -",IBSTAT=8:"has now been placed ON HOLD",1:"has now been passed")

 +50      ;  IB*2.0*784

                   SET IBFR=$PIECE(IBND,U,14)

 +51      ;IB*2.0*663 If charge successfully passed, extract the bill number and update the visit tracking database if this is a CC URGENT CARE Charge

 +52      ; IB*2.0*784

                   IF IBBLNO'=""

                       IF $PIECE($GET(^IBE(350.1,IBATYPE,0)),U)["CC URGENT CARE"

                           Begin DoDot:2

 +53      ; send update to the Visit Tracking file.

 +54      ; IB*2.0*784

                               SET IBVSTIEN=$$FNDVST^IBECEA4("ON HOLD",IBFR,$PIECE(IBND,U,2))

 +55      ;ADD THE NOT FOUND MESSAGE HERE?

 +56      ; IB*2.0*784

                               if +IBVSTIEN

                                   DO UPDATE^IBECEA38(IBVSTIEN,2,IBBLNO,"",1,.IBERROR)

                           End DoDot:2

 +57      ; IB*2.0*784

 +58               SET IBSTOPDA=$PIECE(IBND,U,20)

                   SET IBOEEVDT=$PIECE(IBND,U,17)

                   SET IBOENC=$PIECE($PIECE(IBND,U,4),";")

                   SET IBCDCHK=0

 +59               IF $PIECE($GET(^IBE(350.1,IBATYPE,0)),U)["CC MH"

                       SET IBCDCHK=1

 +60               IF 'IBCDCHK

                       IF $$CDCHK^IBECEAMH($$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E"),IBFR)

                           SET IBCDCHK=1

 +61               IF 'IBCDCHK

                       IF $$ISCDELIG^IBECEAMH(IBFR)

                           IF $PIECE(IBOENC,":")="409.68"

                               SET IBCDCHK=$$CHKST44^IBECEAMH($PIECE(IBOENC,":",2))

 +62               IF 'IBCDCHK

                       IF $PIECE(IBOENC,":")=409.68

                           SET IBCDCHK=$$OECHK^IBECEAMH($PIECE(IBOENC,":",2),IBOEEVDT)

 +63               IF IBBLNO'=""

                       IF IBCDCHK

                           Begin DoDot:2

 +64                           SET IBMHVST=$ORDER(^IBMH(351.83,"D",IBNOS2,""))

                               if 'IBMHVST

                                   QUIT 

 +65                           DO MESS2B^IBECEAMH

                               SET Z=$$UPDATE^IBECEAMH(0,IBMHVST,2,IBBLNO,"",1,.IBERROR)

 +66                           QUIT 

                           End DoDot:2

 +67      ;

 +68      ; - if there is no active billing clock, add one

 +69      ;   added check for LTC, don't do this for LTC

 +70      ; IB*2.0*784

                   SET IBXA=$PIECE($GET(^IBE(350.1,IBATYPE,0)),"^",11)

 +71               IF $PIECE(IBND,"^",14)

                       IF '$PIECE($GET(^IB(IBNOS2,1)),"^",5)

                           IF '$DATA(^IBE(351,"ACT",DFN))

                               IF IBXA'=8

                                   IF IBXA'=9

                                       Begin DoDot:2

 +72                                       WRITE !,"This patient has no active billing clock.  Adding a new one... "

 +73                                       SET IBCLDT=$PIECE(IBND,"^",14)

 +74                                       IF '$DATA(IBSERV)

                                               DO SERV^IBAUTL2

 +75                                       DO CLADD^IBAUTL3

                                           WRITE $SELECT(IBY>0:"done.",1:"error (see msg)")

                                       End DoDot:2

 +76      ;

 +77      ; - if charge was on hold pending review, pass data to IVM

 +78               IF IBHLDR

                       WRITE !,"Passing billing data to the IVM package...  "

                       DO IVM^IBAMTV32(IBND)

                       WRITE "done."

               End DoDot:1

               LOCK -^IB(IBNOS2)

               DO MSG

 +79       QUIT 

 +80      ;

MSG       ; Display results message.

 +1       ; IB*2.0*630

           if +$GET(IBDUPCPY)>0

               QUIT 

 +2        WRITE !,"Charge #"_IBII_" "_IBMSG

           IF +IBY=-1

               DO ^IBAERR1

 +3        WRITE !

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR

           WRITE !

 +4        QUIT 

 +5       ;

 +6       ;

ADD       ; 'Add a Charge' Entry Action

 +1       ;IB*2.0*312

           IF '$$PFSSWARN^IBBSHDWN()

               SET VALMBCK="R"

               QUIT 

 +2        GOTO ^IBECEA3

 +3       ;

UPD       ; 'Edit a Charge' Entry Action

 +1        SET IBAUPD=1

 +2       ;

CAN       ; 'Cancel a Charge' Entry Action

 +1        DO EN^VALM2(IBNOD(0))

           IF '$ORDER(VALMY(0))

               SET VALMBCK=""

               GOTO CANQ

 +2       ;IB*2.0*312

           IF $GET(IBAUPD)

               IF '$$PFSSWARN^IBBSHDWN()

                   SET VALMBCK="R"

                   QUIT 

 +3       ;

 +4        SET (IBNBR,IBCOMMIT)=0

           SET VALMBCK="R"

 +5        FOR 

               SET IBNBR=$ORDER(VALMY(IBNBR))

               if 'IBNBR

                   QUIT 

               DO ^@$SELECT($GET(IBAUPD):"IBECEA2",1:"IBECEA4")

 +6        IF IBCOMMIT

               SET IBBG=VALMBG

               WRITE !,"Rebuilding list of charges..."

               DO ARRAY^IBECEA0

               SET VALMBG=IBBG

 +7        KILL IBBG,IBNBR,IBAUPD,IBCOMMIT

CANQ       QUIT 

 +1       ;

PAUSE     ; Keep this around for awhile.

 +1        WRITE !

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR

           WRITE !

 +2        QUIT 

 +3       ;

 +4       ; Beginning of IB*2.0*630 changes

DUPCPYCHK(IBIENS) ;

 +1       ; Input: IBIENS = A single charge IEN to release or a series of charge IENs separated by commas

 +2       ; Output: 0: No Duplicate Copay exists for the patient/date

 +3       ;         #: IEN of the Duplicate Copay

 +4       ; If the charge currently being released is a Copay charge, then check for duplicates

 +5       ; All charges including ON HOLD Copay charges will be in the ACHDT x-ref

 +6        NEW IBARY,IBDT,IBDUPCPY,IBIEN,IBPRTY

 +7       ; Initialize Copay check to 0:No duplicate copay for Patient/Date

 +8        SET IBDUPCPY=0

 +9       ; Prioritize charges in Y into IBARY array

 +10       DO IBARY(IBIENS,.IBARY)

 +11      ; Quit if no entries in IBARY

 +12       if '$DATA(IBARY)

               QUIT 0

 +13      ; Loop through charges in IBARY by Date, Priority and IEN

 +14       SET IBDT=""

 +15       FOR 

               SET IBDT=$ORDER(IBARY(IBDT))

               if IBDT=""

                   QUIT 

               Begin DoDot:1

 +16               SET IBPRTY=""

 +17               FOR 

                       SET IBPRTY=$ORDER(IBARY(IBDT,IBPRTY))

                       if 'IBPRTY

                           QUIT 

                       Begin DoDot:2

 +18                       SET IBIEN=""

 +19                       FOR 

                               SET IBIEN=$ORDER(IBARY(IBDT,IBPRTY,IBIEN))

                               if 'IBIEN

                                   QUIT 

                               Begin DoDot:3

 +20      ; Check charge in IBARY against any existing charge in AR

 +21                               SET IBDUPCPY=$$COPAYCHK^IBAUTL8(DFN,IBIEN,1)

 +22      ; If a duplicate copay was found Quit

 +23                               if IBDUPCPY

                                       QUIT 

                               End DoDot:3

                               if IBDUPCPY

                                   QUIT 

 +24                       QUIT 

                       End DoDot:2

                       if IBDUPCPY

                           QUIT 

 +25               QUIT 

               End DoDot:1

               if IBDUPCPY

                   QUIT 

 +26       QUIT IBDUPCPY

 +27      ;

IBARY(IBIENS,IBARY) ; Process user selection and save in IBARY ordered by priority

 +1       ; IBARY will only contain the Copay related charges that need to be checked for duplicates.

 +2       ; Input: Y = A single charge IEN to release or a series of charge IENs separated by commas

 +3       ; IBARY = Array name passed by reference for return array.

 +4       ; Output: IBARY(Date of Interest, Priority Index, IEN in "#350)=""

 +5        NEW IBAT,IBDATA0,IBDT,IBINDX,IBIEN

 +6       ; Loop through selected IENs

 +7        FOR IBINDX=1:1

               SET IBIEN=$PIECE(IBIENS,",",IBINDX)

               if IBIEN=""

                   QUIT 

               Begin DoDot:1

 +8                SET IBDATA0=$GET(^IB(IBIEN,0))

 +9                if IBDATA0=""

                       QUIT 

 +10      ; Load ACTION TYPE (#.03)

 +11               SET IBAT=$PIECE(IBDATA0,U,3)

 +12               if IBAT=""

                       QUIT 

 +13      ; Load EVENT DATE (#.17)

 +14               SET IBDT=$PIECE(IBDATA0,U,17)

 +15      ; If EVENT DATE not defined, use DATE BILLED FROM (#.14)

 +16               IF IBDT=""

                       SET IBAT=$PIECE(IBDATA0,U,14)

 +17               if IBDT=""

                       QUIT 

 +18      ; Check prioritization Billing Group #1

 +19               IF IBAT=130

                       SET IBARY(IBDT,1,IBIEN)=""

                       QUIT 

 +20      ; Billing Group #2

 +21               IF "^16^17^18^19^20^21^22^23^24^"[("^"_IBAT_"^")

                       Begin DoDot:2

 +22                       SET IBARY(IBDT,2,IBIEN)=""

                       End DoDot:2

                       QUIT 

 +23      ; Billing Group #3

 +24               IF "^45^48^133^"[("^"_IBAT_"^")

                       Begin DoDot:2

 +25                       SET IBARY(IBDT,3,IBIEN)=""

                       End DoDot:2

                       QUIT 

 +26      ; Billing Group #4 - Outpatient Observation Copays have precedence over other copays in Billing Group #3

 +27               IF IBAT=74

                       SET IBARY(IBDT,4,IBIEN)=""

                       QUIT 

 +28      ; Billing Group #4 - Everything but Outpatient Observation Copays

 +29               IF "^51^136^203^"[("^"_IBAT_"^")

                       Begin DoDot:2

 +30                       SET IBARY(IBDT,5,IBIEN)=""

                       End DoDot:2

                       QUIT 

 +31      ; Billing Group #8

 +32               IF "^89^92^95^105^108^"[("^"_IBAT_"^")

                       Begin DoDot:2

 +33                       SET IBARY(IBDT,6,IBIEN)=""

                       End DoDot:2

                       QUIT 

               End DoDot:1

 +34       QUIT 

 +35      ;  

GETINFO(IBIEN) ; Display Duplicate Copay info to the user.

 +1       ; IBIEN = Existing Copay already charged for Patient/Date

 +2        NEW IBBIL,IBCSTOP,IBDATE,IBTCH,IBTEXT,IBTRN,IBATYP

 +3       ; Get data in External format for charge being passed to AR

 +4       ; ACTION TYPE

           SET IBATYP=$$GET1^DIQ(350,IBIEN_",",".03","E")

 +5        SET IBATYP=$EXTRACT(IBATYP,1,25)

 +6       ; TOTAL CHARGE

           SET IBTCH=$$GET1^DIQ(350,IBIEN_",",".07","E")

 +7       ; AR BILL NUMBER

           SET IBBIL=$$GET1^DIQ(350,IBIEN_",",".11","E")

 +8       ; AR TRANSACTION NUMBER

           SET IBTRN=$$GET1^DIQ(350,IBIEN_",",".12","E")

 +9       ; CLINIC STOP

           SET IBCSTOP=$$GET1^DIQ(350,IBIEN_",",".2","E")

 +10       SET IBCSTOP=$JUSTIFY(IBCSTOP,3)

 +11      ; EVENT DATE

           SET IBDATE=$$GET1^DIQ(350,IBIEN_",",".17","I")

 +12      ; DATE BILLED FROM

           IF IBDATE=""

               SET IBDATE=$$GET1^DIQ(350,IBIEN_",",".14","I")

 +13       SET IBDATE=$$FMTE^XLFDT(IBDATE,"2Z")

 +14       SET IBTEXT=IBDATE

           SET $EXTRACT(IBTEXT,10)=" "

 +15       SET IBTEXT=IBTEXT_IBATYP

           SET $EXTRACT(IBTEXT,37)=" "

 +16       SET IBTEXT=IBTEXT_IBCSTOP

           SET $EXTRACT(IBTEXT,44)="$"

 +17       SET IBTEXT=IBTEXT_$JUSTIFY(IBTCH,9,2)

           SET $EXTRACT(IBTEXT,55)=" "

 +18       SET IBTEXT=IBTEXT_IBBIL

           SET $EXTRACT(IBTEXT,69)=" "

 +19       SET IBTEXT=IBTEXT_IBTRN

 +20       QUIT IBTEXT

 +21      ;

CPYDISPLAY(IBIEN1,IBIEN2) ; Display Duplicate Copay info to the user.

 +1       ; Input: IBIEN1 - IEN of 1st charge - Currently in IB

 +2       ;        IBIEN2 - IEN of 2nd charge - Could be in IB or AR

 +3       ;

 +4       ; Output: Info related to the duplicate charges

 +5       ;

 +6        if IBIEN1=""!(IBIEN2="")

               QUIT 

 +7       ; Get info to display

 +8        NEW IBFLAG,IBTEXT1,IBTEXT2,IBTEXT3,IBTRANS

 +9        SET IBTEXT1=$$GETINFO^IBECEA1(IBIEN1)

 +10       SET IBTEXT2=$$GETINFO^IBECEA1(IBIEN2)

 +11       SET IBTEXT3=""

 +12      ; Load AR TRANSACTION NUMBER of Duplicate Copay found

 +13       SET IBTRANS=$$GET1^DIQ(350,IBIEN2_",",".12","I")

 +14       SET IBFLAG=+IBTRANS

 +15      ; For Inpatient copays, check for an existing Outpatient Observation copays

 +16      ; and display that info if it exists.

 +17       IF $PIECE(IBIEN2,U,2)

               SET IBTEXT3=$$GETINFO^IBECEA1($PIECE(IBIEN2,U,2))

 +18      ;

 +19       WRITE !

 +20      ; Display message if both charges are only in IB

 +21       IF 'IBFLAG

               Begin DoDot:1

 +22               WRITE !,"There are ",$SELECT(IBTEXT3'="":"three ",1:"two "),"On Hold copay charges in the selection you made for the same"

 +23               WRITE !,"patient/date."

 +24               IF IBTEXT3'=""

                       Begin DoDot:2

 +25                       WRITE !,"Also check the following Outpatient Observation charge."

                       End DoDot:2

 +26               WRITE !!,"Date      Charge Type                Stop      Charge"

               End DoDot:1

 +27      ;

 +28      ; Display message if the duplicate charge has already been passed AR

 +29       IF IBFLAG

               Begin DoDot:1

 +30               WRITE !,"There are ",$SELECT(IBTEXT3'="":"three ",1:"two "),"copay charges for this Patient/Date."

 +31               WRITE !,"The first charge is currently On Hold, the second charge has already been"

 +32               WRITE !,"passed to AR:"

 +33               IF IBTEXT3'=""

                       Begin DoDot:2

 +34                       WRITE !,"Also check the following Outpatient Observation charge."

                       End DoDot:2

 +35               WRITE !!,"Date      Charge Type                Stop      Charge  Bill          Transaction"

               End DoDot:1

 +36      ;

 +37      ; Display info for the charges

 +38       WRITE !,"================================================================================"

 +39       WRITE !,IBTEXT1

 +40       WRITE !,IBTEXT2

 +41       IF IBTEXT3'=""

               WRITE !,IBTEXT3

 +42      ;

 +43       WRITE !!,"Please review these charges and determine what action(s) should be taken."

 +44       DO PAUSE

 +45       QUIT 

 +46      ; End of IB*2.0*630 changes