Produced by Araxis Merge on 10/23/2018 6:40:08 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
| # | Location | File | Last Modified |
|---|---|---|---|
| 1 | docs | TAS ePay US1954 SDD - Copy.doc | Mon Oct 22 16:27:48 2018 UTC |
| 2 | docs | TAS ePay US1954 SDD - Copy.doc | Mon Oct 22 16:31:12 2018 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 1 | 1734 |
| Changed | 0 | 0 |
| Inserted | 0 | 0 |
| Removed | 0 | 0 |
| Whitespace | |
|---|---|
| Character case | Differences in character case are significant |
| Line endings | Differences in line endings (CR and LF characters) are ignored |
| CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
| 1 | MCCF EDI T AS US1954 | |
| 2 | System Des ign Docume nt | |
| 3 | PRCA*4.5*x xx | |
| 4 | ||
| 5 | Department of Vetera ns Affairs | |
| 6 | June 2017 | |
| 7 | Version 1 | |
| 8 | User Story Number: U S1954 | |
| 9 | Story | |
| 10 | As an AR c lerk, I ne ed the abi lity to se e who mark ed a claim payment f or 'auto-p ost' from the ERA Wo rklist and APAR list . If Vist A auto-pos ted the cl aim paymen t, the fie ld would s how 'Postm aster' (or appropria te truncat ion). If clerk mark ed for aut o-post, it should sh ow the 3 c haracter e mployee id entificati on | |
| 11 | Conversati on | |
| 12 | 5/31/17 | |
| 13 | Display on Receipt P rofile in Receipt pr ocessing a nd Transac tion Profi le, Profil e of Accou nts Receiv able under TPJI | |
| 14 | Postmaster displays AE on List All Recei pts Report , "Opened By: EDILO CKBOX,AUTO MATIC" di splays on the Receip t Profile screen for user iden tification on report s | |
| 15 | Fred to lo ok at whic h reports and receip t views wo uld automa tically up date with the nightl y process and which would need coding in order to display wh o marked c laim for a uto-post | |
| 16 | 6/7 – List All Recei pts report will auto matically get this c hange | |
| 17 | Display in itials of user from the new pe rsons file (#200) | |
| 18 | ePay – no informatio n needed u nder Accou nts Profil e | |
| 19 | Summary: | |
| 20 | Data Dicit ionary – C hanges nee ded | |
| 21 | File 344.4 – ELECTRO NIC REMITA NCE ADVICE | |
| 22 | New field | |
| 23 | 344.4,4.04 MARKED FOR AUTOP OST USER 4; 3 POINTER TO NEW PER SON FILE ( #200) | |
| 24 | HELP-P ROMPT: Select t he person who marked the ERA f or auto-po sting | |
| 25 | DESCRI PTION: This is the person who marke d the ERA for auto-p osting. T his field is set aut omatically by the sy stem. | |
| 26 | 344.41,6.0 1 MARK ED FOR AUT OPOST USER 5;6 POI NTER TO NE W PERSON F ILE (#200) | |
| 27 | HELP -PROMPT: Select t he person who marked the ERA d etail for auto-posti ng | |
| 28 | DESC RIPTION: This is the person who marke d the ERA detail for auto-post ing. This field is set automa tically by the syste m. | |
| 29 | Changed Ro utines: | |
| 30 | RCDPEAA2 - Existing routine | |
| 31 | In subrout ine MARK, record MAR KED FOR AU TOPOST USE R (344.41, 6.01) as DUZ. | |
| 32 | RCDPEAP – Existing r outine | |
| 33 | In subrout ine SETSTA , record M ARKED FOR AUTOPOST U SER (344.4 , 4.04) as DUZ. | |
| 34 | In subrout ine AUTOPO ST, get MA RKED FOR A UTOPOST US ER (344.4, 4.04) and pass that into rece ipt and de tail creat ion. | |
| 35 | In Subrout ine EN2, g et MARKED FOR AUTOPO ST USER (3 44.4, 4.04 ) (if any) and pass that into receipt cr eation. | |
| 36 | RCDPUREC – Existing routine | |
| 37 | Use MARKED FOR AUTOP OST USER ( 344.4, 4.0 4) as crea tor of the receipt f rom the ni ghtly job. | |
| 38 | RCDPEM – E xisting ro utine | |
| 39 | Pass MARKE D FOR AUTO POST USER (344.4, 4. 04) into s ubroutine for creati on of rece ipt transa ctions. | |
| 40 | RCDPEMA - Existing r outine | |
| 41 | Pass MARKE D FOR AUTO POST USER (344.41, 6 .01) into subroutine for creat ion of rec eipt trans actions. | |
| 42 | RCDPURET - Existing routine | |
| 43 | Use MARKED FOR AUTOP OST USER ( whichever is passed in) as cre ator of th e receipt transactio ns if pres ent. | |
| 44 | Notes on D isplay | |
| 45 | Display of the user initials i s hard cod ed to be “ ar” if the DUZ=.5, otherwise the first characters of the us er’s first and last name are u sed (N.B. not the us ers initia ls from fi le #200). | |
| 46 | Display of user name is hard c oded to be “accounts recievabl e” if the DUZ=.5, ot herwise th e Name fie ld from fi le #200 is used. | |
| 47 | Resolution – Added C hanged Obj ects | |
| 48 | RoutinesAc tivitiesRo utine Name RCDPEAA2En hancement Category N ew Modify Delete No ChangeRTMR elated Opt ionsRCDPE APARRelate d Routines Routines “ Called By” Routines “ Called” RCDPEAA3 | |
| 49 | RCDPEWL1$$ RXST^IBARX EU | |
| 50 | RELBILL^IB RFN | |
| 51 | $$ORI^PRCA FN | |
| 52 | $$SEL^RCDP EAA1 | |
| 53 | $$VALID^RC DPEAP | |
| 54 | PRERA^RCDP EWL0 | |
| 55 | GETPHARM^R CDPEWLP | |
| 56 | $$BILL^RCJ IBFN2Curre nt Logic. | |
| 57 | . | |
| 58 | . | |
| 59 | MARK(RCIEN S) ;EP - P rotocol ac tion - RCD PE MARK FO R AUTO POS T | |
| 60 | ; Mark fo r Auto-Pos t - EEOB o n APAR get s marked f or auto-po st if it p asses | |
| 61 | ; autopos ting valid ation | |
| 62 | ; Input: RCIENS - I nternal IE N of entry in file 3 44.49^ien of | |
| 63 | ; 344.491 ^selectabl e line ite m from lis tman scree n | |
| 64 | ; | |
| 65 | I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA*4.5*318 Added sec urity key check | |
| 66 | . D FULL^ VALM1 | |
| 67 | . S VALMB CK="R" | |
| 68 | . W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",! | |
| 69 | . D PAUSE ^VALM1 | |
| 70 | ; | |
| 71 | N RESULT, REASON,LIN E,DIR,X,Y, RCERROR,XX ,ERADA1,RC DFDA | |
| 72 | S:$G(RCIE NS)="" RCI ENS=+$$SEL ^RCDPEAA1( ) | |
| 73 | Q:'RCIENS | |
| 74 | I '$$VALI D^RCDPEAP( $P(RCIENS, U),$P(RCIE NS,U,2),.R ESULT) D G MARKQ | |
| 75 | . S LINE= $O(RESULT( "")) | |
| 76 | . S REASO N=$TR(RESU LT(LINE),U ,"-") | |
| 77 | . S DIR(0 )="EA",DIR ("A",1)="E EOB cannot be marked for Auto- Post for t he followi ng reason: " | |
| 78 | . S DIR(" A",2)=REAS ON | |
| 79 | . S DIR(" A")="PRESS RETURN TO CONTINUE " | |
| 80 | . W ! D ^ DIR K DIR W ! | |
| 81 | ; EEOB pa ssed valid ation; rea dy for Aut opost | |
| 82 | L +^RCY(3 44.4,$P(RC IENS,U),0) :5 I '$T D NOLOCK G MARKQ | |
| 83 | S ERADA1= $P($G(^RCY (344.49,$P (RCIENS,U) ,1,$P(RCIE NS,U,2),0) ),U,9) ; g et 344.41 ien (344.4 91,.09) | |
| 84 | S RCDFDA( 344.41,ERA DA1_","_$P (RCIENS,U) _",",6)=1 | |
| 85 | D FILE^DI E("","RCDF DA") | |
| 86 | S DIR(0)= "EA",DIR(" A",1)=$P(R CIENS,U)_" ."_ERADA1_ " has been marked fo r auto-pos t and has been remov ed from th e APAR Lis t." | |
| 87 | S DIR("A" )="PRESS R ETURN TO C ONTINUE " | |
| 88 | W ! D ^DI R K DIR W ! | |
| 89 | L -^RCY(3 44.4,$P(RC IENS,U),0) | |
| 90 | MARKQ ; | |
| 91 | QModified Logic (Ch anges are in bold). | |
| 92 | . | |
| 93 | . | |
| 94 | MARK(RCIEN S) ;EP - P rotocol ac tion - RCD PE MARK FO R AUTO POS T | |
| 95 | ; Mark fo r Auto-Pos t - EEOB o n APAR get s marked f or auto-po st if it p asses | |
| 96 | ; autopos ting valid ation | |
| 97 | ; Input: RCIENS - I nternal IE N of entry in file 3 44.49^ien of | |
| 98 | ; 344.491 ^selectabl e line ite m from lis tman scree n | |
| 99 | ; | |
| 100 | I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA*4.5*318 Added sec urity key check | |
| 101 | . D FULL^ VALM1 | |
| 102 | . S VALMB CK="R" | |
| 103 | . W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",! | |
| 104 | . D PAUSE ^VALM1 | |
| 105 | ; | |
| 106 | N RESULT, REASON,LIN E,DIR,X,Y, RCERROR,XX ,ERADA1,RC DFDA | |
| 107 | S:$G(RCIE NS)="" RCI ENS=+$$SEL ^RCDPEAA1( ) | |
| 108 | Q:'RCIENS | |
| 109 | I '$$VALI D^RCDPEAP( $P(RCIENS, U),$P(RCIE NS,U,2),.R ESULT) D G MARKQ | |
| 110 | . S LINE= $O(RESULT( "")) | |
| 111 | . S REASO N=$TR(RESU LT(LINE),U ,"-") | |
| 112 | . S DIR(0 )="EA",DIR ("A",1)="E EOB cannot be marked for Auto- Post for t he followi ng reason: " | |
| 113 | . S DIR(" A",2)=REAS ON | |
| 114 | . S DIR(" A")="PRESS RETURN TO CONTINUE " | |
| 115 | . W ! D ^ DIR K DIR W ! | |
| 116 | ; EEOB pa ssed valid ation; rea dy for Aut opost | |
| 117 | L +^RCY(3 44.4,$P(RC IENS,U),0) :5 I '$T D NOLOCK G MARKQ | |
| 118 | S ERADA1= $P($G(^RCY (344.49,$P (RCIENS,U) ,1,$P(RCIE NS,U,2),0) ),U,9) ; g et 344.41 ien (344.4 91,.09) | |
| 119 | S RCDFDA( 344.41,ERA DA1_","_$P (RCIENS,U) _",",6)=1 | |
| 120 | S RCDFDA( 344.41,ERA DA1_","_$P (RCIENS,U) _",",6.01) =DUZ | |
| 121 | D FILE^DI E("","RCDF DA") | |
| 122 | S DIR(0)= "EA",DIR(" A",1)=$P(R CIENS,U)_" ."_ERADA1_ " has been marked fo r auto-pos t and has been remov ed from th e APAR Lis t." | |
| 123 | S DIR("A" )="PRESS R ETURN TO C ONTINUE " | |
| 124 | W ! D ^DI R K DIR W ! | |
| 125 | L -^RCY(3 44.4,$P(RC IENS,U),0) | |
| 126 | MARKQ ; | |
| 127 | Q | |
| 128 | RoutinesAc tivitiesRo utine Name RCDPEAPEnh ancement C ategory Ne w Modify D elete No C hangeRTMRe lated Opti onsPRCA NI GHTLY PROC ESSRelated RoutinesR outines “C alled By”R outines “C alled” R CDPEAA2 | |
| 129 | RCDPEAD | |
| 130 | RCDPEAP1 | |
| 131 | RCDPEAPP | |
| 132 | RCDPEAPS | |
| 133 | RCDPEM | |
| 134 | RCDPEM0 | |
| 135 | RCDPEM2 | |
| 136 | RCDPEWL8 | |
| 137 | RCDPEX32 | |
| 138 | $$LOCKDEP^ RCDPDPLU | |
| 139 | $$UNBAL^RC DPEAP1 | |
| 140 | ERADET^RCD PEAP1 | |
| 141 | VALID^RCDP EAP1 | |
| 142 | RCPTDET^RC DPEM | |
| 143 | $$BLDRCPT^ RCDPEMA | |
| 144 | RCPTDET^RC DPEMA | |
| 145 | $$ADDREC^R CDPEWL | |
| 146 | ADDLINES^R CDPEWLA | |
| 147 | $$LOCKREC^ RCDPRPLU | |
| 148 | PROCESS^RC DPURE1 | |
| 149 | $$BLDRCPT^ RCDPUREC | |
| 150 | $$FMSSTAT^ RCDPUREC | |
| 151 | $$PENDPAY^ RCDPURETCu rrent Logi c. | |
| 152 | . | |
| 153 | . | |
| 154 | SETSTA(DA, STATUS,RCR EASON) ;Se t ERA auto -post stat us | |
| 155 | ; Log sta tus change | |
| 156 | I '$G(DA) Q | |
| 157 | I $G(STAT US)="" Q | |
| 158 | ; | |
| 159 | D AUDITLO G(DA,STATU S,$G(RCREA SON)) | |
| 160 | ; Update status | |
| 161 | N DIE,DR | |
| 162 | S DIE="^R CY(344.4," ,DR="4.02/ ///"_STATU S D ^DIE | |
| 163 | Q | |
| 164 | ; | |
| 165 | POSTALL(RC ERA) ; all lines in ERA get po sted on fi rst attemp t of auto- post | |
| 166 | ; | |
| 167 | ; RCERA = ien of 34 4.4 | |
| 168 | ; | |
| 169 | ;ERA Rece ipt is cre ated from scratchpad entry - t ype 14 is EDI Lockbo x payment | |
| 170 | S RCRCPTD A=$$BLDRCP T^RCDPUREC (DT,"",+$O (^RC(341.1 ,"AC",14,0 ))) ; Crea tes basic receipt fo r ERA of p ayment typ e EDI LOCK BOX; 2nd p arameter m eans no al pha suffix on receip t number | |
| 171 | D RCPTDET ^RCDPEM(RC SCR,RCRCPT DA,.RCERR) ; Adds de tail to a receipt ba sed on fil e 344.49 | |
| 172 | ; | |
| 173 | ;Unable t o create r eceipt - c lear scrat chpad, res et AUTO-PO ST STATUS = NULL | |
| 174 | I $O(RCER R("")) D C LEAR(RCSCR ),SETSTA(R CERA,"@"," Auto Posti ng: Remove d from Aut o Posting- Unable to create rec eipt") Q | |
| 175 | ; | |
| 176 | ;Lock ERA receipt a nd deposit ticket | |
| 177 | I '$$LOCK REC^RCDPRP LU(RCRCPTD A) Q | |
| 178 | I '$$LOCK DEP^RCDPDP LU(RCDEPTD A) D UNLOC KR Q | |
| 179 | ; | |
| 180 | ;Process Receipt to FMS | |
| 181 | D PROCESS ^RCDPURE1( RCRCPTDA,2 ) | |
| 182 | I $D(^TMP ("RCDPE-RE CEIPT-ERRO R",$J)) D CLEAR(RCSC R),SETSTA( RCERA,"@", "Auto Post ing: Remov ed from Au to Posting -Error in receipt pr ocessing") ,UNLOCKR Q | |
| 183 | ; | |
| 184 | ; update 344, .18 E RA REFEREN CE field | |
| 185 | D ERAREF( RCSCR,RCRC PTDA) | |
| 186 | ; | |
| 187 | ;Unlock d eposit tic ket and re ceipt | |
| 188 | D UNLOCKR | |
| 189 | ; | |
| 190 | ;Update t he audit l og | |
| 191 | D AUDITLO G(RCERA,2, "Auto Post ing: ERA p osted succ essfully") | |
| 192 | ;Update E RA receipt and detai l post sta tus | |
| 193 | S DIE="^R CY(344.4," ,DR=".14// //1;.08/// /"_RCRCPTD A,DA=RCERA D ^DIE | |
| 194 | ;Set ERA auto-post status to 'complete' and updat e latest a uto-post d ate | |
| 195 | S DIE="^R CY(344.4," ,DR="4.01/ ///"_DT_"; 4.02////2" ,DA=RCERA D ^DIE | |
| 196 | ;Update a uto-post d ate for ea ch claim l ine | |
| 197 | N RCLINE, RCSCSUB,RC SCD0 | |
| 198 | S RCSCSUB =0 | |
| 199 | F S RCSC SUB=$O(^RC Y(344.49,R CERA,1,RCS CSUB)) Q:' RCSCSUB D | |
| 200 | . S RCSCD 0=$G(^RCY( 344.49,RCE RA,1,RCSCS UB,0)) | |
| 201 | . ;Ignore if zero v alue (line not on re ceipt) oth erwise get original ERA line s equence | |
| 202 | . Q:'+$P( RCSCD0,U,3 ) S RCLINE =$P(RCSCD0 ,U,9) Q:'R CLINE | |
| 203 | . ;Update ERA line with recei pt number and auto-p ost date | |
| 204 | . N DA,DI E,DR S DA( 1)=RCERA,D A=RCLINE,D IE="^RCY(3 44.4,"_DA( 1)_",1,",D R=".25//// "_RCRCPTDA _";9////"_ DT D ^DIE | |
| 205 | Q | |
| 206 | ; | |
| 207 | POSTERA(RC ERA,RCLINE S) ; only some of th e EEOB lin es passed validation on first attempt (D AY 1) of a uto-post | |
| 208 | ; therefo re assign the receip t number a nd 'partia l' post st atus to ER A summary | |
| 209 | ; | |
| 210 | ; RCERA = ien of 34 4.4 | |
| 211 | ; RCLINES = array o f ERA line reference s | |
| 212 | ; | |
| 213 | ; no line s passed v alidation; at lease 1 EEOB lin e needs to pass vali dation bef ore assign ing a rece ipt to the ERA | |
| 214 | I RCLINES =0 S RCRCP TDA="" G P OSTERAQ | |
| 215 | ;ERA Rece ipt is cre ated from scratchpad entry - t ype 14 is EDI Lockbo x payment | |
| 216 | S RCRCPTD A=$$BLDRCP T^RCDPEMA( RCERA) ; C reates bas ic receipt for ERA o f payment type EDI L OCKBOXA | |
| 217 | D RCPTDET ^RCDPEMA(R CSCR,RCRCP TDA,.RCLIN ES,.RCERR) ; Adds de tail to a receipt ba sed on fil e 344.49 a nd RCLINES array | |
| 218 | ; | |
| 219 | ;Unable t o create r eceipt - c lear scrat chpad, res et AUTO-PO ST STATUS = NULL | |
| 220 | I $O(RCER R("")) D C LEAR(RCSCR ),SETSTA(R CERA,"@"," Auto Posti ng: Remove d from Aut o Posting- Unable to create rec eipt") Q | |
| 221 | ; | |
| 222 | ;Lock ERA receipt a nd deposit ticket | |
| 223 | I '$$LOCK REC^RCDPRP LU(RCRCPTD A) Q | |
| 224 | I '$$LOCK DEP^RCDPDP LU(RCDEPTD A) D UNLOC KR Q | |
| 225 | ; | |
| 226 | ;Process Receipt to FMS | |
| 227 | D PROCESS ^RCDPURE1( RCRCPTDA,2 ) | |
| 228 | I $D(^TMP ("RCDPE-RE CEIPT-ERRO R",$J)) D CLEAR(RCSC R),SETSTA( RCERA,"@", "Auto Post ing: Remov ed from Au to Posting -Error in receipt pr ocessing") ,UNLOCKR Q | |
| 229 | ; | |
| 230 | ; update 344, .18 E RA REFEREN CE field | |
| 231 | D ERAREF( RCSCR,RCRC PTDA) | |
| 232 | ; | |
| 233 | ;Unlock d eposit tic ket and re ceipt | |
| 234 | D UNLOCKR | |
| 235 | ;Update E RA receipt and detai l post sta tus | |
| 236 | S DIE="^R CY(344.4," ,DR=".14// //5;.08/// /"_RCRCPTD A,DA=RCERA D ^DIE | |
| 237 | POSTERAQ ; | |
| 238 | D POSTLNS (RCERA,RCR CPTDA,.RCL INES) | |
| 239 | Q | |
| 240 | ; | |
| 241 | . | |
| 242 | . | |
| 243 | EN2 ;Auto- Post Previ ously Proc essed ERA | |
| 244 | N AUTORCP T,CLAIM,CO MPLETE,EOB IEN,RCERA, RCIFN,RCRC PTDA,RCLIN ES | |
| 245 | S RCERA=0 ,AUTORCPT= 1 ;Variabl e AUTORCPT suppresse s #344 tri gger updat e to ERA r eceipt fie ld | |
| 246 | ;Scan ERA file for auto-post candidates with AUTO -POST STAT US = PARTI AL | |
| 247 | F S RCER A=$O(^RCY( 344.4,"E", 1,RCERA)) Q:'RCERA D | |
| 248 | . ;Ignore if it was just part ially post ed in POST LNS so we do not pro cess again | |
| 249 | . Q:$D(^T MP("RCDPEA P",$J,RCER A)) | |
| 250 | . ;Set re ceipt vari able to nu ll for eac h ERA so t hat the re ceipt numb er from th e previous ERA is no t hanging around | |
| 251 | . S RCRCP TDA="" | |
| 252 | . ;Check if there a re lines t hat are se t for auto -posting a nd if they can be po sted or ha ve errors. | |
| 253 | . K RCLIN ES | |
| 254 | . S RCLIN ES=0 | |
| 255 | . D VALID ^RCDPEAP1( RCERA,.RCL INES) | |
| 256 | . ;If val id lines f ound creat e receipt for those lines (Var iable RCLI NES is onl y incremen ted for va lid lines) | |
| 257 | . I RCLIN ES D | |
| 258 | . . N RCE FTDA,RCDEP TDA,RCRECT DA | |
| 259 | . . ;Get EFT refere nce | |
| 260 | . . S RCE FTDA=$O(^R CY(344.31, "AERA",RCE RA,"")) Q: 'RCEFTDA | |
| 261 | . . ;Get deposit ti cket and E FT receipt | |
| 262 | . . S RCD EPTDA=+$P( $G(^RCY(34 4.3,+$G(^R CY(344.31, +RCEFTDA,0 )),0)),U,3 ),RCRECTDA =+$O(^RCY( 344,"AD",+ RCDEPTDA,0 )) | |
| 263 | . . ;ERA Receipt is created f rom scratc hpad entry - type 14 is EDI Lo ckbox paym ent | |
| 264 | . . S RCR CPTDA=$$BL DRCPT^RCDP EMA(RCERA) ; Creates basic rec eipt for E RA of paym ent type E DI LOCKBOX ; 2nd para meter mean s an alpha suffix on receipt n umber | |
| 265 | . . I 'RC RCPTDA Q ;PRCA*4.5* 318 - Prob lem buildi ng receipt header | |
| 266 | . . K RCE RR | |
| 267 | . . D RCP TDET^RCDPE MA(RCERA,R CRCPTDA,.R CLINES,.RC ERR) ; Add s detail t o a receip t based on file 344. 49 and RCL INES array | |
| 268 | . . ;;Una ble to cre ate receip t - clear scratchpad , reset AU TO-POST ST ATUS = NUL L - PRCA*4 .5*318 - r eplaced fo llowing li ne | |
| 269 | . . ;;I $ O(RCERR("" )) D CLEAR (RCSCR),SE TSTA(RCERA ,"@","Auto Posting: Removed fr om Auto Po sting-Unab le to crea te receipt ") Q | |
| 270 | . . I $O( RCERR("")) Q ; PRCA *4.5*318 - Do not at tempt to p rocess par tially fil ed receipt | |
| 271 | . . ;Lock ERA recei pt and dep osit ticke t | |
| 272 | . . I '$$ LOCKREC^RC DPRPLU(RCR CPTDA) Q | |
| 273 | . . I '$$ LOCKDEP^RC DPDPLU(RCD EPTDA) D U NLOCKR Q | |
| 274 | . . ;Proc ess Receip t to FMS | |
| 275 | . . D PRO CESS^RCDPU RE1(RCRCPT DA,2) I $D (^TMP("RCD PE-RECEIPT -ERROR",$J )) D UNLOC KR Q | |
| 276 | . . ; upd ate 344, . 18 ERA REF ERENCE fie ld | |
| 277 | . . D ERA REF(RCERA, RCRCPTDA) | |
| 278 | . . ;Unlo ck deposit ticket an d receipt | |
| 279 | . . D UNL OCKR | |
| 280 | . ;Update ERA and E RA detail lines with receipt # or auto-p ost reject ion reason | |
| 281 | . D ERADE T^RCDPEAP1 (RCERA,RCR CPTDA,.RCL INES) | |
| 282 | . ;Determ ine if pos ting compl ete for th is ERA | |
| 283 | . S COMPL ETE=$$COMP LETE(RCERA ) | |
| 284 | . ;If com plete upda te ERA det ail post s tatus to P OSTED | |
| 285 | . I COMPL ETE S DIE= "^RCY(344. 4,",DR=".1 4////1",DA =RCERA D ^ DIE | |
| 286 | . ;Update the audit log | |
| 287 | . D AUDIT LOG(RCERA, $S(COMPLET E:2,1:1)," Auto Posti ng: Previo usly proce ssed ERA p osting att empt") | |
| 288 | . ;Set ER A auto-pos t status a nd update latest aut o-post dat e | |
| 289 | . S DIE=" ^RCY(344.4 ,",DR="4.0 1////"_DT_ ";4.02//// "_$S(COMPL ETE:2,1:1) ,DA=RCERA D ^DIE | |
| 290 | ;Unlock E RA | |
| 291 | D UNLOCKE | |
| 292 | QModified Logic (Ch anges are in bold). | |
| 293 | . | |
| 294 | . | |
| 295 | SETSTA(DA, STATUS,RCR EASON) ;Se t ERA auto -post stat us | |
| 296 | ; Log sta tus change | |
| 297 | I '$G(DA) Q | |
| 298 | I $G(STAT US)="" Q | |
| 299 | ; | |
| 300 | D AUDITLO G(DA,STATU S,$G(RCREA SON)) | |
| 301 | ; Update status | |
| 302 | N DIE,DR | |
| 303 | S DIE="^R CY(344.4," | |
| 304 | S DR="4.0 2////"_STA TUS_";4.04 ////”_DUZ | |
| 305 | D ^DIE | |
| 306 | Q | |
| 307 | ; | |
| 308 | POSTALL(RC ERA) ; all lines in ERA get po sted on fi rst attemp t of auto- post | |
| 309 | ; | |
| 310 | ; RCERA = ien of 34 4.4 | |
| 311 | ; | |
| 312 | N RCDUZ | |
| 313 | S RCDUZ=$ $GET1^DIQ( 344.4,RCER A_",",4.04 , "I") | |
| 314 | ;ERA Rece ipt is cre ated from scratchpad entry - t ype 14 is EDI Lockbo x payment | |
| 315 | ;Creates basic rece ipt for ER A of payme nt type ED I LOCKBOX; 2nd param eter means no alpha suffix on receipt nu mber | |
| 316 | S RCRCPTD A=$$BLDRCP T^RCDPUREC (DT,"",+$O (^RC(341.1 ,"AC",14,0 )),RCDUZ) | |
| 317 | D RCPTDET ^RCDPEM(RC SCR,RCRCPT DA,.RCERR, RCDUZ) ; A dds detail to a rece ipt based on file 34 4.49 | |
| 318 | ; | |
| 319 | ;Unable t o create r eceipt - c lear scrat chpad, res et AUTO-PO ST STATUS = NULL | |
| 320 | I $O(RCER R("")) D C LEAR(RCSCR ),SETSTA(R CERA,"@"," Auto Posti ng: Remove d from Aut o Posting- Unable to create rec eipt") Q | |
| 321 | ; | |
| 322 | ;Lock ERA receipt a nd deposit ticket | |
| 323 | I '$$LOCK REC^RCDPRP LU(RCRCPTD A) Q | |
| 324 | I '$$LOCK DEP^RCDPDP LU(RCDEPTD A) D UNLOC KR Q | |
| 325 | ; | |
| 326 | ;Process Receipt to FMS | |
| 327 | D PROCESS ^RCDPURE1( RCRCPTDA,2 ) | |
| 328 | I $D(^TMP ("RCDPE-RE CEIPT-ERRO R",$J)) D CLEAR(RCSC R),SETSTA( RCERA,"@", "Auto Post ing: Remov ed from Au to Posting -Error in receipt pr ocessing") ,UNLOCKR Q | |
| 329 | ; | |
| 330 | ; update 344, .18 E RA REFEREN CE field | |
| 331 | D ERAREF( RCSCR,RCRC PTDA) | |
| 332 | ; | |
| 333 | ;Unlock d eposit tic ket and re ceipt | |
| 334 | D UNLOCKR | |
| 335 | ; | |
| 336 | ;Update t he audit l og | |
| 337 | D AUDITLO G(RCERA,2, "Auto Post ing: ERA p osted succ essfully") | |
| 338 | ;Update E RA receipt and detai l post sta tus | |
| 339 | S DIE="^R CY(344.4," ,DR=".14// //1;.08/// /"_RCRCPTD A,DA=RCERA D ^DIE | |
| 340 | ;Set ERA auto-post status to 'complete' and updat e latest a uto-post d ate | |
| 341 | S DIE="^R CY(344.4," | |
| 342 | S DR="4.0 1////"_DT_ ";4.02//// 2;4.04//// @" ; US195 4 remove a utopost us er when do ne | |
| 343 | S DA=RCER A | |
| 344 | D ^DIE | |
| 345 | ;Update a uto-post d ate for ea ch claim l ine | |
| 346 | N RCLINE, RCSCSUB,RC SCD0 | |
| 347 | S RCSCSUB =0 | |
| 348 | F S RCSC SUB=$O(^RC Y(344.49,R CERA,1,RCS CSUB)) Q:' RCSCSUB D | |
| 349 | . S RCSCD 0=$G(^RCY( 344.49,RCE RA,1,RCSCS UB,0)) | |
| 350 | . ;Ignore if zero v alue (line not on re ceipt) oth erwise get original ERA line s equence | |
| 351 | . Q:'+$P( RCSCD0,U,3 ) S RCLINE =$P(RCSCD0 ,U,9) Q:'R CLINE | |
| 352 | . ;Update ERA line with recei pt number and auto-p ost date | |
| 353 | . N DA,DI E,DR S DA( 1)=RCERA,D A=RCLINE,D IE="^RCY(3 44.4,"_DA( 1)_",1,",D R=".25//// "_RCRCPTDA _";9////"_ DT D ^DIE | |
| 354 | Q | |
| 355 | ; | |
| 356 | POSTERA(RC ERA,RCLINE S) ; only some of th e EEOB lin es passed validation on first attempt (D AY 1) of a uto-post | |
| 357 | ; therefo re assign the receip t number a nd 'partia l' post st atus to ER A summary | |
| 358 | ; | |
| 359 | ; RCERA = ien of 34 4.4 | |
| 360 | ; RCLINES = array o f ERA line reference s | |
| 361 | ; | |
| 362 | ; no line s passed v alidation; at lease 1 EEOB lin e needs to pass vali dation bef ore assign ing a rece ipt to the ERA | |
| 363 | I RCLINES =0 S RCRCP TDA="" G P OSTERAQ | |
| 364 | ;ERA Rece ipt is cre ated from scratchpad entry - t ype 14 is EDI Lockbo x payment | |
| 365 | S RCRCPTD A=$$BLDRCP T^RCDPEMA( RCERA) ; C reates bas ic receipt for ERA o f payment type EDI L OCKBOXA | |
| 366 | D RCPTDET ^RCDPEMA(R CSCR,RCRCP TDA,.RCLIN ES,.RCERR) ; Adds de tail to a receipt ba sed on fil e 344.49 a nd RCLINES array | |
| 367 | ; | |
| 368 | ;Unable t o create r eceipt - c lear scrat chpad, res et AUTO-PO ST STATUS = NULL | |
| 369 | I $O(RCER R("")) D C LEAR(RCSCR ),SETSTA(R CERA,"@"," Auto Posti ng: Remove d from Aut o Posting- Unable to create rec eipt") Q | |
| 370 | ; | |
| 371 | ;Lock ERA receipt a nd deposit ticket | |
| 372 | I '$$LOCK REC^RCDPRP LU(RCRCPTD A) Q | |
| 373 | I '$$LOCK DEP^RCDPDP LU(RCDEPTD A) D UNLOC KR Q | |
| 374 | ; | |
| 375 | ;Process Receipt to FMS | |
| 376 | D PROCESS ^RCDPURE1( RCRCPTDA,2 ) | |
| 377 | I $D(^TMP ("RCDPE-RE CEIPT-ERRO R",$J)) D CLEAR(RCSC R),SETSTA( RCERA,"@", "Auto Post ing: Remov ed from Au to Posting -Error in receipt pr ocessing") ,UNLOCKR Q | |
| 378 | ; | |
| 379 | ; update 344, .18 E RA REFEREN CE field | |
| 380 | D ERAREF( RCSCR,RCRC PTDA) | |
| 381 | ; | |
| 382 | ;Unlock d eposit tic ket and re ceipt | |
| 383 | D UNLOCKR | |
| 384 | ;Update E RA receipt and detai l post sta tus | |
| 385 | S DIE="^R CY(344.4," ,DR=".14// //5;.08/// /"_RCRCPTD A,DA=RCERA D ^DIE | |
| 386 | POSTERAQ ; | |
| 387 | D POSTLNS (RCERA,RCR CPTDA,.RCL INES) | |
| 388 | Q | |
| 389 | ; | |
| 390 | . | |
| 391 | . | |
| 392 | EN2 ;Auto- Post Previ ously Proc essed ERA | |
| 393 | N AUTORCP T,CLAIM,CO MPLETE,EOB IEN,RCDUZ, RCERA,RCIF N,RCRCPTDA ,RCLINES | |
| 394 | S RCERA=0 ,AUTORCPT= 1 ;Variabl e AUTORCPT suppresse s #344 tri gger updat e to ERA r eceipt fie ld | |
| 395 | S RCDUZ=$ $GET1^DIQ( 344.4,RCER A_",",4.04 , "I") | |
| 396 | ;Scan ERA file for auto-post candidates with AUTO -POST STAT US = PARTI AL | |
| 397 | F S RCER A=$O(^RCY( 344.4,"E", 1,RCERA)) Q:'RCERA D | |
| 398 | . ;Ignore if it was just part ially post ed in POST LNS so we do not pro cess again | |
| 399 | . Q:$D(^T MP("RCDPEA P",$J,RCER A)) | |
| 400 | . ;Set re ceipt vari able to nu ll for eac h ERA so t hat the re ceipt numb er from th e previous ERA is no t hanging around | |
| 401 | . S RCRCP TDA="" | |
| 402 | . ;Check if there a re lines t hat are se t for auto -posting a nd if they can be po sted or ha ve errors. | |
| 403 | . K RCLIN ES | |
| 404 | . S RCLIN ES=0 | |
| 405 | . D VALID ^RCDPEAP1( RCERA,.RCL INES) | |
| 406 | . ;If val id lines f ound creat e receipt for those lines (Var iable RCLI NES is onl y incremen ted for va lid lines) | |
| 407 | . I RCLIN ES D | |
| 408 | . . N RCE FTDA,RCDEP TDA,RCRECT DA | |
| 409 | . . ;Get EFT refere nce | |
| 410 | . . S RCE FTDA=$O(^R CY(344.31, "AERA",RCE RA,"")) Q: 'RCEFTDA | |
| 411 | . . ;Get deposit ti cket and E FT receipt | |
| 412 | . . S RCD EPTDA=+$P( $G(^RCY(34 4.3,+$G(^R CY(344.31, +RCEFTDA,0 )),0)),U,3 ),RCRECTDA =+$O(^RCY( 344,"AD",+ RCDEPTDA,0 )) | |
| 413 | . . ;ERA Receipt is created f rom scratc hpad entry - type 14 is EDI Lo ckbox paym ent | |
| 414 | . . S RCR CPTDA=$$BL DRCPT^RCDP EMA(RCERA, RCDUZ) ; C reates bas ic receipt for ERA o f payment type EDI L OCKBOX; 2n d paramete r means an alpha suf fix on rec eipt numbe r | |
| 415 | . . I 'RC RCPTDA Q ;PRCA*4.5* 318 - Prob lem buildi ng receipt header | |
| 416 | . . K RCE RR | |
| 417 | . . D RCP TDET^RCDPE MA(RCERA,R CRCPTDA,.R CLINES,.RC ERR) ; Add s detail t o a receip t based on file 344. 49 and RCL INES array | |
| 418 | . . ;;Una ble to cre ate receip t - clear scratchpad , reset AU TO-POST ST ATUS = NUL L - PRCA*4 .5*318 - r eplaced fo llowing li ne | |
| 419 | . . ;;I $ O(RCERR("" )) D CLEAR (RCSCR),SE TSTA(RCERA ,"@","Auto Posting: Removed fr om Auto Po sting-Unab le to crea te receipt ") Q | |
| 420 | . . I $O( RCERR("")) Q ; PRCA *4.5*318 - Do not at tempt to p rocess par tially fil ed receipt | |
| 421 | . . ;Lock ERA recei pt and dep osit ticke t | |
| 422 | . . I '$$ LOCKREC^RC DPRPLU(RCR CPTDA) Q | |
| 423 | . . I '$$ LOCKDEP^RC DPDPLU(RCD EPTDA) D U NLOCKR Q | |
| 424 | . . ;Proc ess Receip t to FMS | |
| 425 | . . D PRO CESS^RCDPU RE1(RCRCPT DA,2) I $D (^TMP("RCD PE-RECEIPT -ERROR",$J )) D UNLOC KR Q | |
| 426 | . . ; upd ate 344, . 18 ERA REF ERENCE fie ld | |
| 427 | . . D ERA REF(RCERA, RCRCPTDA) | |
| 428 | . . ;Unlo ck deposit ticket an d receipt | |
| 429 | . . D UNL OCKR | |
| 430 | . ;Update ERA and E RA detail lines with receipt # or auto-p ost reject ion reason | |
| 431 | . D ERADE T^RCDPEAP1 (RCERA,RCR CPTDA,.RCL INES) | |
| 432 | . ;Determ ine if pos ting compl ete for th is ERA | |
| 433 | . S COMPL ETE=$$COMP LETE(RCERA ) | |
| 434 | . ;If com plete upda te ERA det ail post s tatus to P OSTED | |
| 435 | . I COMPL ETE S DIE= "^RCY(344. 4,",DR=".1 4////1",DA =RCERA D ^ DIE | |
| 436 | . ;Update the audit log | |
| 437 | . D AUDIT LOG(RCERA, $S(COMPLET E:2,1:1)," Auto Posti ng: Previo usly proce ssed ERA p osting att empt") | |
| 438 | . ;Set ER A auto-pos t status a nd update latest aut o-post dat e | |
| 439 | . S DIE=" ^RCY(344.4 ,",DR="4.0 1////"_DT_ ";4.02//// "_$S(COMPL ETE:2,1:1) ,DA=RCERA D ^DIE | |
| 440 | ;Unlock E RA | |
| 441 | D UNLOCKE | |
| 442 | QRoutines Activities Routine Na meRCDPUREC Enhancemen t Category New Modif y Delete N o ChangeRT MRelated O ptionsPRCA NIGHTLY P ROCESSRela ted Routin esRoutines “Called B y”Routines “Called” RCDPDPL1 | |
| 443 | RCDPDPLM | |
| 444 | RCDPE8NZ | |
| 445 | RCDPEAP | |
| 446 | RCDPEM0 | |
| 447 | RCDPEM2 | |
| 448 | RCDPEMA | |
| 449 | RCDPEREC | |
| 450 | RCDPEWL4 | |
| 451 | RCDPEWL5 | |
| 452 | RCDPEWL7 | |
| 453 | RCDPLPL1 | |
| 454 | RCDPLPL2 | |
| 455 | RCDPLPL4 | |
| 456 | RCDPLPLM | |
| 457 | RCDPRLIS | |
| 458 | RCDPRPL1 | |
| 459 | RCDPRPL3 | |
| 460 | RCDPRPLM | |
| 461 | RCDPTAR | |
| 462 | RCDPTT1 | |
| 463 | RCDPTTA1 | |
| 464 | RCDPURE1 | |
| 465 | RCDPUREC | |
| 466 | RCDPURET | |
| 467 | RCDPUT | |
| 468 | RCDPXPAP$$ STATUS^GEC SSGET | |
| 469 | $$EDILBEV^ RCDPEU | |
| 470 | $$LBEVENT^ RCDPEU | |
| 471 | EDIT4^RCDP URE1Curren t LogicBLD RCPT(TRAND ATE,RCDEPT DA,PAYTYPD A) ; funct ion, Build a receipt with/with out deposi t | |
| 472 | ; LAYGO n ew entry t o AR BATCH PAYMENT f ile (#344) | |
| 473 | ; returns new IEN o n success, else zero | |
| 474 | ; | |
| 475 | N GOTONE, RECEIPT,TY PE | |
| 476 | ; ATTMPT - count of attempts | |
| 477 | ; GOTONE - new rece ipt # flag | |
| 478 | S GOTONE= 0 | |
| 479 | ; build u nique rece ipt number for date | |
| 480 | S TYPE=$E ($G(^RC(34 1.1,PAYTYP DA,0))) I TYPE="" S TYPE="Z" ; ^RC(341. 1,0) = AR EVENT TYPE | |
| 481 | I TYPE="C ",$G(RCDEP TDA)["ERAC HK" S RCDE PTDA=+RCDE PTDA,TYPE= "E" ; ERA plus paper check EDI Lockbox r eceipt | |
| 482 | ; | |
| 483 | ; ----- | |
| 484 | ; PRCA*4. 5*298 - re moved test ing code t hat allowe d for dupl icate rece ipt number s in testi ng environ ments | |
| 485 | ; code fo r checking environme nt: S PROD =$S($$PROD ^XUPROD(1) :"PROD",1: "TEST") | |
| 486 | ; The use r would be prompted for a dupl icate rece ipt number of from 1 to 12 cha rs: | |
| 487 | ; S DIR(0 )="FAO^1:1 2",DIR("A" )="ENTER A DUPLICATE RECEIPT # : " | |
| 488 | ; if user didn't en ter duplic ate receip t #, they would be a sked if th ey wanted a | |
| 489 | ; duplica te receipt # for tes ting. If y es, the co de would i terate: | |
| 490 | ; ;.. F S RECEIPT=$ O(^PRCA(43 3,"AF",REC EIPT)) D Q :DONE | |
| 491 | ; ;... I RECEIPT="" W !!,"NO MORE DUPLI CATE RECEI PT NUMBER SCENARIOS FOUND!",! S DONE=1 H 2 Q | |
| 492 | ; ;... I '$D(^RCY(3 44,"B",REC EIPT)) D | |
| 493 | ; ;.... W !!,"RECEI PT #: "_RE CEIPT_" WA S FOUND & WE WILL AT TEMPT TO U SE IT.",! S DONE=1 H 2 | |
| 494 | ; the cod e was crea ting probl ems during the queue d nightly job in dev elopment e nvironment s | |
| 495 | ; Account s Receivab le Nightly Process B ackground Job [PRCA NIGHTLY PR OCESS] | |
| 496 | ; ----- | |
| 497 | ; | |
| 498 | ;lockbox receipt in the form of L980901 A0, do not include c entury | |
| 499 | F D Q:+ GOTONE&$L( RECEIPT) ; must be n ew and non -null | |
| 500 | .;find a unique rec eipt # | |
| 501 | .S RECEIP T=$$NEXT(T YPE_$E(TRA NDATE,2,7) ) ;get las t two digi ts from 00 to ZZ | |
| 502 | .I RECEIP T="" Q | |
| 503 | .I $D(^RC Y(344,"B", RECEIPT)) Q ; AR BA TCH PAYMEN T file (#3 44), RECEI PT # field (#.01) | |
| 504 | .I $D(^PR CA(433,"AF ",RECEIPT) ) Q ; AR TRANSACTIO N file (#4 33), RECEI PT # field (#13) | |
| 505 | .S GOTONE =1 | |
| 506 | ; | |
| 507 | ; | |
| 508 | L +^RCY(3 44,"B",REC EIPT):DILO CKTM E Q 0 ; PRCA*4 .5*298, if LOCK time out return zero | |
| 509 | ; | |
| 510 | ; add ent ry to AR B ATCH PAYME NT file (# 344) | |
| 511 | N %,%DT,D 0,DA,DD,DI ,DIC,DIE,D LAYGO,DO,D Q,DR,X,Y | |
| 512 | S DIC="^R CY(344,",D IC(0)="L", DLAYGO=344 | |
| 513 | ; .02 = o pened by . 03 = date opened = t ransmissio n dt | |
| 514 | ; .04 = t ype of pay ment .06 = deposit t icket | |
| 515 | ; .14 = s tatus (set to 1:open ) | |
| 516 | S DIC("DR ")=".02/// /"_DUZ_";. 03///"_TRA NDATE_";.0 4////"_PAY TYPDA_$S(R CDEPTDA:"; .06////"_R CDEPTDA,1: "")_";.14/ ///1;" | |
| 517 | S X=RECEI PT | |
| 518 | D FILE^DI CN | |
| 519 | L -^RCY(3 44,"B",REC EIPT) | |
| 520 | I Y>0 Q + Y ; Y set by DICN, return new IEN | |
| 521 | Q 0 ; ent ry not cre atedModifi ed Logic ( Changes ar e in bold) BLDRCPT(TR ANDATE,RCD EPTDA,PAYT YPDA,RCDUZ ) ; functi on, Build a receipt with/witho ut deposit | |
| 522 | ; LAYGO n ew entry t o AR BATCH PAYMENT f ile (#344) | |
| 523 | ; returns new IEN o n success, else zero | |
| 524 | ; | |
| 525 | N GOTONE, RECEIPT,TY PE | |
| 526 | ; ATTMPT - count of attempts | |
| 527 | ; GOTONE - new rece ipt # flag | |
| 528 | S GOTONE= 0 | |
| 529 | ; build u nique rece ipt number for date | |
| 530 | S TYPE=$E ($G(^RC(34 1.1,PAYTYP DA,0))) I TYPE="" S TYPE="Z" ; ^RC(341. 1,0) = AR EVENT TYPE | |
| 531 | I TYPE="C ",$G(RCDEP TDA)["ERAC HK" S RCDE PTDA=+RCDE PTDA,TYPE= "E" ; ERA plus paper check EDI Lockbox r eceipt | |
| 532 | ; | |
| 533 | ; ----- | |
| 534 | ; PRCA*4. 5*298 - re moved test ing code t hat allowe d for dupl icate rece ipt number s in testi ng environ ments | |
| 535 | ; code fo r checking environme nt: S PROD =$S($$PROD ^XUPROD(1) :"PROD",1: "TEST") | |
| 536 | ; The use r would be prompted for a dupl icate rece ipt number of from 1 to 12 cha rs: | |
| 537 | ; S DIR(0 )="FAO^1:1 2",DIR("A" )="ENTER A DUPLICATE RECEIPT # : " | |
| 538 | ; if user didn't en ter duplic ate receip t #, they would be a sked if th ey wanted a | |
| 539 | ; duplica te receipt # for tes ting. If y es, the co de would i terate: | |
| 540 | ; ;.. F S RECEIPT=$ O(^PRCA(43 3,"AF",REC EIPT)) D Q :DONE | |
| 541 | ; ;... I RECEIPT="" W !!,"NO MORE DUPLI CATE RECEI PT NUMBER SCENARIOS FOUND!",! S DONE=1 H 2 Q | |
| 542 | ; ;... I '$D(^RCY(3 44,"B",REC EIPT)) D | |
| 543 | ; ;.... W !!,"RECEI PT #: "_RE CEIPT_" WA S FOUND & WE WILL AT TEMPT TO U SE IT.",! S DONE=1 H 2 | |
| 544 | ; the cod e was crea ting probl ems during the queue d nightly job in dev elopment e nvironment s | |
| 545 | ; Account s Receivab le Nightly Process B ackground Job [PRCA NIGHTLY PR OCESS] | |
| 546 | ; ----- | |
| 547 | ; | |
| 548 | ;lockbox receipt in the form of L980901 A0, do not include c entury | |
| 549 | F D Q:+ GOTONE&$L( RECEIPT) ; must be n ew and non -null | |
| 550 | .;find a unique rec eipt # | |
| 551 | .S RECEIP T=$$NEXT(T YPE_$E(TRA NDATE,2,7) ) ;get las t two digi ts from 00 to ZZ | |
| 552 | .I RECEIP T="" Q | |
| 553 | .I $D(^RC Y(344,"B", RECEIPT)) Q ; AR BA TCH PAYMEN T file (#3 44), RECEI PT # field (#.01) | |
| 554 | .I $D(^PR CA(433,"AF ",RECEIPT) ) Q ; AR TRANSACTIO N file (#4 33), RECEI PT # field (#13) | |
| 555 | .S GOTONE =1 | |
| 556 | ; | |
| 557 | ; | |
| 558 | L +^RCY(3 44,"B",REC EIPT):DILO CKTM E Q 0 ; PRCA*4 .5*298, if LOCK time out return zero | |
| 559 | ; | |
| 560 | ; add ent ry to AR B ATCH PAYME NT file (# 344) | |
| 561 | N %,%DT,D 0,DA,DD,DI ,DIC,DIE,D LAYGO,DO,D Q,DR,X,Y | |
| 562 | S DIC="^R CY(344,",D IC(0)="L", DLAYGO=344 | |
| 563 | ; .02 = o pened by . 03 = date opened = t ransmissio n dt | |
| 564 | ; .04 = t ype of pay ment .06 = deposit t icket | |
| 565 | ; .14 = s tatus (set to 1:open ) | |
| 566 | S DIC("DR ")=".02/// /"_$S($G(R CDUZ:RCDUZ ,1:DUZ) ; US1954 use autoflag person DUZ | |
| 567 | S DIC(“DR ”)=DIC(“DR ”)_";.03// /"_TRANDAT E_";.04/// /"_PAYTYPD A_$S(RCDEP TDA:";.06/ ///"_RCDEP TDA,1:"")_ ";.14////1 ;" | |
| 568 | S X=RECEI PT | |
| 569 | D FILE^DI CN | |
| 570 | L -^RCY(3 44,"B",REC EIPT) | |
| 571 | I Y>0 Q + Y ; Y set by DICN, return new IEN | |
| 572 | Q 0 ; ent ry not cre ated | |
| 573 | RoutinesAc tivitiesRo utine Name RCDPEMEnha ncement Ca tegory New Modify De lete No Ch angeRTMRel ated Optio nsPRCA NIG HTLY PROCE SSRelated RoutinesRo utines “Ca lled By”Ro utines “Ca lled” RC DPEU | |
| 574 | RCDPTTA1 | |
| 575 | SPL1^IBCEO BAR | |
| 576 | EN^RCDPEAD | |
| 577 | EN^RCDPEAP | |
| 578 | AUDIT^RCDP ECH | |
| 579 | $$ADDDEP^R CDPEM0 | |
| 580 | $$ADDREC^R CDPEM0 | |
| 581 | $$SETERR^R CDPEM0 | |
| 582 | MATCH^RCDP EM0 | |
| 583 | STORERR^RC DPEM0 | |
| 584 | BULL^RCDPE M1 | |
| 585 | EN2^RCDPEM 1 | |
| 586 | SENDBULL^R CDPEM1 | |
| 587 | $$AUTO^RCD PEM5 RCPTDET+42 | |
| 588 | EN^RCDPEM8 | |
| 589 | NEWPYR^RCD PESP | |
| 590 | $$CHKSUM^R CDPESR3 | |
| 591 | EN^RCDPEX4 | |
| 592 | CONFIRM^RC DPUDEP | |
| 593 | $$ADDTRAN^ RCDPURET Current Lo gic. | |
| 594 | . | |
| 595 | RCPTDET(RC RZ,RECTDA1 ,RCER) ; A dds detail to a rece ipt based on file 34 4.49 | |
| 596 | ; RCRZ = ien of ERA entry in file 344.4 9 | |
| 597 | ; RECTDA1 = ien of receipt en try in fil e 344 | |
| 598 | ; RCER = error arra y returned if passed by refere nce | |
| 599 | ; | |
| 600 | N DA,DIE, DR,Q,RCR,R CSPL,RCZ0, RCTRANDA,R CQ,X,Y,Z0, Z1,Z ; PRC A*4.5*318 | |
| 601 | ; | |
| 602 | S RCR=0 F S RCR=$O (^RCY(344. 49,RCRZ,1, RCR)) Q:'R CR D | |
| 603 | . S RCZ0= $G(^RCY(34 4.49,RCRZ, 1,RCR,0)) | |
| 604 | . I $P(RC Z0,U)'["." S RCSPL(+ RCZ0)=$P(R CZ0,U,9) Q | |
| 605 | . I $S(+$ P(RCZ0,U,3 )=0:$P($G( ^RCY(344.4 9,RCRZ,0)) ,U,3),1:$P (RCZ0,U,3) <0) S RCSP L(RCZ0\1,+ RCZ0)=RCZ0 Q | |
| 606 | . S RCTRA NDA=$$ADDT RAN^RCDPUR ET(RECTDA1 ) | |
| 607 | . ;Modifi ed Logic ( Changes ar e in bold) . | |
| 608 | . | |
| 609 | RCPTDET(RC RZ,RECTDA1 ,RCER,RCDU Z) ; Adds detail to a receipt based on f ile 344.49 | |
| 610 | ; RCRZ = ien of ERA entry in file 344.4 9 | |
| 611 | ; RECTDA1 = ien of receipt en try in fil e 344 | |
| 612 | ; RCER = error arra y returned if passed by refere nce | |
| 613 | ; | |
| 614 | N DA,DIE, DR,Q,RCR,R CSPL,RCZ0, RCTRANDA,R CQ,X,Y,Z0, Z1,Z ; PRC A*4.5*318 | |
| 615 | ; | |
| 616 | S RCR=0 F S RCR=$O (^RCY(344. 49,RCRZ,1, RCR)) Q:'R CR D | |
| 617 | . S RCZ0= $G(^RCY(34 4.49,RCRZ, 1,RCR,0)) | |
| 618 | . I $P(RC Z0,U)'["." S RCSPL(+ RCZ0)=$P(R CZ0,U,9) Q | |
| 619 | . I $S(+$ P(RCZ0,U,3 )=0:$P($G( ^RCY(344.4 9,RCRZ,0)) ,U,3),1:$P (RCZ0,U,3) <0) S RCSP L(RCZ0\1,+ RCZ0)=RCZ0 Q | |
| 620 | . S RCTRA NDA=$$ADDT RAN^RCDPUR ET(RECTDA1 ,RCDUZ) | |
| 621 | . ; | |
| 622 | RoutinesAc tivitiesRo utine Name RCDPURETEn hancement Category N ew Modify Delete No ChangeRTMR elated Opt ionsPRCA N IGHTLY PRO CESSRelate d Routines Routines “ Called By” Routines “ Called” RCDPAPLI | |
| 623 | RCDPEAD | |
| 624 | RCDPEAP | |
| 625 | RCDPEM | |
| 626 | RCDPEAM0 | |
| 627 | RCDPEAMA | |
| 628 | RCDPEWL5 | |
| 629 | RCDPLPL1 | |
| 630 | RCDPLPL2 | |
| 631 | RCDPLPL3 | |
| 632 | RCDPLPL4 | |
| 633 | RCDPRPL1 | |
| 634 | RCDPRPL3 | |
| 635 | RCDPURED | |
| 636 | RCDPXPAP | |
| 637 | RCXFMSCR$$ BAL^PRCAFN | |
| 638 | AUDIT^RCBE PAY | |
| 639 | SUSPDIS^RC BEPAY | |
| 640 | RECEIPT^RC DPRECT | |
| 641 | LASTEDIT^R CDPURECCur rent Logic . | |
| 642 | . | |
| 643 | ; | |
| 644 | ADDTRAN(RE CTDA) ; ad d transact ion for re ceipt (in da) | |
| 645 | N %DT,%T, D0,DA,DD,D I,DIC,DIE, DINUM,DLAY GO,DO,DQ,D R,X,Y | |
| 646 | I '$D(^RC Y(344,RECT DA,1,0)) S ^(0)="^34 4.01A^" | |
| 647 | ; | |
| 648 | ; find ne xt transac tion numbe r | |
| 649 | S X=$O(^R CY(344,REC TDA,1,9999 999),-1) | |
| 650 | F X=X+1:1 Q:'$D(^RC Y(344,RECT DA,1,X,0)) | |
| 651 | S DINUM=X | |
| 652 | ; | |
| 653 | S DA(1)=R ECTDA | |
| 654 | S DIC="^R CY(344,"_R ECTDA_",1, ",DIC(0)=" L",DLAYGO= 344.01 | |
| 655 | S DIC("DR ")=".12/// /"_DUZ_";. 06///TODAY ;" | |
| 656 | D FILE^DI CN | |
| 657 | Q +Y | |
| 658 | ;Modified Logic (Ch anges are in bold). | |
| 659 | . | |
| 660 | ; | |
| 661 | ADDTRAN(RE CTDA,RCDUZ ) ; add tr ansaction for receip t (in da) | |
| 662 | N %DT,%T, D0,DA,DD,D I,DIC,DIE, DINUM,DLAY GO,DO,DQ,D R,X,Y | |
| 663 | I '$D(^RC Y(344,RECT DA,1,0)) S ^(0)="^34 4.01A^" | |
| 664 | ; | |
| 665 | ; find ne xt transac tion numbe r | |
| 666 | S X=$O(^R CY(344,REC TDA,1,9999 999),-1) | |
| 667 | F X=X+1:1 Q:'$D(^RC Y(344,RECT DA,1,X,0)) | |
| 668 | S DINUM=X | |
| 669 | ; | |
| 670 | S DA(1)=R ECTDA | |
| 671 | S DIC="^R CY(344,"_R ECTDA_",1, ",DIC(0)=" L",DLAYGO= 344.01 | |
| 672 | S DIC("DR ")=".12/// /"_$S($G(R CDUZ):RCDU Z,1:DUZ)_" ;.06///TOD AY;" | |
| 673 | D FILE^DI CN | |
| 674 | Q +Y | |
| 675 | ; | |
| 676 | RoutinesAc tivitiesRo utine Name RCDPEMAEnh ancement C ategory Ne w Modify D elete No C hangeRTMRe lated Opti onsPRCA NI GHTLY PROC ESSRelated RoutinesR outines “C alled By”R outines “C alled” R CDPEAPPL1^ IBCEOBAR | |
| 677 | AUDIT^RCDP ECH | |
| 678 | $$SETERR^R CDPEM0 | |
| 679 | $$AUTO^RCD PEM5 | |
| 680 | $$NEXT^RCD PUREC | |
| 681 | $$ADDTRAN^ RCDPURETCu rrent Logi c. | |
| 682 | . | |
| 683 | RCPTDET(RC RZ,RECTDA1 ,RCLINES,R CER) ; Add s detail t o a receip t based on file 344. 49 and exc eptions in array RCL INES | |
| 684 | ; RCRZ = ien of ERA entry in file 344.4 9 | |
| 685 | ; RECTDA1 = ien of receipt en try in fil e 344 | |
| 686 | ; RCER = error arra y returned if passed by refere nce | |
| 687 | ; RCLINES = array t o indicate which scr atchpad li nes can be posted (a ssigned a receipt) | |
| 688 | ; | |
| 689 | N DA,DIE, DR,Q,RCLIN E,RCQ,RCR, RCSPL,RCTR ANDA,RCZ0, SEQLINES,R CSEQ,X,Y,Z ,Z0,Z1 | |
| 690 | ; | |
| 691 | S RCR=0 F S RCR=$O (^RCY(344. 49,RCRZ,1, RCR)) Q:'R CR D | |
| 692 | . S RCZ0= $G(^RCY(34 4.49,RCRZ, 1,RCR,0)), RCSEQ=$P(R CZ0,U) | |
| 693 | . ;Check first line for prefi x to see i f ERA line is valid for auto-p ost | |
| 694 | . I RCSEQ ?1N.N,$P(R CZ0,U,9),$ P($G(RCLIN ES($P(RCZ0 ,U,9))),U) S SEQLINE S(RCSEQ)=" " | |
| 695 | . ;Skip W ORKLIST li nes that d o not need associate d receipt detail | |
| 696 | . Q:'$D(S EQLINES(RC SEQ\1)) | |
| 697 | . I RCSEQ '["." S RC SPL(+RCZ0) =$P(RCZ0,U ,9) Q | |
| 698 | . I $S(+$ P(RCZ0,U,3 )=0:$P($G( ^RCY(344.4 9,RCRZ,0)) ,U,3),1:$P (RCZ0,U,3) <0) S RCSP L(RCZ0\1,+ RCZ0)=RCZ0 Q | |
| 699 | . S RCTRA NDA=$$ADDT RAN^RCDPUR ET(RECTDA1 ) | |
| 700 | . ; | |
| 701 | . I RCTRA NDA'>0 D Q ; Error adding re ceipt deta il - PRCA* 4.5*318 | |
| 702 | .. S RCER (1)=$$SETE RR^RCDPEM0 (1) ; PRCA *4.5*318 - pass RCPR OC value t o $$SETERR | |
| 703 | .. S RCER ($O(RCER(" "),-1)+1)= " NO DETAI L LINE ADD ED TO RECE IPT "_$P($ G(^RCY(344 ,RECTDA1,0 )),U)_" FO R LINE #"_ $P(RCZ0,U) _" IN EEOB WORKLIST SCRATCH PA D" | |
| 704 | . ; | |
| 705 | . ;Store receipt li ne detail | |
| 706 | . D DET(R CRZ,RCR,RE CTDA1,RCTR ANDA) | |
| 707 | . S RCSPL (RCZ0\1,+R CZ0)=RCZ0 | |
| 708 | ; | |
| 709 | ; Update A/R CORREC TED PAYMEN T multiple with appo rtionment for split lines | |
| 710 | S Z=0 F S Z=$O(RCS PL(Z)) Q:' Z S RCQ=+ $G(RCSPL(Z )) I RCQ D | |
| 711 | .; Move E EOB if one claim ent ered-chang ed 10/19/1 1-see +25^ RCDPEWL8 | |
| 712 | . S Z1=$O (RCSPL(Z," ")) Q:Z1=" " | |
| 713 | . I $O(RC SPL(Z,""), -1)=Z1,'$$ SPLIT(Z,Z1 ,RCERA) Q ; No spli t occurred | |
| 714 | . S Z1=0 F S Z1=$O (RCSPL(Z,Z 1)) Q:'Z1 S Z0=$G(R CSPL(Z,Z1) ) D | |
| 715 | .. S Q=+$ P($G(^RCY( 344.4,RCRZ ,1,RCQ,0)) ,U,2) ; EO B detail r ec | |
| 716 | .. Q:'Q | |
| 717 | .. I '$P( Z0,U,7)!($ P(Z0,U,2)= "") D ; S uspense | |
| 718 | ... D SPL 1^IBCEOBAR (Q,$S($P(Z 0,U,2)="": "NO BILL", 1:$P(Z0,U, 2)),"",$P( Z0,U,6)) ; IA 4050 | |
| 719 | .. E D | |
| 720 | ... D SPL 1^IBCEOBAR (Q,$P(Z0,U ,2),$P(Z0, U,7),$P(Z0 ,U,6)) ; A dd the spl it bill # ; IA 4050 | |
| 721 | . ; BEGIN - PRCA*4. 5*321 | |
| 722 | . ;Move/C opy/Remove EEOB deta il for spl it line | |
| 723 | . N CLAIM ,RCSPLIT,R CZSAV | |
| 724 | . ; Sub-a rray of sp lit claim detail for individua l line | |
| 725 | . M RCSPL IT=RCSPL(Z ) | |
| 726 | . ; Prote ct Z subsc ript varia ble from o verwrite b y triggers | |
| 727 | . S RCZSA V=Z | |
| 728 | . ; Origi nal claim number fro m Scratchp ad line | |
| 729 | . S CLAIM =$$GET1^DI Q(344.491, Z_","_RCRZ _",",.02) | |
| 730 | . ; Autom atic Move/ Copy/Remov e EOB | |
| 731 | . I $$AUT O^RCDPEM5( CLAIM,.RCS PLIT,RCERA ,"A") | |
| 732 | . ; Resto re Z | |
| 733 | . S Z=RCZ SAV | |
| 734 | . ; END - PRCA*4.5* 321 ; | |
| 735 | Q | |
| 736 | . | |
| 737 | . | |
| 738 | BLDRCPT(RC ERA) ; Cre ate a rece ipt for Au to Posting ERA with multiple R eceipts - alpha char at the 10 th charact er | |
| 739 | ; LAYGO n ew entry t o AR BATCH PAYMENT f ile (#344) | |
| 740 | ; input - RCERA = P ointer to 344.4 | |
| 741 | ; returns new IEN o n success, else zero | |
| 742 | ; called by auto-po st process (RCDPEAP) | |
| 743 | ; | |
| 744 | N RECEIPT ,TYPE,LAST REC | |
| 745 | S TYPE=$E ($G(^RC(34 1.1,+$O(^R C(341.1,"A C",14,0)), 0))) ; ^RC (341.1,0) = AR EVENT TYPE | |
| 746 | ; retriev e the last receipt r ecorded on the ERA ( if it exis ts) | |
| 747 | S LASTREC =$$GETREC( RCERA) | |
| 748 | ; Make su re last re ceipt for the ERA is 10-chars long and t he last ch ar is betw een A - Y (can't be Z), | |
| 749 | ; Otherwi se grab a new number and appen d "A" | |
| 750 | I LASTREC '="",$L(LA STREC)=10, $A($E(LAST REC,10))>6 4,$A($E(LA STREC,10)) <90 D | |
| 751 | . S RECEI PT=$E(LAST REC,1,9)_$ C($A($E(LA STREC,10)) +1) | |
| 752 | E D | |
| 753 | . S RECEI PT=$$NEXT^ RCDPUREC(T YPE_$E(DT, 2,7))_"A" | |
| 754 | ; | |
| 755 | ; Prevent s duplicat e Receipt # entries from being filed | |
| 756 | F Q:'$D( ^RCY(344," B",RECEIPT )) D | |
| 757 | . S RECEI PT=$E(RECE IPT,1)_$E( 1000001+$E (RECEIPT,2 ,7),2,7)_$ E(RECEIPT, 8,9)_"A" | |
| 758 | ; | |
| 759 | L +^RCY(3 44,"B",REC EIPT):DILO CKTM E Q 0 ; if LOC K timeout return zer o | |
| 760 | ; | |
| 761 | ; add ent ry to AR B ATCH PAYME NT file (# 344) | |
| 762 | N %,%DT,D 0,DA,DD,DI ,DIC,DIE,D LAYGO,DO,D Q,DR,X,Y | |
| 763 | S DIC="^R CY(344,",D IC(0)="L", DLAYGO=344 | |
| 764 | ; .02 = o pened by . 03 = date opened = t ransmissio n date | |
| 765 | ; .04 = t ype of pay ment | |
| 766 | ; .14 = s tatus (set to 1:open ) | |
| 767 | S DIC("DR ")=".02/// /"_DUZ_";. 03///"_DT_ ";.04////1 4;.14////1 ;" | |
| 768 | S X=RECEI PT | |
| 769 | D FILE^DI CN | |
| 770 | L -^RCY(3 44,"B",REC EIPT) | |
| 771 | I Y>0 Q + Y ; Y set by DICN, return new IEN | |
| 772 | Q 0 ; ent ry not cre ated | |
| 773 | ;Modified Logic (Ch anges are in bold). | |
| 774 | . | |
| 775 | RCPTDET(RC RZ,RECTDA1 ,RCLINES,R CER) ; Add s detail t o a receip t based on file 344. 49 and exc eptions in array RCL INES | |
| 776 | ; RCRZ = ien of ERA entry in file 344.4 9 | |
| 777 | ; RECTDA1 = ien of receipt en try in fil e 344 | |
| 778 | ; RCER = error arra y returned if passed by refere nce | |
| 779 | ; RCLINES = array t o indicate which scr atchpad li nes can be posted (a ssigned a receipt) | |
| 780 | ; | |
| 781 | N DA,DIE, DR,Q,RCDUZ ,RCLINE,RC OSQ,RCQ,RC R,RCSEQ,RC SPL,RCTRAN DA,RCZ0,SE QLINES,X,Y ,Z,Z0,Z1 | |
| 782 | ; | |
| 783 | S RCR=0 F S RCR=$O (^RCY(344. 49,RCRZ,1, RCR)) Q:'R CR D | |
| 784 | . S RCZ0= $G(^RCY(34 4.49,RCRZ, 1,RCR,0)), RCSEQ=$P(R CZ0,U) | |
| 785 | . S RCOSE Q=$P(RCZ0, U,9) | |
| 786 | . ;Check first line for prefi x to see i f ERA line is valid for auto-p ost | |
| 787 | . I RCSEQ ?1N.N,$P(R CZ0,U,9),$ P($G(RCLIN ES(RCOSEQ) ),U) S SEQ LINES(RCSE Q)="" | |
| 788 | . ;Skip W ORKLIST li nes that d o not need associate d receipt detail | |
| 789 | . Q:'$D(S EQLINES(RC SEQ\1)) | |
| 790 | . I RCSEQ '["." S RC SPL(+RCZ0) =$P(RCZ0,U ,9) Q | |
| 791 | . I $S(+$ P(RCZ0,U,3 )=0:$P($G( ^RCY(344.4 9,RCRZ,0)) ,U,3),1:$P (RCZ0,U,3) <0) S RCSP L(RCZ0\1,+ RCZ0)=RCZ0 Q | |
| 792 | . S RCDUZ =$$GET1^DI Q(344.41,R COSEQ_","_ RCRZ_",",6 .01, "I") | |
| 793 | . S RCTRA NDA=$$ADDT RAN^RCDPUR ET(RECTDA1 ,RCDUZ) | |
| 794 | . ; | |
| 795 | . I RCTRA NDA'>0 D Q ; Error adding re ceipt deta il - PRCA* 4.5*318 | |
| 796 | .. S RCER (1)=$$SETE RR^RCDPEM0 (1) ; PRCA *4.5*318 - pass RCPR OC value t o $$SETERR | |
| 797 | .. S RCER ($O(RCER(" "),-1)+1)= " NO DETAI L LINE ADD ED TO RECE IPT "_$P($ G(^RCY(344 ,RECTDA1,0 )),U)_" FO R LINE #"_ $P(RCZ0,U) _" IN EEOB WORKLIST SCRATCH PA D" | |
| 798 | . ; | |
| 799 | . ;Store receipt li ne detail | |
| 800 | . D DET(R CRZ,RCR,RE CTDA1,RCTR ANDA) | |
| 801 | . S RCSPL (RCZ0\1,+R CZ0)=RCZ0 | |
| 802 | ; | |
| 803 | ; Update A/R CORREC TED PAYMEN T multiple with appo rtionment for split lines | |
| 804 | S Z=0 F S Z=$O(RCS PL(Z)) Q:' Z S RCQ=+ $G(RCSPL(Z )) I RCQ D | |
| 805 | .; Move E EOB if one claim ent ered-chang ed 10/19/1 1-see +25^ RCDPEWL8 | |
| 806 | . S Z1=$O (RCSPL(Z," ")) Q:Z1=" " | |
| 807 | . I $O(RC SPL(Z,""), -1)=Z1,'$$ SPLIT(Z,Z1 ,RCERA) Q ; No spli t occurred | |
| 808 | . S Z1=0 F S Z1=$O (RCSPL(Z,Z 1)) Q:'Z1 S Z0=$G(R CSPL(Z,Z1) ) D | |
| 809 | .. S Q=+$ P($G(^RCY( 344.4,RCRZ ,1,RCQ,0)) ,U,2) ; EO B detail r ec | |
| 810 | .. Q:'Q | |
| 811 | .. I '$P( Z0,U,7)!($ P(Z0,U,2)= "") D ; S uspense | |
| 812 | ... D SPL 1^IBCEOBAR (Q,$S($P(Z 0,U,2)="": "NO BILL", 1:$P(Z0,U, 2)),"",$P( Z0,U,6)) ; IA 4050 | |
| 813 | .. E D | |
| 814 | ... D SPL 1^IBCEOBAR (Q,$P(Z0,U ,2),$P(Z0, U,7),$P(Z0 ,U,6)) ; A dd the spl it bill # ; IA 4050 | |
| 815 | . ; BEGIN - PRCA*4. 5*321 | |
| 816 | . ;Move/C opy/Remove EEOB deta il for spl it line | |
| 817 | . N CLAIM ,RCSPLIT,R CZSAV | |
| 818 | . ; Sub-a rray of sp lit claim detail for individua l line | |
| 819 | . M RCSPL IT=RCSPL(Z ) | |
| 820 | . ; Prote ct Z subsc ript varia ble from o verwrite b y triggers | |
| 821 | . S RCZSA V=Z | |
| 822 | . ; Origi nal claim number fro m Scratchp ad line | |
| 823 | . S CLAIM =$$GET1^DI Q(344.491, Z_","_RCRZ _",",.02) | |
| 824 | . ; Autom atic Move/ Copy/Remov e EOB | |
| 825 | . I $$AUT O^RCDPEM5( CLAIM,.RCS PLIT,RCERA ,"A") | |
| 826 | . ; Resto re Z | |
| 827 | . S Z=RCZ SAV | |
| 828 | . ; END - PRCA*4.5* 321 ; | |
| 829 | Q | |
| 830 | . | |
| 831 | . | |
| 832 | BLDRCPT(RC ERA,RCDUZ) ; Create a receipt for Auto P osting ERA with mult iple Recei pts - alph a char at the 10th c haracter | |
| 833 | ; LAYGO n ew entry t o AR BATCH PAYMENT f ile (#344) | |
| 834 | ; input - RCERA = P ointer to 344.4 | |
| 835 | ; returns new IEN o n success, else zero | |
| 836 | ; called by auto-po st process (RCDPEAP) | |
| 837 | ; | |
| 838 | N RECEIPT ,TYPE,LAST REC | |
| 839 | S TYPE=$E ($G(^RC(34 1.1,+$O(^R C(341.1,"A C",14,0)), 0))) ; ^RC (341.1,0) = AR EVENT TYPE | |
| 840 | ; retriev e the last receipt r ecorded on the ERA ( if it exis ts) | |
| 841 | S LASTREC =$$GETREC( RCERA) | |
| 842 | ; Make su re last re ceipt for the ERA is 10-chars long and t he last ch ar is betw een A - Y (can't be Z), | |
| 843 | ; Otherwi se grab a new number and appen d "A" | |
| 844 | I LASTREC '="",$L(LA STREC)=10, $A($E(LAST REC,10))>6 4,$A($E(LA STREC,10)) <90 D | |
| 845 | . S RECEI PT=$E(LAST REC,1,9)_$ C($A($E(LA STREC,10)) +1) | |
| 846 | E D | |
| 847 | . S RECEI PT=$$NEXT^ RCDPUREC(T YPE_$E(DT, 2,7))_"A" | |
| 848 | ; | |
| 849 | ; Prevent s duplicat e Receipt # entries from being filed | |
| 850 | F Q:'$D( ^RCY(344," B",RECEIPT )) D | |
| 851 | . S RECEI PT=$E(RECE IPT,1)_$E( 1000001+$E (RECEIPT,2 ,7),2,7)_$ E(RECEIPT, 8,9)_"A" | |
| 852 | ; | |
| 853 | L +^RCY(3 44,"B",REC EIPT):DILO CKTM E Q 0 ; if LOC K timeout return zer o | |
| 854 | ; | |
| 855 | ; add ent ry to AR B ATCH PAYME NT file (# 344) | |
| 856 | N %,%DT,D 0,DA,DD,DI ,DIC,DIE,D LAYGO,DO,D Q,DR,X,Y | |
| 857 | S DIC="^R CY(344,",D IC(0)="L", DLAYGO=344 | |
| 858 | ; .02 = o pened by . 03 = date opened = t ransmissio n date | |
| 859 | ; .04 = t ype of pay ment | |
| 860 | ; .14 = s tatus (set to 1:open ) | |
| 861 | S DIC("DR ")=".02/// /"_$S($G(R CDUZ):RCDU Z,1:DUZ)_" ;.03///"_D T_";.04/// /14;.14/// /1;" | |
| 862 | S X=RECEI PT | |
| 863 | D FILE^DI CN | |
| 864 | L -^RCY(3 44,"B",REC EIPT) | |
| 865 | I Y>0 Q + Y ; Y set by DICN, return new IEN | |
| 866 | Q 0 ; ent ry not cre ated | |
| 867 | ; |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.