IBCEOB4.m

IBCEOB4 ;ALB/PJH - EPAYMENTS MOVE/COPY EEOB TO NEW CLAIM ;Jun 11, 2014@17:45:06

 ;;2.0;INTEGRATED BILLING;**451,511,596**;21-MAR-1994;Build 31

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

 ;

 ;Entry point for EEOB Move

MOVE(EOBIEN,IBIFN,DUZ,MDATE,JCOM,EVENT) ;

 ;

 N DA,DIC,DIE,DIK,DR,IEN101,OBILL,X,Y

 S OBILL=$$EXTERNAL^DILFD(361.1,.01,,$P($G(^IBM(361.1,EOBIEN,0)),U))

 ;

 ;Create new MOVE/COPY HISTORY stub

 S DA(1)=EOBIEN

 S DIC="^IBM(361.1,"_DA(1)_",101,",DIC(0)="L",X=MDATE

 D FILE^DICN

 S IEN101=+Y Q:'IEN101

 ;

 ;Update detail on MOVE/COPY HISTORY

 K DA,DIE,DR,X,Y

 S DIE="^IBM(361.1,"_EOBIEN_",101,",DA=IEN101

 ;Update User, Date/Time, Comments,Move/Copy event

 S DR=".02///"_DUZ_";.03///"_JCOM_";.05///"_EVENT

 ;Update original bill number

 S DR=DR_";.04///"_OBILL

 D ^DIE

 ;

 ;Update bill number on EOB

 K DA,DIE,DR,X,Y

 S DIE="^IBM(361.1,",DA=EOBIEN,DR=".01///"_IBIFN

 D ^DIE

 ;

 ;Re-index updated EOB to correct PAYER NAME - IB*2*511

 K DA S DIK="^IBM(361.1,",DA=EOBIEN D IX^DIK

 ;

 ;Update any AR AMOUNTS DISTRIBUTION (split/edit detail)

 D FUNCTION(EOBIEN,OBILL,IBIFN)

 ;

 Q

 ;

 ;Entry point for EEOB Copy

COPY(EOBIEN,IBIFN,DUZ,MDATE,JCOM,EVENT) ;'

 ;

 N IEN,IEN1,OBILL,NEWEOB

 ;

 ;Original Claim number

 S OBILL=$$EXTERNAL^DILFD(361.1,.01,,$P($G(^IBM(361.1,EOBIEN,0)),U))

 ;

 ;Lock zero node before making inserts

 Q:'$$LOCK(0)

 ;

 ;Scan through list of new claims

 S IEN=0

 F  S IEN=$O(IBIFN(IEN)) Q:'IEN  D

 .;Create stub

 .N DA,DIC,DIE,DIK,DLAYGO,DR,IEN1,IEN101,X,Y

 .S DIC(0)="L",DIC="^IBM(361.1,",DLAYGO=361.1

 .;Use 399 ien as .01 field

 .S X=IEN

 .D FILE^DICN

 .S NEWEOB=+Y Q:'NEWEOB

 .;Lock the new entry

 .Q:'$$LOCK(NEWEOB)

 .;Copy details to new EOB (except for audit information)

 .N ARRAY

 .M ARRAY=^IBM(361.1,EOBIEN) K ARRAY(101)

 .M ^IBM(361.1,NEWEOB)=ARRAY

 .;Re-index new EOB

 .K DA,DIE,DIK,DR,IEN1,IEN101,X,Y

 .S DIK="^IBM(361.1,",DA=NEWEOB D IX^DIK

 .;Update .01 field in new EOB

 .K DA,X,Y

 .S DIE="^IBM(361.1,",DA=NEWEOB

 .S DR=".01////"_IBIFN(IEN)

 .D ^DIE

 .;Re-index updated EOB to correct PAYER NAME - IB*2*511

 .K DA,DIK,X,Y S DIK="^IBM(361.1,",DA=NEWEOB D IX^DIK

 .;

 .;Update any AR AMOUNTS DISTRIBUTION (split/edit detail)

 .D FUNCTION(NEWEOB,OBILL,IBIFN(IEN))

 .;

 .;Create stub for audit information

 .K DA,DIC,X,Y

 .S DA(1)=NEWEOB

 .S DIC="^IBM(361.1,"_DA(1)_",101,",DIC(0)="L",X=MDATE

 .D FILE^DICN

 .S IEN101=+Y Q:'IEN101

 .;

 .;Update detail on MOVE/COPY HISTORY

 .K DA,DIE,DR,X,Y

 .S DIE="^IBM(361.1,"_NEWEOB_",101,",DA=IEN101

 .;Update User, Date/Time, Comments,Event

 .S DR=".02///"_DUZ_";.03///"_JCOM_";.05///"_EVENT

 .S DR=DR_";.04///"_OBILL

 .D ^DIE

 .;

 .;Insert Other claim numbers

 .K DIC,DLAYGO,IEN1,X,Y

 .S IEN1=""

 .F  S IEN1=$O(IBIFN(IEN1)) Q:'IEN1  D

 ..;current claim excluded

 ..Q:IEN1=IEN

 ..N DA,DIC,DLAYGO,DR,X

 ..S DA(1)=IEN101,DA(2)=NEWEOB

 ..S DIC="^IBM(361.1,"_DA(2)_",101,"_DA(1)_",1,"

 ..S DIC(0)="L",X=IBIFN(IEN1)

 ..D FILE^DICN

 .;Unlock new entry

 .D UNLOCK(NEWEOB)

 ;

 ;Update original EOB audit information

 N DA,DIC,DIE,DLAYGO,DR,IEN1,IEN101,X,Y

 S DA(1)=EOBIEN

 S DIC="^IBM(361.1,"_DA(1)_",101,",DIC(0)="L",X=MDATE

 D FILE^DICN

 S IEN101=+Y Q:'IEN101

 ;

 ;Update User, Date/Time, Comments,Event

 K DA,DIC,X,Y

 S DIE="^IBM(361.1,"_EOBIEN_",101,",DA=IEN101

 S DR=".02///"_DUZ_";.03///"_JCOM_";.05///"_EVENT

 D ^DIE

 ;

 ;Insert Other claim numbers

 K DA,DIC,X,Y

 S IEN1=""

 F  S IEN1=$O(IBIFN(IEN1)) Q:'IEN1  D

 .K DA,DIC,DR,X

 .S DA(1)=IEN101,DA(2)=EOBIEN

 .S DIC="^IBM(361.1,"_DA(2)_",101,"_DA(1)_",1,"

 .S DIC(0)="L",X=IBIFN(IEN1)

 .D FILE^DICN

 ;

 ;Release zero node after inserts

 D UNLOCK(0)

 Q

 ;

