source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEWL7.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1RCDPEWL7 ;ALB/TMK - EDI LOCKBOX WORKLIST ERA DISPLAY SCREEN ;16-JAN-04
2 ;;4.5;Accounts Receivable;**208,222**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6BLD(RCSORT) ; Build list with sort criteria
7 ; RCSORT = the sort levels to use to display the data in ^ pieces
8 ; piece 1 = the codes for the first level sort (sort code;null or -)
9 ; piece 2 = the codes for the second level sort
10 ; sort code is the type of data to sort by;- indicates reverse order
11 N Z,Z1,RCT,RCZ
12 S (RCT,VALMCNT)=0
13 I '$D(^TMP($J,"RCERA_LIST")) D
14 . S Z=0 F S Z=$O(^TMP("RCDPE-ERA_WLDX",$J,Z)) Q:'Z S RCZ=$P($G(^(Z)),U,2) D
15 .. I $$FILTER^RCDPEWL0(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,$P(RCSORT,U)),$$SL(RCZ,$P(RCSORT,U,2)),RCZ)=""
16 . K ^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCDPE-ERA_WL",$J)
17 ;
18 S Z=""
19 I RCSORT'["PN;-" D
20 . F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
21 ;
22 I $P(RCSORT,U)["PN;-" D
23 . F S Z=$O(^TMP($J,"RCERA_LIST",Z),-1) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
24 ;
25 I $P(RCSORT,U,2)["PN;-" D
26 . F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1),-1) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
27 ;
28 I '$O(^TMP($J,"RCERA_LIST",0)) D SET("No ERAs left for your selection criteria")
29 K ^TMP($J,"RCERA_LIST")
30 S ^TMP("RCERA_PARAMS",$J,"SORT")=RCSORT
31 Q
32 ;
33EXTRACT(RCSRT1,RCSRT2,RCT) ; Extract the data
34 ; RCSRT1 = data value at 1st sort level
35 ; RCSRT2 = data value at 2nd sort level
36 ; RCT = running entry counter - returned if passed by ref
37 N FIRST,RCZ,RC0,RCEFT,RCSTAT,RCPOST,X,Z,Z0
38 S RCZ=0 F S RCZ=$O(^TMP($J,"RCERA_LIST",RCSRT1,RCSRT2,RCZ)) Q:'RCZ D
39 . S RCT=RCT+1,RC0=$G(^RCY(344.4,RCZ,0))
40 . S RCEFT=+$O(^RCY(344.31,"AERA",RCZ,0))
41 . S RCSTAT=$S('RCEFT:U_$S($P(RC0,U,15)="CHK":"(CHECK PAYMENT EXPECTED)",$P(RC0,U,15)="NON":"(NO PAYMENT EXPECTED)",$P(RC0,U,9)=2:"(CHECK PAYMENT CHOSEN)",1:"N/A"),1:$$FMSSTAT^RCDPUREC(+$P($G(^RCY(344.31,RCEFT,0)),U,9)))
42 . S RCPOST=$S(RCEFT:"EFT RECEIPT STATUS: ",1:"")_$P(RCSTAT,U,2)
43 . S X=$E(RCT_$J("",4),1,4)_$S($D(^RCY(344.49,RCZ)):" ",1:"-")_$E($P(RC0,U)_$J("",5),1,5)_" "_$E($P(RC0,U,2)_$J("",30),1,30)_" "_$J($$FMTE^XLFDT($P(RC0,U,7),"2D"),8)_$J("",5)_$J(+$P(RC0,U,5),12,2)
44 . S $E(X,73,80)=$$FMTE^XLFDT($P(RC0,U,7),"2D")
45 . D SET(X,RCT,RCZ)
46 . S X=$J("",12)_$E($P(RC0,U,6)_$J("",30),1,30)_" APPROX # EEOBs: "_+$$CTEEOB^RCDPEWLB(RCZ)
47 . D SET(X,RCT,RCZ)
48 . S X=$J("",12)_$E($$EXTERNAL^DILFD(344.4,.09,"",$P(RC0,U,9))_$J("",30),1,30)_" "_RCPOST
49 . D SET(X,RCT)
50 . I $G(^TMP("RCERA_PARAMS",$J,"BATCHON")) D
51 .. S Z=0 F S Z=$O(^RCY(344.49,RCZ,3,Z)) Q:'Z S Z0=$G(^(Z,0)) I Z0'="" D
52 ... S X=$J("",12)_$E("- BATCH #"_$P(Z0,U)_$J("",4),1,13)_" "_$E($P(Z0,U,2)_$J("",30),1,30)_" "_$S('$P(Z0,U,3):"NOT ",1:"")_"READY TO POST"
53 ... D SET(X,RCT)
54 . D SET(" ",RCT)
55 S VALMSG="'-' Before the ERA # indicates no scratchpad entry yet"
56 ;
57 Q
58 ;
59SL(Y,SORT) ; Returns data for sort level from entry Y in file 344.4
60 ; SORT = the sort data in ';' delimited pieces
61 ; pc 1 = code for sort data
62 ; pc 2 = the order requested (- or null)
63 ;
64 N RC0,DAT,SORT1,SORT2
65 S SORT1=$P(SORT,";"),SORT2=$P(SORT,";",2)
66 S RC0=$G(^RCY(344.4,Y,0)),DAT=" "
67 ; No sort
68 I SORT="" G SLQ
69 ; Amt paid
70 I SORT1="AP" D G SLQ
71 . S DAT=SORT2_+$P(RC0,U,5)
72 ; ERA date pd
73 I SORT1="DP" D G SLQ
74 . S DAT=SORT2_($P(RC0,U,4)\1)
75 ; Payer name
76 I SORT1="PN" D G SLQ
77 . S DAT=$$UPPER($P(RC0,U,6))
78 ; ERA date received
79 I SORT1="DR" D G SLQ
80 . S DAT=SORT2_($P(RC0,U,7)\1)
81 ;
82SLQ Q $S(DAT'="":DAT,1:" ")
83 ;
84INIT ; Entry point for List template to build the display of ERAs
85 ;
86 ; Parameters for selecting ERAs to be included in the list are
87 ; contained in the global ^TMP("RCERA_PARAMS",$J,parameter name)
88 ;
89 N RCZ,RC0,RCT,RCTT,RCQUIT,RCDTFR,RCDTTO,DTOUT,DUOUT,DIR,X,Y,Z,Z1,RCPOST,RCEFT,RCINDX
90 D CLEAN^VALM10
91 K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST")
92 ;
93 S (RCT,RCTT,RCQUIT)=0
94 ;
95 S RCDTFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTTO=$S($P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2):$P(^("RCDT"),U,2),1:DT)
96 ;
97 S RCINDX=$S(RCDTFR:RCDTFR-.00000001,1:0)
98 F S RCINDX=$O(^RCY(344.4,"AFD",RCINDX)) Q:'RCINDX!(RCINDX\1>RCDTTO)!RCQUIT S RCZ=0 F S RCZ=$O(^RCY(344.4,"AFD",RCINDX,RCZ)) Q:'RCZ D Q:RCQUIT
99 . ;
100 . S RCTT=RCTT+1 I '(RCTT#5000) D Q:RCQUIT
101 .. S DIR("A",1)=RCTT_" ERA RECORDS HAVE ALREADY BEEN SEARCHED USING YOUR CRITERIA",DIR("A",2)="LAST DATE SEARCHED WAS "_$$FMTE^XLFDT(RCINDX,"2D"),DIR("A")="DO YOU WANT TO CONTINUE THIS SEARCH?: "
102 .. S DIR("B")="NO",DIR("?")="RESPOND NO HERE AND RESTART TO SELECT A DATE RANGE TO LIMIT THE SEARCH",DIR(0)="YA" W ! D ^DIR K DIR
103 .. I Y=1!$D(DTOUT) W !,$S($D(DTOUT):"TIME OUT - ",1:""),"SEARCH CONTINUED",! Q
104 .. I $D(DUOUT)!(Y=0) S RCQUIT=1 Q
105 . ;
106 . S RC0=$G(^RCY(344.4,RCZ,0))
107 . I $$FILTER^RCDPEWL0(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,"DR"),$$SL(RCZ,""),RCZ)=""
108 ;
109 ; Output the list
110 I 'RCQUIT D
111 . D:$D(^TMP($J,"RCERA_LIST")) BLD("DR^N")
112 . I '$O(^TMP("RCDPE-ERA_WL",$J,0)) D
113 .. S DIR(0)="EA",DIR("A",1)="THERE ARE NO ERAs MATCHING YOUR SELECTION CRITERIA",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR S RCQUIT=1
114 I RCQUIT K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST") S VALMQUIT=""
115 Q
116 ;
117HDR ; Header for ERA list
118 N X
119 S X=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH"))
120 S VALMHDR(1)=$E("SELECTED: MATCH STATUS: "_$S(X="N":"NOT MATCHED",X="M":"MATCHED",1:"BOTH")_$J("",38),1,38)
121 S X=$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))
122 S VALMHDR(1)=VALMHDR(1)_" POST STATUS: "_$S(X="U":"UNPOSTED",X="P":"POSTED",1:"BOTH")
123 S X=$G(^TMP("RCERA_PARAMS",$J,"RCDT"))
124 S VALMHDR(2)=$J("",11)_"DATE RANGE : "_$S($P(X,U):$$FMTE^XLFDT($P(X,U),2)_$S($P(X,U,2):"-"_$$FMTE^XLFDT($P(X,U,2),2),1:""),1:"NONE SELECTED")
125 S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))
126 S VALMHDR(3)=$J("",11)_$S($P(X,U)="A"!(X=""):"ALL PAYERS",1:"PAYERS: "_$P(X,U,2)_"-"_$P(X,U,3))
127 Q
128 ;
129FNL ; -- Clean up list
130 K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCERA_PARAMS",$J),^TMP($J,"RCERA_LIST")
131 Q
132 ;
133SET(X,RCSEQ,RCSEQ1) ; -- set arrays
134 ; X = the data to set into the global
135 ; RCSEQ = the selectable line #
136 ; RCSEQ1 = the ien of the entry in file 344.4
137 S VALMCNT=VALMCNT+1,^TMP("RCDPE-ERA_WL",$J,VALMCNT,0)=X
138 I $G(RCSEQ) S ^TMP("RCDPE-ERA_WL",$J,"IDX",VALMCNT,RCSEQ)=$G(RCSEQ1)
139 I $G(RCSEQ1) S ^TMP("RCDPE-ERA_WLDX",$J,RCSEQ)=VALMCNT_U_RCSEQ1
140 Q
141 ;
142ENTERWL ; Enter the worklist with an ERA
143 D WL($$SEL())
144 D BLD($G(^TMP("RCERA_PARAMS",$J,"SORT")))
145 S VALMBCK="R"
146 Q
147 ;
148SEL() ; Select an ERA from the ERA list
149 N RCDA,VALMY
150 D FULL^VALM1
151 D EN^VALM2($G(XQORNOD(0)),"S")
152 S RCERA=0
153 S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RCERA=+$P($G(^TMP("RCDPE-ERA_WLDX",$J,RCDA)),U,2)
154 ;
155 Q RCERA
156 ;
157WL(RCERA) ; Enter worklist
158 ; RCERA = ien of the ERA entry in file 344.4
159 N RC0,RCNOED,RCQUIT,RCSORT,DA,DIE,X,Y,DR,DIR,DTOUT,DUOUT
160 Q:RCERA'>0
161 S (RCQUIT,RCNOED)=0,RC0=$G(^RCY(344.4,RCERA,0)),RCSORT=""
162 I $P(RC0,U,8) D
163 . I '$D(^RCY(344.49,RCERA,0)) D Q
164 .. S RCQUIT=1
165 .. W ! S DIR(0)="EA",DIR("A",1)="A SCRATCH PAD WAS NOT CREATED FOR THIS ERA BEFORE POSTING",DIR("A",2)="USE THE VIEW/PRINT ERA OPTION TO SEE ITS DETAIL",DIR("A")="PRESS RETURN TO CONTINUE: " D ^DIR K DIR Q
166 . ;
167 . S RCNOED=+$P(RC0,U,8)
168 . S DIR(0)="EA",DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - YOU MAY ONLY VIEW ITS SCRATCH PAD",DIR("A")="PRESS RETURN TO CONTINUE "
169 . W ! D ^DIR K DIR W !
170 I 'RCQUIT D
171 . N RCQUIT
172 . D DISP^RCDPEWL(RCERA,RCNOED)
173 ;
174 I 'RCQUIT,$G(^TMP("RCBATCH_SELECTED",$J)) D
175 . S DA(1)=RCERA,DA=+$G(^TMP("RCBATCH_SELECTED",$J)),DR=".05////0",DIE="^RCY(344.49,"_DA(1)_",3," D ^DIE
176 . L -^RCY(344.49,DA(1),3,DA,0)
177 . K ^TMP("RCBATCH_SELECTED",$J)
178 E D
179 . L -^RCY(344.4,RCERA,0)
180 Q
181 ;
182PRERA ; View/Print ERA from ERA list menu
183 N RCSCR
184 S RCSCR=$$SEL()
185 I RCSCR>0 D PRERA^RCDPEWL0
186 S VALMBCK="R"
187 Q
188 ;
189BAT(RCERA) ; Select batch, if needed
190 ; Returns 1 if batch selected OK or no batch needed
191 ; RCERA = ien of entry in file 344.49
192 N RCINUSE,RCQUIT,RCADJ,RC0,RCOK,DIR,DTOUT,DUOUT,X,Y,Z
193 K ^TMP("RCBATCH_SELECTED",$J)
194 S RCOK=1
195 I '$O(^RCY(344.49,RCERA,3,0)) G BATQ
196 S RC0=$G(^RCY(344.4,RCERA,0))
197 S (RCQUIT,RCADJ)=0
198 I $$HASADJ^RCDPEWL8(RCERA) D
199 . S RCADJ=1
200 . S DIR("A",1)="THIS ERA HAS NEGATIVE ADJUSTMENTS THAT NEED TO BE DISTRIBUTED TO OTHER",DIR("A",2)="PAYMENTS ON THE ERA. YOU CANNOT SELECT ANY INDIVIDUAL BATCHES UNTIL",DIR("A",3)="THE DISTRIBUTIONS ARE COMPLETE."
201 . S DIR("A")="PRESS RETURN TO CONTINUE: ",DIR(0)="EA" W ! D ^DIR K DIR
202 S RCINUSE=+$O(^RCY(344.49,"AINUSE",1,RCERA,0))
203 I RCINUSE D
204 . N OK,Z
205 . Q:RCADJ!$P(RC0,U,8)
206 . S OK=0 S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z I '$P($G(^RCY(344.49,RCERA,3,Z,0)),U,5) S OK=1 Q
207 . I 'OK D Q
208 .. S DIR("A",1)="ALL BATCHES WITHIN THIS ERA ARE CURRENTLY IN USE - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR S RCQUIT=1,RCOK=0 Q
209 . W !!,"AT LEAST 1 BATCH WITHIN THIS ERA IS CURRENTLY IN USE",!,"AT THIS TIME, YOU CAN ONLY ACCESS INDIVIDUAL BATCHES",!
210 . D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
211 . I RCQUIT S RCOK=0
212 E D
213 . Q:$P(RC0,U,8)!RCADJ ; Always require the entire ERA be used
214 . S DIR(0)="SA^E:(E)NTIRE ERA;B:(B)ATCH",DIR("A")="DO YOU WANT THE (E)NTIRE ERA OR JUST A (B)ATCH?: " W ! D ^DIR K DIR
215 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1,RCOK=0 Q
216 . I Y="E" D Q
217 .. S RCQUIT=1 F Z=1:1:2 L +^RCY(344.4,RCERA,0):5 I $T S RCQUIT=0 Q
218 .. I RCQUIT S RCOK=0,DIR(0)="EA",DIR("A",1)="ANOTHER USER IS CURRENTLY USING THIS ERA, TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR Q
219 . D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
220 . I RCQUIT S RCOK=0
221 ;
222BATQ Q RCOK
223 ;
224UPPER(X) ; Function returns X as all upper case
225 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
226 ;
Note: See TracBrowser for help on using the repository browser.