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 ---[H[J[2J[HIBCEOB4 5386 printed Dec 13, 2024@02:11:25 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
