source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM1.m@ 1608

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1IBCEM1 ;ALB/TMP - 837 EDI RETURN MESSAGE MAIN LIST TEMPLATE ;02-MAY-96
2 ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-94
3 ;
4EN ; 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 ;
11INIT ; -- set up inital variables
12 S U="^",VALMCNT=0,VALMBG=1
13 D BLD
14 Q
15 ;
16REBLD ; Set up formatted global
17 ;
18BLD ; -- 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 ;
45FNL ; -- Clean up list
46 K ^TMP("IBCEM-837DX",$J)
47 D CLEAN^VALM10
48 K IBFASTXT
49 Q
50 ;
51SET(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 ;
57BILLNO(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 ;
62BATNO(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 ;
65HDR ;
66 S VALMHDR(1)=$J("",17)_"RETURN MESSAGES NEEDING TO BE FILED"
67 S VALMHDR(2)=" "
68 Q
69 ;
Note: See TracBrowser for help on using the repository browser.