Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEPTM

IBCEPTM.m

Go to the documentation of this file.
  1. IBCEPTM ;ALB/TMK - FILE EDI CLAIMS TEST MESSAGES ;01/27/05
  1. ;;2.0;INTEGRATED BILLING;**296**;21-MAR-94
  1. Q
  1. ;
  1. 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
  1. N IBT,IBZ,IBZ0,IBZ1,IBE,IBY,IB0,IBMNUM,IBBDA,IBBILL,IB3614,DIC,X,Y,Z,DLAYGO,DO,DD,DA
  1. ;
  1. I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock message in file 364.2
  1. ;
  1. D UPDMSG^IBCESRV2(IBTDA,"U",0)
  1. ;
  1. S IB0=$G(^IBA(364.2,IBTDA,0)),IBBDA=$P(IB0,U,4),IBBILL=$P(IB0,U,5)
  1. S IBMNUM=$P(IB0,U) ; Message number
  1. ;
  1. ; esg - 5/12/05 - Update the 364.1 batch status and some other fields even though this is for a test batch
  1. ;
  1. I IBBDA,$P($G(^IBA(364.1,+IBBDA,0)),U,2)'="A0" D
  1. . N DA,DIE,DR
  1. . S DA=IBBDA,DIE="^IBA(364.1,"
  1. . S DR=".02////A0;1.06///NOW"
  1. . I $P(IB0,U,10) S DR=DR_";1.05////"_$P(IB0,U,10)
  1. . D ^DIE
  1. . Q
  1. ;
  1. ; If a status message references a batch, update the message for all bills in the batch
  1. I 'IBBDA S IBBILL(+$G(^IBA(364,+IBBILL,0)))=""
  1. I IBBDA S IBBILL="" F S IBBILL=$O(^IBM(361.4,"C",+IBBDA,IBBILL)) Q:'IBBILL S IBBILL(IBBILL)=""
  1. S IBBILL=0 F S IBBILL=$O(IBBILL(IBBILL)) Q:'IBBILL D
  1. . ;
  1. . S IB3614=IBBILL
  1. . ; Create new entry and stuff fields
  1. . I $D(^IBM(361.4,IB3614,2,"AC",(IBMNUM\1))) Q ; Msg already there
  1. . 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()
  1. . S DA(1)=IB3614,DIC="^IBM(361.4,"_DA(1)_",2,"
  1. . K DO,DD D FILE^DICN K DIC,DO,DD,DLAYGO
  1. . I Y'>0 Q
  1. . S IBY=+Y
  1. . K IBE("DIERR"),IBT
  1. . S (IBZ,IBZ0)=0
  1. . 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
  1. . D MSGLNSZ^IBCEST(.IBT)
  1. . 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
  1. ;
  1. D DELMSG^IBCESRV2(IBTDA)
  1. ;
  1. UPDQ S ZTREQ="@"
  1. Q
  1. ;
  1. ADDTXM(IBBILL,IBBATCH,IBDATE) ; Add an entry to the transmission multiple for
  1. ; the claim. Add the claim record, if needed.
  1. ; IBBILL = array subscripted by iens of file 399
  1. N DIC,DINUM,DLAYGO,DO,DD,DA,X,Y,IB3614,IBDA
  1. Q:'IBBATCH!'IBDATE
  1. S IBDA=0 F S IBDA=$O(IBBILL(IBDA)) Q:'IBDA D
  1. . ;
  1. . S IB3614=+$G(^IBA(364,IBDA,0))
  1. . I '$D(^IBM(361.4,IB3614)) D ; Add the record for the claim
  1. .. K DO,DD
  1. .. S DIC(0)="L",DLAYGO=361.4,DIC="^IBM(361.4,",X=IB3614,DINUM=X
  1. .. D FILE^DICN K DO,DD,DIC,DLAYGO,DINUM
  1. .. Q:Y>0
  1. .. S IB3614=0
  1. . Q:'IB3614
  1. . ;
  1. . S DA(1)=IB3614,DIC="^IBM(361.4,"_DA(1)_",1,",X=IBDATE
  1. . S DIC(0)="L",DLAYGO=361.41,DIC("DR")=".02////"_IBBATCH_";.03////"_DUZ_";.04////"_+$$COBN^IBCEF(IB3614)
  1. . D FILE^DICN K DO,DD,DIC,DLAYGO
  1. Q
  1. ;