Produced by Araxis Merge on 8/2/2017 2:39:15 PM Eastern 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 | OSCIF_MCCF EDI TAS_ PRCA_4.5_318_July_2017.zip | MCCF EDI TAS US56 SDD.docx | Tue Apr 4 21:24:02 2017 UTC |
| 2 | OSCIF_MCCF EDI TAS_ PRCA_4.5_318_July_2017.zip | MCCF EDI TAS US56 SDD.docx | Wed Aug 2 15:18:06 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 2 | 3156 |
| Changed | 0 | 0 |
| Inserted | 0 | 0 |
| Removed | 1 | 4 |
| 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 US56 (f ormerly US PY-30) | ||
| 2 | System Des ign Docume nt | ||
| 3 | PRCA*4.5*3 18 | ||
| 4 | |||
| 5 | |||
| 6 | |||
| 7 | |||
| 8 | Department of Vetera ns Affairs | ||
| 9 | March 2017 | ||
| 10 | Version 1 | ||
| 11 | User Story Number: U S56 | ||
| 12 | User Story Name: Cle rk needs a uto-decrea se report to reflect all CARCs associate d with the decrease (Backlog I D# 328, Ro w 226) – f ormerly US PY-30 | ||
| 13 | Story | ||
| 14 | As a user, I need th e auto-dec rease repo rt to disp lay all de crease cod es used in adjudicat ing a clai m and the dollar amo unt associ ated with the CARC. This allo ws a user to properl y analyze the paymen t for eval uating tha t VA has r eceived th e correct payment am ount and h as not bee n underpai d, nor ove rpaid for services r endered. Each CARC code has a specific dialogue a ssociated with it, a nd is univ ersal acro ss payment systems. | ||
| 15 | Conversati on | ||
| 16 | Auto-Decre ase Adjust ment Repor t [RCDPE A UTO-DECREA SE REPORT] | ||
| 17 | A clerk ne eds an aut o-decrease report to reflect a ll CARCs a ssociated with the d ecrease. The FY13 A uto-Decrea se audit r eport DOES NOT show CARC’s tha t were use d for decr ease at th e line lev el. The F Y14 didn’t update th e report t o reflect the line l evel infor mation. I t shows a decrease, but not th e CARC – w hich is a key piece of the dec rease. | ||
| 18 | The header of the re port shoul d show the sort sele ction. | ||
| 19 | |||
| 20 | Resoluti on – Added Changed O bjects | ||
| 21 | |||
| 22 | Routines | ||
| 23 | Activities | ||
| 24 | Routine Na me | ||
| 25 | RCDPEADP | ||
| 26 | Enhancemen t Category | ||
| 27 | New | ||
| 28 | Modify | ||
| 29 | Delete | ||
| 30 | No Change | ||
| 31 | RTM | ||
| 32 | |||
| 33 | Related Op tions | ||
| 34 | RCDPE AUTO -DECREASE REPORT | ||
| 35 | Routines | ||
| 36 | Activities | ||
| 37 | Data Dicti onary (DD) Reference s | ||
| 38 | |||
| 39 | Related Pr otocols | ||
| 40 | |||
| 41 | Related In tegration Control Re gistration s (ICRs) | ||
| 42 | Previously existing and activa ted ICR’s | ||
| 43 | Read ^DGCR (399) via Priva te IA 3820 | ||
| 44 | Read ^DG(4 0.8) via Contr olled IA 4 17 | ||
| 45 | Read ^IBM( 361.1) via Priva te IA 4051 | ||
| 46 | Use DIVISI ON^VAUTOMA via Contr olled IA 6 64 | ||
| 47 | |||
| 48 | Data Passi ng | ||
| 49 | Input | ||
| 50 | Output Re ference | ||
| 51 | Both | ||
| 52 | Global Re ference | ||
| 53 | Local | ||
| 54 | Input Attr ibute Name and Defin ition | ||
| 55 | Name: | ||
| 56 | Definition : | ||
| 57 | Output Att ribute Nam e and Defi nition | ||
| 58 | Name: | ||
| 59 | Definition : | ||
| 60 | |||
| 61 | Related Ro utines | ||
| 62 | Routines “ Called By” | ||
| 63 | Routines “ Called” | ||
| 64 | |||
| 65 | RCDPENR1 | ||
| 66 | RCDPENR2 | ||
| 67 | RCDPENR3 | ||
| 68 | RCDPENR4 | ||
| 69 | CARCS^RCDP EAD1 | ||
| 70 | COMPILE^RC DPEAD1 | ||
| 71 | HDR^RCDPEA D1 | ||
| 72 | TOTALD^RCD PEAD1 TOTALG^RCD PEAD1 | ||
| 73 | ENDORPRT^R CDPEARL | ||
| 74 | INFO^RCDPE M6 | ||
| 75 | PNM4^RCDPE WL1 | ||
| 76 | |||
| 77 | |||
| 78 | |||
| 79 | Current Lo gic | ||
| 80 | RCDPEADP ; OIFO-BAYPI NES/PJH - AUTO-DECRE ASE REPORT ;Nov 23, 2014@12:48 :50 | ||
| 81 | ; ;4.5;Accou nts Receiv able;**298 **;Mar 20, 1995;Buil d 121 | ||
| 82 | ; Per VA Dir ective 640 2, this ro utine shou ld not be modified. | ||
| 83 | ; Read ^DGCR (399) via Private IA 3820 | ||
| 84 | ; Read ^DG(4 0.8) via C ontrolled IA 417 | ||
| 85 | ; Read ^IBM( 361.1) via Private I A 4051 | ||
| 86 | ; Use DIVISI ON^VAUTOMA via Contr olled IA 6 64 | ||
| 87 | ; | ||
| 88 | RPT ; entry poi nt for Aut o-Decrease Adjustmen t report [ RCDPE AUTO -DECREASE REPORT] | ||
| 89 | N %ZIS,RCDI SP,RCDIV,R CDTRNG,RCP AGE,RCPAY, RCPROG,RCR ANGE,RCSOR T,RCVAUTD, STANAM,STA NUM,VAUTD, X,Y | ||
| 90 | ; Initialize page and start poin t | ||
| 91 | S (RCDTRNG, RCPAGE)=0, RCPROG="RC DPEADP" | ||
| 92 | ; Select Fil ter/Sort b y Division | ||
| 93 | D STADIV Q: 'RCDIV | ||
| 94 | ; Select sor t criteria | ||
| 95 | S DIR(0)="S A^C:CLAIM; P:PAYER;N: PATIENT NA ME;",DIR(" A")="SORT BY (C)LAIM #, (P)AYE R or PATIE NT (N)AME? : ",DIR("B ")="CLAIM" D | ||
| 96 | ^DIR K DI R Q:$D(DTO UT)!$D(DUO UT) | ||
| 97 | S RCSORT=Y | ||
| 98 | ; Select dis play order within so rt | ||
| 99 | S DIR("A")= "SORT "_$S (RCSORT="C ":"CLAIM", RCSORT="P" :"PAYER",1 :"PATIENT NAME")_" ( F)IRST TO LAST OR (L )AST TO FI RST?: " | ||
| 100 | S DIR(0)="S A^F:FIRST TO LAST;L: LAST TO FI RST",DIR(" B")="FIRST TO LAST" D ^DIR K D IR Q:$D(DT OUT)!$D(DU OUT) | ||
| 101 | I Y="L" S R CSORT=RCSO RT_";-" | ||
| 102 | ; Select Dat e Range fo r Report | ||
| 103 | S RCRANGE=$ $DTRNG() Q :RCRANGE=0 | ||
| 104 | ; Select Dis play Type | ||
| 105 | S RCDISP=$$ DISPTY() Q :RCDISP=-1 | ||
| 106 | ; Display ca pture info rmation fo r Excel | ||
| 107 | I RCDISP D INFO^RCDPE M6 | ||
| 108 | ; Select out put device | ||
| 109 | S %ZIS="QM" D ^%ZIS Q :POP | ||
| 110 | ; Option to queue | ||
| 111 | I 'RCDISP,$ D(IO("Q")) D Q | ||
| 112 | . N ZTDESC,Z TQUEUED,ZT RTN,ZTSAVE ,ZTSK | ||
| 113 | . S ZTRTN="R EPORT^RCDP EADP" | ||
| 114 | . S ZTDESC=" EDI LOCKBO X AUTO-DEC REASE REPO RT" | ||
| 115 | . S ZTSAVE(" RC*")="",Z TSAVE("VAU TD")="" | ||
| 116 | . D ^%ZTLOAD | ||
| 117 | . I $D(ZTSK) W !!,"Tas k number " _ZTSK_" ha s been que ued." | ||
| 118 | . E W !!,"U nable to q ueue this job." | ||
| 119 | . K ZTSK,IO( "Q") D HOM E^%ZIS | ||
| 120 | ; | ||
| 121 | ; Compile an d Print Re port | ||
| 122 | D REPORT | ||
| 123 | Q | ||
| 124 | ; | ||
| 125 | REPORT ; Compile an d print re port | ||
| 126 | U IO | ||
| 127 | N DTOTAL,GL OB,GTOTAL, RCHDR,ZTRE Q | ||
| 128 | K ^TMP(RCPR OG,$J) | ||
| 129 | S GLOB=$NA( ^TMP(RCPRO G,$J)) | ||
| 130 | ; Scan ERA f ile for en tries in d ate range | ||
| 131 | D COMPILE | ||
| 132 | ; | ||
| 133 | ; header in formation | ||
| 134 | S RCHDR("ST ART")=$$FM TE^XLFDT($ P(RCRANGE, U,2),2) | ||
| 135 | S RCHDR("EN D")=$$FMTE ^XLFDT($P( RCRANGE,U, 3),2) | ||
| 136 | S RCHDR("RU NDATE")=$$ FMTE^XLFDT ($$NOW^XLF DT,"2S") | ||
| 137 | ; Format Di vision fil ter | ||
| 138 | S RCHDR("DI VISIONS")= $S(RCDIV=2 :$$LINE(.R CVAUTD),1: "ALL") | ||
| 139 | ; | ||
| 140 | ; Display Re port | ||
| 141 | D DISP | ||
| 142 | ; Clear ^TMP global | ||
| 143 | K ^TMP(RCPR OG,$J),^TM P("RCSELPA Y",$J) | ||
| 144 | D ^%ZISC ; close dev ice | ||
| 145 | Q | ||
| 146 | ; | ||
| 147 | COMPILE ; Generate t he Auto-De crease rep ort ^TMP a rray | ||
| 148 | N ADDATE,EN D,ERAIEN,R CNTR,RCRZ, STA,STNAM, STNUM | ||
| 149 | ; | ||
| 150 | ; Date Range | ||
| 151 | S ADDATE=$$ FMADD^XLFD T($P(RCRAN GE,U,2),-1 ),END=$P(R CRANGE,U,3 ) | ||
| 152 | S RCNTR=0 ; record c ounter | ||
| 153 | ; ^RCY(344. 4,0) = "EL ECTRONIC R EMITTANCE ADVICE^344 .4I^" | ||
| 154 | ; G cross- ref. REG ULAR WH OLE FILE ( #344.4) | ||
| 155 | ; Field: AUTO-POST DATE (344 .41,9) | ||
| 156 | ; Scan G ind ex for ERA within da te range | ||
| 157 | F S ADDATE =$O(^RCY(3 44.4,"G",A DDATE)) Q: 'ADDATE Q :(ADDATE\1 )>END D | ||
| 158 | . S ERAIEN=" " | ||
| 159 | . F S ERAIE N=$O(^RCY( 344.4,"G", ADDATE,ERA IEN)) Q:'E RAIEN D | ||
| 160 | . .;Check di vision | ||
| 161 | . .D ERASTA( ERAIEN,.ST A,.STNUM,. STNAM) | ||
| 162 | . .I RCDIV=2 ,'$D(RCVAU TD(STA)) Q | ||
| 163 | . .;Scan ind ex for aut o-decrease d claim li nes within the ERA | ||
| 164 | . .S RCRZ="" | ||
| 165 | . .;Save cla im line de tail to ^T MP global | ||
| 166 | . .F S RCRZ =$O(^RCY(3 44.4,"G",A DDATE,ERAI EN,RCRZ)) Q:'RCRZ D SAVE | ||
| 167 | Q | ||
| 168 | ; | ||
| 169 | SAVE ; Put the da ta into th e ^TMP glo bal | ||
| 170 | N AMOUNT,CA RC,CLAIM,D ATE,EOBIEN ,PAYNAM,PT NAM,SUB,Y | ||
| 171 | ; Payer name from ERA record | ||
| 172 | S PAYNAM=$P ($G(^RCY(3 44.4,ERAIE N,0)),U,6) | ||
| 173 | ; Format Aut o-Decrease date | ||
| 174 | S DATE=$$FM TE^XLFDT(A DDATE,"2S" ) | ||
| 175 | ; Auto-Decre ase Amount | ||
| 176 | S AMOUNT=$P ($G(^RCY(3 44.4,ERAIE N,1,RCRZ,5 )),U,4) | ||
| 177 | Q :+AMOUNT=0 | ||
| 178 | ; Get pointe r to EOB f ile #361.1 from ERA DETAIL | ||
| 179 | S EOBIEN=+$ P($G(^RCY( 344.4,ERAI EN,1,RCRZ, 0)),U,2) | ||
| 180 | ; Claim | ||
| 181 | S CLAIM=$$C LAIM(EOBIE N) | ||
| 182 | ; Patient na me from cl aim file # 399 | ||
| 183 | S PTNAM=$$P NM4^RCDPEW L1(ERAIEN, RCRZ) S:PT NAM="" PTN AM="(unkno wn)" | ||
| 184 | ; CARC code | ||
| 185 | S CARC=$$CA RC(EOBIEN) | ||
| 186 | S RCNTR=RCN TR+1 | ||
| 187 | ; If EXCEL s orting is done in EX CEL | ||
| 188 | I RCDISP S SUB="EXCEL ",SUB("SOR T")=$G(@GL OB@(SUB))+ 1,@GLOB@(S UB)=SUB("S ORT") | ||
| 189 | ; Otherwise sort by DA TE and sel ected crit eria | ||
| 190 | E S SUB=AD DATE,SUB(" SORT")=$S( $E(RCSORT) ="C":CLAIM ,$E(RCSORT )="P":PAYN AM,1:PTNAM ) | ||
| 191 | ; Update ^TM P global | ||
| 192 | S @GLOB@(SU B,SUB("SOR T"),RCNTR) =STNAM_U_S TNUM_U_CLA IM_U_PTNAM _U_PAYNAM_ U_AMOUNT_U _DATE_U_CA RC | ||
| 193 | ; Update tot als for in dividual d ate | ||
| 194 | S $P(DTOTAL (ADDATE),U )=$P($G(DT OTAL(ADDAT E)),U)+1,$ P(DTOTAL(A DDATE),U,2 )=$P($G(DT OTAL(ADDAT E)),U,2)+A MOUNT | ||
| 195 | ; Update tot als for da te range | ||
| 196 | S $P(GTOTAL ,U)=$P($G( GTOTAL),U) +1,$P(GTOT AL,U,2)=$P ($G(GTOTAL ),U,2)+AMO UNT | ||
| 197 | Q | ||
| 198 | ; | ||
| 199 | DISP ; Format th e display for screen /printer o r MS Excel | ||
| 200 | N MODE,SUB, RCDATA,RCR DNUM,RCSTO P,SUB,Y | ||
| 201 | ; | ||
| 202 | ; use the se lected dev ice | ||
| 203 | U IO | ||
| 204 | ; | ||
| 205 | S SUB="",RC STOP=0,MOD E=$S(RCSOR T["-":-1,1 :1) ; mod e for $ORD ER | ||
| 206 | F S SUB=$O (@GLOB@(SU B)) Q:SUB= "" D Q:R CSTOP | ||
| 207 | . ;Display H eader | ||
| 208 | . I RCPAGE D ASK(.RCST OP,0) Q:RC STOP | ||
| 209 | . D HDR | ||
| 210 | . ; | ||
| 211 | . S SUB("SOR T")="" | ||
| 212 | . F S SUB(" SORT")=$O( @GLOB@(SUB ,SUB("SORT ")),MODE) D:SUB("SOR T")=""&('R CDISP) TOT ALD(SUB) Q :SUB("SORT ")="" D Q:RCSTOP | ||
| 213 | . .S RCRDNUM =0 F S RC RDNUM=$O(@ GLOB@(SUB, SUB("SORT" ),RCRDNUM) ) Q:'RCRDN UM!RCSTOP D | ||
| 214 | . ..S RCDATA =@GLOB@(SU B,SUB("SOR T"),RCRDNU M) ;Auto- Decreased Claim | ||
| 215 | . ..I RCDISP W !,RCDAT A Q ; Exc el spreads heet | ||
| 216 | . ..I $Y>(IO SL-6) D AS K(.RCSTOP, 0) Q:RCSTO P D HDR | ||
| 217 | . ..S Y=$E($ P(RCDATA,U ,3),1,12) ;CLAIM | ||
| 218 | . ..S $E(Y,1 5)=$E($P(R CDATA,U,4) ,1,20) ;P ATIENT | ||
| 219 | . ..S $E(Y,3 5)=$E($P(R CDATA,U,5) ,1,19) ;PA YER | ||
| 220 | . ..S $E(Y,5 5)=$J($P(R CDATA,U,6) ,7,2) ;AMO UNT | ||
| 221 | . ..S $E(Y,6 7)=$J($P(R CDATA,U,7) ,8) ;DATE | ||
| 222 | . ..S $E(Y,7 6)=$P(RCDA TA,U,8) ;C ARC | ||
| 223 | . ..W !,Y | ||
| 224 | ; | ||
| 225 | ; Grand tota ls | ||
| 226 | I $D(GTOTAL ) D | ||
| 227 | . ;Print gra nd total i f not EXCE L | ||
| 228 | . I 'RCSTOP, 'RCDISP D TOTALG | ||
| 229 | . ;Report fi nished | ||
| 230 | . I 'RCSTOP W !,$$ENDO RPRT^RCDPE ARL,! D AS K(.RCSTOP, 1) | ||
| 231 | ; | ||
| 232 | ; Null Repor t | ||
| 233 | I '$D(GTOTA L) D | ||
| 234 | . D HDR | ||
| 235 | . W !!,?26," *** NO REC ORDS TO PR INT ***",! | ||
| 236 | ; | ||
| 237 | ; Close devi ce | ||
| 238 | I '$D(ZTQUE UED) D ^%Z ISC | ||
| 239 | I $D(ZTQUEU ED) S ZTRE Q="@" | ||
| 240 | Q | ||
| 241 | ; | ||
| 242 | ASK(STOP,T YP) ; Ask to continu e, if TYP= 1 then pro mpt to fin ish | ||
| 243 | ; If passed by refere nce, RCSTO P is retur ned as 1 i f print is aborted | ||
| 244 | I $E(IOST,1 ,2)'["C-" Q | ||
| 245 | N DIR,DIROU T,DIRUT,DT OUT,DUOUT | ||
| 246 | S :$G(TYP)=1 DIR("A")= "Enter RET URN to fin ish" | ||
| 247 | S DIR(0)="E " W ! D ^D IR | ||
| 248 | I ($D(DIRUT ))!($D(DUO UT)) S STO P=1 | ||
| 249 | Q | ||
| 250 | ; | ||
| 251 | DATES(BDAT E,EDATE) ; Get a date range. | ||
| 252 | S (BDATE,ED ATE)=0 | ||
| 253 | S DIR("?")= "ENTER THE EARLIEST AUTO POSTI NG DATE TO INCLUDE O N THE REPO RT" | ||
| 254 | S DIR(0)="D AO^:"_DT_" :APE",DIR( "A")="STAR T DATE: " D ^DIR K D IR | ||
| 255 | I $D(DTOUT) !$D(DUOUT) !(Y="") S BDATE=-1 Q | ||
| 256 | S BDATE=Y | ||
| 257 | S DIR("?")= "ENTER THE LATEST AU TO POSTING DATE TO I NCLUDE ON THE REPORT " | ||
| 258 | S DIR("B")= Y(0) | ||
| 259 | S DIR(0)="D AO^"_BDATE _":"_DT_": APE",DIR(" A")="END D ATE: " D ^ DIR K DIR | ||
| 260 | I $D(DTOUT) !$D(DUOUT) !(Y="") S BDATE=-1 Q | ||
| 261 | S EDATE=Y | ||
| 262 | Q | ||
| 263 | ; | ||
| 264 | CARC(EOBIE N) ;Get fi rst adjust ment reaso n code fro m EOB | ||
| 265 | N ADJSUB,AD JSUB1 | ||
| 266 | S ADJSUB=$O (^IBM(361. 1,EOBIEN,1 0,0)) Q:'A DJSUB "" | ||
| 267 | S ADJSUB1=$ O(^IBM(361 .1,EOBIEN, 10,1,0)) Q :'ADJSUB1 "" | ||
| 268 | Q $P($G(^IB M(361.1,EO BIEN,10,AD JSUB,1,ADJ SUB1,0)),U ) | ||
| 269 | ; | ||
| 270 | CLAIM(EOBI EN) ;funct ion, Get c laim numbe r from AR | ||
| 271 | Q :'$G(EOBIE N)>0 "(no EOB IEN)" | ||
| 272 | N CLAIM,CLA IMIEN,REC4 30 | ||
| 273 | ; Default to EOB claim | ||
| 274 | S CLAIM=$$E XTERNAL^DI LFD(344.41 ,.02,,EOBI EN) | ||
| 275 | ; Get ^DGCR( 399 pointe r | ||
| 276 | S CLAIMIEN= $P($G(^IBM (361.1,EOB IEN,0)),U) Q:'CLAIMI EN "(no Cl aim IEN)" ;CLAIM | ||
| 277 | ; Use DINUM to get AR Claim #430 | ||
| 278 | S REC430=$G (^PRCA(430 ,CLAIMIEN, 0)) Q:$P(R EC430,U)=" " "(CLAIM not found) " ;CLAIM | ||
| 279 | ; Return cla im (nnn-Kn nnnnn) | ||
| 280 | Q $P(REC430 ,U) | ||
| 281 | ; | ||
| 282 | DISPTY() ; Get displ ay/output type | ||
| 283 | N DIR,DUOUT ,Y | ||
| 284 | S DIR(0)="Y " | ||
| 285 | S DIR("A")= "Export th e report t o Microsof t Excel" | ||
| 286 | S DIR("B")= "NO" | ||
| 287 | D ^DIR I $G (DUOUT) Q -1 | ||
| 288 | Q Y | ||
| 289 | ; | ||
| 290 | DTRNG() ; Get the d ate range for the re port | ||
| 291 | N DIR,DUOUT ,RNGFLG,X, Y,RCSTART, RCEND | ||
| 292 | D DATES(.RC START,.RCE ND) | ||
| 293 | Q :RCSTART=- 1 0 | ||
| 294 | Q :RCSTART " 1^"_RCSTAR T_"^"_RCEN D | ||
| 295 | Q :'RCSTART "0^^" | ||
| 296 | Q 0 | ||
| 297 | ; | ||
| 298 | ERASTA(ERA IEN,STA,ST NUM,STNAM) ; Get the station f or this ER A | ||
| 299 | N ERAEOB,ER ABILL,FOUN D,STAIEN | ||
| 300 | S (ERAEOB,E RABILL,FOU ND)="" | ||
| 301 | S (STA,STNU M,STNAM)=" UNKNOWN" | ||
| 302 | D | ||
| 303 | . S ERAEOB=$ P($G(^RCY( 344.4,ERAI EN,1,1,0)) ,U,2) Q:'E RAEOB | ||
| 304 | . S ERABILL= $P($G(^IBM (361.1,ERA EOB,0)),U, 1) Q:'ERAB ILL | ||
| 305 | . S STAIEN=$ P($G(^DGCR (399,ERABI LL,0)),U,2 2) Q:'STAI EN | ||
| 306 | . S STA=STAI EN | ||
| 307 | . S STNAM=$$ EXTERNAL^D ILFD(399,. 22,,STA) | ||
| 308 | . S STNUM=$P ($G(^DG(40 .8,STAIEN, 0)),U,2) | ||
| 309 | Q | ||
| 310 | ; | ||
| 311 | HDR ; Print the report he ader | ||
| 312 | N MSG,Y,DIV ,SUB,Z0,Z1 | ||
| 313 | ; | ||
| 314 | I 'RCDISP D Q:RCSTOP | ||
| 315 | . S RCPAGE=R CPAGE+1 | ||
| 316 | . W @IOF | ||
| 317 | . S MSG(1)=" EDI LOCKB OX AUTO-DE CREASE ADJ USTMENT RE PORT " | ||
| 318 | . S MSG(1)=M SG(1)_" Page: "_RCPAGE | ||
| 319 | . S MSG(2)=" RUN DA TE: "_RCHD R("RUNDATE ") | ||
| 320 | . S Z0="DIVI SIONS: "_R CHDR("DIVI SIONS") | ||
| 321 | . S MSG(3)=$ S($L(Z0)<7 5:$J("",75 -$L(Z0)\2) ,1:"")_Z0 | ||
| 322 | . S MSG(4)=" DATE RANGE: "_R CHDR("STAR T")_" - "_ RCHDR("END ")_" (Date Decrease Applied)" | ||
| 323 | . S MSG(5)=" " | ||
| 324 | . S MSG(6)=" CLAIM # PATIEN T NAME PAYER DECREAS E AMT DA TE CARC" | ||
| 325 | . S MSG(7)=" ========== ========== ========== ========== ========== ========== ========== =========" | ||
| 326 | . D EN^DDIOL (.MSG) | ||
| 327 | I RCDISP D | ||
| 328 | . W !,"STATI ON^STATION NUMBER^CL AIM #^PATI ENT NAME^P AYER^DECRE ASE AMOUNT ^DATE^CARC " | ||
| 329 | Q | ||
| 330 | ; | ||
| 331 | LINE(DIV) ;List sele cted stati ons | ||
| 332 | N LINE,P,SU B | ||
| 333 | S LINE="",S UB="",P=0 | ||
| 334 | F S SUB=$O (DIV(SUB)) Q:'SUB S P=P+1,$P( LINE,", ", P)=$G(DIV( SUB)) | ||
| 335 | Q LINE | ||
| 336 | ; | ||
| 337 | STADIV ; Division/S tation Fil ter/Sort | ||
| 338 | ; Sort selec tion | ||
| 339 | N DIR,DUOUT ,Y | ||
| 340 | S RCDIV=0 | ||
| 341 | ; Division s election - IA 664 | ||
| 342 | ; RETURNS Y= -1 (quit), VAUTD=1 ( for all),V AUTD=0 (se lected div isions in VAUTD) | ||
| 343 | D DIVISION^ VAUTOMA Q: Y<0 | ||
| 344 | ; If ALL sel ected | ||
| 345 | I VAUTD=1 S RCDIV=1 Q | ||
| 346 | ; If some DI VISIONS se lected | ||
| 347 | S RCDIV=2 | ||
| 348 | M RCVAUTD=V AUTD ; sa ve selecte d division s | ||
| 349 | Q | ||
| 350 | ; | ||
| 351 | TOTALS ; Print tota ls for EXC EL | ||
| 352 | N DAY,DAMT, DCNT | ||
| 353 | S DAY="" | ||
| 354 | F S DAY=$O (DTOTAL(DA Y)) Q:'DAY D Q:RCS TOP | ||
| 355 | . ;Day total s | ||
| 356 | . D TOTALD(D AY) | ||
| 357 | ; Grand tota ls | ||
| 358 | D TOTALG | ||
| 359 | Q | ||
| 360 | ; | ||
| 361 | TOTALD(DAY ) ;Total f or a day | ||
| 362 | N DCNT,DAMT ,Y | ||
| 363 | I 'RCDISP,$ Y>(IOSL-6) D HDR Q:R CSTOP | ||
| 364 | S DCNT=$P(D TOTAL(DAY) ,U),DAMT=$ P(DTOTAL(D AY),U,2) | ||
| 365 | S Y="**TOTA LS FOR DAT E: "_$$FMT E^XLFDT(DA Y,2),$E(Y, 35)=" # OF DECREA SE ADJUSTM ENTS: "_DC NT | ||
| 366 | W !!,Y | ||
| 367 | S Y="",$E(Y ,28)="TOTA L AMOUNT O F DECREASE ADJUSTMEN TS: $"_$J( DAMT,3,2) W !,Y | ||
| 368 | Q | ||
| 369 | ; | ||
| 370 | TOTALG ; Overall re port total | ||
| 371 | I 'RCDISP,$ Y>(IOSL-6) D HDR Q:R CSTOP | ||
| 372 | N Y | ||
| 373 | W !!,"**** TOTALS FOR DATE RANG E: # OF DE CREASE ADJ USTMENTS: "_+$P(GTOT AL,U) | ||
| 374 | S Y="",$E(Y ,28)="TOTA L AMOUNT O F DECREASE ADJUSTMEN TS: $"_$J( (+$P(GTOTA L,U,2)),3, 2) | ||
| 375 | W !,Y,! | ||
| 376 | Q | ||
| 377 | ; | ||
| 378 | |||
| 379 | Modified L ogic | ||
| 380 | RCDPEADP ; OIFO-BAYPI NES/PJH - AUTO-DECRE ASE REPORT ;Nov 23, 2014@12:48 :50 | ||
| 381 | ; ;4.5;Accou nts Receiv able;**298 ,317,318** ;Mar 20, 1 995;Build 121 | ||
| 382 | ; ;Per VA Di rective 64 02, this r outine sho uld not be modified. | ||
| 383 | ; Read ^DGC R(399) via Priv ate IA 382 0 | ||
| 384 | ; Read ^DG( 40.8) via Cont rolled IA 417 | ||
| 385 | ; Read ^IBM (361.1) via Priv ate IA 405 1 | ||
| 386 | ; Use DIVIS ION^VAUTOM A via Cont rolled IA 664 | ||
| 387 | ; | ||
| 388 | RPT ; entry poi nt for Aut o-Decrease Adjustmen t report [ RCDPE AUTO -DECREASE REPORT] | ||
| 389 | N INPUT,RCV AUTD | ||
| 390 | S INPUT=$$S TADIV(.RCV AUTD) ; Divi sion filte r | ||
| 391 | Q :'INPUT ; '^' or timeout | ||
| 392 | S $P(INPUT, "^",2)=$$A SKSORT() ; Sele ct Sort Cr iteria | ||
| 393 | Q :$P(INPUT, "^",2)="0" ; '^' or timeout | ||
| 394 | S $P(INPUT, "^",3)=$$S ORTORD($P( INPUT,"^", 2)) ; Sele ct Sort Or der | ||
| 395 | Q :$P(INPUT, "^",3)="0" ; '^' or timeout | ||
| 396 | S $P(INPUT, "^",4)=$$D TRNG() ; Sele ct Date Ra nge for Re port | ||
| 397 | Q :'$P(INPUT ,"^",4) ; '^' or timeout | ||
| 398 | S $P(INPUT, "^",4)=$P( $P(INPUT," ^",4),"|", 2,3) | ||
| 399 | S $P(INPUT, "^",5)=$$D ISPTY() ; Sele ct Display Type | ||
| 400 | Q :$P(INPUT, "^",5)=-1 ; '^' or timeout | ||
| 401 | D :$P(INPUT, "^",5)=1 I NFO^RCDPEM 6 ; Disp lay captur e informat ion for Ex cel | ||
| 402 | Q :'$$DEVICE ($P(INPUT, "^",5),.IO ) ; Ask output dev ice | ||
| 403 | ; | ||
| 404 | ; Compile a nd Display Report da ta (queued ) - not al lowed for EXCEL | ||
| 405 | I $P(INPUT, "^",5)'=1, $D(IO("Q") ) D Q | ||
| 406 | . N ZTDESC,Z TQUEUED,ZT RTN,ZTSAVE ,ZTSK | ||
| 407 | . S ZTRTN="R EPORT^RCDP EADP(INPUT ,.RCVAUTD, .IO)" | ||
| 408 | . S ZTDESC=" EDI LOCKBO X AUTO-DEC REASE REPO RT" | ||
| 409 | . S ZTSAVE(" RC*")="",Z TSAVE("INP UT")="",ZT SAVE("IO*" )="" | ||
| 410 | . D ^%ZTLOAD | ||
| 411 | . I $D(ZTSK) W !!,"Tas k number " _ZTSK_" ha s been que ued." | ||
| 412 | . E W !!,"U nable to q ueue this job." | ||
| 413 | . K ZTSK,IO( "Q") | ||
| 414 | . D HOME^%ZI S | ||
| 415 | ; Compile a nd Display Report da ta (non-qu eued) | ||
| 416 | D REPORT(IN PUT,.RCVAU TD,.IO) ; Compile an d Display Report dat a | ||
| 417 | Q | ||
| 418 | ; | ||
| 419 | STADIV(RCV AUTD) ; Di vision/Sta tion Filte r | ||
| 420 | ; Input: None | ||
| 421 | ; Output: RCVAUTD() - Array of selecte d Division s/Stations if 2 is r eturned | ||
| 422 | ; Returns: 1 - All Di visions/St ations sel ected | ||
| 423 | ; 2 - Specif ied Divisi ons/Statio ns selecte d | ||
| 424 | ; 0 - "^" or timeout | ||
| 425 | N DIR,DIROU T,DTOUT,DU OUT,VAUTD, Y | ||
| 426 | ; | ||
| 427 | ; Division selection - IA 664 | ||
| 428 | ; RETURNS Y =-1 (quit) , VAUTD=1 (for all), VAUTD=0 (s elected di visions in VAUTD) | ||
| 429 | D DIVISION^ VAUTOMA | ||
| 430 | Q :Y<0 0 | ||
| 431 | Q :VAUTD=1 1 ; All Di visions se lected | ||
| 432 | M RCVAUTD=V AUTD ; Save s elected di visions | ||
| 433 | Q 2 | ||
| 434 | ; | ||
| 435 | ASKSORT() ; Select t he sort cr iteria | ||
| 436 | ; Input: None | ||
| 437 | ; Returns: C - Sort by Cl aim | ||
| 438 | ; P - Sort by Pa yer | ||
| 439 | ; N - Sort by Pa tient Name | ||
| 440 | ; 0 - User enter ed '^' or timed out | ||
| 441 | N DIR,DIROU T,DIRUT,DT OUT,DUOUT, XX | ||
| 442 | S DIR(0)="S A^C:CLAIM; P:PAYER;N: PATIENT NA ME;" | ||
| 443 | S DIR("A")= "Sort by ( C)LAIM #, (P)AYER or PATIENT ( N)AME?: " | ||
| 444 | S DIR("?",1 )="Enter ' C' to sort by Claim Number, 'P ' to sort by Payer o r 'N' to s ort" | ||
| 445 | S DIR("?")= "by Patien t Name." | ||
| 446 | S DIR("B")= "CLAIM" | ||
| 447 | D ^DIR | ||
| 448 | Q :$D(DTOUT) !$D(DUOUT) 0 | ||
| 449 | Q Y | ||
| 450 | ; | ||
| 451 | SORTORD(SO RT) ; Sele ct the sor t order | ||
| 452 | ; Input: SORT - 'C' - Sort by Claim Number | ||
| 453 | ; 'P' - Sort by Payer | ||
| 454 | ; 'N' - Sort by Patien t Name | ||
| 455 | ; Returns: F - First to L ast | ||
| 456 | ; L - Last to Fi rst | ||
| 457 | ; 0 - User enter ed '^' or timed out | ||
| 458 | N DIR,DIROU T,DIRUT,DT OUT,DUOUT, XX,YY | ||
| 459 | S XX=" (F)I RST TO LAS T or (L)AS T TO FIRST ?: " | ||
| 460 | S YY=$S(SOR T="C":"CLA IM",SORT=" P":"PAYER" ,1:"PATIEN T NAME") | ||
| 461 | S DIR("A")= "Sort "_YY _XX | ||
| 462 | S DIR(0)="S A^F:FIRST TO LAST;L: LAST TO FI RST" | ||
| 463 | S DIR("B")= "FIRST TO LAST" | ||
| 464 | D ^DIR | ||
| 465 | Q :$D(DTOUT) !$D(DUOUT) 0 | ||
| 466 | Q Y | ||
| 467 | ; | ||
| 468 | DTRNG() ; Get the d ate range for the re port | ||
| 469 | ; Input: None | ||
| 470 | ; Returns: A1|A2|A3 - Where: | ||
| 471 | ; A1 - 0 - User up-arrowed or timed out, 1 oth erwise | ||
| 472 | ; A2 - Auto-Post Start Dat e | ||
| 473 | ; A3 - Auto-Post End Date | ||
| 474 | N DIR,DIROU T,DIRUT,DT OUT,DUOUT, RCEND,RCST ART,RNGFLG ,X,Y | ||
| 475 | D DATES(.RC START,.RCE ND) | ||
| 476 | Q :RCSTART=- 1 0 | ||
| 477 | Q :RCSTART " 1|"_RCSTAR T_"|"_RCEN D | ||
| 478 | Q :'RCSTART "0||" | ||
| 479 | Q 0 | ||
| 480 | ; | ||
| 481 | DATES(BDAT E,EDATE) ; Get a dat e range. | ||
| 482 | ; Input: None | ||
| 483 | ; Output: BDATE - Internal A uto-Post S tart Date | ||
| 484 | ; EDATE - Internal A uto-Post E nd Date | ||
| 485 | D1 ; looping t ag | ||
| 486 | S (BDATE,ED ATE)=0 | ||
| 487 | S DIR("?")= "Enter the earliest Auto-Posti ng date to include o n the repo rt." | ||
| 488 | S DIR(0)="D AO^:"_DT_" :APE" | ||
| 489 | S DIR("A")= "Start Dat e: " | ||
| 490 | D ^DIR | ||
| 491 | K DIR | ||
| 492 | I $D(DTOUT) !$D(DUOUT) !(Y="") S BDATE=-1 Q | ||
| 493 | S BDATE=Y | ||
| 494 | S DIR("?")= "Enter the latest Au to-Posting date to i nclude on the report ." | ||
| 495 | S DIR("B")= Y(0) | ||
| 496 | S DIR(0)="D AO^"_BDATE _":"_DT_": APE" | ||
| 497 | S DIR("A")= "End Date: " | ||
| 498 | D ^DIR | ||
| 499 | K DIR | ||
| 500 | I $D(DTOUT) !$D(DUOUT) !(Y="") S BDATE=-1 Q | ||
| 501 | S EDATE=Y | ||
| 502 | Q | ||
| 503 | ; | ||
| 504 | DISPTY() ; Get displ ay/output type | ||
| 505 | ; Input: None | ||
| 506 | ; Returns: 1 - Output to Excel | ||
| 507 | ; 0 - Output to paper | ||
| 508 | N DIR,DIROU T,DIRUT,DT OUT,DUOUT, Y | ||
| 509 | S DIR(0)="Y " | ||
| 510 | S DIR("A")= "Export th e report t o Microsof t Excel" | ||
| 511 | S DIR("B")= "NO" | ||
| 512 | D ^DIR | ||
| 513 | I $G(DUOUT) Q -1 | ||
| 514 | Q Y | ||
| 515 | ; | ||
| 516 | DEVICE(EXC EL,IO) ; S elect the output dev ice | ||
| 517 | ; Input: EXCEL - 1 - Output to Excel, 0 otherwi se | ||
| 518 | ; Output: | ||
| 519 | ; IO - Array of s elected ou tput info | ||
| 520 | ; Returns: 0 - No device selected, 1 Otherwis e | ||
| 521 | N POP,%ZIS | ||
| 522 | S %ZIS="QM" | ||
| 523 | D ^%ZIS | ||
| 524 | Q :POP 0 | ||
| 525 | Q 1 | ||
| 526 | ; | ||
| 527 | REPORT(INP UTS,RCVAUT D,IO) ; Co mpile and print repo rt | ||
| 528 | ; Input: INPUTS - A1^A2^A3^. ..^An Wher e: | ||
| 529 | ; A1 - 1 - All di visions se lected | ||
| 530 | ; 2 - Select ed divisio ns | ||
| 531 | ; A2 - C - Sort b y Claim | ||
| 532 | ; P - Sort b y Payer | ||
| 533 | ; N - Sort b y Patient Name | ||
| 534 | ; A3 - F - First to Last So rt Order | ||
| 535 | ; L - Last t o First So rt Order | ||
| 536 | ; A4 - B 1|B2 | ||
| 537 | ; B 1 - Auto-P ost Start Date | ||
| 538 | ; B 2 - Auto-P ost End Da te | ||
| 539 | ; A5 - 1 - Output to Excel | ||
| 540 | ; 0 - Otherwi se | ||
| 541 | ; RCVAUTD - A rray of se lected Div isions | ||
| 542 | ; O nly passed if A1=2 | ||
| 543 | ; IO - Output Dev ice | ||
| 544 | ; Output: | ||
| 545 | N DTOTAL,GT OTAL,XX,ZT REQ | ||
| 546 | U IO | ||
| 547 | K ^TMP("RCD PEADP",$J) | ||
| 548 | D COMPILE^R CDPEAD1(IN PUTS,.RCVA UTD,.DTOTA L,.GTOTAL) ; Scan ER A file for | ||
| 549 | entries i n date ran ge | ||
| 550 | D DISP(INPU TS,.DTOTAL ,.GTOTAL) ; Displ ay Report | ||
| 551 | K ^TMP("RCD PEADP",$J) ,^TMP("RCS ELPAY",$J) ; Clear TMP global | ||
| 552 | D ^%ZISC ; Close device | ||
| 553 | Q | ||
| 554 | ; | ||
| 555 | SAVE(ADDAT E,ERAIEN,R CRZ,EXCEL, RCSORT,CAR CS,RCTR,ST NAM,STNUM) ; Put the data into the ^TMP global | ||
| 556 | ; Input: ADDATE - Current Internal D ate being processed | ||
| 557 | ; ERAIEN - Internal IEN of th e ERA reco rd | ||
| 558 | ; RCRZ - ERA line number | ||
| 559 | ; EXCEL - 1 output to Excel, 0 otherwi se | ||
| 560 | ; RCSORT - C - Sor t by Claim | ||
| 561 | ; P - Sor t by Payer | ||
| 562 | ; N - Sor t by Patie nt Name | ||
| 563 | ; CARCS - ^ delimi ted string of CARC i nformation found | ||
| 564 | ; on the E OB record pointed to by the ER A detail r ecord | ||
| 565 | ; A1;A2;A3 ;A4^B1;B2; B3;B4^...^ N1;N2;N3;N 4 Where: | ||
| 566 | ; A1 - A uto-Decrea se amount of the 1st CARC code | ||
| 567 | ; A2 - 1 st CARC co de | ||
| 568 | ; A3 - Q uantity of the first CARC code | ||
| 569 | ; A4 - T runcated R eason text of the 1s t CARC | ||
| 570 | ; DTOTAL() - Current Array of t otals by A uto-Post D ate | ||
| 571 | ; GTOTAL - Current Grand tota ls | ||
| 572 | ; RCTR - Current Record Cou nter | ||
| 573 | ; STNAM - Station Name | ||
| 574 | ; STNUM - Station Number | ||
| 575 | ; ^TMP("RCDP EADP",$J) - Current report dat a | ||
| 576 | ; See DISP for a ful l descript ion | ||
| 577 | ; Output: DTOTAL() - Updated Array of t otals by A uto-Post D ate | ||
| 578 | ; GTOTAL - Updated Grand tota ls | ||
| 579 | ; RCTR - Updated Record Cou nter | ||
| 580 | ; ^TMP("RCDP EADP",$J,A 1,A2,A3) - B1^B2^B3^ ...^Bn Whe re: | ||
| 581 | ; - A1 - "EXCEL" if export ing to exc el | ||
| 582 | ; Intern al fileman date if n ot exporti ng to exce l | ||
| 583 | ; A2 - Excel L ine Counte r if expor ting to ex cel | ||
| 584 | ; Externa l Claim nu mber is so rting by c laim | ||
| 585 | ; Externa l Payer Na me if sort ing by Pay er | ||
| 586 | ; Externa l Patient Name if so rting by P atient Nam e | ||
| 587 | ; A3 - Record Counter | ||
| 588 | ; B1 - Externa l Station Name | ||
| 589 | ; B2 - Externa l Station Number | ||
| 590 | ; B3 - Externa l Claim Nu mber | ||
| 591 | ; B4 - Externa l Patient Name | ||
| 592 | ; B5 - Externa l Payer Na me | ||
| 593 | ; B6 - Auto-De crease Amo unt | ||
| 594 | ; B7 - Auto-De crease Dat e | ||
| 595 | ; ^TMP("RCDP EADP",$J,A 1,A2,A3,A4 ) - C1^C2^ C3^C4 Wher e: | ||
| 596 | ; - A1 - "EXCEL" if export ing to exc el | ||
| 597 | ; Intern al fileman date if n ot exporti ng to exce l | ||
| 598 | ; A2 - Excel L ine Counte r if expor ting to ex cel | ||
| 599 | ; Externa l Claim nu mber is so rting by c laim | ||
| 600 | ; Externa l Payer Na me if sort ing by Pay er | ||
| 601 | ; Externa l Patient Name if so rting by P atient Nam e | ||
| 602 | ; A3 - Record Counter | ||
| 603 | ; A4 - CARC Co unter | ||
| 604 | ; C1 - CARC Co de (file 3 61.111, fi eld .01) | ||
| 605 | ; C2 - Decreas e Amount ( file 361.1 11, field .02) | ||
| 606 | ; C3 - Quantit y (file 36 1.111, fie ld .03) | ||
| 607 | ; C4 - Reason (file 361. 111, field .04) | ||
| 608 | N A1,A2,AMO UNT,CARC,C LAIM,DATE, EOBIEN,PAY NAM,PTNAM, XX,Y | ||
| 609 | S PAYNAM=$$ GET1^DIQ(3 44.4,ERAIE N,.06,"E") ; Paye r name fro m ERA reco rd | ||
| 610 | S DATE=$$FM TE^XLFDT(A DDATE,"2SZ ") ; Form at Auto-De crease dat e | ||
| 611 | S AMOUNT=$$ GET1^DIQ(3 44.41,RCRZ _","_ERAIE N_",",8,"I ") ; Auto -Decrease Amount | ||
| 612 | Q :+AMOUNT=0 | ||
| 613 | S EOBIEN=$$ GET1^DIQ(3 44.41,RCRZ _","_ERAIE N_",",.02, "I") ; IEN to file 3 61.1 -ERA detail | ||
| 614 | S CLAIM=$$C LAIM(EOBIE N) ; Clai m # | ||
| 615 | S PTNAM=$$P NM4^RCDPEW L1(ERAIEN, RCRZ) ; Pati ent Name f rom Claim file #399 | ||
| 616 | S :PTNAM="" PTNAM="(un known)" | ||
| 617 | S RCTR=RCTR +1 | ||
| 618 | ; | ||
| 619 | ; If EXCEL sorting is done in E XCEL | ||
| 620 | I EXCEL=1 D | ||
| 621 | . S A1="EXC EL",A2=$G( ^TMP("RCDP EADP",$J,A 1))+1 | ||
| 622 | . S ^TMP("R CDPEADP",$ J,A1)=A2 | ||
| 623 | ; | ||
| 624 | ; Otherwise sort by D ATE and se lected cri teria | ||
| 625 | I 'EXCEL D | ||
| 626 | . S A1=ADDA TE | ||
| 627 | . S A2=$S($ E(RCSORT)= "C":CLAIM, $E(RCSORT) ="P":PAYNA M,1:PTNAM) | ||
| 628 | ; | ||
| 629 | ; Update ^T MP global if claim l evel adjus tments ar e found fo r this cla im | ||
| 630 | Q :'+$O(^IBM (361.1,EOB IEN,10,0)) ; No c laim level adjustmen ts | ||
| 631 | S XX=STNAM_ U_STNUM_U_ CLAIM_U_PT NAM_U_PAYN AM_U_AMOUN T_U_DATE | ||
| 632 | S ^TMP("RCD PEADP",$J, A1,A2,RCTR )=XX ; Clai m Informat ion | ||
| 633 | D CARCS^RCD PEAD1(A1,A 2,RCTR,CAR CS) ; CARC informatio n | ||
| 634 | ; | ||
| 635 | ; Update to tals for i ndividual date | ||
| 636 | S $P(DTOTAL (ADDATE),U )=$P($G(DT OTAL(ADDAT E)),U)+1 | ||
| 637 | S $P(DTOTAL (ADDATE),U ,2)=$P($G( DTOTAL(ADD ATE)),U,2) +AMOUNT | ||
| 638 | ; | ||
| 639 | ; Update to tals for d ate range | ||
| 640 | S $P(GTOTAL ,U)=$P($G( GTOTAL),U) +1,$P(GTOT AL,U,2)=$P ($G(GTOTAL ),U,2)+AMO UNT | ||
| 641 | Q | ||
| 642 | ; | ||
| 643 | DISP(INPUT S,DTOTAL,G TOTAL) ; F ormat the display fo r screen/p rinter or MS Excel | ||
| 644 | ; Input: INPUTS - A1^A2^A3^. ..^An Wher e: | ||
| 645 | ; A1 - 1 - All di visions se lected | ||
| 646 | ; 2 - Select ed divisio ns | ||
| 647 | ; A2 - C - Sort b y Claim | ||
| 648 | ; P - Sort b y Payer | ||
| 649 | ; N - Sort b y Patient Name | ||
| 650 | ; A3 - F - First to Last So rt Order | ||
| 651 | ; L - Last t o First So rt Order | ||
| 652 | ; A4 - B 1|B2 | ||
| 653 | ; B 1 - Auto-P ost Start Date | ||
| 654 | ; B 2 - Auto-P ost End Da te | ||
| 655 | ; A5 - 1 - Output to Excel | ||
| 656 | ; 0 - Otherwi se | ||
| 657 | ; IO - Output Dev ice | ||
| 658 | ; DTOTAL()- Array of t otals by I nternal Au to-Post da te | ||
| 659 | ; GTOTAL - Grand Tota ls for the selected date perio d | ||
| 660 | ; ^TMP("RCDP EADP",$J) - See SAVE for a com plete desc ription | ||
| 661 | N A1,A2,A3, DATA,EXCEL ,HDRINFO,M ODE,PAGE,R CRDNUM,STO P,Y | ||
| 662 | U IO ; Use th e selected device | ||
| 663 | S EXCEL=$P( INPUTS,"^" ,5) | ||
| 664 | ; | ||
| 665 | ; Header in formation | ||
| 666 | S XX=$P(INP UTS,"^",4) ; Auto-P ost Date r ange | ||
| 667 | S HDRINFO(" START")=$$ FMTE^XLFDT ($P(XX,"|" ,1),"2SZ") | ||
| 668 | S HDRINFO(" END")=$$FM TE^XLFDT($ P(XX,"|",2 ),"2SZ") | ||
| 669 | S HDRINFO(" RUNDATE")= $$FMTE^XLF DT($$NOW^X LFDT,"2SZ" ) | ||
| 670 | s XX=$P(INP UTS,"^",2) ; Sort T ype | ||
| 671 | S HDRINFO(" SORT")="So rted By: " _$S(XX="C" :"Claim",X X="P":"Pay er",1:"Pat ient Name" ) | ||
| 672 | S XX=$S($P( INPUTS,"^" ,3)="L":"L ast to Fir st",1:"Fir st to Last ") | ||
| 673 | S HDRINFO(" SORT")=HDR INFO("SORT ")_" - "_X X | ||
| 674 | ; | ||
| 675 | ; Format Di vision fil ter | ||
| 676 | S XX=$P(INP UTS,"^",1) ; XX=1 - All Divis ions, 2- s elected | ||
| 677 | S HDRINFO(" DIVISIONS" )=$S(XX=2: $$LINE(.RC VAUTD),1:" ALL") | ||
| 678 | ; | ||
| 679 | S A1="",PAG E=0,STOP=0 | ||
| 680 | S MODE=$S($ P(INPUTS," ^",3)="L": -1,1:1) ; Mode f or $ORDER direction | ||
| 681 | F D Q:(A1 ="")!STOP | ||
| 682 | . S A1=$O(^ TMP("RCDPE ADP",$J,A1 )) | ||
| 683 | . Q:A1="" | ||
| 684 | . I PAGE D ASK(.STOP, 0) Q:STOP ; Output to screen , quit if user wants to | ||
| 685 | . D HDR^RCD PEAD1(EXCE L,.HDRINFO ,.PAGE) ; Display Header | ||
| 686 | . ; | ||
| 687 | . S A2="" | ||
| 688 | . F D Q:( A2="")!STO P | ||
| 689 | . . S A2=$O (^TMP("RCD PEADP",$J, A1,A2),MOD E) | ||
| 690 | . . I 'EXCE L,A2="" D TOTALD^RCD PEAD1(EXCE L,.HDRINFO ,.PAGE,.ST OP,A1,.DTO TAL) | ||
| 691 | . . Q:A2="" | ||
| 692 | . . S A3=0 | ||
| 693 | . . F D Q :'A3!STOP | ||
| 694 | . . . S A3= $O(^TMP("R CDPEADP",$ J,A1,A2,A3 )) | ||
| 695 | . . . Q:'A3 | ||
| 696 | . . . S DAT A=^TMP("RC DPEADP",$J ,A1,A2,A3) ; Auto-De creased Cl aim | ||
| 697 | . . . I EXC EL D EXCEL (DATA,A1,A 2,A3) Q ; Out put to Exc el | ||
| 698 | . . . I $Y> (IOSL-4) D Q:STOP ; End of page | ||
| 699 | . . . . D A SK(.STOP,0 ) | ||
| 700 | . . . . Q:S TOP | ||
| 701 | . . . . D H DR^RCDPEAD 1(EXCEL,.H DRINFO,.PA GE) | ||
| 702 | . . . S Y=$ E($P(DATA, U,3),1,12) ; Claim # | ||
| 703 | . . . S $E( Y,15)=$E($ P(DATA,U,4 ),1,20) ; Patient Name | ||
| 704 | . . . S $E( Y,37)=$E($ P(DATA,U,5 ),1,19) ; Payer N ame | ||
| 705 | . . . S $E( Y,55)=$J($ P(DATA,U,6 ),12,2) ; Auto-De crease Am ount | ||
| 706 | . . . S $E( Y,69)=$P(D ATA,U,7) ; Auto-De crease Dat e | ||
| 707 | . . . W !,Y | ||
| 708 | . . . D DCA RCS(A1,A2, A3,EXCEL,. HDRINFO,.P AGE,.STOP) ; Display CARCs | ||
| 709 | . . . W:'EX CEL ! | ||
| 710 | ; | ||
| 711 | ; Grand tot als | ||
| 712 | I $D(GTOTAL ) D | ||
| 713 | . I 'STOP,' EXCEL D ; Print gr and total if not Exc el | ||
| 714 | . . D TOTAL G^RCDPEAD1 (EXCEL,.HD RINFO,.PAG E,GTOTAL) | ||
| 715 | . I 'STOP D ; Report f inished | ||
| 716 | . . W !,$$E NDORPRT^RC DPEARL,! | ||
| 717 | . . D ASK(. STOP,1) | ||
| 718 | ; | ||
| 719 | ; Null Repo rt | ||
| 720 | I '$D(GTOTA L) D | ||
| 721 | . D HDR^RCD PEAD1(EXCE L,.HDRINFO ,.PAGE) | ||
| 722 | . W !!,?26, "*** No Re cords to P rint ***", ! | ||
| 723 | ; | ||
| 724 | ; Close dev ice | ||
| 725 | I '$D(ZTQUE UED) D ^%Z ISC | ||
| 726 | I $D(ZTQUEU ED) S ZTRE Q="@" | ||
| 727 | Q | ||
| 728 | ; | ||
| 729 | DCARCS(A1, A2,A3,EXCE L,HDRINFO, PAGE,STOP) ; Display CARC info rmation | ||
| 730 | ; Input: A1 - "EXCEL" if exporti ng to exce l | ||
| 731 | ; Internal fileman d ate if not exporting to excel | ||
| 732 | ; A2 - Excel Li ne Counter if export ing to exc el | ||
| 733 | ; External Claim num ber is sor ting by cl aim | ||
| 734 | ; External Payer Nam e if sorti ng by Paye r | ||
| 735 | ; External Patient N ame if sor ting by Pa tient Name | ||
| 736 | ; A3 - Record C ounter | ||
| 737 | ; EXCEL - 1 if exp orting to Excel, 0 o therwise | ||
| 738 | ; HDRINFO() - Array of header in formation | ||
| 739 | ; PAGE - Current Page numbe r | ||
| 740 | ; ^TMP("RCDP EADP",$J) - Array of report da ta. See SA VE for det ails | ||
| 741 | ; Output: PAGE - Updated Page numbe r | ||
| 742 | ; STOP - 1 if use r aborts d isplay, 0 otherwise | ||
| 743 | N A4,DATA,F IRST,XX | ||
| 744 | S A4="",FIR ST=1 | ||
| 745 | F D Q:(A4 ="")!STOP | ||
| 746 | . S A4=$O(^ TMP("RCDPE ADP",$J,A1 ,A2,A3,A4) ) | ||
| 747 | . Q:A4="" | ||
| 748 | . S DATA=^T MP("RCDPEA DP",$J,A1, A2,A3,A4) | ||
| 749 | . I 'EXCEL, $Y>(IOSL-4 ) D Q:STO P ; End of page | ||
| 750 | . . D ASK(. STOP,0) | ||
| 751 | . . Q:STOP | ||
| 752 | . . S FIRST =1 | ||
| 753 | . . D HDR^R CDPEAD1(EX CEL,.HDRIN FO,.PAGE,1 ) | ||
| 754 | . I FIRST D ; CARC h eader | ||
| 755 | . . S FIRST =0 | ||
| 756 | . . I EXCEL D Q | ||
| 757 | . . . W !!, "CARC^Decr ease Amt^Q uantity^Re ason" | ||
| 758 | . . W !!," CARC Decre ase Amt # Reas on" | ||
| 759 | . . W !," -------- ---------- -- ------ ------- - --- ----- ---------- | ||
| 760 | ---------- ----" | ||
| 761 | . S XX=" "_$E($P(D ATA,U,1),1 ,20) ; CARC | ||
| 762 | . S $E(XX,2 7)=$J($P(D ATA,U,2),1 2,2) ; Decrea se Amount | ||
| 763 | . S $E(XX,4 2)=$J($P(D ATA,U,3),4 ) ; Quanti ty | ||
| 764 | . S $E(XX,4 8)=$E($P(D ATA,U,4),1 ,32) ; Reason | ||
| 765 | . W !,XX | ||
| 766 | Q | ||
| 767 | ; | ||
| 768 | EXCEL(DATA ,A1,A2,A3) ; Format EXCEL line | ||
| 769 | ; Input: DATA - ERA line adju stment tot al | ||
| 770 | ; A1,A2,A3 - ^TMP("RCD PEAP") sub scripts | ||
| 771 | N CARCAMT,C CTR,DATA1 | ||
| 772 | S CCTR=0 | ||
| 773 | F S CCTR=$ O(^TMP("RC DPEADP",$J ,A1,A2,A3, CCTR)) Q:' CCTR D | ||
| 774 | . ;Display an EXCEL l ine for ea ch CARC ad justment o n the line | ||
| 775 | . S DATA1=$ G(^TMP("RC DPEADP",$J ,A1,A2,A3, CCTR)),CAR CAMT=$P(DA TA1,U,2) | ||
| 776 | . W !,$P(DA TA,U,1,5)_ U_CARCAMT_ U_$P(DATA, U,7)_U_DAT A1 | ||
| 777 | Q | ||
| 778 | ; | ||
| 779 | LINE(DIV) ; List sel ected stat ions | ||
| 780 | ; Input: DIV() - Array of selecte d division s | ||
| 781 | ; Returns: Comma deli mited list of select ed divisio ns | ||
| 782 | N LINE,P,SU B | ||
| 783 | S LINE="",S UB="",P=0 | ||
| 784 | F D Q:'SU B | ||
| 785 | . S SUB=$O( DIV(SUB)) | ||
| 786 | . Q:'SUB | ||
| 787 | . S P=P+1,$ P(LINE,", ",P)=$G(DI V(SUB)) | ||
| 788 | Q LINE | ||
| 789 | ; | ||
| 790 | ASK(STOP,T YP) ; Ask to continu e, if TYP= 1 then pro mpt to fin ish | ||
| 791 | ; Input: TYP - 1 - Prompt to finish , 0 Otherw ise | ||
| 792 | ; IOST - Device Typ e | ||
| 793 | ; Output: STOP - 1 to abort print, 0 otherwise | ||
| 794 | N DIR,DIROU T,DIRUT,DT OUT,DUOUT | ||
| 795 | Q :$E(IOST,1 ,2)'["C-" ; Not a te rminal | ||
| 796 | S :$G(TYP)=1 DIR("A")= "Enter RET URN to fin ish" | ||
| 797 | S DIR(0)="E " | ||
| 798 | W ! | ||
| 799 | D ^DIR | ||
| 800 | I ($D(DIRUT ))!($D(DUO UT)) S STO P=1 | ||
| 801 | Q | ||
| 802 | ; | ||
| 803 | CLAIM(EOBI EN) ; Gets the claim number fr om AR | ||
| 804 | ; Input: EOBIEN - Intern al IEN for file 361. 1 | ||
| 805 | ; Returns: External C laim Numbe r | ||
| 806 | N CLAIM,CLA IMIEN | ||
| 807 | Q :'$G(EOBIE N)>0 "(no EOB IEN)" | ||
| 808 | S CLAIMIEN= $$GET1^DIQ (361.1,EOB IEN,.01,"I ") ; IE N for file 399 | ||
| 809 | Q :'CLAIMIEN "(no Clai m IEN)" | ||
| 810 | S CLAIM=$$G ET1^DIQ(43 0,CLAIMIEN ,.01,"I") | ||
| 811 | Q :CLAIM="" "(Claim no t found)" | ||
| 812 | Q CLAIM ; Re turn claim (nnn-Knnn nnn) | ||
| 813 | ; | ||
| 814 | |||
| 815 | |||
| 816 | |||
| 817 | Routines | ||
| 818 | Activities | ||
| 819 | Routine Na me | ||
| 820 | RCDPEAD1 | ||
| 821 | Enhancemen t Category | ||
| 822 | New | ||
| 823 | Modify | ||
| 824 | Delete | ||
| 825 | No Change | ||
| 826 | RTM | ||
| 827 | |||
| 828 | Related Op tions | ||
| 829 | RCDPE AUTO -DECREASE REPORT | ||
| 830 | Routines | ||
| 831 | Activities | ||
| 832 | Data Dicti onary (DD) Reference s | ||
| 833 | |||
| 834 | Related Pr otocols | ||
| 835 | N/A | ||
| 836 | Related In tegration Control Re gistration s (ICRs) | ||
| 837 | N/A | ||
| 838 | Data Passi ng | ||
| 839 | Input | ||
| 840 | Output Re ference | ||
| 841 | Both | ||
| 842 | Global Re ference | ||
| 843 | Local | ||
| 844 | Input Attr ibute Name and Defin ition | ||
| 845 | Name: | ||
| 846 | Definition : | ||
| 847 | Output Att ribute Nam e and Defi nition | ||
| 848 | Name: | ||
| 849 | Definition : | ||
| 850 | |||
| 851 | Related Ro utines | ||
| 852 | Routines “ Called By” | ||
| 853 | Routines “ Called” | ||
| 854 | |||
| 855 | RCDPEADP | ||
| 856 | |||
| 857 | $$CARCL MT^RCDPEAD | ||
| 858 | SAVE^RC DPEADP | ||
| 859 | |||
| 860 | |||
| 861 | Current Lo gic | ||
| 862 | N/A | ||
| 863 | |||
| 864 | |||
| 865 | Modified L ogic | ||
| 866 | RCDPEAD1 ; OIFO-BAYPI NES/PJH - AUTO-DECRE ASE REPORT ;Nov 23, 2014@12:48 :50 | ||
| 867 | ; ;4.5;Accou nts Receiv able;**298 ,317,318** ;Mar 20, 1 995;Build 121 | ||
| 868 | ; ;Per VA Di rective 64 02, this r outine sho uld not be modified. | ||
| 869 | ; | ||
| 870 | CARCS(A1,A 2,A3,CARCS ) ; Get CA RC Auto-De crease dat a | ||
| 871 | ; Input: A1 - "E XCEL" if e xporting t o excel | ||
| 872 | ; In ternal fil eman date if not exp orting to excel | ||
| 873 | ; A2 - Ex cel Line C ounter if exporting to excel | ||
| 874 | ; Ex ternal Cla im number is sorting by claim | ||
| 875 | ; Ex ternal Pay er Name if sorting b y Payer | ||
| 876 | ; Ex ternal Pat ient Name if sorting by Patien t Name | ||
| 877 | ; A3 - Re cord Count er | ||
| 878 | ; CARCS - ^ delimited string of CARC infor mation | ||
| 879 | ; Se e SAVE for a complet e descript ion | ||
| 880 | ; Output: ^TMP("RCDP EADP",$J,A 1,A2,A3,A4 ) - C1^C2^ C3^C4 Wher e: | ||
| 881 | ; - A1 - "EXCEL" if export ing to exc el | ||
| 882 | ; Intern al fileman date if n ot exporti ng to exce l | ||
| 883 | ; A2 - Excel L ine Counte r if expor ting to ex cel | ||
| 884 | ; Externa l Claim nu mber is so rting by c laim | ||
| 885 | ; Externa l Payer Na me if sort ing by Pay er | ||
| 886 | ; Externa l Patient Name if so rting by P atient Nam e | ||
| 887 | ; A3 - Record Counter | ||
| 888 | ; A4 - CARC Co unter | ||
| 889 | ; C1 - CARC Co de (file 3 61.111, fi eld .01) | ||
| 890 | ; C2 - Decreas e Amount ( file 361.1 11, field .02) | ||
| 891 | ; C3 - Quantit y (file 36 1.111, fie ld .03) | ||
| 892 | ; C4 - Reason (file 361. 111, field .04) | ||
| 893 | N AMT,CCTR, OCARC,QUAN T,REASON,X X | ||
| 894 | ; | ||
| 895 | ; Loop thro ugh all of the valid CARCs fou nd in the EOB record | ||
| 896 | F CCTR=1:1: $L(CARCS," ^") D | ||
| 897 | . S OCARC=$ P(CARCS,"^ ",CCTR) | ||
| 898 | . S CARC=$P (OCARC,";" ,2) ; CARC C ode | ||
| 899 | . S AMT=$P( OCARC,";", 1) ; Amount | ||
| 900 | . S QUANT=$ P(OCARC,"; ",3) ; Quanti ty | ||
| 901 | . S REASON= $P(OCARC," ;",4) ; Reason Text | ||
| 902 | . S XX=CARC _"^"_AMT_" ^"_QUANT_" ^"_REASON | ||
| 903 | . S ^TMP("R CDPEADP",$ J,A1,A2,A3 ,CCTR)=XX | ||
| 904 | Q | ||
| 905 | ; | ||
| 906 | COMPILE(IN PUTS,RCVAU TD,DTOTAL, GTOTAL) ; Generate t he Auto-De crease rep ort ^TMP a rray | ||
| 907 | ; Input: INPUTS - A1^A2^A3^. ..^An Wher e: | ||
| 908 | ; A1 - 1 - All di visions se lected | ||
| 909 | ; 2 - Select ed divisio ns | ||
| 910 | ; A2 - C - Sort b y Claim | ||
| 911 | ; P - Sort b y Payer | ||
| 912 | ; N - Sort b y Patient Name | ||
| 913 | ; A3 - F - First to Last So rt Order | ||
| 914 | ; L - Last t o First So rt Order | ||
| 915 | ; A4 - B 1|B2 | ||
| 916 | ; B 1 - Auto-P ost Start Date | ||
| 917 | ; B 2 - Auto-P ost End Da te | ||
| 918 | ; A5 - 1 - Output to Excel | ||
| 919 | ; 2 - Otherwi se | ||
| 920 | ; RCVAUTD - Array of selecte d Division s | ||
| 921 | ; Only p assed if A 1=2 | ||
| 922 | ; Output: DTOTAL() - Array of totals by Auto-Post Date | ||
| 923 | ; GTOTAL - Grand to tals | ||
| 924 | ; ^TMP("RCDP EADP",$J) - Array of report da ta | ||
| 925 | ; See SAVE for a ful l descript ion | ||
| 926 | N ADDATE,CA RCS,END,ER AIEN,EOBIE N,EXCEL,RC TR,RCRZ,RC SORT,STA,S TNAM,STNUM ,XX | ||
| 927 | ; | ||
| 928 | S XX=$P(INP UTS,"^",4) ; Auto-P ost Date r ange | ||
| 929 | S ADDATE=$$ FMADD^XLFD T($P(XX,"| ",1),-1) | ||
| 930 | S END=$P(XX ,"|",2) ; Auto-P ost End Da te | ||
| 931 | S RCTR=0 ; Record counter | ||
| 932 | S EXCEL=$P( INPUTS,"^" ,5) ; 1 outp ut to Exce l, 0 other wise | ||
| 933 | S RCSORT=$P (INPUTS,"^ ",2) ; Sort T ype | ||
| 934 | ; | ||
| 935 | ; ^RCY(344. 4,0) = "EL ECTRONIC R EMITTANCE ADVICE^344 .4I^" | ||
| 936 | ; G c ross-ref. REGULAR WHOLE F ILE (#344. 4) | ||
| 937 | ; Fie ld: AUTO- POST DATE (344.41,9 ) | ||
| 938 | ; Scan G in dex for ER A within d ate range | ||
| 939 | F S ADDATE =$O(^RCY(3 44.4,"G",A DDATE)) Q: 'ADDATE Q :(ADDATE\1 )>END D | ||
| 940 | . S ERAIEN= "" | ||
| 941 | . F D Q:' ERAIEN | ||
| 942 | . . S ERAIE N=$O(^RCY( 344.4,"G", ADDATE,ERA IEN)) | ||
| 943 | . . Q:'ERAI EN | ||
| 944 | . . D ERAST A(ERAIEN,. STA,.STNUM ,.STNAM) ; Ch eck for va lid Divisi on | ||
| 945 | . . I $P(IN PUTS,"^",1 )=2,'$D(RC VAUTD(STA) ) Q ; No t a valid Division | ||
| 946 | . . ; | ||
| 947 | . . ; Scan index for auto-decre ased claim lines wit hin the ER A | ||
| 948 | . . ; and S ave claim line detai l to ^TMP global | ||
| 949 | . . S RCRZ= "" | ||
| 950 | . . F D Q :'RCRZ | ||
| 951 | . . . S RCR Z=$O(^RCY( 344.4,"G", ADDATE,ERA IEN,RCRZ)) | ||
| 952 | . . . Q:'RC RZ | ||
| 953 | . . . S EOB IEN=$$GET1 ^DIQ(344.4 1,RCRZ_"," _ERAIEN_", ",.02,"I") | ||
| 954 | . . . ; | ||
| 955 | . . . ; Fin d all Clai m level an d Claim li ne level C ARCs | ||
| 956 | . . . S CAR CS=$$CARCL MT^RCDPEAD (EOBIEN,1, ADDATE) | ||
| 957 | . . . Q:+CA RCS=0 ; No CARCs fou nd | ||
| 958 | . . . D SAV E^RCDPEADP (ADDATE,ER AIEN,RCRZ, EXCEL,RCSO RT,CARCS,. RCTR,STNAM ,STNUM) | ||
| 959 | Q | ||
| 960 | ; | ||
| 961 | ERASTA(ERA IEN,STA,ST NUM,STNAM) ; Get the station f or this ER A | ||
| 962 | ; Input: ERAIEN - Internal I EN for fil e 344.4 | ||
| 963 | ; Output: STA - Internal S tation IEN | ||
| 964 | ; STNUM - Station Nu mber | ||
| 965 | ; STNAM - Station Na me | ||
| 966 | N ERAEOB,ER ABILL,STAI EN | ||
| 967 | S (ERAEOB,E RABILL)="" | ||
| 968 | S (STA,STNU M,STNAM)=" UNKNOWN" | ||
| 969 | S ERAEOB=$$ GET1^DIQ(3 44.41,"1," _ERAIEN_", ",.02,"I") | ||
| 970 | Q :'ERAEOB | ||
| 971 | S ERABILL=$ $GET1^DIQ( 361.1,ERAE OB,.01,"I" ) | ||
| 972 | Q :'ERABILL | ||
| 973 | S STAIEN=$$ GET1^DIQ(3 99,ERABILL ,.22,"I") | ||
| 974 | Q :'STAIEN | ||
| 975 | S STA=STAIE N | ||
| 976 | S STNAM=$$E XTERNAL^DI LFD(399,.2 2,,STA) | ||
| 977 | S STNUM=$$G ET1^DIQ(40 .8,STAIEN, 1,"I") | ||
| 978 | Q | ||
| 979 | ; | ||
| 980 | HDR(EXCEL, HDRINFO,PA GE,NOLINE) ; Print t he report header | ||
| 981 | ; Input: EXCEL - 1 if o utput to E xcel, 0 ot herwise | ||
| 982 | ; HDRINFO() - Array of Header informatio n | ||
| 983 | ; PAGE - Curren t Page Num ber | ||
| 984 | ; NOLINE - 1 to n ot display Claim lin e header | ||
| 985 | ; Option al, defaul ts to 0 | ||
| 986 | ; Output: PAGE - Update d Page Num ber (if EX CEL=0) | ||
| 987 | N DIV,MSG,S UB,XX,Y,Z0 ,Z1 | ||
| 988 | S :'$D(NOLIN E) NOLINE= 0 | ||
| 989 | I EXCEL D Q | ||
| 990 | . W !,"STAT ION^STATIO N NUMBER^C LAIM #^PAT IENT NAME^ PAYER^DECR EASE AMOUN T^DATE^CAR C" | ||
| 991 | . W "^DECRE ASE AMT^#^ REASON" | ||
| 992 | ; | ||
| 993 | S PAGE=PAGE +1 | ||
| 994 | W @IOF | ||
| 995 | S MSG(1)=" EDI Lockbo x Auto-Dec rease Adju stment Rep ort " | ||
| 996 | S MSG(1)=MS G(1)_" Page: " _PAGE | ||
| 997 | S MSG(2)=" Run Dat e: "_HDRIN FO("RUNDAT E") | ||
| 998 | S Z0="Divis ions: "_HD RINFO("DIV ISIONS") | ||
| 999 | S MSG(3)=$S ($L(Z0)<75 :$J("",75- $L(Z0)\2), 1:"")_Z0 | ||
| 1000 | S XX=" (Dat e Decrease Applied)" | ||
| 1001 | S MSG(4)=" Date R ange: "_HD RINFO("STA RT")_" - " _HDRINFO(" END")_XX | ||
| 1002 | S MSG(5)=" "_HDR INFO("SORT ") | ||
| 1003 | S MSG(6)="" | ||
| 1004 | I 'NOLINE D | ||
| 1005 | . S MSG(7)= "Claim # Patie nt Name Pay er Decre ase Amt D ate " | ||
| 1006 | . S MSG(8)= "========= ========== ========== ========== ========== ========== | ||
| 1007 | ========== =======" | ||
| 1008 | D EN^DDIOL( .MSG) | ||
| 1009 | Q | ||
| 1010 | ; | ||
| 1011 | TOTALD(EXC EL,HDRINFO ,PAGE,STOP ,DAY,DTOTA L) ; Total s for a si ngle day | ||
| 1012 | ; Input: EXCEL - 1 if o utput to E xcel, 0 ot herwise | ||
| 1013 | ; HDRINFO() - Array of header informatio n | ||
| 1014 | ; PAGE - Curren t Page Num ber | ||
| 1015 | ; DAY - Intern al Fileman date to d isplay tot als for | ||
| 1016 | ; DTOTAL() - Array of totals by day | ||
| 1017 | ; IOSL - Page l ength | ||
| 1018 | ; Output: PAGE - Update d Page Num ber (if a new header is displa yed) | ||
| 1019 | ; STOP - 1 if d isplaying to screen and user a sked to st op | ||
| 1020 | N DCNT,DAMT ,Y | ||
| 1021 | I 'EXCEL,$Y >(IOSL-4) D | ||
| 1022 | . D HDR(EXC EL,.HDRINF O,.PAGE) | ||
| 1023 | S DCNT=$P(D TOTAL(DAY) ,U),DAMT=$ P(DTOTAL(D AY),U,2) | ||
| 1024 | S Y="**Tota ls for Dat e: "_$$FMT E^XLFDT(DA Y,"2Z") | ||
| 1025 | S $E(Y,35)= " # of Decrease A djustments : "_DCNT | ||
| 1026 | W !!,Y | ||
| 1027 | S Y="",$E(Y ,28)="Tota l Amount o f Decrease Adjustmen ts: $"_$J( DAMT,3,2) | ||
| 1028 | W !,Y | ||
| 1029 | Q | ||
| 1030 | ; | ||
| 1031 | TOTALS ; Print tot als for EX CEL | ||
| 1032 | N DAY,DAMT, DCNT | ||
| 1033 | S DAY="" | ||
| 1034 | F S DAY=$O (DTOTAL(DA Y)) Q:'DAY D Q:STO P | ||
| 1035 | . ;Day total s | ||
| 1036 | . D TOTALD(D AY) | ||
| 1037 | ; Grand tota ls | ||
| 1038 | D TOTALG | ||
| 1039 | Q | ||
| 1040 | ; | ||
| 1041 | TOTALG(EXC EL,HDRINFO ,PAGE,GTOT AL) ; Over all report total | ||
| 1042 | ; Input: EXCEL - 1 if o utput to E xcel, 0 ot herwise | ||
| 1043 | ; HDRINFO() - Array of header informatio n | ||
| 1044 | ; PAGE - Curren t Page Num ber | ||
| 1045 | ; GTOTAL() - Grand Totals for report | ||
| 1046 | ; IOSL - Page l ength | ||
| 1047 | ; Output: PAGE - Update d Page Num ber (if a new header is displa yed) | ||
| 1048 | N Y | ||
| 1049 | I 'EXCEL,$Y >(IOSL-6) D HDR(EXCE L,.HDRINFO ,.PAGE) | ||
| 1050 | W !!,"**** Totals for Date Rang e: # of De crease Adj ustments: | ||
| 1051 | "_+$P(GTOT AL,U,1) | ||
| 1052 | S Y="",$E(Y ,28)="Tota l Amount o f Decrease Adjustmen ts: $"_$J( (+$P(GTOTA L,U,2)),3, 2) | ||
| 1053 | W !,Y,! | ||
| 1054 | Q | ||
| 1055 | ; | ||
| 1056 | |||
| 1057 | |||
| 1058 | |||
| 1059 | |||
| 1060 | |||
| 1061 | Routines | ||
| 1062 | Activities | ||
| 1063 | Routine Na me | ||
| 1064 | RCDPEAD | ||
| 1065 | Enhancemen t Category | ||
| 1066 | New | ||
| 1067 | Modify | ||
| 1068 | Delete | ||
| 1069 | No Change | ||
| 1070 | RTM | ||
| 1071 | |||
| 1072 | Related Op tions | ||
| 1073 | PRCA NIGHT LY PROCESS (auto dec rease modu le) | ||
| 1074 | RCDPE AUTO -DECREASE REPORT | ||
| 1075 | Routines | ||
| 1076 | Activities | ||
| 1077 | Data Dicti onary (DD) Reference s | ||
| 1078 | |||
| 1079 | Related Pr otocols | ||
| 1080 | |||
| 1081 | Related In tegration Control Re gistration s (ICRs) | ||
| 1082 | Previously existing and activa ted ICR’s | ||
| 1083 | Read ^IBM( 361.1) via Private I A 4051 | ||
| 1084 | Data Passi ng | ||
| 1085 | Input | ||
| 1086 | Output Re ference | ||
| 1087 | Both | ||
| 1088 | Global Re ference | ||
| 1089 | Local | ||
| 1090 | Input Attr ibute Name and Defin ition | ||
| 1091 | Name: | ||
| 1092 | Definition : | ||
| 1093 | Output Att ribute Nam e and Defi nition | ||
| 1094 | Name: | ||
| 1095 | Definition : | ||
| 1096 | |||
| 1097 | Related Ro utines | ||
| 1098 | Routines “ Called By” | ||
| 1099 | Routines “ Called” | ||
| 1100 | |||
| 1101 | RCDPEM | ||
| 1102 | RCDPEAD1 | ||
| 1103 | INCDEC^RCB EUTR1 | ||
| 1104 | BUILD^RCDP EAP | ||
| 1105 | PHARM^RCDP EAP1 | ||
| 1106 | PENDPAY^RC DPURET | ||
| 1107 | |||
| 1108 | Current Lo gic | ||
| 1109 | RCDPEAD ; ALB/PJH - AUTO DECRE ASE ;Jun 0 6, 2014@19 :11:19 | ||
| 1110 | ; ;4.5;Accou nts Receiv able;**298 ,304**;Mar 20, 1995; Build 104 | ||
| 1111 | ; Per VA Dir ective 640 2, this ro utine shou ld not be modified. | ||
| 1112 | ; Read ^IBM( 361.1) via Private I A 4051 | ||
| 1113 | ; | ||
| 1114 | EN ; Auto Decre ase - appl ies to aut o-posted c laims only | ||
| 1115 | N PAYID,PAY NAM,RCAMT, RCDATE,RCD AY,RCDREC, RCERA,RCLI NE,RCSTART ,RCITEM | ||
| 1116 | N RC344610, RCMDAP,RCM DAD,RCRTYP E,RCJ,RCK, RCIARR,J | ||
| 1117 | ; | ||
| 1118 | ; Quit if me dical auto posting i s OFF or m edical aut o decrease is OFF | ||
| 1119 | Q :'$P($G(^R CY(344.61, 1,0)),U,2) Q:'$P($G (^RCY(344. 61,1,0)),U ,3) | ||
| 1120 | ; Get the RC DPE PARAME TER file # 344.61 fie ld.04 AUTO DECREASE MED DAYS D EFAULT val ue and | ||
| 1121 | ; calculate process da te by subt racting th is value f rom today' s date | ||
| 1122 | S RCDAY=$$F MADD^XLFDT (DT\1,-$P( $G(^RCY(34 4.61,1,0)) ,U,4)) | ||
| 1123 | ; | ||
| 1124 | ; PRCA*4.5*3 04 - remov ed generic auto-decr ease amoun t. Now aut o-decrease is by CAR C | ||
| 1125 | ; Allow for a range of dates in future - c urrently o nly checks for RCDAY | ||
| 1126 | S RCDATE=$$ FMADD^XLFD T(RCDAY,-1 ) | ||
| 1127 | ; Scan F ind ex for ERA within da te range | ||
| 1128 | F S RCDATE =$O(^RCY(3 44.4,"F",R CDATE)) Q: 'RCDATE Q :(RCDATE\1 )>RCDAY D | ||
| 1129 | . ; Scan "F " index of ERA file for ERA en tries with AUTOPOST DATE field #4.03 mat ching RCDA Y | ||
| 1130 | . S RCERA=0 | ||
| 1131 | . F S RCER A=$O(^RCY( 344.4,"F", RCDATE,RCE RA)) Q:'RC ERA D | ||
| 1132 | . . N RC3446 ,RCPARM | ||
| 1133 | . . ; Quit i f ERA is f or Pharmac y | ||
| 1134 | . . S RCRTYP E=$$PHARM^ RCDPEAP1(R CERA) | ||
| 1135 | . . Q:RCRTYP E | ||
| 1136 | . . ; Check payer excl usion file for this ERA's paye r | ||
| 1137 | . . S PAYID= $P($G(^RCY (344.4,RCE RA,0)),U,3 ),PAYNAM=$ P($G(^RCY( 344.4,RCER A,0)),U,6) | ||
| 1138 | . . I PAYID' ="",PAYNAM '="" S RCP ARM=$O(^RC Y(344.6,"C PID",PAYNA M,PAYID,"" )) S:RCPAR M'="" RC34 46=$G(^RCY (344.6,RCP ARM,0)) | ||
| 1139 | . . ; Ignore ERA if EX CLUDE MED CLAIMS POS TING (#.0 6) or EXCL UDE MED CL AIMS DECRE ASE (#.07) fields se t to 'yes' | ||
| 1140 | . . I $G(RC3 446)]"" Q: $P(RC3446, U,6)=1 Q: $P(RC3446, U,7)=1 | ||
| 1141 | . . ; Build index to s cratchpad for this E RA | ||
| 1142 | . . N RCARRA Y D BUILD^ RCDPEAP(RC ERA,.RCARR AY) | ||
| 1143 | . . ; Scan E RA DETAIL entries in #344.41 f or auto-po sted medic al claims | ||
| 1144 | . . S RCLINE =0 | ||
| 1145 | . . F S RCL INE=$O(^RC Y(344.4,"F ",RCDATE,R CERA,RCLIN E)) Q:'RCL INE D | ||
| 1146 | . .. ;Ignore claim lin e if alrea dy auto de creased | ||
| 1147 | . .. Q:$P($G (^RCY(344. 4,RCERA,1, RCLINE,5)) ,U,3) | ||
| 1148 | . .. ; Get r ecord deta il | ||
| 1149 | . .. S RCDRE C=$G(^RCY( 344.4,RCER A,1,RCLINE ,0)) | ||
| 1150 | . .. ; Get c laim numbe r RCBILL f or the ERA line usin g EOB #361 .1 pointer | ||
| 1151 | . .. N COMME NT,EOBIEN, RCBAL,RCBI LL,RCTRAND A | ||
| 1152 | . .. ; Get p ointer to EOB file # 361.1 from ERA DETAI L | ||
| 1153 | . .. S EOBIE N=$P($G(^R CY(344.4,R CERA,1,RCL INE,0)),U, 2),RCBILL= 0 | ||
| 1154 | . .. ; Get ^ DGCR(399 p ointer (DI NUM for #4 30 file) | ||
| 1155 | . .. S:EOBIE N RCBILL=$ P($G(^IBM( 361.1,EOBI EN,0)),U) Q:'RCBILL | ||
| 1156 | . .. ;If cla im has bee n split/ed it and cla im changed in APAR d o not auto decrease | ||
| 1157 | . .. Q:$$SPL IT(RCERA,R CLINE,RCBI LL,.RCARRA Y) | ||
| 1158 | . .. ;Do not auto decr ease if cl aim is ref erred to G eneral Cou ncil | ||
| 1159 | . .. Q:$P($G (^PRCA(430 ,RCBILL,6) ),U,4)]"" | ||
| 1160 | . .. ; Claim must be O PEN or ACT IVE | ||
| 1161 | . .. N STATU S S STATUS =$P($G(^PR CA(430,RCB ILL,0)),"^ ",8) I STA TUS'=42,ST ATUS'=16 Q | ||
| 1162 | . .. ; | ||
| 1163 | . .. ; PRCA* 4.5*304 - A CARC mus t be inclu ded and ha ve an auto -decrease limit befo re auto-de creasing c an occur. | ||
| 1164 | . .. S RCAMT =$$CARCLMT (EOBIEN) | ||
| 1165 | . .. Q:$L(RC AMT)=0 ;No C ARCs on EO B were eli gible for auto-decre ase | ||
| 1166 | . .. ; Order CARCs for Auto-Decr ease in la rgest to s mallest am ount order | ||
| 1167 | . .. K RCIAR R F J=1:1 S RCITEM=$ P(RCAMT,U, J) Q:RCITE M="" S RC IARR(-($P( RCITEM,";" ,1)),J)=RC ITEM | ||
| 1168 | . .. Q:$D(RC IARR)<10 ; Quit if CARC adjus tment arra y doesn't have any e lements to process | ||
| 1169 | . .. ; Walk the RCIARR and apply CARC base d adjustme nts to the bill. | ||
| 1170 | . .. S RCJ=" " F S RCJ =$O(RCIARR (RCJ)) Q:R CJ="" S R CK="" F S RCK=$O(RC IARR(RCJ,R CK)) Q:RCK ="" D | ||
| 1171 | . ... ; Get current ba lance on B ill | ||
| 1172 | . ... S RCBA L=$P($G(^P RCA(430,RC BILL,7)),U ) | ||
| 1173 | . ... ; Chec k pending payment am ount and b ill balanc e | ||
| 1174 | . ... N PEND ING S PEND ING=$$PEND PAY^RCDPUR ET(RCBILL) K ^TMP($J ,"RCDPUREC ","PP") Q: (RCBAL-PEN DING)<(+$P (RCIARR(RC J,RCK),";" ,1 | ||
| 1175 | )) | ||
| 1176 | . ... ; Add comment | ||
| 1177 | . ... S COMM ENT(1)="ME DICAL AUTO -DECREASE FOR CARC: "_$P(RCIAR R(RCJ,RCK) ,";",2)_" AMOUNT: "_ +$P(RCIARR (RCJ,RCK), ";",1)_" ( MA | ||
| 1178 | X DEC: "_+ $P($$ACTCA RC($P(RCIA RR(RCJ,RCK ),";",2)), U,2)_")" | ||
| 1179 | . ... ; If t his CARC i s expired then add t hat inform ation to t he comment | ||
| 1180 | . ... I $P(R CIARR(RCJ, RCK),";",3 )'="" S CO MMENT(1)=C OMMENT(1)_ " CARC exp ired on "_ $$FMTE^XLF DT($P(RCIA RR(RCJ,RCK ),";",3)," 6D | ||
| 1181 | ") | ||
| 1182 | . ... ; Appl y contract adjustmen t for CARC adjustmen t amount f rom claim informatio n | ||
| 1183 | . ... S RCTR ANDA=$$INC DEC^RCBEUT R1(RCBILL, -$P(RCIARR (RCJ,RCK), ";",1),.CO MMENT,""," ",1) Q:'RC TRANDA | ||
| 1184 | . ... ; Upda te auto-de crease ind icator, au to decreas e amount a nd auto de crease dat e | ||
| 1185 | . ... N DA,D IE,DR S DA (1)=RCERA, DA=RCLINE, DIE="^RCY( 344.4,"_DA (1)_",1,", DR="7///1; 8///"_+$P( RCIARR(RCJ ,RCK),";", 1)_";10/// "_ | ||
| 1186 | DT D ^DIE | ||
| 1187 | . .. ; PRCA* 4.5*304 - End of upd ates | ||
| 1188 | . . ; Update last auto decrease date on ER A | ||
| 1189 | . . N DA,DIE ,DR S DA=R CERA,DIE=" ^RCY(344.4 ,",DR="4.0 3///"_DT D ^DIE | ||
| 1190 | Q | ||
| 1191 | ; | ||
| 1192 | SPLIT(RCSC R,RCLINE,R CBILL,RCAR RAY) ;Chec k for SPLI T/EDIT in scratchpad | ||
| 1193 | ; Input RCSC R - IEN of #344.49 | ||
| 1194 | ; RCLI NE - ERA d etail line sequence number | ||
| 1195 | ; RCBI LL - IEN o f #430 | ||
| 1196 | ; ARRA Y - refere nce to pas sed array (from BUIL D^RCDPEAP) | ||
| 1197 | ; Output ret urn value 1/0 = Spli t/Not Spli t | ||
| 1198 | N SUB,SUB1 | ||
| 1199 | ; Find ERA l ine in scr atchpad | ||
| 1200 | S SUB=$G(RC ARRAY(RCLI NE)) Q:'SU B 0 | ||
| 1201 | ; Get n.001 line | ||
| 1202 | S SUB1=$O(^ RCY(344.49 ,RCSCR,1,S UB)) Q:'SU B1 0 | ||
| 1203 | ; Check sequ ence numbe r is the s ame | ||
| 1204 | Q :$P($G(^RC Y(344.49,R CSCR,1,SUB 1,0)),".") '=$P($G(^R CY(344.49, RCSCR,1,SU B,0)),U) 0 | ||
| 1205 | ; Check that claim num ber is unc hanged fro m original ERA | ||
| 1206 | Q :$P($G(^RC Y(344.49,R CSCR,1,SUB 1,0)),U,7) =RCBILL 0 | ||
| 1207 | ; Otherwise claim was edited (an d should n ot be decr eased) | ||
| 1208 | Q 1 | ||
| 1209 | ; | ||
| 1210 | ; PRCA*4.5*3 04 - Check to see if CARC/RARC are inclu ded and ar e eligible | ||
| 1211 | ; for auto- decrease. Return 0 i f not, Max Amount ^ CARC if it is. | ||
| 1212 | CARCLMT(RC EOB) ; | ||
| 1213 | N RCCODES,R CAMT,RCCAM T,RCTAMT,I ,RCITEM,RC DATA,RCCOD E | ||
| 1214 | S RCAMT="", RCCODES="" | ||
| 1215 | ; | ||
| 1216 | ; Extract t he CARC co des from t he EOB. Re turned are ^CARC;[ad j amount]^ CARC;[adj amount]^.. . | ||
| 1217 | D GETCARCS( RCEOB,.RCC ODES) | ||
| 1218 | ; Remove le ading , | ||
| 1219 | ; Loop thro ugh all of the CARC codes foun d. If non e, it will exit. | ||
| 1220 | F I=2:1:$L( RCCODES,"^ ") S RCITE M=$P(RCCOD ES,"^",I) D:RCITEM'= "" | ||
| 1221 | . S RCCODE= $P(RCITEM, ";",1),RCC AMT=$P(RCI TEM,";",2) | ||
| 1222 | . ; If Adju stment amo unt is a n egative am ount don't include, Quit | ||
| 1223 | . Q:+RCCAMT <0 | ||
| 1224 | . ; Look up code in C ARC table and get ma x adjustme nt | ||
| 1225 | . S RCDATA= $$ACTCARC( RCCODE) | ||
| 1226 | . ; If auto decrease is not act ive on thi s code, Qu it | ||
| 1227 | . Q:+RCDATA =0 | ||
| 1228 | . ; Get cod e inactive date if i t exists | ||
| 1229 | . N XIEN,XD T S XIEN=$ $FIND1^DIC (345,,"O", RCCODE) S: $G(XIEN)'= "" XDT=$$G ET1^DIQ(34 5,XIEN_"," ,2,"I") I $G(XDT)'=" " S:XDT'<D T | ||
| 1230 | XDT="" | ||
| 1231 | . ; Get lim it | ||
| 1232 | . S RCTAMT= $P(RCDATA, U,2) | ||
| 1233 | . ; | ||
| 1234 | . ; 11/11/2 015: Need to compare the max a djustment in paramet ers to the adjustmen t on EEOB if under o kay if ove r skip. | ||
| 1235 | . ; | ||
| 1236 | . ; If the CARC payer adjustmen t <= CARC max adjust ment amoun t, Then ad d to list for possib le adjustm ents. | ||
| 1237 | . S:RCCAMT< (RCTAMT+.0 1) RCAMT=$ S($L(RCAMT )=0:RCCAMT _";"_RCCOD E_";"_XDT, 1:RCAMT_U_ RCCAMT_";" _RCCODE_"; "_XDT) | ||
| 1238 | ; Exit rout ine | ||
| 1239 | Q RCAMT | ||
| 1240 | ; | ||
| 1241 | ; PRCA*4.5*3 04 - Extra ct the CAR Cs from an EOB at cl aim and li ne levels | ||
| 1242 | GETCARCS(R CEOB,RCCOD ES) ; | ||
| 1243 | ; | ||
| 1244 | N RCI,RCJ,R CL,RCDATA, RCCODE,RCA MT | ||
| 1245 | ; | ||
| 1246 | S RCI=0,RCC ODES="" | ||
| 1247 | ; | ||
| 1248 | ; 11/11/201 5: This fu nction nee d to grab the list o f CARCs an d amounts at the cla im and lin e level | ||
| 1249 | ; | ||
| 1250 | ; get to th e Codes at the claim level | ||
| 1251 | F S RCI=$O (^IBM(361. 1,RCEOB,10 ,RCI)) Q:' RCI D | ||
| 1252 | . S RCJ=0 | ||
| 1253 | . F S RCJ =$O(^IBM(3 61.1,RCEOB ,10,RCI,1, RCJ)) Q:'R CJ D | ||
| 1254 | . . ; | ||
| 1255 | . . ;get the adjustmen t data | ||
| 1256 | . . S RCDATA =$G(^IBM(3 61.1,RCEOB ,10,RCI,1, RCJ,0)) | ||
| 1257 | . . Q:RCDATA ="" | ||
| 1258 | . . ; | ||
| 1259 | . . ;get the Adjustmen t code | ||
| 1260 | . . S RCCODE =$P(RCDATA ,U),RCAMT= $P(RCDATA, U,2) | ||
| 1261 | . . Q:RCCODE ="" | ||
| 1262 | . . ; | ||
| 1263 | . . ;Add to list of al ready extr acted code s | ||
| 1264 | . . S RCCODE S=RCCODES_ "^"_RCCODE _";"_RCAMT | ||
| 1265 | ; get line level CARC s | ||
| 1266 | S RCL=0 F S RCL=$O(^ IBM(361.1, RCEOB,15,R CL)) Q:+RC L=0 S RCI =0 F S RC I=$O(^IBM( 361.1,RCEO B,15,RCL,1 ,RCI)) Q:+ RCI=0 D | ||
| 1267 | . S RCJ=0 F S RCJ=$O (^IBM(361. 1,RCEOB,15 ,RCL,1,RCI ,1,RCJ)) Q :+RCJ=0 D | ||
| 1268 | . . ; | ||
| 1269 | . . ;get the adjustmen t data | ||
| 1270 | . . S RCDATA =$G(^IBM(3 61.1,RCEOB ,15,RCL,1, RCI,1,RCJ, 0)) | ||
| 1271 | . . Q:RCDATA ="" | ||
| 1272 | . . ; | ||
| 1273 | . . ;get the Adjustmen t code | ||
| 1274 | . . S RCCODE =$P(RCDATA ,U),RCAMT= $P(RCDATA, U,2) | ||
| 1275 | . . Q:RCCODE ="" | ||
| 1276 | . . ; | ||
| 1277 | . . ;Add to list of al ready extr acted code s | ||
| 1278 | . . S RCCODE S=RCCODES_ "^"_RCCODE _";"_RCAMT | ||
| 1279 | Q | ||
| 1280 | ; | ||
| 1281 | ; PRCA*4.5* 304 - Adde d function | ||
| 1282 | ACTCARC(CO DE) ; Is t his CARC a n active c ode for au to-decreas e | ||
| 1283 | ; Return '0 ^NOT ACTIV E' if not active | ||
| 1284 | ; Return '1 ^{amount}' if active and the s econd peic e is the d ecrease am ount | ||
| 1285 | N AIEN G:$G (CODE)="" AQ | ||
| 1286 | S AIEN=$O(^ RCY(344.62 ,"B",CODE, "")) G:AIE N="" AQ | ||
| 1287 | I $P(^RCY(3 44.62,AIEN ,0),U,2)=1 Q "1^"_$P (^(0),U,6) | ||
| 1288 | AQ Q "0^NOT AC TIVE" | ||
| 1289 | ; | ||
| 1290 | |||
| 1291 | |||
| 1292 | Modified L ogic | ||
| 1293 | RCDPEAD ; ALB/PJH - AUTO DECRE ASE ;Jun 0 6, 2014@19 :11:19 | ||
| 1294 | ; ;4.5;Accou nts Receiv able;**298 ,304,318** ;Mar 20, 1 995;Build 104 | ||
| 1295 | ; Per VA Dir ective 640 2, this ro utine shou ld not be modified. | ||
| 1296 | ; Read ^IBM( 361.1) via Private I A 4051 | ||
| 1297 | ; | ||
| 1298 | EN ; Auto Decre ase - appl ies to aut o-posted c laims only | ||
| 1299 | N RCAMT,RCD ATE,RCDAY, RCSTART,RC ITEM | ||
| 1300 | N RC344610, RCMDAP,RCM DAD,RCJ,RC K,RCIARR,J | ||
| 1301 | ; | ||
| 1302 | ; Quit if m edical aut o posting is OFF or medical au to decreas e is OFF | ||
| 1303 | Q :'$P($G(^R CY(344.61, 1,0)),U,2) Q:'$P($G (^RCY(344. 61,1,0)),U ,3) | ||
| 1304 | ; | ||
| 1305 | ; Get the R CDPE PARAM ETER file #344.61 fi eld.04 AUT O DECREASE MED DAYS DEFAULT va lue and | ||
| 1306 | ; calculate process d ate by sub tracting t his value from today 's date | ||
| 1307 | S RCDAY=$$F MADD^XLFDT (DT\1,-$P( $G(^RCY(34 4.61,1,0)) ,U,4)) | ||
| 1308 | ; | ||
| 1309 | ; PRCA*4.5* 304 - remo ved generi c auto-dec rease amou nt. Now au to-decreas e is by CA RC | ||
| 1310 | ; Allow for a range o f dates in future - currently only check s for RCDA Y | ||
| 1311 | ; | ||
| 1312 | ; Scan F in dex for ER A within d ate range | ||
| 1313 | S RCDATE=$$ FMADD^XLFD T(RCDAY,-1 ) | ||
| 1314 | F S RCDATE =$O(^RCY(3 44.4,"F",R CDATE)) Q: 'RCDATE Q :(RCDATE\1 )>RCDAY D | ||
| 1315 | . ; | ||
| 1316 | . ; Scan "F " index of ERA file for ERA en tries with AUTOPOST DATE field #4.03 mat ching RCDA Y | ||
| 1317 | . D EN2(RCD ATE,RCDAY) | ||
| 1318 | Q | ||
| 1319 | ; | ||
| 1320 | EN2(RCDATE ,RCDAY) ; Scans the 'F' index of the ERA file for ERA entrie s with an | ||
| 1321 | ; AUTOPOST DATE field (#4.03) m atching RC DAY | ||
| 1322 | ; Input: RCDATE - Curren t date bei ng search | ||
| 1323 | ; RCDAY - AUTO D ECREATES M ED DAYS DE FAULT (Fil e 344.61, field .04) | ||
| 1324 | N PAYID,PAY NAM,RCERA, RCRTYPE | ||
| 1325 | S RCERA=0 | ||
| 1326 | F S RCERA= $O(^RCY(34 4.4,"F",RC DATE,RCERA )) Q:'RCER A D | ||
| 1327 | . N RC3446, RCPARM | ||
| 1328 | . ; | ||
| 1329 | . ; Quit if ERA is fo r Pharmacy | ||
| 1330 | . S RCRTYPE =$$PHARM^R CDPEAP1(RC ERA) | ||
| 1331 | . Q:RCRTYPE | ||
| 1332 | . ; | ||
| 1333 | . ; Check p ayer exclu sion file for this E RA's payer | ||
| 1334 | . S PAYID=$ P($G(^RCY( 344.4,RCER A,0)),U,3) | ||
| 1335 | . S PAYNAM= $P($G(^RCY (344.4,RCE RA,0)),U,6 ) | ||
| 1336 | . I PAYID'= "",PAYNAM' ="" D | ||
| 1337 | . . S RCPAR M=$O(^RCY( 344.6,"CPI D",PAYNAM, PAYID,"")) | ||
| 1338 | . . S:RCPAR M'="" RC34 46=$G(^RCY (344.6,RCP ARM,0)) | ||
| 1339 | . ; | ||
| 1340 | . ; Ignore ERA if EXC LUDE MED C LAIMS POST ING (#.06 ) or | ||
| 1341 | . ; EXCLUDE MED CLAIM S DECREASE (#.07) fi elds set t o 'yes' | ||
| 1342 | . I $G(RC34 46)'="" Q: $P(RC3446, U,6)=1 Q: $P(RC3446, U,7)=1 | ||
| 1343 | . ; | ||
| 1344 | . ; Build i ndex to sc ratchpad f or this ER A | ||
| 1345 | . N RCARRAY | ||
| 1346 | . D BUILD^R CDPEAP(RCE RA,.RCARRA Y) | ||
| 1347 | . ; | ||
| 1348 | . ; Scan ER A DETAIL e ntries in #344.41 fo r auto-pos ted medica l claims | ||
| 1349 | . D EN3(RCD ATE,RCERA) | ||
| 1350 | Q | ||
| 1351 | ; | ||
| 1352 | EN3(RCDATE ,RCERA) ; Scan ERA D ETAIL entr ies in #34 4.41 for a uto-posted medical c laims | ||
| 1353 | ; Input: RCDATE - Curren t date bei ng search | ||
| 1354 | ; RCERA - ERA nu mber | ||
| 1355 | N RCADJ,RCD REC,RCLINE | ||
| 1356 | S RCLINE=0 | ||
| 1357 | F S RCLINE =$O(^RCY(3 44.4,"F",R CDATE,RCER A,RCLINE)) Q:'RCLINE D | ||
| 1358 | . ; | ||
| 1359 | . ; Ignore claim line if alread y auto dec reased | ||
| 1360 | . Q:$P($G(^ RCY(344.4, RCERA,1,RC LINE,5)),U ,3) | ||
| 1361 | . ; | ||
| 1362 | . ; Get rec ord detail | ||
| 1363 | . S RCDREC= $G(^RCY(34 4.4,RCERA, 1,RCLINE,0 )) | ||
| 1364 | . ; | ||
| 1365 | . ; Get cla im number RCBILL for the ERA l ine using EOB #361.1 pointer | ||
| 1366 | . N COMMENT ,EOBIEN,RC BAL,RCBILL ,RCTRANDA | ||
| 1367 | . ; | ||
| 1368 | . ; Get poi nter to EO B file #36 1.1 from E RA DETAIL | ||
| 1369 | . S EOBIEN= $P($G(^RCY (344.4,RCE RA,1,RCLIN E,0)),U,2) ,RCBILL=0 | ||
| 1370 | . ; | ||
| 1371 | . ; Get ^DG CR(399 poi nter (DINU M for #430 file) | ||
| 1372 | . S:EOBIEN RCBILL=$P( $G(^IBM(36 1.1,EOBIEN ,0)),U) Q: 'RCBILL | ||
| 1373 | . ; | ||
| 1374 | . ; If clai m has been split/edi t and clai m changed in APAR do not auto decrease | ||
| 1375 | . Q:$$SPLIT (RCERA,RCL INE,RCBILL ,.RCARRAY) | ||
| 1376 | . ; | ||
| 1377 | . ; Do not auto decre ase if cla im is refe rred to Ge neral Coun cil | ||
| 1378 | . Q:$P($G(^ PRCA(430,R CBILL,6)), U,4)]"" | ||
| 1379 | . ; | ||
| 1380 | . ; Claim m ust be OPE N or ACTIV E | ||
| 1381 | . N STATUS | ||
| 1382 | . S STATUS= $P($G(^PRC A(430,RCBI LL,0)),"^" ,8) | ||
| 1383 | . I STATUS' =42,STATUS '=16 Q | ||
| 1384 | . ; | ||
| 1385 | . ; PRCA*4. 5*304 - A CARC must be include d and have an auto-d ecrease li mit before auto-decr easing can occur. | ||
| 1386 | . S RCAMT=$ $CARCLMT(E OBIEN) | ||
| 1387 | . Q:$L(RCAM T)=0 ; No CA RCs on EOB were elig ible for a uto-decrea se | ||
| 1388 | . ; | ||
| 1389 | . ; Order C ARCs for A uto-Decrea se in larg est to sma llest amou nt order | ||
| 1390 | . K RCIARR | ||
| 1391 | . F J=1:1 S RCITEM=$P (RCAMT,U,J ) Q:RCITEM ="" S RCI ARR(-($P(R CITEM,";", 1)),J)=RCI TEM | ||
| 1392 | . Q:$D(RCIA RR)<10 ; Quit if CA RC adjustm ent array doesn't ha ve any ele ments to p rocess | ||
| 1393 | . ; | ||
| 1394 | . ; Walk th e RCIARR a nd apply C ARC based adjustment s to the b ill. | ||
| 1395 | . S RCJ="", RCADJ=0 | ||
| 1396 | . F S RCJ= $O(RCIARR( RCJ)) Q:RC J="" S RC K="" F S RCK=$O(RCI ARR(RCJ,RC K)) Q:RCK= "" D | ||
| 1397 | . . ; Get c urrent bal ance on Bi ll | ||
| 1398 | . . S RCBAL =$P($G(^PR CA(430,RCB ILL,7)),U) | ||
| 1399 | . . ; | ||
| 1400 | . . ; Check pending p ayment amo unt and bi ll balance | ||
| 1401 | . . N PENDI NG | ||
| 1402 | . . S PENDI NG=$$PENDP AY^RCDPURE T(RCBILL) | ||
| 1403 | . . K ^TMP( $J,"RCDPUR EC","PP") | ||
| 1404 | . . Q:(RCBA L-PENDING) <(+$P(RCIA RR(RCJ,RCK ),";",1)) | ||
| 1405 | . . ; | ||
| 1406 | . . ; Add c omment | ||
| 1407 | . . S COMME NT(1)="MED ICAL AUTO- DECREASE F OR CARC: " _$P(RCIARR (RCJ,RCK), ";",2)_" A MOUNT: "_+ $P(RCIARR( RCJ,RCK)," ;",1)_" (M AX | ||
| 1408 | DEC: "_+$ P($$ACTCAR C($P(RCIAR R(RCJ,RCK) ,";",2)),U ,2)_")" | ||
| 1409 | . . ; If th is CARC is expired t hen add th at informa tion to th e comment | ||
| 1410 | . . I $P(RC IARR(RCJ,R CK),";",3) '="" S COM MENT(1)=CO MMENT(1)_" CARC expi red on "_$ $FMTE^XLFD T($P(RCIAR R(RCJ,RCK) ,";",3),"6 D" | ||
| 1411 | ) | ||
| 1412 | . . ; Apply contract adjustment for CARC adjustment amount fr om claim i nformation | ||
| 1413 | . . S RCTRA NDA=$$INCD EC^RCBEUTR 1(RCBILL,- $P(RCIARR( RCJ,RCK)," ;",1),.COM MENT,"","" ,1) Q:'RCT RANDA | ||
| 1414 | . . ; Updat e total ad justments for line | ||
| 1415 | . . S RCADJ =RCADJ+$P( RCIARR(RCJ ,RCK),";", 1) | ||
| 1416 | . ; Update auto-decre ase indica tor, auto decrease a mount and auto decre ase date | ||
| 1417 | . N DA,DIE, DR S DA(1) =RCERA,DA= RCLINE,DIE ="^RCY(344 .4,"_DA(1) _",1,",DR= "7///1;8// /"_RCADJ_" ;10///"_DT D ^DIE | ||
| 1418 | . ; PRCA*4. 5*304 - En d of updat es | ||
| 1419 | . ; Update last auto decrease d ate on ERA | ||
| 1420 | . N DA,DIE, DR S DA=RC ERA,DIE="^ RCY(344.4, ",DR="4.03 ///"_DT D ^DIE | ||
| 1421 | Q | ||
| 1422 | ; | ||
| 1423 | SPLIT(RCSC R,RCLINE,R CBILL,RCAR RAY) ;Chec k for SPLI T/EDIT in scratchpad | ||
| 1424 | ; Input RCSC R - IEN of #344.49 | ||
| 1425 | ; RCLI NE - ERA d etail line sequence number | ||
| 1426 | ; RCBI LL - IEN o f #430 | ||
| 1427 | ; ARRA Y - refere nce to pas sed array (from BUIL D^RCDPEAP) | ||
| 1428 | ; Output ret urn value 1/0 = Spli t/Not Spli t | ||
| 1429 | N SUB,SUB1 | ||
| 1430 | ; Find ERA l ine in scr atchpad | ||
| 1431 | S SUB=$G(RC ARRAY(RCLI NE)) Q:'SU B 0 | ||
| 1432 | ; Get n.001 line | ||
| 1433 | S SUB1=$O(^ RCY(344.49 ,RCSCR,1,S UB)) Q:'SU B1 0 | ||
| 1434 | ; Check sequ ence numbe r is the s ame | ||
| 1435 | Q :$P($G(^RC Y(344.49,R CSCR,1,SUB 1,0)),".") '=$P($G(^R CY(344.49, RCSCR,1,SU B,0)),U) 0 | ||
| 1436 | ; Check that claim num ber is unc hanged fro m original ERA | ||
| 1437 | Q :$P($G(^RC Y(344.49,R CSCR,1,SUB 1,0)),U,7) =RCBILL 0 | ||
| 1438 | ; Otherwise claim was edited (an d should n ot be decr eased) | ||
| 1439 | Q 1 | ||
| 1440 | ; | ||
| 1441 | CARCLMT(RC EOB,FROMAD P,ADATE) ; EP from CO MPILE^RCDP EADP | ||
| 1442 | ; PRCA*4.5* 304 - Chec k to see i f CARC are included and are el igible | ||
| 1443 | ; for auto- decrease. Return 0 i f not, Max Amount ^ CARC if it is. | ||
| 1444 | ; Input: RCEOB - Internal I EN for the explanati on of bene fits field (361.1) | ||
| 1445 | ; FROMADP - 1 if being called fr om COMPILE ^RCDPEADP, 0 otherwi se | ||
| 1446 | ; Optional, default to 0 | ||
| 1447 | ; ADATE - Internal A uto-Post D ate (only passed if FROMADP=1) | ||
| 1448 | ; Returns: A1;A2;A3;A 4^B1;B2;B3 ;B4^...^N1 ;N2;N3;N4 Where: | ||
| 1449 | ; A1 - Auto -Decrease amount of the 1st CA RC code in the EOB | ||
| 1450 | ; A2 - 1st CARC code in the EOB | ||
| 1451 | ; A3 - Deac tivation D ate of the 1st CARC code in th e EOB if | ||
| 1452 | ; it h as one and is less t han today AND FROMAD P=0 | ||
| 1453 | ; Othe rwise Quan tity of th e first CA RC code in the EOB i f | ||
| 1454 | ; FROM ADP=1 | ||
| 1455 | ; A4 - Reas on of the 1st CARC c ode in the EOB | ||
| 1456 | ; only passed if FROMADP=1 | ||
| 1457 | N I,RCAMT,R CCAMT,RCCO DE,RCCODES ,RCDATA,RC ITEM,RCTAM T,XDT,XIEN | ||
| 1458 | S :'$D(FROMA DP) FROMAD P=0 | ||
| 1459 | S RCAMT="", RCCODES="" | ||
| 1460 | ; | ||
| 1461 | ; Extract t he CARC co des from t he EOB. | ||
| 1462 | ; Returned are ^A1;A2 ;A3;A4^A1; A2;A3;A4^. .. Where | ||
| 1463 | ; A1 - CARC cod e | ||
| 1464 | ; A2 - Auto Dec rease Amou nt | ||
| 1465 | ; A3 - Quantity (on ly returne d if FROMA DP=1) | ||
| 1466 | ; A4 - REASON (on ly returne d if FROMA DP=1) | ||
| 1467 | D GETCARCS( RCEOB,.RCC ODES,FROMA DP) | ||
| 1468 | ; | ||
| 1469 | ; Loop thro ugh all of the CARC codes foun d. If non e, it will exit. | ||
| 1470 | F I=2:1:$L( RCCODES,"^ ") D | ||
| 1471 | . S RCITEM= $P(RCCODES ,"^",I) | ||
| 1472 | . Q:RCITEM= "" | ||
| 1473 | . S RCCODE= $P(RCITEM, ";",1),RCC AMT=$P(RCI TEM,";",2) | ||
| 1474 | . ; | ||
| 1475 | . ; Quit If the Adjus tment amou nt is a ne gative amo unt | ||
| 1476 | . Q:+RCCAMT <0 | ||
| 1477 | . ; | ||
| 1478 | . ; Look up code in C ARC table and get ma x adjustme nt | ||
| 1479 | . S RCDATA= $$ACTCARC( RCCODE) | ||
| 1480 | . ; | ||
| 1481 | . ; Quit If auto decr ease is no t active o n this cod e | ||
| 1482 | . Q:+RCDATA =0 | ||
| 1483 | . ; | ||
| 1484 | . ; Get cod e inactive date if i t exists | ||
| 1485 | . S XIEN=$$ FIND1^DIC( 345,,"O",R CCODE) | ||
| 1486 | . S:$G(XIEN )'="" XDT= $$GET1^DIQ (345,XIEN_ ",",2,"I") | ||
| 1487 | . I $G(XDT) '="" S:XDT '<DT XDT=" " | ||
| 1488 | . S RCTAMT= $P(RCDATA, U,2) ; Get li mit | ||
| 1489 | . ; | ||
| 1490 | . ; 11/11/2 015: Compa re the max adjustmen t in param eters to t he adjustm ent on EEO B | ||
| 1491 | . ; Quit if over | ||
| 1492 | . ; | ||
| 1493 | . ; If the CARC payer adjustmen t <= CARC max adjust ment amoun t, Then ad d to list | ||
| 1494 | . ; for pos sible adju stments. | ||
| 1495 | . I RCCAMT< (RCTAMT+.0 1) D | ||
| 1496 | . . ; | ||
| 1497 | . . ; If we 're being called fro m the auto -decrease report, re turn all C ARC inform ation | ||
| 1498 | . . I FROMA DP D Q | ||
| 1499 | . . . S XX= RCCAMT_";" _RCCODE_"; "_$P(RCITE M,";",3,4) | ||
| 1500 | . . . S RCA MT=$S(RCAM T'[";":XX, 1:RCAMT_"^ "_XX) | ||
| 1501 | . . S RCAMT =$S($L(RCA MT)=0:RCCA MT_";"_RCC ODE_";"_XD T,1:RCAMT_ U_RCCAMT_" ;"_RCCODE_ ";"_XDT) | ||
| 1502 | Q RCAMT | ||
| 1503 | ; | ||
| 1504 | GETCARCS(R CEOB,RCCOD ES,FROMADP ) ; Extrac t the CARC s from an EOB at cla im and lin e levels | ||
| 1505 | ; Input: RCEOB - Internal I EN for the explanati on of bene fits field (361.1) | ||
| 1506 | ; FROMADP - 1 if being called fr om COMPILE ^RCDPEADP, 0 otherwi se | ||
| 1507 | ; Optional, default to 0 | ||
| 1508 | ; Output: RCCODES - ^ delimitt ed string of CARC co de informa tion from the | ||
| 1509 | ; claim an d claim in e levels f or the spe cified EOB | ||
| 1510 | ; ^A1;A2;A 3;A4^A1;A2 ;A3;A4^... Where | ||
| 1511 | ; A1 - C ARC code | ||
| 1512 | ; A2 - A uto Decrea se Amount | ||
| 1513 | ; A3 - Q uantity (only returned i f FROMADP= 1) | ||
| 1514 | ; A4 - R EASON (only returned i f FROMADP= 1) | ||
| 1515 | N IENS,RCAM T,QUANT,RE ASON,RCCOD E,RCI,RCJ, RCL | ||
| 1516 | S :'$D(FROMA DP) FROMAD P=0 | ||
| 1517 | S RCI=0,RCC ODES="" | ||
| 1518 | ; | ||
| 1519 | ; Get to th e Codes at the claim level | ||
| 1520 | F D Q:'RC I | ||
| 1521 | . S RCI=$O( ^IBM(361.1 ,RCEOB,10, RCI)) | ||
| 1522 | . Q:'RCI | ||
| 1523 | . S RCJ=0 | ||
| 1524 | . F D Q:' RCJ | ||
| 1525 | . . S RCJ=$ O(^IBM(361 .1,RCEOB,1 0,RCI,1,RC J)) | ||
| 1526 | . . Q:'RCJ | ||
| 1527 | . . S IENS= RCJ_","_RC I_","_RCEO B_"," | ||
| 1528 | . . S RCCOD E=$$GET1^D IQ(361.111 ,IENS,.01, "I") ; CAR C Code | ||
| 1529 | . . Q:RCCOD E="" | ||
| 1530 | . . S RCAMT =$$GET1^DI Q(361.111, IENS,.02," I") ; CAR C Amount | ||
| 1531 | . . I 'FROM ADP S RCCO DES=RCCODE S_"^"_RCCO DE_";"_RCA MT Q | ||
| 1532 | . . S QUANT =$$GET1^DI Q(361.111, IENS,.03," I") ; CAR C Quantity | ||
| 1533 | . . S REASO N=$$GET1^D IQ(361.111 ,IENS,.04, "I") ; CAR C Reason | ||
| 1534 | . . S:$L(RE ASON)>27 R EASON=$E(R EASON,1,27 )_"..." | ||
| 1535 | . . S RCCOD ES=RCCODES _"^"_RCCOD E_";"_RCAM T_";"_QUAN T_";"_REAS ON | ||
| 1536 | ; | ||
| 1537 | ; Get Claim Line leve l CARCs | ||
| 1538 | S RCL=0 | ||
| 1539 | F D Q:+RC L=0 | ||
| 1540 | . S RCL=$O( ^IBM(361.1 ,RCEOB,15, RCL)) | ||
| 1541 | . Q:+RCL=0 | ||
| 1542 | . S RCI=0 | ||
| 1543 | . F D Q:+ RCI=0 | ||
| 1544 | . . S RCI=$ O(^IBM(361 .1,RCEOB,1 5,RCL,1,RC I)) | ||
| 1545 | . . Q:+RCI= 0 | ||
| 1546 | . . S RCJ=0 | ||
| 1547 | . . F D Q :+RCJ=0 | ||
| 1548 | . . . S RCJ =$O(^IBM(3 61.1,RCEOB ,15,RCL,1, RCI,1,RCJ) ) | ||
| 1549 | . . . Q:+RC J=0 | ||
| 1550 | . . . S IEN S=RCJ_","_ RCI_","_RC L_","_RCEO B_"," | ||
| 1551 | . . . S RCC ODE=$$GET1 ^DIQ(361.1 15,IENS,.0 1,"I") ; C ARC Code | ||
| 1552 | . . . Q:RCC ODE="" | ||
| 1553 | . . . S RCA MT=$$GET1^ DIQ(361.11 5,IENS,.02 ,"I") ; C ARC Amount | ||
| 1554 | . . . I 'FR OMADP S RC CODES="^"_ RCCODE_";" _RCAMT Q | ||
| 1555 | . . . S QUA NT=$$GET1^ DIQ(361.11 5,IENS,.03 ,"I") ; C ARC Quanti ty | ||
| 1556 | . . . S REA SON=$$GET1 ^DIQ(361.1 15,IENS,.0 4,"I") ; C ARC Reason | ||
| 1557 | . . . S:$L( REASON)>27 REASON=$E (REASON,1, 27)_"..." | ||
| 1558 | . . . S RCC ODES=RCCOD ES_"^"_RCC ODE_";"_RC AMT_";"_QU ANT_";"_RE ASON | ||
| 1559 | Q | ||
| 1560 | ; | ||
| 1561 | ; PRCA*4.5* 304 - Adde d function | ||
| 1562 | ACTCARC(CO DE) ; Is t his CARC a n active c ode for au to-decreas e | ||
| 1563 | ; Input: CODE - CARC code being chec ked | ||
| 1564 | ; Returns: '0^NOT ACT IVE' if no t active | ||
| 1565 | ; '1^{amount }' if acti ve and the second pe ice is the decrease amount | ||
| 1566 | N AIEN,XX | ||
| 1567 | I $G(CODE)= "" Q "0^NO T ACTIVE" | ||
| 1568 | S AIEN=$O(^ RCY(344.62 ,"B",CODE, "")) | ||
| 1569 | I AIEN="" Q "0^NOT AC TIVE" | ||
| 1570 | S XX=$$GET1 ^DIQ(344.6 2,AIEN,.02 ,"I") ; Quit i f auto-dec rease is o ff | ||
| 1571 | I XX=1 Q "1 ^"_$$GET1^ DIQ(344.62 ,AIEN,.06) ; Active code retu rns maximu m allowed decrease a mount | ||
| 1572 | Q "0^NOT AC TIVE" | ||
| 1573 | ; | ||
| 1574 | |||
| 1575 | |||
| 1576 | |||
| 1577 | |||
| 1578 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.