10. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/23/2018 6:40:15 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.

10.1 Files compared

# Location File Last Modified
1 docs TAS epay US318 SDD - Copy.doc Mon Oct 22 16:27:48 2018 UTC
2 docs TAS epay US318 SDD - Copy.doc Mon Oct 22 16:33:13 2018 UTC

10.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 1 996
Changed 0 0
Inserted 0 0
Removed 0 0

10.3 Comparison options

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

10.4 Active regular expressions

No regular expressions were active.

10.5 Comparison detail

  1   MCCF EDI T AS US318
  2   System Des ign Docume nt
  3   PRCA*4.5*x xx
  4  
  5   Department  of Vetera ns Affairs
  6   May 2017
  7   Version 1
  8   Story
  9   As part of  my accoun ts receiva ble job, I  am tasked  with decr easing den ied claim  payments a nd residua l claim ba lances, af ter paymen ts are pos ted.  If t he claim b alances ar e decrease d and the  payer has  sent an ad ditional p ayment, cl erks have  to re-esta blish or i ncrease th e claims t hey just d ecreased,  creating e xtra and u nnecessary  work.  Th is can’t b e prevente d in all c ases, but  if the add itional pa yment/ERA  is sitting  in VistA,  clerks sh ould get a  warning t hat additi onal payme nts are pe nding, whe n attempti ng to comp lete the d ecrease.
  10   Option use d is ‘decr ease adjus tment’.  A fter enter ing the cl aim number , if there  are addit ional unpo sted payme nts, a pro mpt such a s:  additi onal payme nts pendin g on trace  # xxxxxxx xx  would  provide th e informat ion for re search and  determinm ation if t he decreas e should b e complete d.
  11   Conversati on
  12   Decrease A djustments  Option [P RCAC TR DE CREASE]
  13   Investigat e whether  or not can  detect pe nding not  marked for  auto-post  payments  in order t o issue a  warning
  14   PRCEC ADJU ST       I ncrease/De crease Adj ustment??
  15   Include de finition o f what is  a pending  payment in  user manu al
  16   5/10 
  17   Need to in vestigate  how to det ermine out standing E RA lines
  18   Add list o f trace #  and receip t number u nder the w arning mes sage
  19   Revisit on  5/17
  20   5/17/17
  21   Are we cor rect in pi cking up a par and ER A worklist  lines inc luding ERA s that hav e not been  processed  to includ e in the p ending pay ments tota ls? Yes
  22   Add Pendin g amounts  for each t race numbe r under th e warning  message
  23   Revisit on  5/25 afte r Peter do es more in vestigatio n and to w rite accep tance crit eria
  24   Summary
  25   Pending Pa yments API
  26   Existing r outine fun ction PEND PAY^RCDPUR ET returns  a total o f pending  payments f or a debto r account.  This figu re is calc ulated as  the total  of unproce ssed recei pts. A det ailed brea kdown of t he receipt s is also  returned a s global a rray ^TMP( $J,"RCDPUR EC","PP")  but is not  used in t his story.
  27   Menu Optio ns
  28   There are  two menu o ptions tha t allow de crease adj ustments. 
  29   Option [PR CAC TR DEC REASE] wil l be modif ied to dis play a tot al of pend ing paymen ts. 
  30   NAME: PRCA C TR DECRE ASE                   MENU TEXT:  Decrease  Adjustment
  31     TYPE: ru n routine                        CREATOR: S HURMAN,JIL LIAN A
  32     PACKAGE:  ACCOUNTS  RECEIVABLE
  33    DESCRIPTI ON:   This  option en ters an ad justment t hat decrea ses an acc ount's
  34    principal  balance.   
  35     ROUTINE:  DECREASE^ RCBEADJ               TIMESTAMP:  55567,414 96
  36     TIMESTAM P OF PRIMA RY MENU: 5 9422,50574
  37     UPPERCAS E MENU TEX T: DECREAS E ADJUSTME NT
  38   The existi ng DECREAS E^RCBEADJ  routine wh ich will n ow call a  new WARN^R CBEADJ1 ro utine whic h display  a warning  if pending  payments  exist. The  existing  routine PE NDPAY^RCDP URET calcu lates pend ing paymen ts for a c laim – thi s will be  used in WA RN^RCBEADJ 1 but addi tionally t he routine  will scan  ERA and S cratchpads  
  39   This is th e revised  dialog for  the [PRCA C TR DECRE ASE] optio n:
  40   Select OPT ION NAME:  PRCAC TR D ECREASE        Decrea se Adjustm ent
  41   Select (B) ILL or (E) CME#: B//  BILL NUMBE R
  42   Select BIL L:    442- K10103S WO RKMAN'S CO MP.  02/01 /11  DEPT  OF LA      ACTIVE
  43           Pr incipal Ba lance:      1507.90   FY: 11  Pr incipal Ba lance: 150 7.90
  44            I nterest Ba lance:         0.00
  45                Admin Ba lance:         0.00
  46                                --- --------
  47                TOTAL Ba lance:      1507.90
  48   Checking t he bill's  balance .. . IN Balan ce!
  49   Warning –  Pending Pa yments of  $XXXX.XX e xist
  50   Rcpt: XXXX XXXXX      $XX.XX     No Trace N umber
  51   Rcpt: XXXX XXXXX      $XXX.XX    XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXX
  52   Rcpt: XXXX XXXXX      $XXX.XX    XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXX
  53   ERA:  XXXX X          $XX.XX     XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXX
  54   Enter the  DECREASE A djustment  AMOUNT, fr om .01 to  1507.90.
  55     DECREASE  PRINCIPAL  BALANCE B Y: 1.00
  56   If you pro cess the t ransaction , the bill  will look  like:
  57   Current Pr incipal Ba lance:      1507.90
  58     NEW DECR EASE Adjus tment:        -1.00
  59                                --- --------
  60       NEW Pr incipal Ba lance:      1506.90
  61   Are you su re you wan t to enter  this DECR EASE adjus tment ? YE S// 
  62     Adjustme nt Transac tion: 8197 304 has be en added.
  63   Enter a co mment for  the DECREA SE Adjustm ent:
  64   COMMENTS:
  65     THERE AR E NO LINES !
  66     Edit? NO //
  67   Option [PR CEC ADJUST ] is an  I FCAP packa ge option  and will n ot be chan ged. 
  68   NAME: PRCE C ADJUST                         MENU TEXT:  Increase/ Decrease A djustment
  69     TYPE: ru n routine                        CREATOR: S HURMAN,JIL LIAN A
  70     PACKAGE:  IFCAP       
  71    DESCRIPTI ON:   This  option is  used for  creating a n increase /decrease
  72    adjustmen t to an op en, obliga ted 1358.   
  73     ROUTINE:  PRCEADJ                         TIMESTAMP:  55595,403 43
  74     UPPERCAS E MENU TEX T: INCREAS E/DECREASE  ADJUSTMEN T
  75   Protocols
  76   The protoc ol RCDPE E OB WORKLIS T ADJUST a llows decr ease adjus tments but  is not li nked to an y protocol  and can b e consider ed disable d. This pr otocol wil l not be c hanged.
  77   NAME: RCDP E EOB WORK LIST ADJUS T          ITEM TEXT:  Adjust (I nc/Dec)
  78     TYPE: ac tion                             CREATOR: I NGOLD,GILB ERTO
  79     PACKAGE:  ACCOUNTS  RECEIVABLE            ENTRY ACTI ON: D ADJU ST^RCDPEWL 6
  80     TIMESTAM P: 62494,6 4807
  81   Regional C ouncil dat abase inte rface 
  82   The Region al Council  database  is updated  from AR u sing ADJBI LL^RCBEADJ  code shar ed with op tion [PRCA C TR DECRE ASE]. Only  INCREASE  adjustment s are tran smitted. C hanges mad e for User  Story 318  are for D ECREASE ad justments  only and w ill not ch ange this  interface.
  83   RCRCHELP.I NT
  84   INC+15       .   D AD JBILL^RCBE ADJ("INCRE ASE",PRCAB N)
  85   RCRCRT.INT
  86   INC+15       .   D AD JBILL^RCBE ADJ("INCRE ASE",PRCAB N)
  87   Resolution  – Added C hanged Obj ects 
  88   RoutinesAc tivitiesRo utine Name RCBEADJEnh ancement C ategory Ne w Modify D elete No C hangeRTMRe lated Opti onsPRCAC T R DECREASE Related Ro utinesRout ines “Call ed By”Rout ines “Call ed”   PRCA RFD
  89   RCDPEWL6 ( Deprecated )
  90   RCRCHELP
  91   RCRCRTEOB^ PRCADJ      
  92   $$FPS^RCAM FN01     
  93   $$OUTOFBAL ^RCBDBBAL
  94   $$GETABILL ^RCBEUBIL
  95   $$INCDEC^R CBEUTR1  
  96   $$EXEMPT^R CBEUTR2  
  97   $$EDIT433^ RCBEUTRA  
  98   $$LDATE^RC RJR       
  99   DECADJ^RCT CSPU      
  100   SHOWBILL^R CWROFF1  
  101   WARN^RCBEA DJ1Current  LogicADJU ST(RCBETYP E,RCEDI) ;  create an  adjustmen t
  102    ; rcbetyp e = INCREA SE for inc rease or D ECREASE fo r decrease
  103    ; rcedi =  the ien o f the bill  selected  via the ED I Worklist ;ien of 
  104    ; XX the  ERA entry  or null/un defined if  bill shou ld be sele cted
  105    N RCBILLD A
  106    F  D  Q:R CBILLDA<0! $G(RCEDI)
  107    . K RCTRA NDA,RCLIST
  108    . ;
  109    . ; selec t a bill
  110    . S RCBIL LDA=$S('$G (RCEDI):$$ GETABILL^R CBEUBIL,1: +RCEDI)
  111    . I RCBIL LDA<1 Q
  112    . I $D(^P RCA(430,"T CSP",RCBIL LDA)),(RCB ETYPE="INC REASE") W  !,"BILL HA S BEEN REF ERRED TO C ROSS-SERVI CING.",!," NO MANUAL  INCREASE A DJUSTMENTS  ARE ALLOW ED." Q  ;p rca*4.5*30 1
  113    . I $D(^P RCA(430,"T CSP",RCBIL LDA)),(RCB ETYPE="DEC REASE") S  %=2 W !!," IS THIS AC TION BEING  PERFORMED  DUE TO TH E CLAIMS M ATCHING PR OCESS? " D  YN^DICN Q :(%<0)!(%= 2) ;prca*4 .5*301
  114    . ;
  115    . ; adjus t the bill
  116    . D ADJBI LL(RCBETYP E,RCBILLDA ,$P($G(RCE DI),";",2) )
  117    Q
  118    ;
  119   ADJBILL(RC BETYPE,RCB ILLDA,RCED IWL) ; adj ust a bill
  120    ; RCEDIWL  = ien of  ERA entry  if called  from workl ist
  121    N RCAMOUN T,RCBALANC ,RCDATA7,R CLIST,RCON TADJ,RCTRA NDA,TOTALC AL,TOTALST O,I,X,Y
  122    ; lock th e bill
  123    L +^PRCA( 430,RCBILL DA):5 E  W  !,"ANOTHE R USER IS  CURRENTLY  WORKING WI TH THIS BI LL." Q
  124    ;
  125    ; show da ta for the  bill
  126    D SHOWBIL L^RCWROFF1 (RCBILLDA)
  127    ;
  128    ; check t he balance  of the bi ll
  129    W !!,"Che cking the  bill's bal ance ..."
  130    S RCBALAN C=$$OUTOFB AL^RCBDBBA L(RCBILLDA )
  131    I RCBALAN C="" W " I N Balance! "
  132    ;
  133    ; out of  balance, a sk to fix  it
  134    I RCBALAN C'="" D  I  RCBILLDA< 1 D UNLOCK  Q
  135    . S TOTAL CAL=$P(RCB ALANC,"^") +$P(RCBALA NC,"^",2)+ $P(RCBALAN C,"^",3)+$ P(RCBALANC ,"^",4)+$P (RCBALANC, "^",5)
  136    . S RCDAT A7=$G(^PRC A(430,RCBI LLDA,7))
  137    . S TOTAL STO=$P(RCD ATA7,"^")+ $P(RCDATA7 ,"^",2)+$P (RCDATA7," ^",3)+$P(R CDATA7,"^" ,4)+$P(RCD ATA7,"^",5 )
  138    . W " OUT  of Balanc e!"
  139    . W !!,"  BALANCE:", $J("Calcul ated",12), $J("Stored ",12)
  140    . W !," - ------ ",$ J("------- -----",12) ,$J("----- -------",1 2)
  141    . W !," P rincipal B alance:",$ J($P(RCBAL ANC,"^",1) ,12,2),$J( $P(RCDATA7 ,"^",1),12 ,2)
  142    . I +$P(R CBALANC,"^ ",1)'=+$P( RCDATA7,"^ ",1) W " < <-- OUT OF  BALANCE"
  143    . W !," I nterest Ba lance:",$J ($P(RCBALA NC,"^",2), 12,2),$J($ P(RCDATA7, "^",2),12, 2)
  144    . I +$P(R CBALANC,"^ ",2)'=+$P( RCDATA7,"^ ",2) W " < <-- OUT OF  BALANCE"
  145    . W !," A dmin Balan ce:",$J($P (RCBALANC, "^",3),12, 2),$J($P(R CDATA7,"^" ,3),12,2)
  146    . I +$P(R CBALANC,"^ ",3)'=+$P( RCDATA7,"^ ",3) W " < <-- OUT OF  BALANCE"
  147    . W !," M F Balance: ",$J($P(RC BALANC,"^" ,4),12,2), $J($P(RCDA TA7,"^",4) ,12,2)
  148    . I +$P(R CBALANC,"^ ",4)'=+$P( RCDATA7,"^ ",4) W " < <-- OUT OF  BALANCE"
  149    . W !," C C Balance: ",$J($P(RC BALANC,"^" ,5),12,2), $J($P(RCDA TA7,"^",5) ,12,2)
  150    . I +$P(R CBALANC,"^ ",5)'=+$P( RCDATA7,"^ ",5) W " < <-- OUT OF  BALANCE"
  151    . W !," - ------ ",$ J("------- ------",12 ),$J("---- ---------" ,12)
  152    . W !," T OTAL:",$J( TOTALCAL,1 2,2),$J(TO TALSTO,12, 2)
  153    . I +TOTA LCAL'=+TOT ALSTO W "  <<-- OUT O F BALANCE"
  154    . ;
  155    . ; ask t o fix the  balances
  156    . S Y=$$A SKFIX I Y' =1 W !," N OTE: You m ust fix th e Balance  Discrepanc y before p rocessing  an adjustm ent!" S RC BILLDA=0 Q
  157    . ;
  158    . ; fix i t
  159    . S $P(RC DATA7,"^", 1)=+$P(RCB ALANC,"^", 1) ; princ ipal
  160    . S $P(RC DATA7,"^", 2)=+$P(RCB ALANC,"^", 2) ; inter est
  161    . S $P(RC DATA7,"^", 3)=+$P(RCB ALANC,"^", 3) ; admin
  162    . S $P(RC DATA7,"^", 4)=+$P(RCB ALANC,"^", 4) ; marsh al fee
  163    . S $P(RC DATA7,"^", 5)=+$P(RCB ALANC,"^", 5) ; court  cost
  164    . S $P(^P RCA(430,RC BILLDA,7), "^",1,5)=$ P(RCDATA7, "^",1,5)
  165    . ;
  166    . W !," B alance Dis crepancy F IXED!"
  167    ;
  168    ; if the  principal  balance is  zero, do  not allow  it to be a djusted
  169    ; ask to  close/canc el it
  170    I RCBETYP E="DECREAS E",'$G(^PR CA(430,RCB ILLDA,7))  W !!,"Note : This bil l has NO P RINCIPAL B ALANCE to  decrease ! " D INTADM IN(RCBILLD A),UNLOCK  Q
  171    ;
  172    ; If entr y is from  EDI Lockbo x worklist , display  total adju stments in  ERA
  173    N AP D
  174    .N BILL,E OB,ERA,SEQ  S ERA="", AP=0
  175    .F  S ERA =$O(^RCY(3 44.4,"AP", 1,ERA)) Q: 'ERA  D  Q :AP
  176    ..S SEQ=0
  177    ..F  S SE Q=$O(^RCY( 344.4,"AP" ,1,ERA,SEQ )) Q:'SEQ   D  Q:AP
  178    ...S EOB= $P($G(^RCY (344.4,ERA ,1,SEQ,0)) ,U,2) Q:'E OB
  179    ...S:$P($ G(^IBM(361 .1,EOB,0)) ,U)=RCBILL DA AP=1 ;I A #4051
  180    ;
  181    ; Ask to  enter tran saction ev en though  it is mark ed for aut opost PRCA *4.5*298
  182    I RCBETYP E="DECREAS E",AP S Y= $$ASKAUPO( ) I Y'=1 W  !,"Exitin g bill adj ustment."  D UNLOCK Q
  183    ;
  184    ; ask to  enter adju stment amo unt
  185    S RCAMOUN T=$$AMOUNT (RCBILLDA, RCBETYPE)
  186    I RCAMOUN T<0 D UNLO CK Q
  187    ;
  188    ; if decr ease, make  negative
  189    I RCBETYP E="DECREAS E" S RCAMO UNT=-RCAMO UNT
  190    ;
  191    ; ask if  it is a co ntract adj ustment
  192    I RCBETYP E="DECREAS E","^9^28^ 29^30^32^" [("^"_$P($ G(^PRCA(43 0,RCBILLDA ,0)),"^",2 )_"^") S R CONTADJ=$$ ASKCONT I  RCONTADJ<0  D UNLOCK  Q
  193    ;
  194    ; show wh at the new  transacti on will lo ok like
  195    S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
  196    W !!,"If  you proces s the tran saction, t he bill wi ll look li ke:"
  197    W !,"Curr ent Princi pal Balanc e: ",$J($P (RCDATA7," ^"),11,2)
  198    W !," NEW  ",RCBETYP E," Adjust ment: ",$J (RCAMOUNT, 11,2)
  199    W !," --- --------"
  200    W !," NEW  Principal  Balance:  ",$J($P(RC DATA7,"^") +RCAMOUNT, 11,2)
  201    ;
  202    ; ask to  enter tran saction
  203    S Y=$$ASK OK(RCBETYP E) I Y'=1  D UNLOCK Q      
  204    ;
  205   ADDADJ ; a dd adjustm ent
  206    S RCTRAND A=$$INCDEC ^RCBEUTR1( RCBILLDA,R CAMOUNT,"" ,"","",$G( RCONTADJ))
  207    I 'RCTRAN DA W !," * ** W A R N  I N G: Ad justment N OT Process ed! ***" D  UNLOCK Q
  208    I RCTRAND A W !," Ad justment T ransaction : ",RCTRAN DA," has b een added. "
  209    I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D  DECADJ^RCT CSPU(RCBIL LDA,RCTRAN DA) ;prca* 4.5*301 ad d cs decre ase adjust ment
  210    I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD^ %DT W !!,"  * * * * T ransmissio n will be  held until  "_Y_" * *  * *"
  211    ;
  212    ; ask to  enter a co mment
  213    W !!,"Ent er a comme nt for the  ",RCBETYP E," Adjust ment:"
  214    S Y=$$EDI T433^RCBEU TRA(RCTRAN DA,"41;")
  215    ;
  216    ; ask to  exempt int erest and  admin char ges
  217    I RCBETYP E="DECREAS E" D INTAD MIN(RCBILL DA)
  218    ;
  219    ; notific ation of s ubsequent  payer bull etin
  220    S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7)),X=0
  221    F I=1:1:5  S X=X+$P( RCDATA7,"^ ",I)
  222    I RCDATA7 '="",'X D
  223    . N PRCAB N,PRCAEN,P RCAMT
  224    . S PRCAB N=RCBILLDA ,PRCAEN=RC TRANDA,PRC AMT=+$P($G (^PRCA(433 ,RCTRANDA, 1)),"^",5)
  225    . D EOB^P RCADJ
  226    ;
  227    ; unlock  and ask th e next bil l to adjus t
  228    D UNLOCK
  229    Q
  230    ;
  231   ASKOK(RCBE TYPE) ; as k record d ecrease or  increase  transactio n
  232    N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
  233    S DIR(0)= "YO",DIR(" B")="YES"
  234    S DIR("A" )="Are you  sure you  want to en ter this " _RCBETYPE_ " adjustme nt "
  235    W ! D ^DI R
  236    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  237    Q Y
  238    ;
  239   ASKAUPO()  ; ask reco rd even th ough marke d for auto  post PRCA *4.5*298
  240    N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
  241    S DIR(0)= "YOA",DIR( "B")="NO"
  242    S DIR("A" )="Marked  for Auto-P ost. Are y ou sure? ( Y/N) "
  243    W ! D ^DI R
  244    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  245    Q Y
  246    ;
  247   ASKFIX() ;  ask to fi x bill's b alance
  248    N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
  249    S DIR(0)= "YO",DIR(" B")="YES"
  250    S DIR("A" )=" Do you  want to F IX the bal ance discr epancy "
  251    W ! D ^DI R
  252    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  253    Q YModifi ed Logic ( Changes ar e in bold) ADJUST(RCB ETYPE,RCED I) ; creat e an adjus tment
  254    ; rcbetyp e = INCREA SE for inc rease or D ECREASE fo r decrease
  255    ; rcedi =  the ien o f the bill  selected  via the ED I Worklist ;ien of 
  256    ; XX the  ERA entry  or null/un defined if  bill shou ld be sele cted
  257    N RCBILLD A
  258    F  D  Q:R CBILLDA<0! $G(RCEDI)
  259    . K RCTRA NDA,RCLIST
  260    . ;
  261    . ; selec t a bill
  262    . S RCBIL LDA=$S('$G (RCEDI):$$ GETABILL^R CBEUBIL,1: +RCEDI)
  263    . I RCBIL LDA<1 Q
  264    . I $D(^P RCA(430,"T CSP",RCBIL LDA)),(RCB ETYPE="INC REASE") W  !,"BILL HA S BEEN REF ERRED TO C ROSS-SERVI CING.",!," NO MANUAL  INCREASE A DJUSTMENTS  ARE ALLOW ED." Q  ;p rca*4.5*30 1
  265    . I $D(^P RCA(430,"T CSP",RCBIL LDA)),(RCB ETYPE="DEC REASE") S  %=2 W !!," IS THIS AC TION BEING  PERFORMED  DUE TO TH E CLAIMS M ATCHING PR OCESS? " D  YN^DICN Q :(%<0)!(%= 2) ;prca*4 .5*301
  266    . ;
  267    . ; adjus t the bill
  268    . D ADJBI LL(RCBETYP E,RCBILLDA ,$P($G(RCE DI),";",2) )
  269    Q
  270    ;
  271   ADJBILL(RC BETYPE,RCB ILLDA,RCED IWL) ; adj ust a bill
  272    ; RCEDIWL  = ien of  ERA entry  if called  from workl ist
  273    N RCAMOUN T,RCBALANC ,RCDATA7,R CLIST,RCON TADJ,RCTRA NDA,TOTALC AL,TOTALST O,I,X,Y
  274    ; lock th e bill
  275    L +^PRCA( 430,RCBILL DA):5 E  W  !,"ANOTHE R USER IS  CURRENTLY  WORKING WI TH THIS BI LL." Q
  276    ;
  277    ; show da ta for the  bill
  278    D SHOWBIL L^RCWROFF1 (RCBILLDA)
  279    ;
  280    ; check t he balance  of the bi ll
  281    W !!,"Che cking the  bill's bal ance ..."
  282    S RCBALAN C=$$OUTOFB AL^RCBDBBA L(RCBILLDA )
  283    I RCBALAN C="" W " I N Balance! "
  284    ;
  285    ; out of  balance, a sk to fix  it
  286    I RCBALAN C'="" D  I  RCBILLDA< 1 D UNLOCK  Q
  287    . S TOTAL CAL=$P(RCB ALANC,"^") +$P(RCBALA NC,"^",2)+ $P(RCBALAN C,"^",3)+$ P(RCBALANC ,"^",4)+$P (RCBALANC, "^",5)
  288    . S RCDAT A7=$G(^PRC A(430,RCBI LLDA,7))
  289    . S TOTAL STO=$P(RCD ATA7,"^")+ $P(RCDATA7 ,"^",2)+$P (RCDATA7," ^",3)+$P(R CDATA7,"^" ,4)+$P(RCD ATA7,"^",5 )
  290    . W " OUT  of Balanc e!"
  291    . W !!,"  BALANCE:", $J("Calcul ated",12), $J("Stored ",12)
  292    . W !," - ------ ",$ J("------- -----",12) ,$J("----- -------",1 2)
  293    . W !," P rincipal B alance:",$ J($P(RCBAL ANC,"^",1) ,12,2),$J( $P(RCDATA7 ,"^",1),12 ,2)
  294    . I +$P(R CBALANC,"^ ",1)'=+$P( RCDATA7,"^ ",1) W " < <-- OUT OF  BALANCE"
  295    . W !," I nterest Ba lance:",$J ($P(RCBALA NC,"^",2), 12,2),$J($ P(RCDATA7, "^",2),12, 2)
  296    . I +$P(R CBALANC,"^ ",2)'=+$P( RCDATA7,"^ ",2) W " < <-- OUT OF  BALANCE"
  297    . W !," A dmin Balan ce:",$J($P (RCBALANC, "^",3),12, 2),$J($P(R CDATA7,"^" ,3),12,2)
  298    . I +$P(R CBALANC,"^ ",3)'=+$P( RCDATA7,"^ ",3) W " < <-- OUT OF  BALANCE"
  299    . W !," M F Balance: ",$J($P(RC BALANC,"^" ,4),12,2), $J($P(RCDA TA7,"^",4) ,12,2)
  300    . I +$P(R CBALANC,"^ ",4)'=+$P( RCDATA7,"^ ",4) W " < <-- OUT OF  BALANCE"
  301    . W !," C C Balance: ",$J($P(RC BALANC,"^" ,5),12,2), $J($P(RCDA TA7,"^",5) ,12,2)
  302    . I +$P(R CBALANC,"^ ",5)'=+$P( RCDATA7,"^ ",5) W " < <-- OUT OF  BALANCE"
  303    . W !," - ------ ",$ J("------- ------",12 ),$J("---- ---------" ,12)
  304    . W !," T OTAL:",$J( TOTALCAL,1 2,2),$J(TO TALSTO,12, 2)
  305    . I +TOTA LCAL'=+TOT ALSTO W "  <<-- OUT O F BALANCE"
  306    . ;
  307    . ; ask t o fix the  balances
  308    . S Y=$$A SKFIX I Y' =1 W !," N OTE: You m ust fix th e Balance  Discrepanc y before p rocessing  an adjustm ent!" S RC BILLDA=0 Q
  309    . ;
  310    . ; fix i t
  311    . S $P(RC DATA7,"^", 1)=+$P(RCB ALANC,"^", 1) ; princ ipal
  312    . S $P(RC DATA7,"^", 2)=+$P(RCB ALANC,"^", 2) ; inter est
  313    . S $P(RC DATA7,"^", 3)=+$P(RCB ALANC,"^", 3) ; admin
  314    . S $P(RC DATA7,"^", 4)=+$P(RCB ALANC,"^", 4) ; marsh al fee
  315    . S $P(RC DATA7,"^", 5)=+$P(RCB ALANC,"^", 5) ; court  cost
  316    . S $P(^P RCA(430,RC BILLDA,7), "^",1,5)=$ P(RCDATA7, "^",1,5)
  317    . ;
  318    . W !," B alance Dis crepancy F IXED!"
  319    ;
  320    ; if the  principal  balance is  zero, do  not allow  it to be a djusted
  321    ; ask to  close/canc el it
  322    I RCBETYP E="DECREAS E",'$G(^PR CA(430,RCB ILLDA,7))  W !!,"Note : This bil l has NO P RINCIPAL B ALANCE to  decrease ! " D INTADM IN(RCBILLD A),UNLOCK  Q
  323    ;
  324    ; If entr y is from  EDI Lockbo x worklist , display  total adju stments in  ERA
  325    N AP D
  326    .N BILL,E OB,ERA,SEQ  S ERA="", AP=0
  327    .F  S ERA =$O(^RCY(3 44.4,"AP", 1,ERA)) Q: 'ERA  D  Q :AP
  328    ..S SEQ=0
  329    ..F  S SE Q=$O(^RCY( 344.4,"AP" ,1,ERA,SEQ )) Q:'SEQ   D  Q:AP
  330    ...S EOB= $P($G(^RCY (344.4,ERA ,1,SEQ,0)) ,U,2) Q:'E OB
  331    ...S:$P($ G(^IBM(361 .1,EOB,0)) ,U)=RCBILL DA AP=1 ;I A #4051
  332    ;
  333    ; Ask to  enter tran saction ev en though  it is mark ed for aut opost PRCA *4.5*298
  334    I RCBETYP E="DECREAS E",AP S Y= $$ASKAUPO( ) I Y'=1 W  !,"Exitin g bill adj ustment."  D UNLOCK Q
  335    ;
  336    ; Display  warning f or decreas e adjustme nt if pend ing paymen ts exist
  337    I RCBETYP E="DECREAS E" D WARN^ RCBEADJ1(R CBILLDA)
  338    ;
  339    ; ask to  enter adju stment amo unt
  340    S RCAMOUN T=$$AMOUNT (RCBILLDA, RCBETYPE)
  341    I RCAMOUN T<0 D UNLO CK Q
  342    ;
  343    ; if decr ease, make  negative
  344    I RCBETYP E="DECREAS E" S RCAMO UNT=-RCAMO UNT
  345    ;
  346    ; ask if  it is a co ntract adj ustment
  347    I RCBETYP E="DECREAS E","^9^28^ 29^30^32^" [("^"_$P($ G(^PRCA(43 0,RCBILLDA ,0)),"^",2 )_"^") S R CONTADJ=$$ ASKCONT I  RCONTADJ<0  D UNLOCK  Q
  348    ;
  349    ; show wh at the new  transacti on will lo ok like
  350    S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
  351    W !!,"If  you proces s the tran saction, t he bill wi ll look li ke:"
  352    W !,"Curr ent Princi pal Balanc e: ",$J($P (RCDATA7," ^"),11,2)
  353    W !," NEW  ",RCBETYP E," Adjust ment: ",$J (RCAMOUNT, 11,2)
  354    W !," --- --------"
  355    W !," NEW  Principal  Balance:  ",$J($P(RC DATA7,"^") +RCAMOUNT, 11,2)
  356    ;
  357    ; ask to  enter tran saction
  358    S Y=$$ASK OK(RCBETYP E) I Y'=1  D UNLOCK Q
  359    ;
  360   ADDADJ ; a dd adjustm ent
  361    S RCTRAND A=$$INCDEC ^RCBEUTR1( RCBILLDA,R CAMOUNT,"" ,"","",$G( RCONTADJ))
  362    I 'RCTRAN DA W !," * ** W A R N  I N G: Ad justment N OT Process ed! ***" D  UNLOCK Q
  363    I RCTRAND A W !," Ad justment T ransaction : ",RCTRAN DA," has b een added. "
  364    I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D  DECADJ^RCT CSPU(RCBIL LDA,RCTRAN DA) ;prca* 4.5*301 ad d cs decre ase adjust ment
  365    I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD^ %DT W !!,"  * * * * T ransmissio n will be  held until  "_Y_" * *  * *"
  366    ;
  367    ; ask to  enter a co mment
  368    W !!,"Ent er a comme nt for the  ",RCBETYP E," Adjust ment:"
  369    S Y=$$EDI T433^RCBEU TRA(RCTRAN DA,"41;")
  370    ;
  371    ; ask to  exempt int erest and  admin char ges
  372    I RCBETYP E="DECREAS E" D INTAD MIN(RCBILL DA)
  373    ;
  374    ; notific ation of s ubsequent  payer bull etin
  375    S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7)),X=0
  376    F I=1:1:5  S X=X+$P( RCDATA7,"^ ",I)
  377    I RCDATA7 '="",'X D
  378    . N PRCAB N,PRCAEN,P RCAMT
  379    . S PRCAB N=RCBILLDA ,PRCAEN=RC TRANDA,PRC AMT=+$P($G (^PRCA(433 ,RCTRANDA, 1)),"^",5)
  380    . D EOB^P RCADJ
  381    ;
  382    ; unlock  and ask th e next bil l to adjus t
  383    D UNLOCK
  384    Q
  385    ;
  386   ASKOK(RCBE TYPE) ; as k record d ecrease or  increase  transactio n
  387    N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
  388    S DIR(0)= "YO",DIR(" B")="YES"
  389    S DIR("A" )="Are you  sure you  want to en ter this " _RCBETYPE_ " adjustme nt "
  390    W ! D ^DI R
  391    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  392    Q Y
  393    ;
  394   ASKAUPO()  ; ask reco rd even th ough marke d for auto  post PRCA *4.5*298
  395    N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
  396    S DIR(0)= "YOA",DIR( "B")="NO"
  397    S DIR("A" )="Marked  for Auto-P ost. Are y ou sure? ( Y/N) "
  398    W ! D ^DI R
  399    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  400    Q Y
  401    ;
  402   ASKFIX() ;  ask to fi x bill's b alance
  403    N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
  404    S DIR(0)= "YO",DIR(" B")="YES"
  405    S DIR("A" )=" Do you  want to F IX the bal ance discr epancy "
  406    W ! D ^DI R
  407    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  408    Q Y
  409    ;Routines Activities Routine Na meRCBEADJ1 Enhancemen t Category  New Modif y Delete N o ChangeRT MRelated O ptionsPRCA C TR DECRE ASERelated  RoutinesR outines “C alled By”R outines “C alled”   R CBEADJ$$GE T1^DIQ
  410   $$PENDPAY^ RCDPURETCu rrent Logi cN/AModifi ed Logic ( Changes ar e in bold) RCBEADJ1 ; ALB/PJH -  PENDING PA YMENTS ;24 -FEB-03
  411    ;;4.5;Acc ounts Rece ivable;**1 73,276,321 **;Mar 20,  1995;Buil d 87
  412    ;;Per VHA  Directive  2004-038,  this rout ine should  not be mo dified.
  413    Q
  414   WARN(DEBTO R) ; Displ ay warning  if pendin g payments  exist EP  ^RCBEADJ 
  415    ; Input –  DEBTOR =  Pointer to  Debtor (e .g. "29061 3;PRCA(430 ,")
  416    ; Output  – None – o utput to s creen only
  417    ;
  418    N RCAMT,R CBILLDA,RC EOB,RCERA, RCLINE,RCP AID,RCPEND ,RCRCPT,RC RCPTN,RCSU B,RCTOT,RC TRACE,RCTR ANDA,RCZ,R CZL
  419    ; Check f or valid i nput
  420    S RCBILLD A=+DEBTOR
  421    Q:'RCBILL DA
  422    ; Check f or unproce ssed recei pts
  423    S RCPEND= $$PENDPAY^ RCDPURET(D EBTOR)
  424    ; Extract  receipt n umbers and  amounts p aid on ind ividual li nes for pe nding rece ipts
  425    S RCRCPT= 0
  426    F  S RCRC PT=$O(^TMP ($J,"RCDPU REC","PP", RCRCPT)) Q :'RCRCPT   D
  427    . S RCRCP TN=$$GET1^ DIQ(344,RC RCPT_",",. 01) Q:RCRC PTN=""
  428    . S RCPEN D("R",RCRC PTN)=0
  429    . S RCTRA NDA=0
  430    . F  S RC TRANDA=$O( ^TMP($J,"R CDPUREC"," PP",RCRCPT ,RCTRANDA) ) Q:'RCTRA NDA  D
  431    . . S RCA MT=$P($G(^ TMP($J,"RC DPUREC","P P",RCRCPT, RCTRANDA)) ,U,4) Q:+R CAMT=0
  432    . . S RCP END("R",RC RCPTN)=RCP END("R",RC RCPTN)+RCA MT
  433    . . ;Alte rnative co de
  434    . . S RCE RA=$$GET1^ DIQ(344,RC RCPT_",",. 18,"I")
  435    . . S RCT RACE=$S(RC ERA:$$GET1 ^DIQ(344.4 ,RCERA_"," ,.02,"I"), 1:"No Trac e Number")
  436    . . S RCP END("R",RC RCPTN,"T") =RCTRACE
  437    ; Clear ^ TMP array  returned b y $$PENDPA Y
  438    K ^TMP($J ,"RCDPUREC ","PP")
  439    ; Find EE OB's for t his claim
  440    S RCEOB=0
  441    F  S RCEO B=$O(^IBM( 361.1,"B", RCBILLDA,R CEOB)) Q:' RCEOB  D
  442    . ;Find E RAs for th is EOB - m ay be mult iple
  443    . S RCERA =0
  444    . F  S RC ERA=$O(^RC Y(344.4,"A DET",RCEOB ,RCERA)) Q :'RCERA  D
  445    . . ; Ign ore ERA wh ich alread y has a re ceipt - pr ocessed or  otherwise
  446    . . I $$G ET1^DIQ(34 4.4,RCERA_ ",",.08,"I ") Q
  447    . . ; Get  ERA lines  for this  EOB
  448    . . S RCL INE=0,RCTO T=0
  449    . . F  S  RCLINE=$O( ^RCY(344.4 ,"ADET",RC EOB,RCERA, RCLINE)) Q :'RCLINE   D
  450    . . . ; G et paid am ount from  ERA line
  451    . . . S R CPAID=$$GE T1^DIQ(344 .41,RCLINE _","_RCERA _",",.03)
  452    . . . ; I gnore zero  lines
  453    . . . Q:' RCPAID
  454    . . . ; I f no scrat chpad use  paid amoun t from ERA  - does no t take int o account  ERA level  adjustment s
  455    . . . I ' $D(^RCY(34 4.49,RCERA )) S RCTOT =RCTOT+RCP AID Q
  456    . . . ; F ind ERA li ne in scra tchpad
  457    . . . S R CZL=$$FIND (RCERA,RCL INE) Q:'RC ZL
  458    . . . ; I f scratchp ad exists  scan B ind ex for spl it lines(3 44.49 is D INUM with  344.4)
  459    . . . S R CSUB=RCZL
  460    . . . F   S RCSUB=$O (^RCY(344. 49,RCERA,1 ,"B",RCSUB )) Q:(RCSU B\1)'=RCZL   D
  461    . . . . S  RCZ=$O(^R CY(344.49, RCERA,1,"B ",RCSUB,"" )) Q:'RCZ
  462    . . . . ;  Check AR  BILL is fo r this cla im
  463    . . . . Q :$$GET1^DI Q(344.491, RCZ_","_RC ERA_",",.0 7,"I")'=RC BILLDA
  464    . . . . ;  Add AMOUN T TO POST  ON RECEIPT  to pendin g total -  should res olve rever sals
  465    . . . . S  RCTOT=RCT OT+$$GET1^ DIQ(344.49 1,RCZ_","_ RCERA_",", .03)
  466    . . ; If  claim tota l for the  ERA is non -zero save  trace num ber and pa id amount
  467    . . Q:RCT OT=0
  468    . . ; Oth erwise get  Trace num ber
  469    . . S RCT RACE=$$GET 1^DIQ(344. 4,RCERA_", ",.02,"I")
  470    . . S RCP END=RCPEND +RCTOT
  471    . . ; Sav e totals b y ERA
  472    . . S RCP END("E",RC ERA)=RCTOT ,RCPEND("E ",RCERA,"T ")=$S(RCTR ACE'="":RC TRACE,1:"N o Trace Nu mber")
  473    Q:'RCPEND
  474    W !!,"War ning - Pen ding Payme nts of $"_ $J(RCPEND, 0,2)_" exi st."
  475    ; List un processed  receipts
  476    S RCRCPTN =""
  477    F  S RCRC PTN=$O(RCP END("R",RC RCPTN)) Q: RCRCPTN=""   D
  478    . W !,"Rc pt:",RCRCP TN,?20,"$" ,$J(RCPEND ("R",RCRCP TN),0,2),? 30,$G(RCPE ND("R",RCR CPTN,"T"))
  479    ; List un processed  EOB
  480    S RCERA=" "
  481    F  S RCER A=$O(RCPEN D("E",RCER A)) Q:'RCE RA  W !,"E RA :",RCER A,?20,"$", $J(RCPEND( "E",RCERA) ,0,2),?30, $G(RCPEND( "E",RCERA, "T"))
  482    Q
  483    ;
  484   FIND(RCERA ,RCLINE) ;  Search OR IGINAL ERA  SEQUENCES  for this  line
  485    ; Input R CERA - Scr atchpad IE
  486    ; RCLINE  - ERA line  to find
  487    ; Output  RET - Scra tchpad lin e number
  488    ;
  489    N DA,ORIG ,RCSUB,RET
  490    S RCSUB=0 ,RET=0
  491    F  S RCSU B=$O(^RCY( 344.49,RCE RA,1,"ASEQ ",RCSUB))  Q:RET  Q:' RCSUB  D
  492    . S DA=$O (^RCY(344. 49,RCERA,1 ,"ASEQ",RC SUB,"")) Q :'DA
  493    . ;Get Or iginal seq uences
  494    . S ORIG= $$GET1^DIQ (344.491,D A_","_RCER A_",",.09)  Q:ORIG=""
  495    . ;Check  if scratch pad line i s for orig inal ERA l ine
  496    . S ORIG= ","_ORIG_" ,"
  497    . S:$F(OR IG,","_RCL INE_",") R ET=RCSUB
  498    Q RET