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

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

initial load of WorldVistAEHR

File size: 4.0 KB
RevLine 
[613]1IBJTED ;ALB/CXW - TPJI EDI STATUS SCREEN ;09-APR-1999
2 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBJ TP EDI STATUS
6 D EN^VALM("IBJT EDI STATUS")
7 Q
8 ;
9HDR ; -- header code
10 D HDR^IBJTU1(+IBIFN,+DFN,1)
11 Q
12 ;
13INIT ; -- init variables and list array
14 K ^TMP("IBJTED",$J)
15 I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ
16 D BLD
17INITQ Q
18 ;
19HELP ; -- help code
20 S X="?" D DISP^XQORM1 W !!
21 Q
22 ;
23EXIT ; -- exit code
24 K ^TMP("IBJTED",$J)
25 D CLEAR^VALM1,CLEAN^VALM10
26 Q
27 ;
28BLD ;display EDI status information
29 N IBY,IBZ,CNT,COL,WD,IBD,IBX,IBDT,IBCNT,IBCH,IBT,IBCH6,IBMS,IBRD,IBSO,IBY,X,IBGS,IBNDT,IBCN2
30 S (IBCNT,VALMCNT)=0
31 ; only display the latest transmit record and status message
32 S IBY=$O(^IBM(361,"B",IBIFN,""))
33 S IBZ=$$LAST364^IBCEF4(IBIFN)
34 I 'IBY,'IBZ D BLDQ Q
35 D E364(IBZ),E361(IBY)
36 Q
37 ;
38E361(IBY) ; Bill Status Message
39 ; IBY = ien of entry in file 361
40 N IBZ,IBX,IBDT,IBT
41 K ^TMP($J,"RET-MSG")
42 S IBCH=0
43 S IBT="EDI Bill Status Messages"
44 D SET($J("",(80-$L(IBT))\2)_IBT)
45 D CNTRL^VALM10(VALMCNT,((80-$L(IBT))\2)+1,$L(IBT),IORVON,IORVOFF)
46 I IBY S IBCH=1 D ; Find all messages rec'd for the bill
47 . N IBCH
48 . S IBDT="",IBCNT=0
49 . F S IBDT=+$O(^IBM(361,"ADR",IBIFN,IBDT),-1) Q:'IBDT S IBY=0 F S IBY=+$O(^IBM(361,"ADR",IBIFN,IBDT,IBY)) Q:'IBY S IBX=$G(^IBM(361,IBY,0)) I IBX'="" D
50 .. N IBT1
51 .. S IBCNT=IBCNT+1
52 .. I IBCNT>1 D SET(" ")
53 .. S IBT1="---Message "_IBCNT_"---"
54 .. S IBT=$J("",32-($L(IBCNT)+1\2))_IBT1
55 .. S IBD=$$SET1(IBT,"",1,80) D SET(IBD)
56 .. D CNTRL^VALM10(VALMCNT,(33-(($L(IBCNT)+1)\2)),$L(IBT1),IOINHI,IOINORM)
57 .. S IBT=$J("",8)_"Date Received: "_$$FMTE^XLFDT(IBDT)
58 .. S IBD=$$SET1(IBT,"",1,49)
59 .. S IBT="Batch #: "_$$EXPAND^IBTRE(361,.05,+$P($G(^IBA(364,+$P(IBX,U,11),0)),U,2)),IBD=$$SET1(IBT,IBD,50,27)
60 .. D SET(IBD)
61 .. ;S IBT="Msg Generation Source: "_$$EXPAND^IBTRE(361,.04,$P(IBX,U,4))
62 .. ;S IBD=$$SET1(IBT,"",1,40)
63 .. S IBT="Return Msg Id: "_$P(IBX,U,6)
64 .. S IBD=$$SET1(IBT,"",9,40)
65 .. S IBT="Msg Severity: "_$$EXPAND^IBTRE(361,.03,$P(IBX,U,3))
66 .. S IBD=$$SET1(IBT,IBD,45,35) D SET(IBD)
67 .. ;S IBT="Return Msg Id: "_$P(IBX,U,6)
68 .. ;S IBD=$$SET1(IBT,"",9,40) D SET(IBD)
69 .. S (IBCH,IBCN)=0
70 .. F S IBCN=$O(^IBM(361,IBY,1,IBCN)) Q:'IBCN S IBD=$$SET1(^(IBCN,0),"",1,79),IBCH=1 D SET(IBD)
71 .. I 'IBCH S IBD=$$SET1(" No message text found","",1,25) D SET(IBD)
72 .. S IBT=$J("",31-($L(IBCNT)+1\2))_"---Msg "_IBCNT_" Review---"
73 .. S IBD=$$SET1(IBT,"",1,80) D SET(IBD)
74 .. S IBCN=0 F S IBCN=$O(^IBM(361,IBY,2,IBCN)) Q:'IBCN S IBGS=$G(^(IBCN,0)) D
75 ... S IBT="Review Date: "_$$DAT1^IBOUTL($P(IBGS,U),1)
76 ... S IBD=$$SET1(IBT,"",1,40)
77 ... ;S IBT="Reviewed By: "_$P($G(^VA(200,+$P(IBGS,U,2),0)),U)
78 ... ;S IBD=$$SET1(IBT,IBD,49,29)
79 ... D SET(IBD)
80 ... S IBCH=0
81 ... S IBCN2=0 F S IBCN2=$O(^IBM(361,IBY,2,IBCN,1,IBCN2)) Q:'IBCN2 S IBD=$$SET1($S('IBCH:"Comments: ",1:"")_$G(^(IBCN2,0)),"",1,$S('IBCH:69,1:79)),IBCH=1 D SET(IBD)
82 D NONE(IBCH)
83 K ^TMP($J,"RET-MSG")
84 Q
85 ;
86E364(IBZ) ; EDI Transmit Bill
87 ; IBZ = ien of entry in file 364
88 N IBY,IBT,IBX
89 S IBX=""
90 I IBZ S IBX=$G(^IBA(364,IBZ,0))
91 S IBT="Last EDI Transmission"
92 D SET($J("",(80-$L(IBT))\2)_IBT)
93 D CNTRL^VALM10(VALMCNT,(80-$L(IBT)\2)+1,$L(IBT),IORVON,IORVOFF)
94 S IBT="Transmission Status: "_$$EXPAND^IBTRE(364,.03,$P(IBX,U,3))
95 S IBD=$$SET1(IBT,"",3,79)
96 D SET(IBD)
97 S IBT="Status Date: "_$$FMTE^XLFDT($P(IBX,U,4))
98 S IBD=$$SET1(IBT,"",11,38)
99 S IBT="Batch #: "_$$EXPAND^IBTRE(364,.02,+$P(IBX,U,2))
100 S IBD=$$SET1(IBT,IBD,50,29)
101 D SET(IBD)
102 I $P(IBX,U,6) D
103 . S IBT="Resubmit Batch #: "_$$EXPAND^IBTRE(364,.06,+$P(IBX,U,6))
104 . S IBD=$$SET1(IBT,"",6,30)
105 . D SET(IBD)
106 D SET("")
107 Q
108 ;
109BLDQ ;
110 D SET(" ",0),SET("No EDI Status Messages Found For This Bill Entry.",0)
111 Q
112 ;
113NONE(IBCH) ;
114 I 'IBCH D
115 . S IBD=$$SET1(" None","",1,10)
116 . D SET(IBD)
117 Q
118 ;
119SET(X,CNT) ;
120 S VALMCNT=VALMCNT+1
121 S ^TMP("IBJTED",$J,VALMCNT,0)=X
122 Q:'$G(CNT)
123 S ^TMP("IBJTED",$J,"IDX",VALMCNT,CNT)=""
124 Q
125 ;
126SET1(IBT,IBD,COL,WD) ;
127 S IBD=$$SETSTR^VALM1(IBT,IBD,COL,WD)
128 Q IBD
129 ;
Note: See TracBrowser for help on using the repository browser.