1 | IBCEM1 ;ALB/TMP - 837 EDI RETURN MESSAGE MAIN LIST TEMPLATE ;02-MAY-96
|
---|
2 | ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-94
|
---|
3 | ;
|
---|
4 | EN ; Main entry point
|
---|
5 | D DT^DICRW
|
---|
6 | K XQORS,VALMEVL,IBFASTXT,IBDA
|
---|
7 | D EN^VALM("IBCEM 837 MESSAGE LIST")
|
---|
8 | K IBFASTXT,IBDA
|
---|
9 | Q
|
---|
10 | ;
|
---|
11 | INIT ; -- set up inital variables
|
---|
12 | S U="^",VALMCNT=0,VALMBG=1
|
---|
13 | D BLD
|
---|
14 | Q
|
---|
15 | ;
|
---|
16 | REBLD ; Set up formatted global
|
---|
17 | ;
|
---|
18 | BLD ; -- build list of messages
|
---|
19 | N IBCNT,IBEOB,IBMSGT,IBMSG,X,IB0
|
---|
20 | K ^TMP("IBCEM-837",$J),^TMP("IBCEM-837DX",$J)
|
---|
21 | S (IBCNT,IBMSG,VALMCNT)=0,IBEOB=+$O(^IBE(364.3,"B","835EOB",0))
|
---|
22 | F S IBMSG=$O(^IBA(364.2,IBMSG)) Q:'IBMSG S IB0=$G(^(IBMSG,0)) D
|
---|
23 | . N IBSTOP
|
---|
24 | . S IBSTOP=0
|
---|
25 | . S IBMSGT=$P(IB0,U,2)
|
---|
26 | . I IBMSGT,IBEOB,IBMSGT=IBEOB D Q:IBSTOP
|
---|
27 | .. N Z,Z0 ; Only allow MRA EOB's to be viewed
|
---|
28 | .. S Z=0 F S Z=$O(^IBA(364.2,IBMSG,2,Z)) Q:'Z!(IBSTOP) S Z0=$G(^(Z,0)) I $E(Z0,1,12)="##RAW DATA: ",$E(Z0,13,18)="835EOB",$P(Z0,U,5)'="Y" S IBSTOP=1 Q
|
---|
29 | . ; -- add to list
|
---|
30 | . S IBCNT=IBCNT+1,X=""
|
---|
31 | . S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
|
---|
32 | . S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB0,U,3),2),X,"DATEREC")
|
---|
33 | . I IB0'="" S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB0,U,10),2),X,"DATEMSG")
|
---|
34 | . S X=$$SETFLD^VALM1(+IB0,X,"MENTRY")
|
---|
35 | . S Z=$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U,6) S:Z="EOB" Z="MRA"
|
---|
36 | . S X=$$SETFLD^VALM1($E(Z_$J("",6),1,6),X,"TYPE")
|
---|
37 | . S X=$$SETFLD^VALM1($P($G(^IBA(364.1,+$P(IB0,U,4),0)),U),X,"BATCH")
|
---|
38 | . S X=$$SETFLD^VALM1($$BILLNO($P(IB0,U,5)),X,"BILL")
|
---|
39 | . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6)),X,"STATUS")
|
---|
40 | . D SET(X)
|
---|
41 | ;
|
---|
42 | I '$D(^TMP("IBCEM-837",$J)) S VALMCNT=2,IBCNT=2,^TMP("IBCEM-837",$J,1,0)=" ",^TMP("IBCEM-837",$J,2,0)=" All Incoming EDI Messages For Billing Have Filed - No Action Needed"
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | FNL ; -- Clean up list
|
---|
46 | K ^TMP("IBCEM-837DX",$J)
|
---|
47 | D CLEAN^VALM10
|
---|
48 | K IBFASTXT
|
---|
49 | Q
|
---|
50 | ;
|
---|
51 | SET(X) ; -- set arrays for 837 return messages
|
---|
52 | S VALMCNT=VALMCNT+1,^TMP("IBCEM-837",$J,VALMCNT,0)=X
|
---|
53 | S ^TMP("IBCEM-837",$J,"IDX",VALMCNT,IBCNT)=""
|
---|
54 | S ^TMP("IBCEM-837DX",$J,IBCNT)=VALMCNT_U_IBMSG
|
---|
55 | Q
|
---|
56 | ;
|
---|
57 | BILLNO(DA) ; Return bill # from entry in file 364
|
---|
58 | N Z
|
---|
59 | S Z=$P($G(^DGCR(399,+$P($G(^IBA(364,+DA,0)),U),0)),U)
|
---|
60 | Q $S($L(Z):Z,1:DA)
|
---|
61 | ;
|
---|
62 | BATNO(DA) ; Return batch # from entry in file 364
|
---|
63 | Q $P($G(^IBA(364.1,+$P($G(^IBA(364,+DA,0)),U,2),0)),U)
|
---|
64 | ;
|
---|
65 | HDR ;
|
---|
66 | S VALMHDR(1)=$J("",17)_"RETURN MESSAGES NEEDING TO BE FILED"
|
---|
67 | S VALMHDR(2)=" "
|
---|
68 | Q
|
---|
69 | ;
|
---|