source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEWL.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: 7.0 KB
Line 
1RCDPEWL ;ALB/TMK - ELECTRONIC EOB MESSAGE WORKLIST ;06-FEB-2003
2 ;;4.5;Accounts Receivable;**173,208**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; IA for read access to ^IBM(361.1 = 4051
5 ;
6EN ; Main entry point
7 N RCFASTXT,DA,DIC,X,Y,RCERA,RCNOED
8 D FULL^VALM1
9 ;
10 S DIR(0)="SA^L:LIST;S:SPECIFIC",DIR("A")="DO YOU WANT A (L)IST OF ERAs OR A (S)PECIFIC ONE?: ",DIR("B")="LIST" W ! D ^DIR K DIR
11 G:$D(DTOUT)!$D(DUOUT) ENQ
12 I Y="S" D G ENQ
13 . S DIC="^RCY(344.4,",DIC(0)="AEMQ" D ^DIC
14 . I Y>0 D WL^RCDPEWL7(+Y)
15 ;
16 D PARAMS^RCDPEWL0
17 I '$D(^TMP("RCERA_PARAMS",$J)) G ENQ
18 D EN^VALM("RCDPE WORKLIST ERA LIST")
19 ;
20ENQ Q
21 ;
22DISP(RCERA,RCNOED) ; Entry to worklist from receipt processing
23 ; RCERA = ien of entry in file 344.49
24 ; RCNOED = 1 if receipt exists/no editing allowed
25 ; = 2 if no edit and called from receipt processing
26 ;
27 N DUOUT,DTOUT,DIC,DIK,X,Y,DIR,RCQUIT,DA,DIE,DR,RCSCR,RC0,RCDAT,RCUNM
28 ;
29 S RCSCR("NOEDIT")=+$G(RCNOED)
30 S RCQUIT=0,RC0=$G(^RCY(344.4,RCERA,0))
31 ;I $$HACERA^RCDPEU(RCERA) S DIR(0)="YA",DIR("A")="THIS ERA IS FROM CHAMPVA (HAC) - ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR("B")="YES" D ^DIR K DIR G:Y'=1 DISPQ
32 I 'RCSCR("NOEDIT"),'$O(^RCY(344.49,"B",RCERA,0)) D G:RCQUIT DISPQ
33 . S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="NO WORKLIST SCRATCH PAD ENTRY EXISTS FOR THIS ERA",DIR("A")="DO YOU WANT TO CREATE ONE NOW?: "
34 . W ! D ^DIR K DIR
35 . I Y'=1 S RCERA=-1,RCQUIT=1 Q
36 . ;
37 . I $P(RC0,U,15)'="" W !!,"PAYMENT METHOD CODE REPORTED: "_$P(RC0,U,15),!
38 . I $P(RC0,U,15)="" W !!,"NO PAYMENT METHOD CODE REPORTED",!
39 . ;I $P(RC0,U,9)=0,$P(RC0,U,13)="",'$$HACERA^RCDPEU(RCERA) D Q:RCQUIT
40 . I $P(RC0,U,9)=0,$P(RC0,U,13)="" D Q:RCQUIT
41 .. S RCQUIT=0,RCUNM=0
42 .. I +$P(RC0,U,5)=0,"ACH"'[(U_$P(RC0,U,15)_U) D Q:RCQUIT!RCUNM
43 ... S DIR("A",1)="THIS ERA HAS NO PAYMENT ASSOCIATED WITH IT AND CAN BE MARKED AS",DIR("A",2)="'MATCH-0 PAYMENT' TO REMOVE IT FROM THE ERA AGING REPORT IF NO PAPER CHECK OR",DIR("A",3)="EFT IS EXPECTED TO BE RECEIVED FOR THIS ERA"
44 ... S DIR("?")="DO NOT RESPOND YES HERE UNLESS YOU ARE SURE THERE WILL BE NO EFT OR PAPER",DIR("?",1)=" CHECK TO BE RECEIVED FOR THIS 0-PAYMENT ERA"
45 ... S DIR("A")="DO YOU WANT TO DO THIS?: "
46 ... S DIR(0)="YA"
47 ... D ^DIR K DIR
48 ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
49 ... I Y'=1 Q
50 ... S DIE="^RCY(344.4,",DR=".09////3;.14////3",DA=RCERA D ^DIE S RCUNM=1
51 .. I 'RCUNM D
52 ... S DIR("A",1)="THIS ERA DOES NOT HAVE A MATCHING EFT",DIR("A")="ENTER THE NUMBER OF THE PAPER CHECK YOU RECEIVED FOR THIS ERA: ",DIR(0)="344.01,.07A"
53 ... I $P(RC0,U,13)'="" S DIR("B")=$P(RC0,U,13)
54 ... I $G(DIR("B"))="",$P(RC0,U,2)'="" S DIR("B")=$P(RC0,U,2)
55 ... W ! D ^DIR K DIR
56 ... I $D(DTOUT)!$D(DUOUT)!(Y="") D S RCQUIT=1 Q
57 .... S DIR(0)="EA",DIR("A",1)="THERE MUST EITHER BE A PAPER CHECK OR AN EFT FOR THIS ERA",DIR("A")="PRESS RETURN TO CONTINUE " W !! D ^DIR K DIR
58 ... S RCDAT("CHECK#")=Y
59 ... S DIR(0)="344.01,.1O",DIR("B")=$$FMTE^XLFDT($P(RC0,U,4),2)
60 ... W ! D ^DIR K DIR
61 ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
62 ... S RCDAT("CHECKDT")=Y
63 ... S DIR(0)="344.01,.08O"
64 ... W ! D ^DIR K DIR
65 ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
66 ... S RCDAT("BANK")=Y
67 ... S DIR("A",1)="ERA #"_RCERA_" (TRACE #:"_$P(RC0,U,2)_") MATCHED TO PAPER CHECK "_RCDAT("CHECK#"),DIR("A")="IS THIS CORRECT?: ",DIR(0)="YA",DIR("B")="YES" W ! D ^DIR K DIR
68 ... I Y'=1 S RCQUIT=1 Q
69 ... S DIE="^RCY(344.4,",DA=RCERA,DR=".13////"_RCDAT("CHECK#")_";.09////2" D ^DIE
70 ;
71 S RCSCR=+$O(^RCY(344.49,"B",RCERA,0))
72 I 'RCSCR D ; Build the entry in file 344.49
73 . I RCSCR("NOEDIT") D Q
74 .. S DIR("A")="NO WORKLIST ENTRY EXISTS FOR THIS ERA - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
75 . ;
76 . S RCSCR=+$$ADDREC(RCERA,.RCDAT)
77 . I RCSCR D Q:'RCSCR
78 .. F X=1:1:6 L +^RCY(344.4,RCSCR):5 Q:$T I X=6 D Q
79 ... S DA=RCSCR,DIK="^RCY(344.49," D ^DIK S RCSCR=0
80 ... S DIR(0)="EA",DIR("A",1)="ANOTHER USER HAS LOCKED THIS ENTRY - NEW RECORD NOT CREATED",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
81 .. Q:'RCSCR
82 .. D SETBATCH^RCDPEWLB(RCSCR)
83 .. D ADDLINES^RCDPEWLA(RCSCR)
84 .. K ^TMP($J,"BATCHES")
85 ;
86 I RCSCR D G:'RCSCR DISPQ
87 . Q:'$$BAT^RCDPEWL7(RCSCR)
88 . I 'RCSCR("NOEDIT"),'$G(^TMP("RCBATCH_SELECTED",$J)) L +^RCY(344.4,RCSCR):5 I '$T W !!,"Another user is currently editing this entry",! S DIR(0)="E" D ^DIR K DIR S RCSCR=0 Q
89 . D EN^VALM("RCDPE EOB WORKLIST")
90 ;
91DISPQ L -^RCY(344.4,+$G(RCERA))
92 Q
93 ;
94INIT ; -- set up initial variables
95 N RCQUIT,RCREV,RCSORT
96 S VALMCNT=0,VALMBG=1
97 S RCQUIT=0
98 I '$D(RCSCR) S VALMQUIT=1 Q
99 S RCREV=+$O(^RCY(344.49,RCSCR,2,"B",DUZ,0))
100 I $P($G(^RCY(344.49,RCSCR,2,RCREV,0)),U,2)=1 S $P(^TMP($J,"RC_SORTPARM"),U,2)=1
101 S RCSORT=$$SELSORT^RCDPEWLA(.RCQUIT)
102 I $G(RCQUIT) S VALMQUIT=1
103 I '$G(RCQUIT) D BLD^RCDPEWL1(RCSORT)
104 Q
105 ;
106ADDREC(RCERA,RCDAT) ; Add a record to file 344.49
107 ; RCERA = ien of file 344.4
108 ; RCDAT = array containing additional data to add to new entry
109 ;
110 N DIC,DLAYGO,X,Y,DO,DD,RCY,DINUM
111 S RCY=0,DIC("DR")=""
112 S DIC(0)="L",DLAYGO=344.49,(DINUM,X)=RCERA,DIC="^RCY(344.49,"
113 I $G(RCDAT("CHECK#"))'="" S DIC("DR")=".04////"_RCDAT("CHECK#")_";"
114 I $G(RCDAT("CHECKDT"))'="" S DIC("DR")=DIC("DR")_".05////"_RCDAT("CHECKDT")_";"
115 I $G(RCDAT("BANK"))'="" S DIC("DR")=DIC("DR")_".06////"_RCDAT("BANK")_";"
116 K DD,DO D FILE^DICN K DIC
117 I Y>0 S RCY=+Y
118 Q RCY
119 ;
120HDR ; Creates header lines for the selected ERA display
121 N X,Z,RC,RCT
122 I '$G(RCSCR) S VALMQUIT=1 Q
123 S RC=$G(^RCY(344.4,+RCSCR,0))
124 S VALMHDR(1)=$E("ERA Entry #: "_$P(RC,U)_$J("",31),1,31)_"Payer Name/ID: "_$P(RC,U,6)_"/"_$P(RC,U,3)
125 S VALMHDR(2)=$E("Total Amt Pd: "_$J(+$P(RC,U,5),"",2)_$J("",31),1,31)
126 S Z=+$O(^RCY(344.31,"AERA",+RCSCR,0))
127 I Z S VALMHDR(2)=VALMHDR(2)_"EFT #/TRACE #: "_$P($G(^RCY(344.3,+$G(^RCY(344.31,Z,0)),0)),U)_"/"_$P(RC,U,2)
128 I 'Z,$P(RC,U,13)'="" S VALMHDR(2)=VALMHDR(2)_"PAPER CHECK #: "_$P(RC,U,13)
129 S RCT=2
130 I $G(^TMP("RCBATCH_SELECTED",$J)) D
131 . N Z,Z0
132 . S Z=+$G(^TMP("RCBATCH_SELECTED",$J)),Z0=$G(^RCY(344.49,RCSCR,3,Z,0))
133 . S RCT=RCT+1,VALMHDR(RCT)="BATCH: "_Z_" "_$P(Z0,U,2)_" "_$$EXTERNAL^DILFD(344.493,.03,"",$P(Z0,U,3))
134 I $G(RCSCR("NOEDIT")) S RCT=RCT+1,VALMHDR(RCT)="*** RECEIPT ALREADY CREATED ("_$P($G(^RCY(344,+$P(RC,U,8),0)),U)_") ***"
135 Q
136 ;
137FNL ; -- Clean up list
138 K ^TMP("RCDPE-EOB_WLDX",$J),^TMP("RCDPE-EOB_WL",$J),^TMP($J,"RC_SORTPARM"),^TMP($J,"RC_BILL")
139 D CLEAN^VALM10,CLEAR^VALM1
140 K RCFASTXT
141 Q
142 ;
143SEL(RCDA) ; Select entry from worklist scratch pad screen
144 ; RCDA = array returned if selections made
145 ; RCDA(n)=ien of entry(s) in file 344.41
146 ; where n = the line # selected
147 K RCDA
148 N VALMY
149 D EN^VALM2($G(XQORNOD(0)),"S")
150 S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RCDA(RCDA)=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCDA)),U,2,5)
151 Q
152 ;
153NOEDIT ; Display no edit allowed if receipt exists
154 N DIR,X,Y
155 S DIR(0)="EA",DIR("A",1)="THIS ACTION IS NOT AVAILABLE SINCE THE ERA ALREADY HAS A RECEIPT."
156 S DIR("A")="PRESS RETURN TO CONTINUE "
157 W ! D ^DIR K DIR W !
158 Q
159 ;
160NOBATCH ; Display action not allowed if working at batch level not the ERA level
161 N DIR,X,Y
162 S DIR(0)="EA",DIR("A",1)="THIS ACTION IS NOT VALID WHEN IN A BATCH WITHIN THE ERA."
163 S DIR("A")="PRESS RETURN TO CONTINUE "
164 W ! D ^DIR K DIR W !
165 Q
166 ;
Note: See TracBrowser for help on using the repository browser.