REMOVE(EOBIEN,DUZ,JCOM) ;Mark EEOB as Removed - IB*2*511

 ; Timestamp

 N DA,DIC,DIE,DR,IEN101,OBILL,X,Y

 S OBILL=$$EXTERNAL^DILFD(361.1,.01,,$P($G(^IBM(361.1,EOBIEN,0)),U))

 ;

 ;Create new MOVE/COPY HISTORY stub for remove action

 S DA(1)=EOBIEN

 S DIC="^IBM(361.1,"_DA(1)_",101,",DIC(0)="L",X=$$NOW^XLFDT

 D FILE^DICN

 S IEN101=+Y Q:'IEN101

 ;

 ;Update detail on MOVE/COPY HISTORY

 N DIE,DA,DR,X,Y

 S DIE="^IBM(361.1,"_EOBIEN_",101,",DA=IEN101

 ;Update User, Date/Time, Comments, Original Bill and Remove event

 S DR=".02///"_DUZ_";.03///"_JCOM_";.04///"_OBILL_";.05///R"

 D ^DIE

 ;

 ;Mark EEOB as removed to prevent further use

 N DIE,DA,DR,X,Y

 S DIE="^IBM(361.1,",DA=EOBIEN

 ;Update EEOB REMOVED

 S DR="102///1"

 D ^DIE

 Q

 ; 

 ;Update Split/Edit history for EOB

FUNCTION(EOBIEN,ONAME,NEWIEN) ;

 N DA,DIE,DR,NEWNAME,SUB,X,Y

 ;Check for split/edit history for original claim

 S SUB=$O(^IBM(361.1,EOBIEN,8,"B",ONAME,"")) Q:'SUB

 ;New bill name

 S NEWNAME=$P($G(^DGCR(399,NEWIEN,0)),U)

 ;Update bill number in Split/Edit history

 S DA(1)=EOBIEN,DIE="^IBM(361.1,"_DA(1)_",8,",DA=SUB

 S DR=".01///"_NEWNAME_";.03///"_NEWNAME

 D ^DIE

 Q

 ;

 ;

