source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPTM.m@ 1166

Last change on this file since 1166 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1IBCEPTM ;ALB/TMK - FILE EDI CLAIMS TEST MESSAGES ;01/27/05
2 ;;2.0;INTEGRATED BILLING;**296**;21-MAR-94
3 Q
4 ;
5UPDTEST(IBTDA) ; Store test claim status message in file 361.4
6 ; IBTDA = ien of the message entry for the status message in 364.2
7 N IBT,IBZ,IBZ0,IBZ1,IBE,IBY,IB0,IBMNUM,IBBDA,IBBILL,IB3614,DIC,X,Y,Z,DLAYGO,DO,DD,DA
8 ;
9 I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock message in file 364.2
10 ;
11 D UPDMSG^IBCESRV2(IBTDA,"U",0)
12 ;
13 S IB0=$G(^IBA(364.2,IBTDA,0)),IBBDA=$P(IB0,U,4),IBBILL=$P(IB0,U,5)
14 S IBMNUM=$P(IB0,U) ; Message number
15 ;
16 ; esg - 5/12/05 - Update the 364.1 batch status and some other fields even though this is for a test batch
17 ;
18 I IBBDA,$P($G(^IBA(364.1,+IBBDA,0)),U,2)'="A0" D
19 . N DA,DIE,DR
20 . S DA=IBBDA,DIE="^IBA(364.1,"
21 . S DR=".02////A0;1.06///NOW"
22 . I $P(IB0,U,10) S DR=DR_";1.05////"_$P(IB0,U,10)
23 . D ^DIE
24 . Q
25 ;
26 ; If a status message references a batch, update the message for all bills in the batch
27 I 'IBBDA S IBBILL(+$G(^IBA(364,+IBBILL,0)))=""
28 I IBBDA S IBBILL="" F S IBBILL=$O(^IBM(361.4,"C",+IBBDA,IBBILL)) Q:'IBBILL S IBBILL(IBBILL)=""
29 S IBBILL=0 F S IBBILL=$O(IBBILL(IBBILL)) Q:'IBBILL D
30 . ;
31 . S IB3614=IBBILL
32 . ; Create new entry and stuff fields
33 . I $D(^IBM(361.4,IB3614,2,"AC",(IBMNUM\1))) Q ; Msg already there
34 . 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()
35 . S DA(1)=IB3614,DIC="^IBM(361.4,"_DA(1)_",2,"
36 . K DO,DD D FILE^DICN K DIC,DO,DD,DLAYGO
37 . I Y'>0 Q
38 . S IBY=+Y
39 . K IBE("DIERR"),IBT
40 . S (IBZ,IBZ0)=0
41 . 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
42 . D MSGLNSZ^IBCEST(.IBT)
43 . 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
44 ;
45 D DELMSG^IBCESRV2(IBTDA)
46 ;
47UPDQ S ZTREQ="@"
48 Q
49 ;
50ADDTXM(IBBILL,IBBATCH,IBDATE) ; Add an entry to the transmission multiple for
51 ; the claim. Add the claim record, if needed.
52 ; IBBILL = array subscripted by iens of file 399
53 N DIC,DINUM,DLAYGO,DO,DD,DA,X,Y,IB3614,IBDA
54 Q:'IBBATCH!'IBDATE
55 S IBDA=0 F S IBDA=$O(IBBILL(IBDA)) Q:'IBDA D
56 . ;
57 . S IB3614=+$G(^IBA(364,IBDA,0))
58 . I '$D(^IBM(361.4,IB3614)) D ; Add the record for the claim
59 .. K DO,DD
60 .. S DIC(0)="L",DLAYGO=361.4,DIC="^IBM(361.4,",X=IB3614,DINUM=X
61 .. D FILE^DICN K DO,DD,DIC,DLAYGO,DINUM
62 .. Q:Y>0
63 .. S IB3614=0
64 . Q:'IB3614
65 . ;
66 . S DA(1)=IB3614,DIC="^IBM(361.4,"_DA(1)_",1,",X=IBDATE
67 . S DIC(0)="L",DLAYGO=361.41,DIC("DR")=".02////"_IBBATCH_";.03////"_DUZ_";.04////"_+$$COBN^IBCEF(IB3614)
68 . D FILE^DICN K DO,DD,DIC,DLAYGO
69 Q
70 ;
Note: See TracBrowser for help on using the repository browser.