IBCEPTM ;ALB/TMK - FILE EDI CLAIMS TEST MESSAGES ;01/27/05
;;2.0;INTEGRATED BILLING;**296**;21-MAR-94
Q
;
UPDTEST(IBTDA) ; Store test claim status message in file 361.4
; IBTDA = ien of the message entry for the status message in 364.2
N IBT,IBZ,IBZ0,IBZ1,IBE,IBY,IB0,IBMNUM,IBBDA,IBBILL,IB3614,DIC,X,Y,Z,DLAYGO,DO,DD,DA
;
I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock message in file 364.2
;
D UPDMSG^IBCESRV2(IBTDA,"U",0)
;
S IB0=$G(^IBA(364.2,IBTDA,0)),IBBDA=$P(IB0,U,4),IBBILL=$P(IB0,U,5)
S IBMNUM=$P(IB0,U) ; Message number
;
; esg - 5/12/05 - Update the 364.1 batch status and some other fields even though this is for a test batch
;
I IBBDA,$P($G(^IBA(364.1,+IBBDA,0)),U,2)'="A0" D
. N DA,DIE,DR
. S DA=IBBDA,DIE="^IBA(364.1,"
. S DR=".02////A0;1.06///NOW"
. I $P(IB0,U,10) S DR=DR_";1.05////"_$P(IB0,U,10)
. D ^DIE
. Q
;
; If a status message references a batch, update the message for all bills in the batch
I 'IBBDA S IBBILL(+$G(^IBA(364,+IBBILL,0)))=""
I IBBDA S IBBILL="" F S IBBILL=$O(^IBM(361.4,"C",+IBBDA,IBBILL)) Q:'IBBILL S IBBILL(IBBILL)=""
S IBBILL=0 F S IBBILL=$O(IBBILL(IBBILL)) Q:'IBBILL D
. ;
. S IB3614=IBBILL
. ; Create new entry and stuff fields
. I $D(^IBM(361.4,IB3614,2,"AC",(IBMNUM\1))) Q ; Msg already there
. S DIC(0)="L",DLAYGO=361.42,DIC("DR")=".02////"_$S($P($G(^IBE(364.3,+$P(IB0,U,2),0)),U)["REJ":"R",1:"I")_";.03////"_(IBMNUM\1),X=$$NOW^XLFDT()
. S DA(1)=IB3614,DIC="^IBM(361.4,"_DA(1)_",2,"
. K DO,DD D FILE^DICN K DIC,DO,DD,DLAYGO
. I Y'>0 Q
. S IBY=+Y
. K IBE("DIERR"),IBT
. S (IBZ,IBZ0)=0
. F S IBZ=$O(^IBA(364.2,IBTDA,2,IBZ)) Q:'IBZ S IBZ1=$G(^(IBZ,0)) Q:$E(IBZ1,1,2)="##" S IBZ0=IBZ0+1,IBT(IBZ0)=IBZ1
. D MSGLNSZ^IBCEST(.IBT)
. F Z=1:1:20 D WP^DIE(361.42,+IBY_","_+IB3614_",",1,"AK","IBT","IBE") Q:$S('$D(IBE("DIERR")):1,+IBE("DIERR")=1:$G(IBE("DIERR",1))'=110,1:1) K IBE("DIERR") ; On lock error (110), retry up to 20 times
;
D DELMSG^IBCESRV2(IBTDA)
;
UPDQ S ZTREQ="@"
Q
;
ADDTXM(IBBILL,IBBATCH,IBDATE) ; Add an entry to the transmission multiple for
; the claim. Add the claim record, if needed.
; IBBILL = array subscripted by iens of file 399
N DIC,DINUM,DLAYGO,DO,DD,DA,X,Y,IB3614,IBDA
Q:'IBBATCH!'IBDATE
S IBDA=0 F S IBDA=$O(IBBILL(IBDA)) Q:'IBDA D
. ;
. S IB3614=+$G(^IBA(364,IBDA,0))
. I '$D(^IBM(361.4,IB3614)) D ; Add the record for the claim
.. K DO,DD
.. S DIC(0)="L",DLAYGO=361.4,DIC="^IBM(361.4,",X=IB3614,DINUM=X
.. D FILE^DICN K DO,DD,DIC,DLAYGO,DINUM
.. Q:Y>0
.. S IB3614=0
. Q:'IB3614
. ;
. S DA(1)=IB3614,DIC="^IBM(361.4,"_DA(1)_",1,",X=IBDATE
. S DIC(0)="L",DLAYGO=361.41,DIC("DR")=".02////"_IBBATCH_";.03////"_DUZ_";.04////"_+$$COBN^IBCEF(IB3614)
. D FILE^DICN K DO,DD,DIC,DLAYGO
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEPTM 2790 printed Jun 11, 2024@22:13:18 Page 2
IBCEPTM ;ALB/TMK - FILE EDI CLAIMS TEST MESSAGES ;01/27/05
+1 ;;2.0;INTEGRATED BILLING;**296**;21-MAR-94
+2 QUIT
+3 ;
UPDTEST(IBTDA) ; Store test claim status message in file 361.4
+1 ; IBTDA = ien of the message entry for the status message in 364.2
+2 NEW IBT,IBZ,IBZ0,IBZ1,IBE,IBY,IB0,IBMNUM,IBBDA,IBBILL,IB3614,DIC,X,Y,Z,DLAYGO,DO,DD,DA
+3 ;
+4 ;Lock message in file 364.2
IF '$$LOCK^IBCEM(IBTDA)
GOTO UPDQ
+5 ;
+6 DO UPDMSG^IBCESRV2(IBTDA,"U",0)
+7 ;
+8 SET IB0=$GET(^IBA(364.2,IBTDA,0))
SET IBBDA=$PIECE(IB0,U,4)
SET IBBILL=$PIECE(IB0,U,5)
+9 ; Message number
SET IBMNUM=$PIECE(IB0,U)
+10 ;
+11 ; esg - 5/12/05 - Update the 364.1 batch status and some other fields even though this is for a test batch
+12 ;
+13 IF IBBDA
IF $PIECE($GET(^IBA(364.1,+IBBDA,0)),U,2)'="A0"
Begin DoDot:1
+14 NEW DA,DIE,DR
+15 SET DA=IBBDA
SET DIE="^IBA(364.1,"
+16 SET DR=".02////A0;1.06///NOW"
+17 IF $PIECE(IB0,U,10)
SET DR=DR_";1.05////"_$PIECE(IB0,U,10)
+18 DO ^DIE
+19 QUIT
End DoDot:1
+20 ;
+21 ; If a status message references a batch, update the message for all bills in the batch
+22 IF 'IBBDA
SET IBBILL(+$GET(^IBA(364,+IBBILL,0)))=""
+23 IF IBBDA
SET IBBILL=""
FOR
SET IBBILL=$ORDER(^IBM(361.4,"C",+IBBDA,IBBILL))
if 'IBBILL
QUIT
SET IBBILL(IBBILL)=""
+24 SET IBBILL=0
FOR
SET IBBILL=$ORDER(IBBILL(IBBILL))
if 'IBBILL
QUIT
Begin DoDot:1
+25 ;
+26 SET IB3614=IBBILL
+27 ; Create new entry and stuff fields
+28 ; Msg already there
IF $DATA(^IBM(361.4,IB3614,2,"AC",(IBMNUM\1)))
QUIT
+29 SET DIC(0)="L"
SET DLAYGO=361.42
SET DIC("DR")=".02////"_$SELECT($PIECE($GET(^IBE(364.3,+$PIECE(IB0,U,2),0)),U)["REJ":"R",1:"I")_";.03////"_(IBMNUM\1)
SET X=$$NOW^XLFDT()
+30 SET DA(1)=IB3614
SET DIC="^IBM(361.4,"_DA(1)_",2,"
+31 KILL DO,DD
DO FILE^DICN
KILL DIC,DO,DD,DLAYGO
+32 IF Y'>0
QUIT
+33 SET IBY=+Y
+34 KILL IBE("DIERR"),IBT
+35 SET (IBZ,IBZ0)=0
+36 FOR
SET IBZ=$ORDER(^IBA(364.2,IBTDA,2,IBZ))
if 'IBZ
QUIT
SET IBZ1=$GET(^(IBZ,0))
if $EXTRACT(IBZ1,1,2)="##"
QUIT
SET IBZ0=IBZ0+1
SET IBT(IBZ0)=IBZ1
+37 DO MSGLNSZ^IBCEST(.IBT)
+38 ; On lock error (110), retry up to 20 times
FOR Z=1:1:20
DO WP^DIE(361.42,+IBY_","_+IB3614_",",1,"AK","IBT","IBE")
if $SELECT('$DATA(IBE("DIERR"))
QUIT
KILL IBE("DIERR")
End DoDot:1
+39 ;
+40 DO DELMSG^IBCESRV2(IBTDA)
+41 ;
UPDQ SET ZTREQ="@"
+1 QUIT
+2 ;
ADDTXM(IBBILL,IBBATCH,IBDATE) ; Add an entry to the transmission multiple for
+1 ; the claim. Add the claim record, if needed.
+2 ; IBBILL = array subscripted by iens of file 399
+3 NEW DIC,DINUM,DLAYGO,DO,DD,DA,X,Y,IB3614,IBDA
+4 if 'IBBATCH!'IBDATE
QUIT
+5 SET IBDA=0
FOR
SET IBDA=$ORDER(IBBILL(IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+6 ;
+7 SET IB3614=+$GET(^IBA(364,IBDA,0))
+8 ; Add the record for the claim
IF '$DATA(^IBM(361.4,IB3614))
Begin DoDot:2
+9 KILL DO,DD
+10 SET DIC(0)="L"
SET DLAYGO=361.4
SET DIC="^IBM(361.4,"
SET X=IB3614
SET DINUM=X
+11 DO FILE^DICN
KILL DO,DD,DIC,DLAYGO,DINUM
+12 if Y>0
QUIT
+13 SET IB3614=0
End DoDot:2
+14 if 'IB3614
QUIT
+15 ;
+16 SET DA(1)=IB3614
SET DIC="^IBM(361.4,"_DA(1)_",1,"
SET X=IBDATE
+17 SET DIC(0)="L"
SET DLAYGO=361.41
SET DIC("DR")=".02////"_IBBATCH_";.03////"_DUZ_";.04////"_+$$COBN^IBCEF(IB3614)
+18 DO FILE^DICN
KILL DO,DD,DIC,DLAYGO
End DoDot:1
+19 QUIT
+20 ;