LOCK(EOBIEN) ;Lock Original EOB

 L +^IBM(361.1,EOBIEN):5 I  Q 1

 W !,"EOB in use by another user, try later"

 Q 0

 ;

UNLOCK(EOBIEN) ;Release EOB

 L -^IBM(361.1,EOBIEN)

 Q

 ;

 ; BEGIN IB*2.0*596

RESTORE(EOBIEN) ;EP - RCDPEM5

 ; Clear EEOB REMOVED flag from previously suspensed EEOB

 ; INPUT - EEOBIEN - #361.1 IEN 

 ;

 Q:'EOBIEN

 ;

 N DIE,DA,DR,X,Y

 S DIE="^IBM(361.1,",DA=EOBIEN

 ;Update EEOB REMOVED

 S DR="102///@"

 D ^DIE

 Q

 ; END IB*2.0*596

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCEOB4   5386     printed  Feb 18, 2025@23:37:49                                                                                                                                                                                                     Page 2

IBCEOB4   ;ALB/PJH - EPAYMENTS MOVE/COPY EEOB TO NEW CLAIM ;Jun 11, 2014@17:45:06

 +1       ;;2.0;INTEGRATED BILLING;**451,511,596**;21-MAR-1994;Build 31

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

 +3       ;

 +4       ;Entry point for EEOB Move

MOVE(EOBIEN,IBIFN,DUZ,MDATE,JCOM,EVENT) ;

 +1       ;

 +2        NEW DA,DIC,DIE,DIK,DR,IEN101,OBILL,X,Y

 +3        SET OBILL=$$EXTERNAL^DILFD(361.1,.01,,$PIECE($GET(^IBM(361.1,EOBIEN,0)),U))

 +4       ;

 +5       ;Create new MOVE/COPY HISTORY stub

 +6        SET DA(1)=EOBIEN

 +7        SET DIC="^IBM(361.1,"_DA(1)_",101,"

           SET DIC(0)="L"

           SET X=MDATE

 +8        DO FILE^DICN

 +9        SET IEN101=+Y

           if 'IEN101

               QUIT 

 +10      ;

 +11      ;Update detail on MOVE/COPY HISTORY

 +12       KILL DA,DIE,DR,X,Y

 +13       SET DIE="^IBM(361.1,"_EOBIEN_",101,"

           SET DA=IEN101

 +14      ;Update User, Date/Time, Comments,Move/Copy event

 +15       SET DR=".02///"_DUZ_";.03///"_JCOM_";.05///"_EVENT

 +16      ;Update original bill number

 +17       SET DR=DR_";.04///"_OBILL

 +18       DO ^DIE

 +19      ;

 +20      ;Update bill number on EOB

 +21       KILL DA,DIE,DR,X,Y

 +22       SET DIE="^IBM(361.1,"

           SET DA=EOBIEN

           SET DR=".01///"_IBIFN

 +23       DO ^DIE

 +24      ;

 +25      ;Re-index updated EOB to correct PAYER NAME - IB*2*511

 +26       KILL DA

           SET DIK="^IBM(361.1,"

           SET DA=EOBIEN

           DO IX^DIK

 +27      ;

 +28      ;Update any AR AMOUNTS DISTRIBUTION (split/edit detail)

 +29       DO FUNCTION(EOBIEN,OBILL,IBIFN)

 +30      ;

 +31       QUIT 

 +32      ;

 +33      ;Entry point for EEOB Copy

