Produced by Araxis Merge on 10/23/2018 6:40:25 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 US3606 SDD - Copy.doc | Mon Oct 22 16:27:48 2018 UTC |
| 2 | docs | TAS ePay US3606 SDD - Copy.doc | Mon Oct 22 16:32:01 2018 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 1 | 2378 |
| 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 US3606 | |
| 2 | System Des ign Docume nt | |
| 3 | PRCA*4.5*3 26 | |
| 4 | ||
| 5 | Department of Vetera ns Affairs | |
| 6 | January 20 18 | |
| 7 | Version 1 | |
| 8 | User Story ID: US360 6 | |
| 9 | User Story Name: Re move auto- decrease l imit with new maximu m paramete r | |
| 10 | Sizing: 3 | |
| 11 | Epic Taxon omy eBiz C ompliance Port Updat e Incre ase No Tou ch TAS Ap psStory | |
| 12 | As a...I w ant to...S o that...A ccounts re ceivable o rganizatio nRemove th e auto-dec rease limi t and add a maximum limit para meter per claim for a facility We can max imize our ability to utilize a uto-decrea se and inc rease no t ouchConver sation (if desired b y develope rs) | |
| 13 | We want to remove th e limit fo r auto-dec rease and provide th em a param eter to se t a top li mit per cl aim for th eir facili ty. | |
| 14 | As an acco unts recei vable orga nization, we need to maximize the abilit y to utili ze auto-de crease. W e need the auto-decr ease limit removed b ut will al so need a parameter to set a m aximum per facility, for auto- decrease. | |
| 15 | Retain CAR C limit fu nction | |
| 16 | New limit parameter to restric t a facili ty (e.g. T ampa) for auto-decre ase ceilin g for curr ent CARC l imits func tionality. | |
| 17 | If over se t limit, a uto –adjus t to new p arameter l imit with warning me ssage/aler t | |
| 18 | The maximu m limit wi ll be set to 99999 f or this ne w paramete r field. | |
| 19 | Upon insta ll of the PRCA*4.5*3 26 patch t he default value wil l be se to 5000 | |
| 20 | US812 intr oduces aut o decrease for non-p aid claims (payer re turns zero payment l ine on ERA ) which ha ve a separ ate list o f CARC’s t o auto dec rease. Au to-decreas e for thes e non-paid claims us es the sam e MAXIMUM DOLLAR AMO UNT introd uced in US 3606 as th e maximum auto-decre ase limit. Therefor e, a separ ate list o f ‘NO-PAY CARC CODES ’ is added to auto-d ecrease wa rning. | |
| 21 | Summary: | |
| 22 | A paramete r field wi ll now be used to li mit the ma ximum auto -decrease amount on any claim. This is a n existing field whi ch was dep recated wh en patch P RCA*4.5*30 4 implemen ted auto-d ecrease by CARC. | |
| 23 | The upper limit of t his field will be in creased fr om 1500 to 99999. | |
| 24 | 344.61,.0 5 MED A MT DEFAULT AUTO-DECR EASE 0;5 N UMBER | |
| 25 | MAXIMU M DOLLAR A MOUNT TO A UTO-DECREA SE PER CLA IM: | |
| 26 | INPUT TRANSFORM: K:+X'=X! (X>99999)! (X<1)!(X?. E1"."1N.N) X | |
| 27 | LAST E DITED: MAY 16, 2014 | |
| 28 | HELP-P ROMPT: Type a n umber betw een 1 and 99999, 0 d ecimal | |
| 29 | digits. | |
| 30 | DESCRI PTION: This par ameter all ows sites to specify the | |
| 31 | claim do llar amoun t maximum of an auto matic | |
| 32 | decrease adjustmen t that is made for a third | |
| 33 | party me dical clai ms, if aut o-posting and | |
| 34 | auto-dec rease of t hird party medical c laims is | |
| 35 | turned o n for the site. This parameter will | |
| 36 | default to null an d require a response from 1 | |
| 37 | to 99999 dollars f or the par ameter que stion to | |
| 38 | allow si tes to spe cify the c laim dolla r amount | |
| 39 | maximum of an auto matic decr ease adjus tment | |
| 40 | that is made for t hird party medical c laims. | |
| 41 | Existing s cheduled o ption [PRC A NIGHTLY PROCESS] w ill be mod ified to p revent tot al autodec reased amo unt on an individual claim exc eeding the MED AMT D EFAULT AUT O-DECREASE parameter value . | |
| 42 | Existing a uto-decrea se routine RCDPEAD w ill be mod ified. | |
| 43 | Existing o ption ‘EDI Lockbox P arameters’ [RCDPE ED I LOCKBOX PARAMETERS ] will be modified t o include display an d edit of the new ME D AMT DEFA ULT AUTO-D ECREASE pa rameter va lue . The CARC Maxim um Amount edit will be modifie d to use t he new par ameter as the maximu m allowed value. If the new pa rameter is modified to a value less than any of th e existing CARC maxi mum amount s then a w arning mes sage will display an d CARC max imum amoun ts reduced to the ne w limit (i f necessar y). | |
| 44 | Existing p arameter e dit routin es RCDPESP and GETAM T^RCDPESP5 will be m odified. | |
| 45 | Existing o ption ‘EDI Lockbox P arameters Report’ [R CDPE SITE PARAMETER REPORT] wi ll be modi fied to in clude the new MED AM T DEFAULT AUTO-DECRE ASE parame ter value . | |
| 46 | Existing r eport rout ine RCDPES P1 will be modified. | |
| 47 | Existing o ption ‘EDI Lockbox P arameters Audit Repo rt’ [RCDP E PARAMETE R AUDIT RE PORT] will report ch anges in t he new MED AMT DEFAU LT AUTO-DE CREASE par ameter val ue. | |
| 48 | No changes to existi ng report routine RC DPESP2 are required. | |
| 49 | The post i nstall rou tine RCP32 6 for patc h PRCA*4.5 *326 will set the ma ximum valu e for the new MED AM T DEFAULT AUTO-DECRE ASE field #344.61, # .05 to $50 00 . | |
| 50 | Resolution – Added C hanged Obj ects | |
| 51 | RoutinesAc tivitiesRo utine Name RCDPEADEnh 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 CDPEM $$ FIND1^DIC | |
| 52 | ^DIE | |
| 53 | $$GET1^ DIQ | |
| 54 | $$INCDE C^RCBEUTR1 | |
| 55 | BUILD^R CDPEAP | |
| 56 | $$PHARM ^RCDPEAP1 | |
| 57 | $$PENDP AY^RCDPURE T | |
| 58 | $$FMADD ^XLFDT | |
| 59 | $$FMTE^ XLFDT Current LogicRCDP EAD ;ALB/P JH - AUTO DECREASE ; Jun 06, 20 14@19:11:1 9 | |
| 60 | ;;4.5;Acc ounts Rece ivable;**2 98,304,318 **;Mar 20, 1995;Buil d 104 | |
| 61 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | |
| 62 | ;Read ^IB M(361.1) v ia Private IA 4051 | |
| 63 | ; | |
| 64 | . | |
| 65 | . | |
| 66 | ; | |
| 67 | EN3(RCDATE ,RCERA) ; Scan ERA D ETAIL entr ies in #34 4.41 for a uto-posted medical c laims | |
| 68 | ; Input: RCDATE - C urrent dat e being se arch | |
| 69 | ; RCERA - ERA numbe r | |
| 70 | N RCADJ,R CDREC,RCLI NE | |
| 71 | S RCLINE= 0 | |
| 72 | F S RCLI NE=$O(^RCY (344.4,"F" ,RCDATE,RC ERA,RCLINE )) Q:'RCLI NE D | |
| 73 | . ; | |
| 74 | . ; Ignor e claim li ne if alre ady auto d ecreased | |
| 75 | . Q:$P($G (^RCY(344. 4,RCERA,1, RCLINE,5)) ,U,3) | |
| 76 | . ; | |
| 77 | . ; Get r ecord deta il | |
| 78 | . S RCDRE C=$G(^RCY( 344.4,RCER A,1,RCLINE ,0)) | |
| 79 | . ; | |
| 80 | . ; Get c laim numbe r RCBILL f or the ERA line usin g EOB #361 .1 pointer | |
| 81 | . N COMME NT,EOBIEN, RCBAL,RCBI LL,RCTRAND A | |
| 82 | . ; | |
| 83 | . ; Get p ointer to EOB file # 361.1 from ERA DETAI L | |
| 84 | . S EOBIE N=$P($G(^R CY(344.4,R CERA,1,RCL INE,0)),U, 2),RCBILL= 0 | |
| 85 | . ; | |
| 86 | . ; Get ^ DGCR(399 p ointer (DI NUM for #4 30 file) | |
| 87 | . S:EOBIE N RCBILL=$ P($G(^IBM( 361.1,EOBI EN,0)),U) Q:'RCBILL | |
| 88 | . ; | |
| 89 | . ; If cl aim has be en split/e dit and cl aim change d in APAR do not aut o decrease | |
| 90 | . Q:$$SPL IT(RCERA,R CLINE,RCBI LL,.RCARRA Y) | |
| 91 | . ; | |
| 92 | . ; Do no t auto dec rease if c laim is re ferred to General Co uncil | |
| 93 | . Q:$P($G (^PRCA(430 ,RCBILL,6) ),U,4)]"" | |
| 94 | . ; | |
| 95 | . ; Claim must be O PEN or ACT IVE | |
| 96 | . N STATU S | |
| 97 | . S STATU S=$P($G(^P RCA(430,RC BILL,0))," ^",8) | |
| 98 | . I STATU S'=42,STAT US'=16 Q | |
| 99 | . ; | |
| 100 | . ; 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. | |
| 101 | . S RCAMT =$$CARCLMT (EOBIEN) | |
| 102 | . Q:$L(RC AMT)=0 ; N o CARCs on EOB were eligible f or auto-de crease | |
| 103 | . ; | |
| 104 | . ; Order CARCs for Auto-Decr ease in la rgest to s mallest am ount order | |
| 105 | . K RCIAR R | |
| 106 | . F J=1:1 S RCITEM= $P(RCAMT,U ,J) Q:RCIT EM="" S R CIARR(-($P (RCITEM,"; ",1)),J)=R CITEM | |
| 107 | . Q:$D(RC IARR)<10 ; Quit if C ARC adjust ment array doesn't h ave any el ements to process | |
| 108 | . ; | |
| 109 | . ; Walk the RCIARR and apply CARC base d adjustme nts to the bill. | |
| 110 | . S RCJ=" ",RCADJ=0 | |
| 111 | . F S RC J=$O(RCIAR R(RCJ)) Q: RCJ="" S RCK="" F S RCK=$O(R CIARR(RCJ, RCK)) Q:RC K="" D | |
| 112 | . . ; Get current b alance on Bill | |
| 113 | . . S RCB AL=$P($G(^ PRCA(430,R CBILL,7)), U) | |
| 114 | . . ; | |
| 115 | . . ; Che ck pending payment a mount and bill balan ce | |
| 116 | . . N PEN DING | |
| 117 | . . S PEN DING=$$PEN DPAY^RCDPU RET(RCBILL ) | |
| 118 | . . K ^TM P($J,"RCDP UREC","PP" ) | |
| 119 | . . Q:(RC BAL-PENDIN G)<(+$P(RC IARR(RCJ,R CK),";",1) ) | |
| 120 | . . ; | |
| 121 | . . ; Add comment | |
| 122 | . . S COM MENT(1)="M EDICAL AUT O-DECREASE FOR CARC: "_$P(RCIA RR(RCJ,RCK ),";",2)_" AMOUNT: " _+$P(RCIAR R(RCJ,RCK) ,";",1)_" (MAX DEC: "_+$P($$AC TCARC($P(R CIARR(RCJ, RCK),";",2 )),U,2)_") " | |
| 123 | . . ; If this CARC is expired then add that infor mation to the commen t | |
| 124 | . . I $P( RCIARR(RCJ ,RCK),";", 3)'="" S C OMMENT(1)= COMMENT(1) _" CARC ex pired on " _$$FMTE^XL FDT($P(RCI ARR(RCJ,RC K),";",3), "6D") | |
| 125 | . . ; App ly contrac t adjustme nt for CAR C adjustme nt amount from claim informati on | |
| 126 | . . S RCT RANDA=$$IN CDEC^RCBEU TR1(RCBILL ,-$P(RCIAR R(RCJ,RCK) ,";",1),.C OMMENT,"", "",1) Q:'R CTRANDA | |
| 127 | . . ; Upd ate total adjustment s for line | |
| 128 | . . S RCA DJ=RCADJ+$ P(RCIARR(R CJ,RCK),"; ",1) | |
| 129 | . ; Updat e auto-dec rease indi cator, aut o decrease amount an d auto dec rease date | |
| 130 | . N DA,DI E,DR S DA( 1)=RCERA,D A=RCLINE,D IE="^RCY(3 44.4,"_DA( 1)_",1,",D R="7///1;8 ///"_RCADJ _";10///"_ DT D ^DIE | |
| 131 | . ; PRCA* 4.5*304 - End of upd ates | |
| 132 | . ; Updat e last aut o decrease date on E RA | |
| 133 | . N DA,DI E,DR S DA= RCERA,DIE= "^RCY(344. 4,",DR="4. 03///"_DT D ^DIE | |
| 134 | Q | |
| 135 | ;Modified Logic (Ch anges are in bold)RC DPEAD ;ALB /PJH - AUT O DECREASE ;Jun 06, 2014@19:11 :19 | |
| 136 | ;;4.5;Acc ounts Rece ivable;**2 98,304,318 ,XXX**;Mar 20, 1995; Build 104 | |
| 137 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | |
| 138 | ;Read ^IB M(361.1) v ia Private IA 4051 | |
| 139 | ; | |
| 140 | . | |
| 141 | . | |
| 142 | ; | |
| 143 | EN3(RCDATE ,RCERA) ; Scan ERA D ETAIL entr ies in #34 4.41 for a uto-posted medical c laims | |
| 144 | ; Input: RCDATE - C urrent dat e being se arch | |
| 145 | ; RCERA - ERA numbe r | |
| 146 | N RCADJ,R CDREC,RCLI NE,RCMAX | |
| 147 | S RCMAX=+ $$GET1^DIQ (344.61,”1 ,”,.05) ; Get top li mit for au to-decreas e | |
| 148 | S RCLINE= 0 | |
| 149 | F S RCLI NE=$O(^RCY (344.4,"F" ,RCDATE,RC ERA,RCLINE )) Q:'RCLI NE D | |
| 150 | . ; | |
| 151 | . ; Ignor e claim li ne if alre ady auto d ecreased | |
| 152 | . Q:$P($G (^RCY(344. 4,RCERA,1, RCLINE,5)) ,U,3) | |
| 153 | . ; | |
| 154 | . ; Get r ecord deta il | |
| 155 | . S RCDRE C=$G(^RCY( 344.4,RCER A,1,RCLINE ,0)) | |
| 156 | . ; | |
| 157 | . ; Get c laim numbe r RCBILL f or the ERA line usin g EOB #361 .1 pointer | |
| 158 | . N COMME NT,EOBIEN, RCBAL,RCBI LL,RCTRAND A | |
| 159 | . ; | |
| 160 | . ; Get p ointer to EOB file # 361.1 from ERA DETAI L | |
| 161 | . S EOBIE N=$P($G(^R CY(344.4,R CERA,1,RCL INE,0)),U, 2),RCBILL= 0 | |
| 162 | . ; | |
| 163 | . ; Get ^ DGCR(399 p ointer (DI NUM for #4 30 file) | |
| 164 | . S:EOBIE N RCBILL=$ P($G(^IBM( 361.1,EOBI EN,0)),U) Q:'RCBILL | |
| 165 | . ; | |
| 166 | . ; If cl aim has be en split/e dit and cl aim change d in APAR do not aut o decrease | |
| 167 | . Q:$$SPL IT(RCERA,R CLINE,RCBI LL,.RCARRA Y) | |
| 168 | . ; | |
| 169 | . ; Do no t auto dec rease if c laim is re ferred to General Co uncil | |
| 170 | . Q:$P($G (^PRCA(430 ,RCBILL,6) ),U,4)]"" | |
| 171 | . ; | |
| 172 | . ; Claim must be O PEN or ACT IVE | |
| 173 | . N STATU S | |
| 174 | . S STATU S=$P($G(^P RCA(430,RC BILL,0))," ^",8) | |
| 175 | . I STATU S'=42,STAT US'=16 Q | |
| 176 | . ; | |
| 177 | . ; 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. | |
| 178 | . S RCAMT =$$CARCLMT (EOBIEN) | |
| 179 | . Q:$L(RC AMT)=0 ; N o CARCs on EOB were eligible f or auto-de crease | |
| 180 | . ; | |
| 181 | . ; Order CARCs for Auto-Decr ease in la rgest to s mallest am ount order | |
| 182 | . K RCIAR R | |
| 183 | . F J=1:1 S RCITEM= $P(RCAMT,U ,J) Q:RCIT EM="" S R CIARR(-($P (RCITEM,"; ",1)),J)=R CITEM | |
| 184 | . Q:$D(RC IARR)<10 ; Quit if C ARC adjust ment array doesn't h ave any el ements to process | |
| 185 | . ; | |
| 186 | . ; Walk the RCIARR and apply CARC base d adjustme nts to the bill. | |
| 187 | . S RCJ=" ",RCADJ=0 | |
| 188 | . F S RC J=$O(RCIAR R(RCJ)) Q: RCJ="" S RCK="" F S RCK=$O(R CIARR(RCJ, RCK)) Q:RC K="" D | |
| 189 | . . ; Get current b alance on Bill | |
| 190 | . . S RCB AL=$P($G(^ PRCA(430,R CBILL,7)), U) | |
| 191 | . . ; | |
| 192 | . . ; Che ck pending payment a mount and bill balan ce | |
| 193 | . . N PEN DING | |
| 194 | . . S PEN DING=$$PEN DPAY^RCDPU RET(RCBILL ) | |
| 195 | . . K ^TM P($J,"RCDP UREC","PP" ) | |
| 196 | . . Q:(RC BAL-PENDIN G)<(+$P(RC IARR(RCJ,R CK),";",1) ) | |
| 197 | . . Q:(RC ADJ+$P(RCI ARR(RCJ,RC K),";",1)> RCMAX ; D on’t apply decrease if over to p limit | |
| 198 | . . ; | |
| 199 | . . ; Add comment | |
| 200 | . . S COM MENT(1)="M EDICAL AUT O-DECREASE FOR CARC: "_$P(RCIA RR(RCJ,RCK ),";",2)_" AMOUNT: " _+$P(RCIAR R(RCJ,RCK) ,";",1)_" (MAX DEC: "_+$P($$AC TCARC($P(R CIARR(RCJ, RCK),";",2 )),U,2)_") " | |
| 201 | . . ; If this CARC is expired then add that infor mation to the commen t | |
| 202 | . . I $P( RCIARR(RCJ ,RCK),";", 3)'="" S C OMMENT(1)= COMMENT(1) _" CARC ex pired on " _$$FMTE^XL FDT($P(RCI ARR(RCJ,RC K),";",3), "6D") | |
| 203 | . . ; App ly contrac t adjustme nt for CAR C adjustme nt amount from claim informati on | |
| 204 | . . S RCT RANDA=$$IN CDEC^RCBEU TR1(RCBILL ,-$P(RCIAR R(RCJ,RCK) ,";",1),.C OMMENT,"", "",1) Q:'R CTRANDA | |
| 205 | . . ; Upd ate total adjustment s for line | |
| 206 | . . S RCA DJ=RCADJ+$ P(RCIARR(R CJ,RCK),"; ",1) | |
| 207 | . ; Updat e auto-dec rease indi cator, aut o decrease amount an d auto dec rease date | |
| 208 | . N DA,DI E,DR S DA( 1)=RCERA,D A=RCLINE,D IE="^RCY(3 44.4,"_DA( 1)_",1,",D R="7///1;8 ///"_RCADJ _";10///"_ DT D ^DIE | |
| 209 | . ; PRCA* 4.5*304 - End of upd ates | |
| 210 | . ; Updat e last aut o decrease date on E RA | |
| 211 | . N DA,DI E,DR S DA= RCERA,DIE= "^RCY(344. 4,",DR="4. 03///"_DT D ^DIE | |
| 212 | Q | |
| 213 | ;Routines Activities Routine Na meRCDPESP | |
| 214 | Enhancemen t Category New Modif y Delete N o ChangeRT MRelated O ptionsRCDP E EDI LOCK BOX PARAME TERS]Relat ed Routine sRoutines “Called By ”Routines “Called” RCDPEM | |
| 215 | RCDPESP5 ^DIC | |
| 216 | $$GET1^ DID | |
| 217 | FILE^DI E | |
| 218 | UPDATE^ DIE | |
| 219 | $$GET1^ DIQ | |
| 220 | ^DIR | |
| 221 | $$AUDIT ^RCDPESP5 | |
| 222 | CARC^RC DPESP5 | |
| 223 | EN^RCDP ESP6 | |
| 224 | EXIT^RC DPESP6 | |
| 225 | $$EDILO CK^RCMSITE | |
| 226 | $$SITE^ VASITE | |
| 227 | $$FMADD ^XLFDT | |
| 228 | $$FMTE^ XLFDT | |
| 229 | $$NOW^X LFDT | |
| 230 | SENDMSG ^XMXAPI | |
| 231 | MES^XPD UTL Current LogicRCDP ESP ;BIRM/ EWL - ePay ment Lockb ox Site Pa rameters D efinition - Files 34 4.61 & 344 .6 ;Nov 19 , 2014@15: 26:16 | |
| 232 | ;;4.5;Acc ounts Rece ivable;**2 98,304,318 ,321,326** ;Mar 20, 1 995;Build 104 | |
| 233 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 234 | ; | |
| 235 | EN ; entry point for EDI Lockb ox Paramet ers [RCDPE EDI LOCKB OX PARAMET ERS] | |
| 236 | N DA,DIC, DIE,DIR,DI RUT,DLAYGO ,DR,DTOUT, DUOUT,X,Y ; FileMan variables | |
| 237 | ; | |
| 238 | W !," Upd ate AR Sit e Paramete rs",! | |
| 239 | ; | |
| 240 | S X="RCDP E AUTO DEC " I '$D(^X USEC(X,DUZ )) W !!,"Y ou do not hold the " _X_" secur ity key." Q | |
| 241 | ; Lock th e paramete r file | |
| 242 | L +^RCY(3 44.61,1):D ILOCKTM E D Q | |
| 243 | .W !!," A nother use r is curre ntly using the AR Si te Paramet ers option ." | |
| 244 | .W !," Pl ease try a gain later ." | |
| 245 | ; | |
| 246 | ; PRCA*4. 5*326 - On ce lock is successfu l, take a snapshot o f the para meters for monitorin g | |
| 247 | D EN^RCDP ESP6 | |
| 248 | ; | |
| 249 | ; Check p arameter f ile | |
| 250 | N FDAEDI, FDAPAYER,I EN,IENS,RC QUIT | |
| 251 | ; FDAPAYE R - FDA ar ray for RC DPE AUTO-P AY EXCLUSI ON file (# 344.6) | |
| 252 | ; FDAEDI - FDA arra y for RCDP E PARAMETE R file (#3 44.61) | |
| 253 | ; RCAUDVA L - audit data for R CDPE PARAM ETER AUDIT file (#34 4.7) | |
| 254 | ; IEN - e ntry # | |
| 255 | ; IENS - IEN_comma | |
| 256 | ; RCQUIT - exit fla g | |
| 257 | ; | |
| 258 | ; functio n returns 1 on succe ss | |
| 259 | S Y=$$EDI LOCK^RCMSI TE ; Updat e EDI Lock box site p arameters | |
| 260 | I 'Y G AB ORT ; use r entered '^' | |
| 261 | ; | |
| 262 | ;-------- ---------- ---------- ---------- -------- | |
| 263 | ; prca*4. 5*304 | |
| 264 | ; Enable/ disable au to-auditin g of paper bills | |
| 265 | ;-------- ---------- ---------- ---------- -------- | |
| 266 | ; | |
| 267 | S RCQUIT= 0 W ! | |
| 268 | S RCQUIT= $$AUDIT^RC DPESP5 | |
| 269 | I RCQUIT G ABORT ; PRCA*4.5*3 26 must ha ve single exit point | |
| 270 | ; | |
| 271 | W ! | |
| 272 | I '$D(^RC Y(344.61,1 ,0)) W !," There is a problem w ith the RC DPE PARAME TER file ( #344.61)." G EXIT | |
| 273 | ; | |
| 274 | ;-------- ---------- ---------- ---------- -------- | |
| 275 | ; prca*4. 5*321 | |
| 276 | ; WORKLOA D NOTIFICA TION BULLE TIN DAYS | |
| 277 | ;-------- ---------- ---------- ---------- -------- | |
| 278 | N BULL S BULL=$$GET 1^DIQ(344. 61,"1,",.1 ,"I") | |
| 279 | K DIR S:B ULL]"" DIR ("B")=$$GE T1^DIQ(344 .61,"1,",. 1,"E") | |
| 280 | S DIR("?" )=$$GET1^D ID(344.61, .1,,"HELP- PROMPT") | |
| 281 | S DIR("A" )=$$GET1^D ID(344.61, .1,,"TITLE ") | |
| 282 | S DIR(0)= "344.61,.1 " | |
| 283 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 284 | I BULL'=Y D ; upda te and aud it | |
| 285 | .S RCAUDV AL(1)="344 .61^.1^1^" _Y_U_BULL | |
| 286 | .S FDAEDI (344.61,"1 ,",.1)=Y D FILE^DIE( ,"FDAEDI") | |
| 287 | .D AUDIT( .RCAUDVAL) K RCAUDVA L | |
| 288 | W ! | |
| 289 | ; | |
| 290 | ;-------- ---------- ---------- ---------- -------- | |
| 291 | ; Enable/ disable au to-posting of medica l claims | |
| 292 | ;-------- ---------- ---------- ---------- -------- | |
| 293 | N APMC,AP MCT | |
| 294 | ;PRCA*4.5 *304 Move from Medic al Auto de crease sec tion below | |
| 295 | N ADMC ; ^DD(344.6 1,.03,0)=" AUTO-DECRE ASE MED EN ABLED^S^0: No;1:Yes;^ 0;3^Q" | |
| 296 | S ADMC="" ; Init i n case Med ical Auto Posting is turned of f. | |
| 297 | ;end PRCA *4.5*304 | |
| 298 | ; APMC=AU TO POSTING OF MEDICA L CLAIMS E NABLED | |
| 299 | ; APMCT=T EMP APMC | |
| 300 | S APMCT=$ $GET1^DIQ( 344.61,"1, ",.02,"I") ,APMC=$S(A PMCT=1:"Ye s",APMCT=0 :"No",1:"" ) | |
| 301 | K DIR S D IR(0)="YA" ,DIR("B")= $S(APMC="" :"Y",1:APM C) | |
| 302 | S DIR("A" )=$$GET1^D ID(344.61, .02,,"TITL E") | |
| 303 | S DIR("?" )=$$GET1^D ID(344.61, .02,,"HELP -PROMPT") | |
| 304 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 305 | I APMCT'= Y D ; use r updated value | |
| 306 | .S FDAEDI (344.61,"1 ,",.02)=Y D FILE^DIE (,"FDAEDI" ) K FDAEDI | |
| 307 | .D NOTIFY ($S(Y=1:"Y es",Y=0:"N o",1:"*mis sing*")) | |
| 308 | .S RCAUDV AL(1)="344 .61^.02^1^ "_Y_U_('Y) D AUDIT(. RCAUDVAL) K RCAUDVAL | |
| 309 | ; | |
| 310 | I Y=0 G R XPARMS | |
| 311 | ; | |
| 312 | ; Set/Res et payer e xclusions for medica l claim po sting | |
| 313 | D EXCLLIS T(1) ; Dis play the e xclusion l ist | |
| 314 | D SETEXCL (1) I $G(R CQUIT) G A BORT ; SET /RESET exc lusions | |
| 315 | D EXCLLIS T(1) ; Dis play the e xclusion l ist | |
| 316 | W ! | |
| 317 | ; | |
| 318 | ; Enable/ disable au to-decreas e of medic al claims | |
| 319 | K FDAEDI ; used fo r FILE^DIE call | |
| 320 | S ADMC=$$ GET1^DIQ(3 44.61,"1," ,.03,"I") ; get curr ent value | |
| 321 | K DIR S D IR(0)="YA" ,DIR("B")= $S(ADMC="" !(ADMC=1): "Yes",1:"N o") | |
| 322 | S DIR("A" )=$$GET1^D ID(344.61, .03,,"TITL E") | |
| 323 | S DIR("?" )=$$GET1^D ID(344.61, .03,,"HELP -PROMPT") | |
| 324 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 325 | ; if user changed v alue, upda te and aud it | |
| 326 | S:ADMC'=Y FDAEDI(34 4.61,"1,", .03)=Y,RCA UDVAL(1)=" 344.61^.03 ^1^"_Y_U_A DMC | |
| 327 | I Y=0 D G RXPARMS ; value s et to No, update (if needed), go to Phar macy param s. | |
| 328 | . D:$D(FD AEDI) FILE ^DIE(,"FDA EDI"),AUDI T(.RCAUDVA L) K RCAUD VAL | |
| 329 | ; | |
| 330 | ; If auto -decrease (medical f or now) on , ask abou t CARC/RAR C auto-dec rease setu p | |
| 331 | W ! | |
| 332 | S RCQUIT= 0 | |
| 333 | D CARC^RC DPESP5(.RC QUIT) ; pa ss RCQUIT by referen ce - PRCA* 4.5*321 | |
| 334 | W ! | |
| 335 | ; If no a ctive CARC s Turn med ical auto- decrease o ff, Then g o to Phara cy params | |
| 336 | I ($$COUN T(1)=0)&($ $GET1^DIQ( 344.61,"1, ",.03,"I") =1) D I ' RCQUIT G R XPARMS ; P RCA*4.5*32 6 don't sk ip ahead i f RCQUIT=1 | |
| 337 | . K FDAED I,RCAUDVAL | |
| 338 | . S ADMC= $$GET1^DIQ (344.61,"1 ,",.03,"I" ) | |
| 339 | . S FDAED I(344.61," 1,",.03)=0 ,RCAUDVAL( 1)="344.61 ^.03^1^"_0 _U_ADMC_U_ "SYSTEM di sabled Med ical Auto- decrease, there are NO active CARCs" | |
| 340 | . D FILE^ DIE(,"FDAE DI"),AUDIT (.RCAUDVAL ) K RCAUDV AL | |
| 341 | . W !,"** * System h as DISABLE D Medical Auto-decre ase, there are NO ac tive CARCs .",! | |
| 342 | . D PAUSE | |
| 343 | I RCQUIT G ABORT ; PRCA*4.5*3 26 must ha ve single exit point | |
| 344 | ; | |
| 345 | ; Set num ber of day s to wait before aut o-decrease amount | |
| 346 | N ADMT ; ^DD(344.61 ,.04,0) = AUTO-DECRE ASE MED DA YS DEFAULT | |
| 347 | S ADMT=$$ GET1^DIQ(3 44.61,"1," ,.04) | |
| 348 | K DIR S:A DMT]"" DIR ("B")=ADMT | |
| 349 | S (DIR("? "),DIR("?? "))=$$GET1 ^DID(344.6 1,.04,,"HE LP-PROMPT" ) | |
| 350 | S DIR(0)= "NA^0:7:0" ,DIR("A")= $$GET1^DID (344.61,.0 4,,"TITLE" ) | |
| 351 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 352 | S:ADMT'=Y FDAEDI(34 4.61,"1,", .04)=Y,RCA UDVAL(2)=" 344.61^.04 ^1^"_Y_U_A DMT | |
| 353 | ; | |
| 354 | ; PRCA*4. 5*304 - re moved gene ral auto-d ecrease am ount in fa vor of aut o-decrease by CARC | |
| 355 | ; | |
| 356 | ; file ch anges to m edical aut o-post and auto-decr ease param eters | |
| 357 | D FILE^DI E(,"FDAEDI ") | |
| 358 | D:$D(RCAU DVAL) AUDI T(.RCAUDVA L) | |
| 359 | K RCAUDVA L | |
| 360 | ; | |
| 361 | ; Set/Res et payer e xclusions for medica l claim de crease | |
| 362 | D EXCLLIS T(2) ; Dis play the e xclusion l ist | |
| 363 | D SETEXCL (2) I $G(R CQUIT) G A BORT ; SET /RESET exc lusions | |
| 364 | D EXCLLIS T(2) ; Dis play the e xclusion l ist | |
| 365 | W ! | |
| 366 | ; | |
| 367 | ; code fa lls throug h | |
| 368 | ; | |
| 369 | RXPARMS ; branch her e from abo ve | |
| 370 | ;-------- ---------- ---------- ---------- -------- | |
| 371 | ; Enable/ disable au to-posting of pharma cy claims | |
| 372 | ;-------- ---------- ---------- ---------- -------- | |
| 373 | N APPC,AP PCT | |
| 374 | ; APPC=AU TO POSTING OF PHARMA CY CLAIMS ENABLED | |
| 375 | ; APPCT=T EMP APMC | |
| 376 | S APPCT=$ $GET1^DIQ( 344.61,"1, ",1.01,"I" ),APPC=$S( APPCT=1:"Y es",APPCT= 0:"No",1:" ") | |
| 377 | K DIR S D IR(0)="YA" ,DIR("B")= $S(APPC="" :"Yes",1:A PPC) | |
| 378 | S DIR("A" )=$$GET1^D ID(344.61, 1.01,,"TIT LE") | |
| 379 | S DIR("?" )=$$GET1^D ID(344.61, 1.01,,"HEL P-PROMPT") | |
| 380 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 381 | I APPCT'= Y D ; use r updated value | |
| 382 | .S FDAEDI (344.61,"1 ,",1.01)=Y D FILE^DI E(,"FDAEDI ") K FDAED I | |
| 383 | .D NOTIFY ($S(Y=1:"Y es",Y=0:"N o",1:"*mis sing*"),1) | |
| 384 | .S RCAUDV AL(1)="344 .61^1.01^1 ^"_Y_U_('Y ) D AUDIT( .RCAUDVAL) K RCAUDVA L | |
| 385 | ; | |
| 386 | ; If yes, set/Reset payer exc lusions fo r pharmacy claims po sting | |
| 387 | I Y=1 D G:$G(RCQUI T)=1 ABORT | |
| 388 | . D EXCLL IST(3) ; D isplay the exclusion list | |
| 389 | . D SETEX CL(3) Q:$G (RCQUIT) ; SET/RESET exclusion s | |
| 390 | . D EXCLL IST(3) ; D isplay the exclusion list | |
| 391 | . W ! | |
| 392 | . ; | |
| 393 | ; | |
| 394 | ; Show Ph armacy pro mpt but do n't allow change | |
| 395 | D:$$GET1^ DIQ(344.61 ,"1,",1.01 ,"I")=1 G: $G(RCQUIT) =1 ABORT | |
| 396 | . W !,"EN ABLE AUTO- DECREASE O F PHARMACY CLAIMS (Y /N): NO//" | |
| 397 | . W !," D etermines if auto-de crease of pharmacy c laims are enabled fo r this sit e." | |
| 398 | . W !," N OTE: Not e ditable an d set to D isabled un til furthe r notice." ,! | |
| 399 | . K DIR S DIR(0)="E A" | |
| 400 | . S DIR(" A")="Press Enter to continue: " | |
| 401 | . D ^DIR I $D(DTOUT )!$D(DUOUT ) S RCQUIT =1 | |
| 402 | . W ! | |
| 403 | ; | |
| 404 | ; set MED ICAL EFT O VERRIDE ^D D(344.61,. 06,0) = ME DICAL EFT POST PREVE NT DAYS | |
| 405 | N MEO S M EO=$$GET1^ DIQ(344.61 ,"1,",.06) | |
| 406 | K DIR S:M EO]"" DIR( "B")=MEO | |
| 407 | S DIR("?" )=$$GET1^D ID(344.61, .06,,"HELP -PROMPT") | |
| 408 | S DIR(0)= "NA^14:60: 0",DIR("A" )=$$GET1^D ID(344.61, .06,,"TITL E") ; PRCA *4.5*321 C hange max from 99 to 60 | |
| 409 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 410 | I MEO'=Y D ; updat e and audi t | |
| 411 | .S RCAUDV AL(1)="344 .61^.06^1^ "_Y_U_MEO | |
| 412 | .S FDAEDI (344.61,"1 ,",.06)=Y D FILE^DIE (,"FDAEDI" ) | |
| 413 | .D AUDIT( .RCAUDVAL) K RCAUDVA L | |
| 414 | ; | |
| 415 | ;-------- ---------- ---------- ---------- -------- | |
| 416 | ; Set PHA RMACY EFT OVERRIDE | |
| 417 | ;-------- ---------- ---------- ---------- -------- | |
| 418 | N PEO S P EO=$$GET1^ DIQ(344.61 ,"1,",.07) | |
| 419 | K DIR S:P EO]"" DIR( "B")=PEO | |
| 420 | S DIR("?" )=$$GET1^D ID(344.61, .07,,"HELP -PROMPT") | |
| 421 | S DIR(0)= "NA^21:365 :0",DIR("A ")=$$GET1^ DID(344.61 ,.07,,"TIT LE") ; PRC A*4.5*321 Change max from 999 to 365 | |
| 422 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 423 | I PEO'=Y D ; updat e and audi t | |
| 424 | .S RCAUDV AL(1)="344 .61^.07^1^ "_Y_U_PEO | |
| 425 | .S FDAEDI (344.61,"1 ,",.07)=Y D FILE^DIE (,"FDAEDI" ) | |
| 426 | .D AUDIT( .RCAUDVAL) K RCAUDVA L | |
| 427 | ; | |
| 428 | G EXITMod ified Logi c (Changes are in bo ld)RCDPESP ;BIRM/EWL - ePaymen t Lockbox Site Param eters Defi nition - F iles 344.6 1 & 344.6 ;Nov 19, 2 014@15:26: 16 | |
| 429 | ;;4.5;Acc ounts Rece ivable;**2 98,304,318 ,321,326** ;Mar 20, 1 995;Build 104 | |
| 430 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 431 | ; | |
| 432 | EN ; entry point for EDI Lockb ox Paramet ers [RCDPE EDI LOCKB OX PARAMET ERS] | |
| 433 | N DA,DIC, DIE,DIR,DI RUT,DLAYGO ,DR,DTOUT, DUOUT,X,Y ; FileMan variables | |
| 434 | ; | |
| 435 | W !," Upd ate AR Sit e Paramete rs",! | |
| 436 | ; | |
| 437 | S X="RCDP E AUTO DEC " I '$D(^X USEC(X,DUZ )) W !!,"Y ou do not hold the " _X_" secur ity key." Q | |
| 438 | ; Lock th e paramete r file | |
| 439 | L +^RCY(3 44.61,1):D ILOCKTM E D Q | |
| 440 | .W !!," A nother use r is curre ntly using the AR Si te Paramet ers option ." | |
| 441 | .W !," Pl ease try a gain later ." | |
| 442 | ; | |
| 443 | ; PRCA*4. 5*326 - On ce lock is successfu l, take a snapshot o f the para meters for monitorin g | |
| 444 | D EN^RCDP ESP6 | |
| 445 | ; | |
| 446 | ; Check p arameter f ile | |
| 447 | N FDAEDI, FDAPAYER,I EN,IENS,RC QUIT | |
| 448 | ; FDAPAYE R - FDA ar ray for RC DPE AUTO-P AY EXCLUSI ON file (# 344.6) | |
| 449 | ; FDAEDI - FDA arra y for RCDP E PARAMETE R file (#3 44.61) | |
| 450 | ; RCAUDVA L - audit data for R CDPE PARAM ETER AUDIT file (#34 4.7) | |
| 451 | ; IEN - e ntry # | |
| 452 | ; IENS - IEN_comma | |
| 453 | ; RCQUIT - exit fla g | |
| 454 | ; | |
| 455 | ; functio n returns 1 on succe ss | |
| 456 | S Y=$$EDI LOCK^RCMSI TE ; Updat e EDI Lock box site p arameters | |
| 457 | I 'Y G AB ORT ; use r entered '^' | |
| 458 | ; | |
| 459 | ;-------- ---------- ---------- ---------- -------- | |
| 460 | ; prca*4. 5*304 | |
| 461 | ; Enable/ disable au to-auditin g of paper bills | |
| 462 | ;-------- ---------- ---------- ---------- -------- | |
| 463 | ; | |
| 464 | S RCQUIT= 0 W ! | |
| 465 | S RCQUIT= $$AUDIT^RC DPESP5 | |
| 466 | I RCQUIT G ABORT ; PRCA*4.5*3 26 must ha ve single exit point | |
| 467 | ; | |
| 468 | W ! | |
| 469 | I '$D(^RC Y(344.61,1 ,0)) W !," There is a problem w ith the RC DPE PARAME TER file ( #344.61)." G EXIT | |
| 470 | ; | |
| 471 | ;-------- ---------- ---------- ---------- -------- | |
| 472 | ; prca*4. 5*321 | |
| 473 | ; WORKLOA D NOTIFICA TION BULLE TIN DAYS | |
| 474 | ;-------- ---------- ---------- ---------- -------- | |
| 475 | N BULL S BULL=$$GET 1^DIQ(344. 61,"1,",.1 ,"I") | |
| 476 | K DIR S:B ULL]"" DIR ("B")=$$GE T1^DIQ(344 .61,"1,",. 1,"E") | |
| 477 | S DIR("?" )=$$GET1^D ID(344.61, .1,,"HELP- PROMPT") | |
| 478 | S DIR("A" )=$$GET1^D ID(344.61, .1,,"TITLE ") | |
| 479 | S DIR(0)= "344.61,.1 " | |
| 480 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 481 | I BULL'=Y D ; upda te and aud it | |
| 482 | .S RCAUDV AL(1)="344 .61^.1^1^" _Y_U_BULL | |
| 483 | .S FDAEDI (344.61,"1 ,",.1)=Y D FILE^DIE( ,"FDAEDI") | |
| 484 | .D AUDIT( .RCAUDVAL) K RCAUDVA L | |
| 485 | W ! | |
| 486 | ; | |
| 487 | ;-------- ---------- ---------- ---------- -------- | |
| 488 | ; Enable/ disable au to-posting of medica l claims | |
| 489 | ;-------- ---------- ---------- ---------- -------- | |
| 490 | N APMC,AP MCT | |
| 491 | ;PRCA*4.5 *304 Move from Medic al Auto de crease sec tion below | |
| 492 | N ADMC ; ^DD(344.6 1,.03,0)=" AUTO-DECRE ASE MED EN ABLED^S^0: No;1:Yes;^ 0;3^Q" | |
| 493 | S ADMC="" ; Init i n case Med ical Auto Posting is turned of f. | |
| 494 | ;end PRCA *4.5*304 | |
| 495 | ; APMC=AU TO POSTING OF MEDICA L CLAIMS E NABLED | |
| 496 | ; APMCT=T EMP APMC | |
| 497 | S APMCT=$ $GET1^DIQ( 344.61,"1, ",.02,"I") ,APMC=$S(A PMCT=1:"Ye s",APMCT=0 :"No",1:"" ) | |
| 498 | K DIR S D IR(0)="YA" ,DIR("B")= $S(APMC="" :"Y",1:APM C) | |
| 499 | S DIR("A" )=$$GET1^D ID(344.61, .02,,"TITL E") | |
| 500 | S DIR("?" )=$$GET1^D ID(344.61, .02,,"HELP -PROMPT") | |
| 501 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 502 | I APMCT'= Y D ; use r updated value | |
| 503 | .S FDAEDI (344.61,"1 ,",.02)=Y D FILE^DIE (,"FDAEDI" ) K FDAEDI | |
| 504 | .D NOTIFY ($S(Y=1:"Y es",Y=0:"N o",1:"*mis sing*")) | |
| 505 | .S RCAUDV AL(1)="344 .61^.02^1^ "_Y_U_('Y) D AUDIT(. RCAUDVAL) K RCAUDVAL | |
| 506 | ; | |
| 507 | I Y=0 G R XPARMS | |
| 508 | ; | |
| 509 | ; Set/Res et payer e xclusions for medica l claim po sting | |
| 510 | D EXCLLIS T(1) ; Dis play the e xclusion l ist | |
| 511 | D SETEXCL (1) I $G(R CQUIT) G A BORT ; SET /RESET exc lusions | |
| 512 | D EXCLLIS T(1) ; Dis play the e xclusion l ist | |
| 513 | W ! | |
| 514 | ; | |
| 515 | ; Enable/ disable au to-decreas e of medic al claims | |
| 516 | K FDAEDI ; used fo r FILE^DIE call | |
| 517 | S ADMC=$$ GET1^DIQ(3 44.61,"1," ,.03,"I") ; get curr ent value | |
| 518 | K DIR S D IR(0)="YA" ,DIR("B")= $S(ADMC="" !(ADMC=1): "Yes",1:"N o") | |
| 519 | S DIR("A" )=$$GET1^D ID(344.61, .03,,"TITL E") | |
| 520 | S DIR("?" )=$$GET1^D ID(344.61, .03,,"HELP -PROMPT") | |
| 521 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 522 | ; if user changed v alue, upda te and aud it | |
| 523 | S:ADMC'=Y FDAEDI(34 4.61,"1,", .03)=Y,RCA UDVAL(1)=" 344.61^.03 ^1^"_Y_U_A DMC | |
| 524 | I Y=0 D G RXPARMS ; value s et to No, update (if needed), go to Phar macy param s. | |
| 525 | . D:$D(FD AEDI) FILE ^DIE(,"FDA EDI"),AUDI T(.RCAUDVA L) K RCAUD VAL | |
| 526 | ; | |
| 527 | ; Set aut o-decrease maximum a mount | |
| 528 | N ADAMT ; ^DD(344.6 1,.05,0) = MED AMT D EFAULT AUT O-DECREASE | |
| 529 | S ADAMT=$ $GET1^DIQ( 344.61,"1, ",.05) | |
| 530 | K DIR S D IR("B")=AD AMT | |
| 531 | S (DIR("? "),DIR("?? "))=$$GET1 ^DID(344.6 1,.05,,"HE LP-PROMPT" ) | |
| 532 | S DIR(0)= "NA^0:7:0" ,DIR("A")= $$GET1^DID (344.61,.0 5,,"TITLE" ) | |
| 533 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 534 | S:ADAMT'= Y FDAEDI(3 44.61,"1," ,.04)=Y,RC AUDVAL(2)= "344.61^.0 5^1^"_Y_U_ ADAMT | |
| 535 | ; | |
| 536 | ; Reset a ny CARC ma x amounts which exce ed the aut o-decrease maximum | |
| 537 | D CHECK^R CDPESP5(AD AMT,1) | |
| 538 | ; Reset a ny NO-PAY CARC max a mounts whi ch exceed the auto-d ecrease ma ximum | |
| 539 | D CHECK^R CDPESP5(AD AMT,2) | |
| 540 | ; | |
| 541 | ; | |
| 542 | ; If auto -decrease (medical f or now) on , ask abou t CARC/RAR C auto-dec rease setu p | |
| 543 | W ! | |
| 544 | S RCQUIT= 0 | |
| 545 | D CARC^RC DPESP5(.RC QUIT) ; pa ss RCQUIT by referen ce - PRCA* 4.5*321 | |
| 546 | W ! | |
| 547 | ; If no a ctive CARC s Turn med ical auto- decrease o ff, Then g o to Phara cy params | |
| 548 | I ($$COUN T(1)=0)&($ $GET1^DIQ( 344.61,"1, ",.03,"I") =1) D I ' RCQUIT G R XPARMS ; P RCA*4.5*32 6 don't sk ip ahead i f RCQUIT=1 | |
| 549 | . K FDAED I,RCAUDVAL | |
| 550 | . S ADMC= $$GET1^DIQ (344.61,"1 ,",.03,"I" ) | |
| 551 | . S FDAED I(344.61," 1,",.03)=0 ,RCAUDVAL( 1)="344.61 ^.03^1^"_0 _U_ADMC_U_ "SYSTEM di sabled Med ical Auto- decrease, there are NO active CARCs" | |
| 552 | . D FILE^ DIE(,"FDAE DI"),AUDIT (.RCAUDVAL ) K RCAUDV AL | |
| 553 | . W !,"** * System h as DISABLE D Medical Auto-decre ase, there are NO ac tive CARCs .",! | |
| 554 | . D PAUSE | |
| 555 | I RCQUIT G ABORT ; PRCA*4.5*3 26 must ha ve single exit point | |
| 556 | ||
| 557 | ; | |
| 558 | I ‘RCQUIT D | |
| 559 | .; Set nu mber of da ys to wait before au to-decreas e amount | |
| 560 | .N ADMT ; ^DD(344.6 1,.04,0) = AUTO-DECR EASE MED D AYS DEFAUL T | |
| 561 | .S ADMT=$ $GET1^DIQ( 344.61,"1, ",.04) | |
| 562 | .K DIR S: ADMT]"" DI R("B")=ADM T | |
| 563 | .S (DIR(" ?"),DIR("? ?"))=$$GET 1^DID(344. 61,.04,,"H ELP-PROMPT ") | |
| 564 | .S DIR(0) ="NA^0:7:0 ",DIR("A") =$$GET1^DI D(344.61,. 04,,"TITLE ") | |
| 565 | .D ^DIR I $D(DTOUT) !$D(DUOUT) G ABORT | |
| 566 | .S:ADMT'= Y FDAEDI(3 44.61,"1," ,.04)=Y,RC AUDVAL(3)= "344.61^.0 4^1^"_Y_U_ ADMT | |
| 567 | ; | |
| 568 | ; PRCA*4. 5*304 - re moved gene ral auto-d ecrease am ount in fa vor of aut o-decrease by CARC | |
| 569 | ; | |
| 570 | ; file ch anges to m edical aut o-post and auto-decr ease param eters | |
| 571 | D FILE^DI E(,"FDAEDI ") | |
| 572 | D:$D(RCAU DVAL) AUDI T(.RCAUDVA L) | |
| 573 | K RCAUDVA L | |
| 574 | ; | |
| 575 | I RCQUIT G ABORT ; PRCA*4.5*3 26 must ha ve single exit point | |
| 576 | ; | |
| 577 | ; Set/Res et payer e xclusions for medica l claim de crease | |
| 578 | D EXCLLIS T(2) ; Dis play the e xclusion l ist | |
| 579 | D SETEXCL (2) I $G(R CQUIT) G A BORT ; SET /RESET exc lusions | |
| 580 | D EXCLLIS T(2) ; Dis play the e xclusion l ist | |
| 581 | W ! | |
| 582 | ; | |
| 583 | ; code fa lls throug h | |
| 584 | ; | |
| 585 | RXPARMS ; branch her e from abo ve | |
| 586 | ;-------- ---------- ---------- ---------- -------- | |
| 587 | ; Enable/ disable au to-posting of pharma cy claims | |
| 588 | ;-------- ---------- ---------- ---------- -------- | |
| 589 | N APPC,AP PCT | |
| 590 | ; APPC=AU TO POSTING OF PHARMA CY CLAIMS ENABLED | |
| 591 | ; APPCT=T EMP APMC | |
| 592 | S APPCT=$ $GET1^DIQ( 344.61,"1, ",1.01,"I" ),APPC=$S( APPCT=1:"Y es",APPCT= 0:"No",1:" ") | |
| 593 | K DIR S D IR(0)="YA" ,DIR("B")= $S(APPC="" :"Yes",1:A PPC) | |
| 594 | S DIR("A" )=$$GET1^D ID(344.61, 1.01,,"TIT LE") | |
| 595 | S DIR("?" )=$$GET1^D ID(344.61, 1.01,,"HEL P-PROMPT") | |
| 596 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 597 | I APPCT'= Y D ; use r updated value | |
| 598 | .S FDAEDI (344.61,"1 ,",1.01)=Y D FILE^DI E(,"FDAEDI ") K FDAED I | |
| 599 | .D NOTIFY ($S(Y=1:"Y es",Y=0:"N o",1:"*mis sing*"),1) | |
| 600 | .S RCAUDV AL(1)="344 .61^1.01^1 ^"_Y_U_('Y ) D AUDIT( .RCAUDVAL) K RCAUDVA L | |
| 601 | ; | |
| 602 | ; If yes, set/Reset payer exc lusions fo r pharmacy claims po sting | |
| 603 | I Y=1 D G:$G(RCQUI T)=1 ABORT | |
| 604 | . D EXCLL IST(3) ; D isplay the exclusion list | |
| 605 | . D SETEX CL(3) Q:$G (RCQUIT) ; SET/RESET exclusion s | |
| 606 | . D EXCLL IST(3) ; D isplay the exclusion list | |
| 607 | . W ! | |
| 608 | . ; | |
| 609 | ; | |
| 610 | ; Show Ph armacy pro mpt but do n't allow change | |
| 611 | D:$$GET1^ DIQ(344.61 ,"1,",1.01 ,"I")=1 G: $G(RCQUIT) =1 ABORT | |
| 612 | . W !,"EN ABLE AUTO- DECREASE O F PHARMACY CLAIMS (Y /N): NO//" | |
| 613 | . W !," D etermines if auto-de crease of pharmacy c laims are enabled fo r this sit e." | |
| 614 | . W !," N OTE: Not e ditable an d set to D isabled un til furthe r notice." ,! | |
| 615 | . K DIR S DIR(0)="E A" | |
| 616 | . S DIR(" A")="Press Enter to continue: " | |
| 617 | . D ^DIR I $D(DTOUT )!$D(DUOUT ) S RCQUIT =1 | |
| 618 | . W ! | |
| 619 | ; | |
| 620 | ; set MED ICAL EFT O VERRIDE ^D D(344.61,. 06,0) = ME DICAL EFT POST PREVE NT DAYS | |
| 621 | N MEO S M EO=$$GET1^ DIQ(344.61 ,"1,",.06) | |
| 622 | K DIR S:M EO]"" DIR( "B")=MEO | |
| 623 | S DIR("?" )=$$GET1^D ID(344.61, .06,,"HELP -PROMPT") | |
| 624 | S DIR(0)= "NA^14:60: 0",DIR("A" )=$$GET1^D ID(344.61, .06,,"TITL E") ; PRCA *4.5*321 C hange max from 99 to 60 | |
| 625 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 626 | I MEO'=Y D ; updat e and audi t | |
| 627 | .S RCAUDV AL(1)="344 .61^.06^1^ "_Y_U_MEO | |
| 628 | .S FDAEDI (344.61,"1 ,",.06)=Y D FILE^DIE (,"FDAEDI" ) | |
| 629 | .D AUDIT( .RCAUDVAL) K RCAUDVA L | |
| 630 | ; | |
| 631 | ;-------- ---------- ---------- ---------- -------- | |
| 632 | ; Set PHA RMACY EFT OVERRIDE | |
| 633 | ;-------- ---------- ---------- ---------- -------- | |
| 634 | N PEO S P EO=$$GET1^ DIQ(344.61 ,"1,",.07) | |
| 635 | K DIR S:P EO]"" DIR( "B")=PEO | |
| 636 | S DIR("?" )=$$GET1^D ID(344.61, .07,,"HELP -PROMPT") | |
| 637 | S DIR(0)= "NA^21:365 :0",DIR("A ")=$$GET1^ DID(344.61 ,.07,,"TIT LE") ; PRC A*4.5*321 Change max from 999 to 365 | |
| 638 | D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT | |
| 639 | I PEO'=Y D ; updat e and audi t | |
| 640 | .S RCAUDV AL(1)="344 .61^.07^1^ "_Y_U_PEO | |
| 641 | .S FDAEDI (344.61,"1 ,",.07)=Y D FILE^DIE (,"FDAEDI" ) | |
| 642 | .D AUDIT( .RCAUDVAL) K RCAUDVA L | |
| 643 | ; | |
| 644 | G EXITRou tinesActiv itiesRouti ne NameRCD PESP5 | |
| 645 | Enhancemen t Category New Modif y Delete N o ChangeRT MRelated O ptionsRCDP E EDI LOCK BOX PARAME TERS]Relat ed Routine sRoutines “Called By ”Routines “Called” RCDPESP $$FIND1^D IC | |
| 646 | ^DIE | |
| 647 | UPDATE^ DIE | |
| 648 | $$GET1^ DIQ | |
| 649 | ^DIR | |
| 650 | $$VAL^R CDPCRR | |
| 651 | GETCODE S^RCDPCRR | |
| 652 | AUDIT^R CDPESP | |
| 653 | $$ACT^R CDPRU | |
| 654 | $$DT^XL FDT Current LogicRCDP ESP5 ;ALB/ SAB - ePay ment Lockb ox Site Pa rameters D efinition - Files 34 4.71 ;03/1 9/2015 | |
| 655 | ;;4.5;Acc ounts Rece ivable;**3 04,321,326 **;Mar 20, 1995;Buil d 104 | |
| 656 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 657 | ; | |
| 658 | Q | |
| 659 | . | |
| 660 | . | |
| 661 | ;Ask user the maximu m amount t o allow fo r auto-dec rease | |
| 662 | GETAMT() ; | |
| 663 | N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT | |
| 664 | S DIR("?" )="Enter t he maximum amount th e CARC can be auto-d ecreased b etween $1 and $1500" | |
| 665 | S DIR(0)= "NA^1:1500 :0" | |
| 666 | S DIR("A" )="MAXIMUM DOLLAR AM OUNT TO AU TO-DECREAS E (1-1500) : " | |
| 667 | D ^DIR | |
| 668 | K DIR | |
| 669 | I $G(DUOU T) S Y=-1 | |
| 670 | Q Y | |
| 671 | ; | |
| 672 | ;Update t he databas e and audi t log | |
| 673 | UPDDATA(RC CIEN,RCSTA T,RCAMT,RC RSN) ; | |
| 674 | N DA,DR,D IE,DTOUT,X ,Y,DIC | |
| 675 | ; replace d //// wit h /// in f ollowing 5 lines - P RCA*4.5*32 1 | |
| 676 | S DA=RCCI EN,(DIC,DI E)="^RCY(3 44.62," | |
| 677 | S DR=".02 ///"_RCSTA T_";" | |
| 678 | S DR=DR_" .05///"_$$ DT^XLFDT_" ;" ; PRCA* 4.5*326 | |
| 679 | S DR=DR_" .04///"_DU Z_";" | |
| 680 | S DR=DR_" .06///"_RC AMT_";" | |
| 681 | S DR=DR_" .07///"_RC RSN_";" | |
| 682 | ; | |
| 683 | L +^RCY(3 44.62,RCCI EN):10 | |
| 684 | D ^DIE | |
| 685 | L -^RCY(3 44.62,RCCI EN) | |
| 686 | Q $D(Y)=0 | |
| 687 | ;Modified Logic (Ch anges are in bold)RC DPESP5 ;AL B/SAB - eP ayment Loc kbox Site Parameters Definitio n - Files 344.71 ;03 /19/2015 | |
| 688 | ;;4.5;Acc ounts Rece ivable;**3 04,321,326 **;Mar 20, 1995;Buil d 104 | |
| 689 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 690 | ; | |
| 691 | Q | |
| 692 | . | |
| 693 | . | |
| 694 | ;Ask user the maximu m amount t o allow fo r auto-dec rease | |
| 695 | GETAMT() ; | |
| 696 | N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT,R CMAX | |
| 697 | S RCMAX=+ $$GET1^DIQ (344.61,"1 ,",.05) | |
| 698 | S DIR("?" )="Enter t he maximum amount th e CARC can be auto-d ecreased b etween $1 and $"_RCM AX | |
| 699 | S DIR(0)= "NA^1:”_RC MAX_”:0" | |
| 700 | S DIR("A" )="MAXIMUM DOLLAR AM OUNT TO AU TO-DECREAS E (1-“_RCM AX_”): " | |
| 701 | D ^DIR | |
| 702 | K DIR | |
| 703 | I $G(DUOU T) S Y=-1 | |
| 704 | Q Y | |
| 705 | ; | |
| 706 | CHECK(RCMA X,RCPAID) ;Reset any CARC maxi mum values which exc eed upper limit - EP ^RCDPESP | |
| 707 | ; Input – RCMAX = Maximum al lowed $ de crease per claim (fr om #344.61 , #.05) | |
| 708 | ; RCPAID – 1 = CARCs for paid claims, 0 = CARC’s f or NO-PAY claims | |
| 709 | ; Output – Updates #344.62 - RCDPE CARC -RARC AUTO DEC | |
| 710 | ; Updates #344.7 - R CDPE PARAM ETER AUDIT | |
| 711 | ; | |
| 712 | N RCAMT,R CARR,RCCAR CD,RCCODE, RCCT,RCDES C,RCFLD,RC I,RCINACT, RCSTAT,RCS UB,RCTXT | |
| 713 | ; | |
| 714 | S RCFLD=$ S(RCPAID:. 06,1:.12) | |
| 715 | S RCI=0,R CARR=0 | |
| 716 | F S RCI= $O(^RCY(34 4.62,RCI)) Q:'RCI D | |
| 717 | . S RCAMT =$$GET1^DI Q(344.62,R CI_",",RCF LD) | |
| 718 | . Q:RCAMT '>RCMAX | |
| 719 | . S RCARR =RCARR+1,R CARR(RCARR )=RCI_U_RC AMT | |
| 720 | ; | |
| 721 | Q:RCARR=0 | |
| 722 | S RCSUB=0 | |
| 723 | S RCTXT=$ S(‘RCPAID: ”NO-PAY ”, 1:””) | |
| 724 | W !!,"War ning:" | |
| 725 | W !," The following “_RCTXT_” CARC codes ' max. amt will be c hanged to the new li mit $"_RCM AX | |
| 726 | F S RCSU B=$O(RCARR (RCSUB)) Q :'RCSUB D | |
| 727 | . S RCI=$ P(RCARR(RC SUB),U) | |
| 728 | . S RCAMT =$P(RCARR( RCSUB),U,2 ) | |
| 729 | . S RCCOD E=$$GET1^D IQ(344.62, RCI_",",.0 1) | |
| 730 | . S RCCIE N=$O(^RC(3 45,"B",RCC ODE,"")) | |
| 731 | . S RCDES C=$G(^RC(3 45,RCCIEN, 1,1,0)) | |
| 732 | . I $L(RC DESC)>50 S RCDESC=$E (RCDESC,1, 50)_" ..." | |
| 733 | . D GETCO DES^RCDPCR R(RCCODE," ","B",$$DT ^XLFDT,"RC CARCD","1^ 70") | |
| 734 | . W !,?3, RCCODE,?9, $E(RCDESC, 1,55),?63, $J(RCAMT,1 0,0) | |
| 735 | . ; | |
| 736 | . N RCAUD ARY,RCSTAT ,RCTXT | |
| 737 | . S RCSTA T=$$GET1^D IQ(344.62, RCI_",",.0 2) ; Leave status un changed | |
| 738 | . ; Updat e #344.62 - RCDPE CA RC-RARC AU TO DEC | |
| 739 | . D UPDDA TA(RCI,RCS TA,RCMAX,R CTXT,RCPAI D) | |
| 740 | . S RCTXT ="Updated automatica lly - over maximum a llowed" | |
| 741 | . ; Updat e #344.7 - RCDPE PAR AMETER AUD IT | |
| 742 | . S RCAUD ARY(1)="34 4.62^”_RCF LD_”^"_RCI _"^"_RCMAX _"^"_RCAMT _"^"_RCTXT | |
| 743 | . D AUDIT ^RCDPESP(. RCAUDARY) | |
| 744 | ; | |
| 745 | Q ;Update the datab ase and au dit log | |
| 746 | UPDDATA(RC CIEN,RCSTA T,RCAMT,RC RSN) ; | |
| 747 | N DA,DR,D IE,DTOUT,X ,Y,DIC | |
| 748 | ; replace d //// wit h /// in f ollowing 5 lines - P RCA*4.5*32 1 | |
| 749 | S DA=RCCI EN,(DIC,DI E)="^RCY(3 44.62," | |
| 750 | S DR=".02 ///"_RCSTA T_";" | |
| 751 | S DR=DR_" .05///"_$$ DT^XLFDT_" ;" ; PRCA* 4.5*326 | |
| 752 | S DR=DR_" .04///"_DU Z_";" | |
| 753 | S DR=DR_" .06///"_RC AMT_";" | |
| 754 | S DR=DR_" .07///"_RC RSN_";" | |
| 755 | ; | |
| 756 | L +^RCY(3 44.62,RCCI EN):10 E Q | |
| 757 | D ^DIE | |
| 758 | L -^RCY(3 44.62,RCCI EN) | |
| 759 | Q $D(Y)=0 | |
| 760 | ; | |
| 761 | RoutinesAc tivitiesRo utine Name RCDPESP1 | |
| 762 | Enhancemen t Category New Modif y Delete N o ChangeRT MRelated O ptionsRCDP E SITE PAR AMETER REP ORTRelated RoutinesR outines “C alled By”R outines “C alled” N /A ^%ZIS | |
| 763 | HOME^%Z IS | |
| 764 | ^%ZISC | |
| 765 | ^%ZTLOA D | |
| 766 | LIST^DI C | |
| 767 | $$GET1^ DID | |
| 768 | GETS^DI Q | |
| 769 | GETCODE S^RCDPCRR | |
| 770 | $$ENDOR PRT^RCDPEA RL | |
| 771 | ASK^RCD PEARL | |
| 772 | $$RTYPE ^RCDPESP2 | |
| 773 | $$ACT^R CDPRU | |
| 774 | $$DT^XL FDT | |
| 775 | $$FMTE^ XLFDT | |
| 776 | $$NOW^X LFDT Current LogicRCDP ESP1 ;BIRM /SAB,hrubo vcak - ePa yment Lock box Site P arameter R eports ;7/ 1/15 | |
| 777 | ;;4.5;Acc ounts Rece ivable;**2 98,304,318 ,321**;Mar 20, 1995; Build 104 | |
| 778 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | |
| 779 | ; | |
| 780 | SPRPT ; si te paramet er report entry poin t | |
| 781 | ; RCNTR - counter | |
| 782 | ; RCFLD - DD field number | |
| 783 | ; RCHDR - header in formation | |
| 784 | ; RCPARM - paramete rs | |
| 785 | ; RCSTOP - exit fla g | |
| 786 | N J,RCNTR ,RCFLD,RCG LB,RCHDR,R CPARM,RCST OP,V,X,Y,R CSTRING | |
| 787 | N RCDATA, RCCODE,RCD ESC,RCSTAT ,RCI,RCCAR CD,RCCIEN, RCITEM,RCA CTV | |
| 788 | ; | |
| 789 | S X="RC" F S X=$O( ^TMP($J,X) ) Q:'($E(X ,1,2)="RC" ) K ^TMP($ J,X) ; cle ar out old data | |
| 790 | ; | |
| 791 | ; RCGLB - ^TMP glob al storage locations | |
| 792 | ; ^TMP($J ,"RC342") - AR SITE PARAMETER file (#342 ) | |
| 793 | ; ^TMP($J ,"RC344.6" ) - RCDPE AUTO-PAY E XCLUSION f ile (#344. 6) | |
| 794 | ; ^TMP($J ,"RC344.61 ") - RCDPE PARAMETER file (#34 4.61) | |
| 795 | F J=342,3 44.6,344.6 1 S RCGLB( J)=$NA(^TM P($J,"RC"_ J)) K @RCG LB(J) | |
| 796 | ; | |
| 797 | S RCHDR(" RUNDATE")= $$FMTE^XLF DT($$NOW^X LFDT,"10S" ) | |
| 798 | S RCHDR(" PGNMBR")=0 ; page nu mber | |
| 799 | ; | |
| 800 | ; AR SITE PARAMETER file (#34 2) | |
| 801 | D GETS^DI Q(342,"1," ,".01;7.02 ;7.03;7.04 ;7.05;7.06 ;7.07;7.08 ;","E",RCG LB(342)) | |
| 802 | ; add sit e to heade r data | |
| 803 | S RCHDR(" SITE")="Si te: "_@RCG LB(342)@(3 42,"1,",.0 1,"E") | |
| 804 | ; | |
| 805 | F RCFLD=7 .02,7.03,7 .04,7.05,7 .06,7.07,7 .08 S RCIT EM=$S(RCFL D>7.04:"TI TLE",1:"LA BEL") D ; EFT and E RA days un matched - PRCA*4.5*3 21 | |
| 806 | . I RCTYP E="P",(RCF LD=7.05)!( RCFLD=7.07 ) Q ; Don t display if only sh owing Phar macy param eters - PR CA*4.5*321 | |
| 807 | . I RCTYP E="M",(RCF LD=7.06)!( RCFLD=7.08 ) Q ; Don t display if only sh owing medi cal parame ters - PRC A*4.5*321 | |
| 808 | . S Y=$$G ET1^DID(34 2,RCFLD,,R CITEM)_": "_@RCGLB(3 42)@(342," 1,",RCFLD, "E") | |
| 809 | . I RCFLD =7.05 D AD 2RPT(" ") | |
| 810 | . I (RCFL D=7.06)&(R CTYPE="P") D AD2RPT( " ") | |
| 811 | . D AD2RP T(Y) | |
| 812 | ; | |
| 813 | D AD2RPT( " ") | |
| 814 | ; | |
| 815 | ; Display Medical P arameters | |
| 816 | ; RCDPE P ARAMETER f ile (#344. 61) | |
| 817 | D GETS^DI Q(344.61," 1,",".02;. 03;.04;.05 ;.06;.07;. 1;1.01;1.0 2","E",RCG LB(344.61) ) ; PRCA*4 .5*321 | |
| 818 | ; | |
| 819 | S Y=$$GET 1^DID(344. 61,.1,,"LA BEL")_": " _@RCGLB(34 4.61)@(344 .61,"1,",. 1,"E") ; P RCA*4.5*32 1 | |
| 820 | D AD2RPT( Y) ; PRCA* 4.5*321 | |
| 821 | D AD2RPT( " ") ; PRC A*4.5*321 | |
| 822 | ; | |
| 823 | ; get aut o-post and auto-decr ease setti ngs, save zero node | |
| 824 | S X=$G(^R CY(344.61, 1,0)),RCPA RM("AUTO-P OST")=$P(X ,U,2),RCPA RM("AUTO-D ECREASE")= $P(X,U,3), RCPARM(344 .61,0)=X | |
| 825 | S RCPARM( "RX AUTO-P OST")=$P($ G(^RCY(344 .61,1,1)), U) | |
| 826 | ; | |
| 827 | ; RCDPE A UTO-PAY EX CLUSION fi le (#344.6 ) | |
| 828 | ; screeni ng logic: ^DD(344.6, .06,0)="EX CLUDE MED CLAIMS POS TING^S^0:N o;1:Yes;^0 ;6^Q" | |
| 829 | D LIST^DI C(344.6,," @;.01;.02; .06;1","P" ,,,,,"I $P (^(0),U,6) =1",,RCGLB (344.6)) | |
| 830 | ; | |
| 831 | ; PRCA*4. 5*304 - Pr int Medica l Claim Pa rameters | |
| 832 | I RCTYPE' ="P" D | |
| 833 | .; RCDPE PARAMETER file (#344 .61), auto -posting o f medical claims | |
| 834 | .S X=$$GE T1^DID(344 .61,.02,," TITLE"),V= " (Y/N)" S :X[V X=$P( X,V)_$P(X, V,2) ; rem ove yes/no prompt | |
| 835 | .S Y=X_" "_@RCGLB(3 44.61)@(34 4.61,"1,", .02,"E") | |
| 836 | .D AD2RPT (Y) | |
| 837 | .; | |
| 838 | .I (RCPAR M("AUTO-PO ST")!RCPAR M("AUTO-DE CREASE")) D ; list auto-post excluded p ayers | |
| 839 | ..I '$D(@ RCGLB(344. 6)@("DILIS T",1,0)) D Q | |
| 840 | ...S X=" No payers excluded f rom medica l auto-pos ting." D A D2RPT($J(" ",80-$L(X )\2)_X) | |
| 841 | ..; | |
| 842 | ..D AD2RP T(" Exclud ed Payer C omment") | |
| 843 | ..S RCNTR =0 | |
| 844 | ..F S RC NTR=$O(@RC GLB(344.6) @("DILIST" ,RCNTR)) Q :'RCNTR D | |
| 845 | ...S V=@R CGLB(344.6 )@("DILIST ",RCNTR,0) ,X=$E($P(V ,U,2),1,35 ) | |
| 846 | ...S Y=" "_X_$J(" " ,36-$L(X)) _$P(V,U,5) | |
| 847 | ...D AD2R PT($E(Y,1, IOM)) | |
| 848 | .; | |
| 849 | .I RCPARM ("AUTO-POS T") D AD2R PT(" ") ; blank line | |
| 850 | .; | |
| 851 | .K @RCGLB (344.6) ; delete old data | |
| 852 | .; RCDPE AUTO-PAY E XCLUSION f ile (#344. 6) | |
| 853 | .; screen ing logic: ^DD(344.6 ,.07,0)="E XCLUDE MED CLAIMS DE CREASE^S^0 :No;1:Yes; ^0;7^Q" | |
| 854 | .D LIST^D IC(344.6,, "@;.01;.02 ;.07;2","P ",,,,,"I $ P(^(0),U,7 )=1",,RCGL B(344.6)) | |
| 855 | .; | |
| 856 | .; RCDPE PARAMETER file (#344 .61), auto -decrease of medical claims | |
| 857 | .S X=$$GE T1^DID(344 .61,.03,," TITLE"),V= " (Y/N): " ,V=" (Y/N) " S:X[V X= $P(X,V)_$P (X,V,2) ; remove yes /no prompt | |
| 858 | .S Y=$J(X ,45)_@RCGL B(344.61)@ (344.61,"1 ,",.03,"E" ) | |
| 859 | .D AD2RPT (Y) ; ,AD2 RPT(" ") | |
| 860 | .; PRCA*4 .5*304 - R emoved bec ause auto- decrease a mounts are based on CARCs | |
| 861 | .;I RCPAR M("AUTO-DE CREASE") D ; list th ese 2 fiel ds only if auto-decr ease enabl ed | |
| 862 | .;.D AD2R PT("NUMBER OF DAYS T O WAIT BEF ORE AUTO-D ECREASE: " _(+$P(RCPA RM(344.61, 0),U,4))) | |
| 863 | .;.D AD2R PT(" MAXIM UM DOLLAR AMOUNT TO AUTO-DECRE ASE: "_"$" _(+$P(RCPA RM(344.61, 0),U,5))) | |
| 864 | .; | |
| 865 | .; PRCA*4 .5*304 - P rint the C ARC Auto-d ecrease pa rameters | |
| 866 | . I $$CAR CCHK(RCTYP E,"M") D | |
| 867 | .. D AD2R PT(" "),AD 2RPT(" AUT O-DECREASE MEDICAL C LAIMS FOR THE FOLLOW ING CARC/A MOUNTS ONL Y:"),AD2RP T(" ") | |
| 868 | .. S RCST RING=$TR($ J("",70)," ","-"),RC I=0 | |
| 869 | .. D AD2R PT(" CARC Descriptio n Max. Amt ") | |
| 870 | .. D AD2R PT(" "_RCS TRING) | |
| 871 | .. ; | |
| 872 | .. ; Loop and print entries | |
| 873 | .. F S R CI=$O(^RCY (344.62,RC I)) Q:'RCI D | |
| 874 | .. . S RC DATA=$G(^R CY(344.62, RCI,0)),Y= "" | |
| 875 | .. . Q:RC DATA="" | |
| 876 | .. . S RC CODE=$P(RC DATA,U),RC CIEN=$O(^R C(345,"B", RCCODE,"") ) | |
| 877 | .. . S RC DESC=$G(^R C(345,RCCI EN,1,1,0)) | |
| 878 | .. . S RC STAT=$P(RC DATA,U,2) | |
| 879 | .. . Q:RC STAT'=1 | |
| 880 | .. . I $L (RCDESC)>5 0 S RCDESC =$E(RCDESC ,1,50)_" . .." | |
| 881 | .. . D GE TCODES^RCD PCRR(RCCOD E,"","A",$ $DT^XLFDT, "RCCARCD", "1^70") | |
| 882 | .. . S Y= " "_$J(RCC ODE,4)_" " | |
| 883 | .. . S Y= Y_$E(RCDES C,1,53) S: $L(RCDESC) <53 Y=Y_$J ("",(53-$L (RCDESC))) S Y=Y_$J( $P(RCDATA, U,6),10,0) | |
| 884 | .. . I '$ $ACT^RCDPR U(345,RCCO DE,) S Y=Y _" (I)" ; if inacti ve, displa y (i) | |
| 885 | .. . D AD 2RPT(Y) | |
| 886 | .. ; | |
| 887 | ..D AD2RP T(" ") ; b lank line | |
| 888 | .I (RCPAR M("AUTO-PO ST")!RCPAR M("AUTO-DE CREASE")) D ; list excluded a uto-decrea se payers | |
| 889 | .. S X=$P ($$GET1^DI D(344.61,. 04,,"TITLE ")," (",1) _": " | |
| 890 | .. S Y=$J (X,50)_@RC GLB(344.61 )@(344.61, "1,",.04," E") | |
| 891 | .. D AD2R PT(Y),AD2R PT(" ") | |
| 892 | .. D AD2R PT(" All p ayers excl uded from Auto-Posti ng are exc luded from Auto-Decr ease.") | |
| 893 | .. Q:'RCP ARM("AUTO- DECREASE") | |
| 894 | .. I '$D( @RCGLB(344 .6)@("DILI ST",1,0)) D Q | |
| 895 | ... S X=" No additi onal payer s excluded from Medi cal Auto-D ecrease." D AD2RPT($ J(" ",80-$ L(X)\2)_X) | |
| 896 | ..; | |
| 897 | .. D AD2R PT(" Addit ional Excl uded Payer Comment") | |
| 898 | .. S RCNT R=0 | |
| 899 | .. F S R CNTR=$O(@R CGLB(344.6 )@("DILIST ",RCNTR)) Q:'RCNTR D | |
| 900 | ... S V=@ RCGLB(344. 6)@("DILIS T",RCNTR,0 ),X=$E($P( V,U,2),1,3 5) | |
| 901 | ... S Y=" "_X_$J(" ",36-$L(X) )_$P(V,U,5 ) | |
| 902 | ... D AD2 RPT($E(Y,1 ,IOM)) | |
| 903 | .; | |
| 904 | .D AD2RPT (" ") ; bl ank line | |
| 905 | ; | |
| 906 | K @RCGLB( 344.6) ; d elete old data | |
| 907 | ; RCDPE A UTO-PAY EX CLUSION fi le (#344.6 ) | |
| 908 | ; screeni ng logic: ^DD(344.6, .06,0)="EX CLUDE MED CLAIMS POS TING^S^0:N o;1:Yes;^0 ;6^Q" | |
| 909 | D LIST^DI C(344.6,," @;.01;.02; .08;3","P" ,,,,,"I $P (^(0),U,8) =1",,RCGLB (344.6)) | |
| 910 | ; | |
| 911 | ; PRCA*4. 5*304 - Pr int Pharma cy Claim P arameters | |
| 912 | I RCTYPE' ="M" D | |
| 913 | .; RCDPE PARAMETER file (#344 .61), auto -posting o f pharmacy claims | |
| 914 | .S X=$$GE T1^DID(344 .61,1.01,, "TITLE"),V =" (Y/N)" S:X[V X=$P (X,V)_$P(X ,V,2) ; re move yes/n o prompt | |
| 915 | .S Y=X_" "_@RCGLB(3 44.61)@(34 4.61,"1,", 1.01,"E") | |
| 916 | .D AD2RPT (Y) | |
| 917 | .; | |
| 918 | . I RCPAR M("RX AUTO -POST") D ; list au to-post ex cluded pay ers | |
| 919 | .. I '$D( @RCGLB(344 .6)@("DILI ST",1,0)) D Q | |
| 920 | ... S X=" No payers excluded from pharm acy auto-p osting." D AD2RPT($J (" ",80-$L (X)\2)_X) | |
| 921 | ..; | |
| 922 | .. D AD2R PT(" Exclu ded Payer Comment") | |
| 923 | .. S RCNT R=0 | |
| 924 | .. F S R CNTR=$O(@R CGLB(344.6 )@("DILIST ",RCNTR)) Q:'RCNTR D | |
| 925 | ... S V=@ RCGLB(344. 6)@("DILIS T",RCNTR,0 ),X=$E($P( V,U,2),1,3 5) | |
| 926 | ... S Y=" "_X_$J(" ",36-$L(X) )_$P(V,U,5 ) | |
| 927 | ... D AD2 RPT($E(Y,1 ,IOM)) | |
| 928 | .. S X=$P ($$GET1^DI D(344.61,1 .02,,"TITL E")," (",1 )_": " ; remove yes /no prompt | |
| 929 | .. S Y=" "_X_" "_$S (@RCGLB(34 4.61)@(344 .61,"1,",1 .02,"E")=" ":"No",1:@ RCGLB(344. 61)@(344.6 1,"1,",1.0 2,"E")) | |
| 930 | .. D AD2R PT(" "),AD 2RPT(Y) | |
| 931 | .; | |
| 932 | .I RCPARM ("RX AUTO- POST") D A D2RPT(" ") ; blank l ine | |
| 933 | .; | |
| 934 | .K @RCGLB (344.6) ; delete old data | |
| 935 | .; | |
| 936 | .; PRCA*4 .5*304 - P rint the C ARC Auto-d ecrease pa rameters | |
| 937 | . I $$CAR CCHK(RCTYP E,"P") D | |
| 938 | .. S RCST RING=$TR($ J("",73)," ","-"),RC I=0 | |
| 939 | .. D AD2R PT(" CARC Descriptio n Max. Amt ") | |
| 940 | .. D AD2R PT(RCSTRIN G) | |
| 941 | .. ; | |
| 942 | .. ; Loop and print entries | |
| 943 | .. F S R CI=$O(^RCY (344.62,RC I)) Q:'RCI D | |
| 944 | .. . S RC DATA=$G(^R CY(344.62, RCI,0)),Y= "" | |
| 945 | .. . Q:RC DATA="" | |
| 946 | .. . S RC CODE=$P(RC DATA,U),RC CIEN=$O(^R C(345,"B", RCCODE,"") ) | |
| 947 | .. . S RC DESC=$G(^R C(345,RCCI EN,1,1,0)) | |
| 948 | .. . S RC STAT=$P(RC DATA,U,2) | |
| 949 | .. . Q:RC STAT'=1 | |
| 950 | .. . I $L (RCDESC)>5 0 S RCDESC =$E(RCDESC ,1,50)_" . .." | |
| 951 | .. . D GE TCODES^RCD PCRR(RCCOD E,"","A",$ $DT^XLFDT, "RCCARCD", "1^70") | |
| 952 | .. . S Y= " "_$E(RCC ODE,1,4)_" " | |
| 953 | .. . S Y= Y_$E(RCDES C,1,55)_$J ($P(RCDATA ,U,6),10,0 ) | |
| 954 | .. . I '$ $ACT^RCDPR U(345,RCCO DE,) S Y=Y _" (I)" ; if inacti ve, displa y (i) | |
| 955 | .. . D AD 2RPT(Y) | |
| 956 | ; | |
| 957 | ; RCDPE P ARAMETER f ile (#344. 61) | |
| 958 | F RCFLD=. 06,.07 D | |
| 959 | . Q:(RCFL D=.06)&(RC TYPE="P") ; Dont dis play if on ly showing Pharmacy parameters | |
| 960 | . Q:(RCFL D=.07)&(RC TYPE="M") ; Dont dis play if on ly showing medical p arameters | |
| 961 | . S Y=$$G ET1^DID(34 4.61,RCFLD ,,"TITLE") _" "_@RCGL B(344.61)@ (344.61,"1 ,",RCFLD," E") | |
| 962 | . D AD2RP T(Y) | |
| 963 | ; | |
| 964 | D AD2RPT( " "),AD2RP T($$ENDORP RT^RCDPEAR L) | |
| 965 | ; | |
| 966 | S RCSTOP= 0 U IO D S PHDR(.RCHD R) | |
| 967 | S J=0 F S J=$O(^TM P($J,"RC S P REPORT", J)) Q:'J!R CSTOP S Y =^TMP($J," RC SP REPO RT",J,0) D | |
| 968 | .W !,Y Q: '$O(^TMP($ J,"RC SP R EPORT",J)) ; quit if last line | |
| 969 | .I '$G(ZT SK),$E(IOS T,1,2)="C- ",$Y+3>IOS L D ASK^RC DPEARL(.RC STOP) I 'R CSTOP D SP HDR(.RCHDR ) Q | |
| 970 | .Q:RCSTOP Q:$Y+2<I OSL | |
| 971 | .D SPHDR( .RCHDR) | |
| 972 | ; | |
| 973 | I '$G(ZTS K),$E(IOST ,1,2)="C-" ,'RCSTOP D ASK^RCDPE ARL(.RCSTO P) | |
| 974 | ; | |
| 975 | ; close d evice | |
| 976 | U IO(0) D ^%ZISC | |
| 977 | ; | |
| 978 | S X="RC" F S X=$O( ^TMP($J,X) ) Q:'($E(X ,1,2)="RC" ) K ^TMP($ J,X) ; cle an up | |
| 979 | ; | |
| 980 | Q | |
| 981 | ; | |
| 982 | Modified L ogic (Chan ges are in bold)RCDP ESP1 ;BIRM /SAB,hrubo vcak - ePa yment Lock box Site P arameter R eports ;7/ 1/15 | |
| 983 | ;;4.5;Acc ounts Rece ivable;**2 98,304,318 ,321,XXX** ;Mar 20, 1 995;Build 104 | |
| 984 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | |
| 985 | ; | |
| 986 | SPRPT ; si te paramet er report entry poin t | |
| 987 | ; RCNTR - counter | |
| 988 | ; RCFLD - DD field number | |
| 989 | ; RCHDR - header in formation | |
| 990 | ; RCPARM - paramete rs | |
| 991 | ; RCSTOP - exit fla g | |
| 992 | N J,RCNTR ,RCFLD,RCG LB,RCHDR,R CPARM,RCST OP,V,X,Y,R CSTRING | |
| 993 | N RCDATA, RCCODE,RCD ESC,RCSTAT ,RCI,RCCAR CD,RCCIEN, RCITEM,RCA CTV | |
| 994 | ; | |
| 995 | S X="RC" F S X=$O( ^TMP($J,X) ) Q:'($E(X ,1,2)="RC" ) K ^TMP($ J,X) ; cle ar out old data | |
| 996 | ; | |
| 997 | ; RCGLB - ^TMP glob al storage locations | |
| 998 | ; ^TMP($J ,"RC342") - AR SITE PARAMETER file (#342 ) | |
| 999 | ; ^TMP($J ,"RC344.6" ) - RCDPE AUTO-PAY E XCLUSION f ile (#344. 6) | |
| 1000 | ; ^TMP($J ,"RC344.61 ") - RCDPE PARAMETER file (#34 4.61) | |
| 1001 | F J=342,3 44.6,344.6 1 S RCGLB( J)=$NA(^TM P($J,"RC"_ J)) K @RCG LB(J) | |
| 1002 | ; | |
| 1003 | S RCHDR(" RUNDATE")= $$FMTE^XLF DT($$NOW^X LFDT,"10S" ) | |
| 1004 | S RCHDR(" PGNMBR")=0 ; page nu mber | |
| 1005 | ; | |
| 1006 | ; AR SITE PARAMETER file (#34 2) | |
| 1007 | D GETS^DI Q(342,"1," ,".01;7.02 ;7.03;7.04 ;7.05;7.06 ;7.07;7.08 ;","E",RCG LB(342)) | |
| 1008 | ; add sit e to heade r data | |
| 1009 | S RCHDR(" SITE")="Si te: "_@RCG LB(342)@(3 42,"1,",.0 1,"E") | |
| 1010 | ; | |
| 1011 | F RCFLD=7 .02,7.03,7 .04,7.05,7 .06,7.07,7 .08 S RCIT EM=$S(RCFL D>7.04:"TI TLE",1:"LA BEL") D ; EFT and E RA days un matched - PRCA*4.5*3 21 | |
| 1012 | . I RCTYP E="P",(RCF LD=7.05)!( RCFLD=7.07 ) Q ; Don t display if only sh owing Phar macy param eters - PR CA*4.5*321 | |
| 1013 | . I RCTYP E="M",(RCF LD=7.06)!( RCFLD=7.08 ) Q ; Don t display if only sh owing medi cal parame ters - PRC A*4.5*321 | |
| 1014 | . S Y=$$G ET1^DID(34 2,RCFLD,,R CITEM)_": "_@RCGLB(3 42)@(342," 1,",RCFLD, "E") | |
| 1015 | . I RCFLD =7.05 D AD 2RPT(" ") | |
| 1016 | . I (RCFL D=7.06)&(R CTYPE="P") D AD2RPT( " ") | |
| 1017 | . D AD2RP T(Y) | |
| 1018 | ; | |
| 1019 | D AD2RPT( " ") | |
| 1020 | ; | |
| 1021 | ; Display Medical P arameters | |
| 1022 | ; RCDPE P ARAMETER f ile (#344. 61) | |
| 1023 | D GETS^DI Q(344.61," 1,",".02;. 03;.04;.05 ;.06;.07;. 1;1.01;1.0 2","E",RCG LB(344.61) ) ; PRCA*4 .5*321 | |
| 1024 | ; | |
| 1025 | S Y=$$GET 1^DID(344. 61,.1,,"LA BEL")_": " _@RCGLB(34 4.61)@(344 .61,"1,",. 1,"E") ; P RCA*4.5*32 1 | |
| 1026 | D AD2RPT( Y) ; PRCA* 4.5*321 | |
| 1027 | D AD2RPT( " ") ; PRC A*4.5*321 | |
| 1028 | ; | |
| 1029 | ; get aut o-post and auto-decr ease setti ngs, save zero node | |
| 1030 | S X=$G(^R CY(344.61, 1,0)),RCPA RM("AUTO-P OST")=$P(X ,U,2),RCPA RM("AUTO-D ECREASE")= $P(X,U,3), RCPARM(344 .61,0)=X | |
| 1031 | S RCPARM( "RX AUTO-P OST")=$P($ G(^RCY(344 .61,1,1)), U) | |
| 1032 | ; | |
| 1033 | ; RCDPE A UTO-PAY EX CLUSION fi le (#344.6 ) | |
| 1034 | ; screeni ng logic: ^DD(344.6, .06,0)="EX CLUDE MED CLAIMS POS TING^S^0:N o;1:Yes;^0 ;6^Q" | |
| 1035 | D LIST^DI C(344.6,," @;.01;.02; .06;1","P" ,,,,,"I $P (^(0),U,6) =1",,RCGLB (344.6)) | |
| 1036 | ; | |
| 1037 | ; PRCA*4. 5*304 - Pr int Medica l Claim Pa rameters | |
| 1038 | I RCTYPE' ="P" D | |
| 1039 | .; RCDPE PARAMETER file (#344 .61), auto -posting o f medical claims | |
| 1040 | .S X=$$GE T1^DID(344 .61,.02,," TITLE"),V= " (Y/N)" S :X[V X=$P( X,V)_$P(X, V,2) ; rem ove yes/no prompt | |
| 1041 | .S Y=X_" "_@RCGLB(3 44.61)@(34 4.61,"1,", .02,"E") | |
| 1042 | .D AD2RPT (Y) | |
| 1043 | .; | |
| 1044 | .I (RCPAR M("AUTO-PO ST")!RCPAR M("AUTO-DE CREASE")) D ; list auto-post excluded p ayers | |
| 1045 | ..I '$D(@ RCGLB(344. 6)@("DILIS T",1,0)) D Q | |
| 1046 | ...S X=" No payers excluded f rom medica l auto-pos ting." D A D2RPT($J(" ",80-$L(X )\2)_X) | |
| 1047 | ..; | |
| 1048 | ..D AD2RP T(" Exclud ed Payer C omment") | |
| 1049 | ..S RCNTR =0 | |
| 1050 | ..F S RC NTR=$O(@RC GLB(344.6) @("DILIST" ,RCNTR)) Q :'RCNTR D | |
| 1051 | ...S V=@R CGLB(344.6 )@("DILIST ",RCNTR,0) ,X=$E($P(V ,U,2),1,35 ) | |
| 1052 | ...S Y=" "_X_$J(" " ,36-$L(X)) _$P(V,U,5) | |
| 1053 | ...D AD2R PT($E(Y,1, IOM)) | |
| 1054 | .; | |
| 1055 | .I RCPARM ("AUTO-POS T") D AD2R PT(" ") ; blank line | |
| 1056 | .; | |
| 1057 | .K @RCGLB (344.6) ; delete old data | |
| 1058 | .; RCDPE AUTO-PAY E XCLUSION f ile (#344. 6) | |
| 1059 | .; screen ing logic: ^DD(344.6 ,.07,0)="E XCLUDE MED CLAIMS DE CREASE^S^0 :No;1:Yes; ^0;7^Q" | |
| 1060 | .D LIST^D IC(344.6,, "@;.01;.02 ;.07;2","P ",,,,,"I $ P(^(0),U,7 )=1",,RCGL B(344.6)) | |
| 1061 | .; | |
| 1062 | .; RCDPE PARAMETER file (#344 .61), auto -decrease of medical claims | |
| 1063 | .S X=$$GE T1^DID(344 .61,.03,," TITLE"),V= " (Y/N): " ,V=" (Y/N) " S:X[V X= $P(X,V)_$P (X,V,2) ; remove yes /no prompt | |
| 1064 | .S Y=$J(X ,45)_@RCGL B(344.61)@ (344.61,"1 ,",.03,"E" ) | |
| 1065 | .D AD2RPT (Y) ; ,AD2 RPT(" ") | |
| 1066 | .; PRCA*4 .5*304 - R emoved bec ause auto- decrease a mounts are based on CARCs | |
| 1067 | .I RCPARM ("AUTO-DEC REASE") D ; list the se 2 field s only if auto-decre ase enable d | |
| 1068 | ..;D AD2R PT("NUMBER OF DAYS T O WAIT BEF ORE AUTO-D ECREASE: " _(+$P(RCPA RM(344.61, 0),U,4))) | |
| 1069 | ..D AD2RP T(" MAXIMU M DOLLAR A MOUNT TO A UTO-DECREA SE: "_"$"_ (+$P(RCPAR M(344.61,0 ),U,5))) | |
| 1070 | .; | |
| 1071 | .; PRCA*4 .5*304 - P rint the C ARC Auto-d ecrease pa rameters | |
| 1072 | . I $$CAR CCHK(RCTYP E,"M") D | |
| 1073 | .. D AD2R PT(" "),AD 2RPT(" AUT O-DECREASE MEDICAL C LAIMS FOR THE FOLLOW ING CARC/A MOUNTS ONL Y:"),AD2RP T(" ") | |
| 1074 | .. S RCST RING=$TR($ J("",70)," ","-"),RC I=0 | |
| 1075 | .. D AD2R PT(" CARC Descriptio n Max. Amt ") | |
| 1076 | .. D AD2R PT(" "_RCS TRING) | |
| 1077 | .. ; | |
| 1078 | .. ; Loop and print entries | |
| 1079 | .. F S R CI=$O(^RCY (344.62,RC I)) Q:'RCI D | |
| 1080 | .. . S RC DATA=$G(^R CY(344.62, RCI,0)),Y= "" | |
| 1081 | .. . Q:RC DATA="" | |
| 1082 | .. . S RC CODE=$P(RC DATA,U),RC CIEN=$O(^R C(345,"B", RCCODE,"") ) | |
| 1083 | .. . S RC DESC=$G(^R C(345,RCCI EN,1,1,0)) | |
| 1084 | .. . S RC STAT=$P(RC DATA,U,2) | |
| 1085 | .. . Q:RC STAT'=1 | |
| 1086 | .. . I $L (RCDESC)>5 0 S RCDESC =$E(RCDESC ,1,50)_" . .." | |
| 1087 | .. . D GE TCODES^RCD PCRR(RCCOD E,"","A",$ $DT^XLFDT, "RCCARCD", "1^70") | |
| 1088 | .. . S Y= " "_$J(RCC ODE,4)_" " | |
| 1089 | .. . S Y= Y_$E(RCDES C,1,53) S: $L(RCDESC) <53 Y=Y_$J ("",(53-$L (RCDESC))) S Y=Y_$J( $P(RCDATA, U,6),10,0) | |
| 1090 | .. . I '$ $ACT^RCDPR U(345,RCCO DE,) S Y=Y _" (I)" ; if inacti ve, displa y (i) | |
| 1091 | .. . D AD 2RPT(Y) | |
| 1092 | .. ; | |
| 1093 | ..D AD2RP T(" ") ; b lank line | |
| 1094 | .I (RCPAR M("AUTO-PO ST")!RCPAR M("AUTO-DE CREASE")) D ; list excluded a uto-decrea se payers | |
| 1095 | .. S X=$P ($$GET1^DI D(344.61,. 04,,"TITLE ")," (",1) _": " | |
| 1096 | .. S Y=$J (X,50)_@RC GLB(344.61 )@(344.61, "1,",.04," E") | |
| 1097 | .. D AD2R PT(Y),AD2R PT(" ") | |
| 1098 | .. D AD2R PT(" All p ayers excl uded from Auto-Posti ng are exc luded from Auto-Decr ease.") | |
| 1099 | .. Q:'RCP ARM("AUTO- DECREASE") | |
| 1100 | .. I '$D( @RCGLB(344 .6)@("DILI ST",1,0)) D Q | |
| 1101 | ... S X=" No additi onal payer s excluded from Medi cal Auto-D ecrease." D AD2RPT($ J(" ",80-$ L(X)\2)_X) | |
| 1102 | ..; | |
| 1103 | .. D AD2R PT(" Addit ional Excl uded Payer Comment") | |
| 1104 | .. S RCNT R=0 | |
| 1105 | .. F S R CNTR=$O(@R CGLB(344.6 )@("DILIST ",RCNTR)) Q:'RCNTR D | |
| 1106 | ... S V=@ RCGLB(344. 6)@("DILIS T",RCNTR,0 ),X=$E($P( V,U,2),1,3 5) | |
| 1107 | ... S Y=" "_X_$J(" ",36-$L(X) )_$P(V,U,5 ) | |
| 1108 | ... D AD2 RPT($E(Y,1 ,IOM)) | |
| 1109 | .; | |
| 1110 | .D AD2RPT (" ") ; bl ank line | |
| 1111 | ; | |
| 1112 | K @RCGLB( 344.6) ; d elete old data | |
| 1113 | ; RCDPE A UTO-PAY EX CLUSION fi le (#344.6 ) | |
| 1114 | ; screeni ng logic: ^DD(344.6, .06,0)="EX CLUDE MED CLAIMS POS TING^S^0:N o;1:Yes;^0 ;6^Q" | |
| 1115 | D LIST^DI C(344.6,," @;.01;.02; .08;3","P" ,,,,,"I $P (^(0),U,8) =1",,RCGLB (344.6)) | |
| 1116 | ; | |
| 1117 | ; PRCA*4. 5*304 - Pr int Pharma cy Claim P arameters | |
| 1118 | I RCTYPE' ="M" D | |
| 1119 | .; RCDPE PARAMETER file (#344 .61), auto -posting o f pharmacy claims | |
| 1120 | .S X=$$GE T1^DID(344 .61,1.01,, "TITLE"),V =" (Y/N)" S:X[V X=$P (X,V)_$P(X ,V,2) ; re move yes/n o prompt | |
| 1121 | .S Y=X_" "_@RCGLB(3 44.61)@(34 4.61,"1,", 1.01,"E") | |
| 1122 | .D AD2RPT (Y) | |
| 1123 | .; | |
| 1124 | . I RCPAR M("RX AUTO -POST") D ; list au to-post ex cluded pay ers | |
| 1125 | .. I '$D( @RCGLB(344 .6)@("DILI ST",1,0)) D Q | |
| 1126 | ... S X=" No payers excluded from pharm acy auto-p osting." D AD2RPT($J (" ",80-$L (X)\2)_X) | |
| 1127 | ..; | |
| 1128 | .. D AD2R PT(" Exclu ded Payer Comment") | |
| 1129 | .. S RCNT R=0 | |
| 1130 | .. F S R CNTR=$O(@R CGLB(344.6 )@("DILIST ",RCNTR)) Q:'RCNTR D | |
| 1131 | ... S V=@ RCGLB(344. 6)@("DILIS T",RCNTR,0 ),X=$E($P( V,U,2),1,3 5) | |
| 1132 | ... S Y=" "_X_$J(" ",36-$L(X) )_$P(V,U,5 ) | |
| 1133 | ... D AD2 RPT($E(Y,1 ,IOM)) | |
| 1134 | .. S X=$P ($$GET1^DI D(344.61,1 .02,,"TITL E")," (",1 )_": " ; remove yes /no prompt | |
| 1135 | .. S Y=" "_X_" "_$S (@RCGLB(34 4.61)@(344 .61,"1,",1 .02,"E")=" ":"No",1:@ RCGLB(344. 61)@(344.6 1,"1,",1.0 2,"E")) | |
| 1136 | .. D AD2R PT(" "),AD 2RPT(Y) | |
| 1137 | .; | |
| 1138 | .I RCPARM ("RX AUTO- POST") D A D2RPT(" ") ; blank l ine | |
| 1139 | .; | |
| 1140 | .K @RCGLB (344.6) ; delete old data | |
| 1141 | .; | |
| 1142 | .; PRCA*4 .5*304 - P rint the C ARC Auto-d ecrease pa rameters | |
| 1143 | . I $$CAR CCHK(RCTYP E,"P") D | |
| 1144 | .. S RCST RING=$TR($ J("",73)," ","-"),RC I=0 | |
| 1145 | .. D AD2R PT(" CARC Descriptio n Max. Amt ") | |
| 1146 | .. D AD2R PT(RCSTRIN G) | |
| 1147 | .. ; | |
| 1148 | .. ; Loop and print entries | |
| 1149 | .. F S R CI=$O(^RCY (344.62,RC I)) Q:'RCI D | |
| 1150 | .. . S RC DATA=$G(^R CY(344.62, RCI,0)),Y= "" | |
| 1151 | .. . Q:RC DATA="" | |
| 1152 | .. . S RC CODE=$P(RC DATA,U),RC CIEN=$O(^R C(345,"B", RCCODE,"") ) | |
| 1153 | .. . S RC DESC=$G(^R C(345,RCCI EN,1,1,0)) | |
| 1154 | .. . S RC STAT=$P(RC DATA,U,2) | |
| 1155 | .. . Q:RC STAT'=1 | |
| 1156 | .. . I $L (RCDESC)>5 0 S RCDESC =$E(RCDESC ,1,50)_" . .." | |
| 1157 | .. . D GE TCODES^RCD PCRR(RCCOD E,"","A",$ $DT^XLFDT, "RCCARCD", "1^70") | |
| 1158 | .. . S Y= " "_$E(RCC ODE,1,4)_" " | |
| 1159 | .. . S Y= Y_$E(RCDES C,1,55)_$J ($P(RCDATA ,U,6),10,0 ) | |
| 1160 | .. . I '$ $ACT^RCDPR U(345,RCCO DE,) S Y=Y _" (I)" ; if inacti ve, displa y (i) | |
| 1161 | .. . D AD 2RPT(Y) | |
| 1162 | ; | |
| 1163 | ; RCDPE P ARAMETER f ile (#344. 61) | |
| 1164 | F RCFLD=. 06,.07 D | |
| 1165 | . Q:(RCFL D=.06)&(RC TYPE="P") ; Dont dis play if on ly showing Pharmacy parameters | |
| 1166 | . Q:(RCFL D=.07)&(RC TYPE="M") ; Dont dis play if on ly showing medical p arameters | |
| 1167 | . S Y=$$G ET1^DID(34 4.61,RCFLD ,,"TITLE") _" "_@RCGL B(344.61)@ (344.61,"1 ,",RCFLD," E") | |
| 1168 | . D AD2RP T(Y) | |
| 1169 | ; | |
| 1170 | D AD2RPT( " "),AD2RP T($$ENDORP RT^RCDPEAR L) | |
| 1171 | ; | |
| 1172 | S RCSTOP= 0 U IO D S PHDR(.RCHD R) | |
| 1173 | S J=0 F S J=$O(^TM P($J,"RC S P REPORT", J)) Q:'J!R CSTOP S Y =^TMP($J," RC SP REPO RT",J,0) D | |
| 1174 | .W !,Y Q: '$O(^TMP($ J,"RC SP R EPORT",J)) ; quit if last line | |
| 1175 | .I '$G(ZT SK),$E(IOS T,1,2)="C- ",$Y+3>IOS L D ASK^RC DPEARL(.RC STOP) I 'R CSTOP D SP HDR(.RCHDR ) Q | |
| 1176 | .Q:RCSTOP Q:$Y+2<I OSL | |
| 1177 | .D SPHDR( .RCHDR) | |
| 1178 | ; | |
| 1179 | I '$G(ZTS K),$E(IOST ,1,2)="C-" ,'RCSTOP D ASK^RCDPE ARL(.RCSTO P) | |
| 1180 | ; | |
| 1181 | ; close d evice | |
| 1182 | U IO(0) D ^%ZISC | |
| 1183 | ; | |
| 1184 | S X="RC" F S X=$O( ^TMP($J,X) ) Q:'($E(X ,1,2)="RC" ) K ^TMP($ J,X) ; cle an up | |
| 1185 | ; | |
| 1186 | Q | |
| 1187 | ; | |
| 1188 | �Moved low er down so that decr ease on/of f paramete r and limi t changes are saved if ^ exit is used in $$CARC^RC DPESP5 | |
| 1189 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.