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

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

initial load of WorldVistAEHR
File size: 6.8 KB
RevLine 
[613]1IBCEMCL ;ALB/ESG - Multiple CSA Message Management ;20-SEP-2005
2 ;;2.0;INTEGRATED BILLING;**320**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6EN ; -- main entry point
7 L +^IBM("MCS"):0 I '$T D Q ; option level lock
8 . W !!?2,"Sorry, another user is currently using the MCS option."
9 . W !?2,"Please try again later."
10 . D PAUSE^VALM1
11 . Q
12 ;
13 K ^TMP($J,"IBCEMCA"),^TMP($J,"IBCEMCL")
14 D EN^VALM("IBCEMC MCS MESSAGE LIST")
15 L -^IBM("MCS") ; option level unlock
16 Q
17 ;
18HDR ; -- header code
19 NEW Z,NUMSEL,TOT
20 S NUMSEL=+$G(^TMP($J,"IBCEMCL",4)) ; number selected
21 S TOT=+$O(^TMP($J,"IBCEMCL",3,""),-1) ; total number in list
22 S Z="Number of Claims Selected: "
23 S Z=Z_$$FO^IBCNEUT1(NUMSEL,8)
24 S Z=Z_$$FO^IBCNEUT1(" ",10)
25 S Z=Z_"Total Number in this List: "
26 S Z=Z_$$FO^IBCNEUT1(TOT,8)
27 S VALMHDR(1)=Z
28 Q
29 ;
30INIT ; -- init variables and list array
31 NEW A,CLAIM,DATA,EDI,IB,IB0,IB361,IB364,IBCNT,IBCURBAL,IBDA,IBDATE
32 NEW IBDIV,IBIFN,IBPAT,IBREV,IBSSN,IBSTSMSG,IBSVC,IBU1,INCLUDE,INS
33 NEW INSTID,PAYER,PROFID,SELTXT,TXT,X
34 W !!,"Compiling MCS Data ... "
35 KILL ^TMP($J,"IBCEMCL") ; List related scratch global
36 S IBREV=""
37 F S IBREV=$O(^IBM(361,"ACSA","R",IBREV)) Q:IBREV="" I IBREV<2 S IBDA=0 F S IBDA=$O(^IBM(361,"ACSA","R",IBREV,IBDA)) Q:'IBDA D
38 . S IB361=$G(^IBM(361,IBDA,0)),IBIFN=+IB361
39 . S IB0=$G(^DGCR(399,IBIFN,0))
40 . ;
41 . ; no cancelled claims
42 . I $P(IB0,U,13)=7 D UPDEDI^IBCEM(+$P(IB361,U,11),"C") Q
43 . ;
44 . ; automatically review this message if the claim was last printed on
45 . ; or after the MCS - 'Resubmit by Print' date
46 . I $P(IB361,U,16),($P($G(^DGCR(399,IBIFN,"S")),U,14)\1)'<$P(IB361,U,16) D UPDEDI^IBCEM(+$P(IB361,U,11),"P") Q
47 . ;
48 . ; payer
49 . S INS=+$P($G(^DGCR(399,IBIFN,"MP")),U,1)
50 . I 'INS S INS=+$$CURR^IBCEF2(IBIFN)
51 . I INS S PAYER=$P($G(^DIC(36,INS,0)),U,1)
52 . I 'INS S PAYER="~unknown payer"
53 . ;
54 . ; screen for user selected payers
55 . I $D(^TMP($J,"IBCEMCA","INS")) D Q:'INCLUDE
56 .. S INCLUDE=0
57 .. I 'INS Q ; don't include if the payer can't be found
58 .. I $D(^TMP($J,"IBCEMCA","INS",1,INS)) S INCLUDE=1 Q
59 .. I '$D(^TMP($J,"IBCEMCA","INS",2)) Q
60 .. S EDI=$$UP^XLFSTR($G(^DIC(36,INS,3)))
61 .. S PROFID=$P(EDI,U,2),INSTID=$P(EDI,U,4)
62 .. I PROFID'="",$D(^TMP($J,"IBCEMCA","INS",2,PROFID)) S INCLUDE=1 Q
63 .. I INSTID'="",$D(^TMP($J,"IBCEMCA","INS",2,INSTID)) S INCLUDE=1 Q
64 .. Q
65 . ;
66 . ; screen for user selected divisions
67 . I $D(^TMP($J,"IBCEMCA","DIV")) D Q:'INCLUDE
68 .. S INCLUDE=0
69 .. S IBDIV=+$P(IB0,U,22) I 'IBDIV Q
70 .. I $D(^TMP($J,"IBCEMCA","DIV",IBDIV)) S INCLUDE=1 Q
71 .. Q
72 . ;
73 . S IBSTSMSG=$$TXT^IBCECSA1(IBDA,300) ; status message text
74 . I IBSTSMSG="" S IBSTSMSG="~no error text"
75 . ;
76 . ; screen for user selected error message text
77 . I $D(^TMP($J,"IBCEMCA","TEXT")) D Q:'INCLUDE
78 .. S INCLUDE=0
79 .. S SELTXT="" F S SELTXT=$O(^TMP($J,"IBCEMCA","TEXT",SELTXT)) Q:SELTXT="" I IBSTSMSG[SELTXT S INCLUDE=1 Q
80 .. Q
81 . ;
82 . ; screen for user selected date range
83 . I $D(^TMP($J,"IBCEMCA","DATE")) D Q:'INCLUDE
84 .. S INCLUDE=0,A=^TMP($J,"IBCEMCA","DATE")
85 .. S IBDATE=$P(IB361,U,2) ; date message received
86 .. I ($P(A,U,1)'>IBDATE),(IBDATE'>$P(A,U,2)) S INCLUDE=1 Q
87 .. Q
88 . ;
89 . ; patient and ssn
90 . S IBPAT=$G(^DPT(+$P(IB0,U,2),0))
91 . S IBSSN=$E($P(IBPAT,U,9),6,9)
92 . S IBPAT=$P(IBPAT,U,1)
93 . ;
94 . S IBSVC=$P($G(^DGCR(399,IBIFN,"U")),U,1) ; statement covers from
95 . S IB364=$P(IB361,U,11) ; transmission file entry
96 . S IBU1=$G(^DGCR(399,IBIFN,"U1"))
97 . S IBCURBAL=$P(IBU1,U,1)-$P(IBU1,U,2) ; current balance
98 . S CLAIM=$P(IB0,U,1) ; external bill#
99 . ;
100 . S DATA=IBIFN_U_IB364_U_CLAIM_U_PAYER_U_IBPAT_U_IBSSN_U_IBSVC_U_IBCURBAL
101 . S ^TMP($J,"IBCEMCL",1,$E(IBSTSMSG,1,80),IBDA)=DATA
102 . Q
103 ;
104 I '$D(^TMP($J,"IBCEMCL",1)) D G INITX
105 . S VALMCNT=2
106 . S ^TMP($J,"IBCEMCL",2,1,0)=""
107 . S ^TMP($J,"IBCEMCL",2,2,0)=" No Status Message Data to Display"
108 . Q
109 ;
110BLD ; Build the display area of the list
111 ;
112 W !,"Building the MCS list display ... "
113 S TXT="",IBCNT=0,VALMCNT=0
114 F S TXT=$O(^TMP($J,"IBCEMCL",1,TXT)) Q:TXT="" D
115 . D SET("")
116 . D SET(TXT)
117 . S IBDA=0
118 . F S IBDA=$O(^TMP($J,"IBCEMCL",1,TXT,IBDA)) Q:'IBDA D
119 .. S IB=$G(^TMP($J,"IBCEMCL",1,TXT,IBDA)),IBIFN=+IB,IB364=$P(IB,U,2)
120 .. S IBCNT=IBCNT+1,DATA=IBIFN_U_IBDA_U_IB364
121 .. S X=$$SETFLD^VALM1($J(IBCNT,3),"","NUMBER")
122 .. S X=$$SETFLD^VALM1($P(IB,U,3),X,"BILL")
123 .. S X=$$SETFLD^VALM1($P(IB,U,4),X,"PAYER")
124 .. S X=$$SETFLD^VALM1($P(IB,U,5),X,"PATIENT")
125 .. S X=$$SETFLD^VALM1($P(IB,U,6),X,"SSN")
126 .. S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB,U,7),"2Z"),X,"SERVICE")
127 .. S X=$$SETFLD^VALM1($J("$"_$FN($P(IB,U,8),"",2),10),X,"CURBAL")
128 .. D SET(X,IBCNT,DATA)
129 .. Q
130 . Q
131 ;
132INITX ;
133 Q
134 ;
135SET(X,CNT,DATA) ; Set an entry into the display array and scratch global
136 ; X - visual line to display
137 ; CNT - current record counter
138 ; DATA - 3 piece string IBIFN^IBDA^IB364 (optional)
139 I X="",'VALMCNT G SETX ; don't start list with a blank line
140 S VALMCNT=VALMCNT+1
141 I '$G(CNT) S CNT=$G(IBCNT)+1
142 S ^TMP($J,"IBCEMCL",2,VALMCNT,0)=X
143 S ^TMP($J,"IBCEMCL",2,"IDX",VALMCNT,CNT)=""
144 I $G(DATA)="" G SETX
145 ;
146 S ^TMP($J,"IBCEMCL",3,CNT)=DATA_U_VALMCNT
147 ;
148 ; When building the list and the ^TMP($J,"IBCEMCA") area is defined,
149 ; then automatically pre-select all entries in the list.
150 I $D(^TMP($J,"IBCEMCA")) D MARK(+$P(DATA,U,2),+DATA,VALMCNT,CNT)
151SETX ;
152 Q
153 ;
154HELP ; -- help code
155 S X="?" D DISP^XQORM1 W !!
156 Q
157 ;
158EXIT ; -- exit code
159 D UNLOCK
160 KILL ^TMP($J,"IBCEMCL"),^TMP($J,"IBCEMCA")
161 Q
162 ;
163UNLOCK ; unlock any entries that may still be selected
164 N IBDA S IBDA=0
165 F S IBDA=$O(^TMP($J,"IBCEMCL",4,1,IBDA)) Q:'IBDA L -^IBM(361,IBDA)
166UNLOCKX ;
167 Q
168 ;
169MARK(IBDA,IBIFN,VALMCNT,INDEX,RESULT) ; Select/De-select Entry in List.
170 ; This procedure toggles the selection of a status message either
171 ; ON or OFF. It also adds or removes the "*" to the list display.
172 ; If a selection can't be locked, then it will not be selected.
173 ; VALMHDR is killed so ListManager will invoke the header code.
174 ;
175 ; RESULT is returned if passed by reference
176 ; "D" message was de-selected and unlocked
177 ; "S" message was selected and locked
178 ; "L" message could not be locked nor selected
179 ;
180 I $D(^TMP($J,"IBCEMCL",4,1,IBDA)) D G MARKX ; already selected
181 . ;
182 . ; de-select action
183 . KILL ^TMP($J,"IBCEMCL",4,1,IBDA)
184 . KILL ^TMP($J,"IBCEMCL",4,2,IBIFN,IBDA)
185 . S ^TMP($J,"IBCEMCL",4)=$G(^TMP($J,"IBCEMCL",4))-1
186 . S $E(^TMP($J,"IBCEMCL",2,VALMCNT,0),6)=" "
187 . KILL VALMHDR
188 . L -^IBM(361,IBDA) ; unlock
189 . S RESULT="D"
190 . Q
191 ;
192 ; lock attempt prior to selection
193 L +^IBM(361,IBDA):0 I '$T D G MARKX
194 . S RESULT="L"
195 . Q
196 ;
197 ; select action
198 S ^TMP($J,"IBCEMCL",4,1,IBDA)=IBIFN_U_VALMCNT_U_INDEX
199 S ^TMP($J,"IBCEMCL",4,2,IBIFN,IBDA)=""
200 S ^TMP($J,"IBCEMCL",4)=$G(^TMP($J,"IBCEMCL",4))+1
201 S $E(^TMP($J,"IBCEMCL",2,VALMCNT,0),6)="*"
202 KILL VALMHDR
203 S RESULT="S"
204MARKX ;
205 Q
206 ;
Note: See TracBrowser for help on using the repository browser.