COPY(EOBIEN,IBIFN,DUZ,MDATE,JCOM,EVENT) ;'

 +1       ;

 +2        NEW IEN,IEN1,OBILL,NEWEOB

 +3       ;

 +4       ;Original Claim number

 +5        SET OBILL=$$EXTERNAL^DILFD(361.1,.01,,$PIECE($GET(^IBM(361.1,EOBIEN,0)),U))

 +6       ;

 +7       ;Lock zero node before making inserts

 +8        if '$$LOCK(0)

               QUIT 

 +9       ;

 +10      ;Scan through list of new claims

 +11       SET IEN=0

 +12       FOR 

               SET IEN=$ORDER(IBIFN(IEN))

               if 'IEN

                   QUIT 

               Begin DoDot:1

 +13      ;Create stub

 +14               NEW DA,DIC,DIE,DIK,DLAYGO,DR,IEN1,IEN101,X,Y

 +15               SET DIC(0)="L"

                   SET DIC="^IBM(361.1,"

                   SET DLAYGO=361.1

 +16      ;Use 399 ien as .01 field

 +17               SET X=IEN

 +18               DO FILE^DICN

 +19               SET NEWEOB=+Y

                   if 'NEWEOB

                       QUIT 

 +20      ;Lock the new entry

 +21               if '$$LOCK(NEWEOB)

                       QUIT 

 +22      ;Copy details to new EOB (except for audit information)

 +23               NEW ARRAY

 +24               MERGE ARRAY=^IBM(361.1,EOBIEN)

                   KILL ARRAY(101)

 +25               MERGE ^IBM(361.1,NEWEOB)=ARRAY

 +26      ;Re-index new EOB

 +27               KILL DA,DIE,DIK,DR,IEN1,IEN101,X,Y

 +28               SET DIK="^IBM(361.1,"

                   SET DA=NEWEOB

                   DO IX^DIK

 +29      ;Update .01 field in new EOB

 +30               KILL DA,X,Y

 +31               SET DIE="^IBM(361.1,"

                   SET DA=NEWEOB

 +32               SET DR=".01////"_IBIFN(IEN)

 +33               DO ^DIE

 +34      ;Re-index updated EOB to correct PAYER NAME - IB*2*511

 +35               KILL DA,DIK,X,Y

                   SET DIK="^IBM(361.1,"

                   SET DA=NEWEOB

                   DO IX^DIK

 +36      ;

 +37      ;Update any AR AMOUNTS DISTRIBUTION (split/edit detail)

 +38               DO FUNCTION(NEWEOB,OBILL,IBIFN(IEN))

 +39      ;

 +40      ;Create stub for audit information

 +41               KILL DA,DIC,X,Y

 +42               SET DA(1)=NEWEOB

 +43               SET DIC="^IBM(361.1,"_DA(1)_",101,"

                   SET DIC(0)="L"

                   SET X=MDATE

 +44               DO FILE^DICN

 +45               SET IEN101=+Y

                   if 'IEN101

                       QUIT 

 +46      ;

 +47      ;Update detail on MOVE/COPY HISTORY

 +48               KILL DA,DIE,DR,X,Y

 +49               SET DIE="^IBM(361.1,"_NEWEOB_",101,"

                   SET DA=IEN101

 +50      ;Update User, Date/Time, Comments,Event

 +51               SET DR=".02///"_DUZ_";.03///"_JCOM_";.05///"_EVENT

 +52               SET DR=DR_";.04///"_OBILL

 +53               DO ^DIE

 +54      ;

 +55      ;Insert Other claim numbers

 +56               KILL DIC,DLAYGO,IEN1,X,Y

 +57               SET IEN1=""

 +58               FOR 

                       SET IEN1=$ORDER(IBIFN(IEN1))

                       if 'IEN1

                           QUIT 

                       Begin DoDot:2

 +59      ;current claim excluded

 +60                       if IEN1=IEN

                               QUIT 

 +61                       NEW DA,DIC,DLAYGO,DR,X

 +62                       SET DA(1)=IEN101

                           SET DA(2)=NEWEOB

 +63                       SET DIC="^IBM(361.1,"_DA(2)_",101,"_DA(1)_",1,"

 +64                       SET DIC(0)="L"

                           SET X=IBIFN(IEN1)

 +65                       DO FILE^DICN

                       End DoDot:2

 +66      ;Unlock new entry

 +67               DO UNLOCK(NEWEOB)

               End DoDot:1

 +68      ;

 +69      ;Update original EOB audit information

 +70       NEW DA,DIC,DIE,DLAYGO,DR,IEN1,IEN101,X,Y

 +71       SET DA(1)=EOBIEN

 +72       SET DIC="^IBM(361.1,"_DA(1)_",101,"

           SET DIC(0)="L"

           SET X=MDATE

 +73       DO FILE^DICN

 +74       SET IEN101=+Y

           if 'IEN101

               QUIT 

 +75      ;

 +76      ;Update User, Date/Time, Comments,Event

 +77       KILL DA,DIC,X,Y

 +78       SET DIE="^IBM(361.1,"_EOBIEN_",101,"

           SET DA=IEN101

 +79       SET DR=".02///"_DUZ_";.03///"_JCOM_";.05///"_EVENT

 +80       DO ^DIE

 +81      ;

 +82      ;Insert Other claim numbers

 +83       KILL DA,DIC,X,Y

 +84       SET IEN1=""

 +85       FOR 

               SET IEN1=$ORDER(IBIFN(IEN1))

               if 'IEN1

                   QUIT 

               Begin DoDot:1

 +86               KILL DA,DIC,DR,X

 +87               SET DA(1)=IEN101

                   SET DA(2)=EOBIEN

 +88               SET DIC="^IBM(361.1,"_DA(2)_",101,"_DA(1)_",1,"

 +89               SET DIC(0)="L"

                   SET X=IBIFN(IEN1)

 +90               DO FILE^DICN

               End DoDot:1

 +91      ;

 +92      ;Release zero node after inserts

 +93       DO UNLOCK(0)

 +94       QUIT 

 +95      ;

REMOVE(EOBIEN,DUZ,JCOM) ;Mark EEOB as Removed - IB*2*511

 +1       ; Timestamp

 +2        NEW DA,DIC,DIE,DR,IEN101,OBILL,X,Y

 +3        SET OBILL=$$EXTERNAL^DILFD(361.1,.01,,$PIECE($GET(^IBM(361.1,EOBIEN,0)),U))

 +4       ;

 +5       ;Create new MOVE/COPY HISTORY stub for remove action

 +6        SET DA(1)=EOBIEN

 +7        SET DIC="^IBM(361.1,"_DA(1)_",101,"

           SET DIC(0)="L"

           SET X=$$NOW^XLFDT

 +8        DO FILE^DICN

 +9        SET IEN101=+Y

           if 'IEN101

               QUIT 

 +10      ;

 +11      ;Update detail on MOVE/COPY HISTORY

 +12       NEW DIE,DA,DR,X,Y

 +13       SET DIE="^IBM(361.1,"_EOBIEN_",101,"

           SET DA=IEN101

 +14      ;Update User, Date/Time, Comments, Original Bill and Remove event

 +15       SET DR=".02///"_DUZ_";.03///"_JCOM_";.04///"_OBILL_";.05///R"

 +16       DO ^DIE

 +17      ;

 +18      ;Mark EEOB as removed to prevent further use

 +19       NEW DIE,DA,DR,X,Y

 +20       SET DIE="^IBM(361.1,"

           SET DA=EOBIEN

 +21      ;Update EEOB REMOVED

 +22       SET DR="102///1"

 +23       DO ^DIE

 +24       QUIT 

 +25      ; 

 +26      ;Update Split/Edit history for EOB

FUNCTION(EOBIEN,ONAME,NEWIEN) ;

 +1        NEW DA,DIE,DR,NEWNAME,SUB,X,Y

 +2       ;Check for split/edit history for original claim

 +3        SET SUB=$ORDER(^IBM(361.1,EOBIEN,8,"B",ONAME,""))

           if 'SUB

               QUIT 

 +4       ;New bill name

 +5        SET NEWNAME=$PIECE($GET(^DGCR(399,NEWIEN,0)),U)

 +6       ;Update bill number in Split/Edit history

 +7        SET DA(1)=EOBIEN

           SET DIE="^IBM(361.1,"_DA(1)_",8,"

           SET DA=SUB

 +8        SET DR=".01///"_NEWNAME_";.03///"_NEWNAME

 +9        DO ^DIE

 +10       QUIT 

 +11      ;

 +12      ;

LOCK(EOBIEN) ;Lock Original EOB

 +1        LOCK +^IBM(361.1,EOBIEN):5

          IF $TEST

               QUIT 1

 +2        WRITE !,"EOB in use by another user, try later"

 +3        QUIT 0

 +4       ;

UNLOCK(EOBIEN) ;Release EOB

 +1        LOCK -^IBM(361.1,EOBIEN)

 +2        QUIT 

 +3       ;

 +4       ; BEGIN IB*2.0*596

RESTORE(EOBIEN) ;EP - RCDPEM5

 +1       ; Clear EEOB REMOVED flag from previously suspensed EEOB

 +2       ; INPUT - EEOBIEN - #361.1 IEN 

 +3       ;

 +4        if 'EOBIEN

               QUIT 

 +5       ;

 +6        NEW DIE,DA,DR,X,Y

 +7        SET DIE="^IBM(361.1,"

           SET DA=EOBIEN

 +8       ;Update EEOB REMOVED

 +9        SET DR="102///@"

 +10       DO ^DIE

 +11       QUIT 

 +12      ; END IB*2.0*596