26. EPMO Open Source Coordination Office Redaction File Detail Report

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

26.1 Files compared

# Location File Last Modified
1 docs TAS ePay US778 SDD - Copy.doc Mon Oct 22 16:27:48 2018 UTC
2 docs TAS ePay US778 SDD - Copy.doc Mon Oct 22 16:32:40 2018 UTC

26.2 Comparison summary

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

26.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

26.4 Active regular expressions

No regular expressions were active.

26.5 Comparison detail

  1   MCCF EDI T AS US778
  2   System Des ign Docume nt
  3   PRCA*4.5*x xx
  4  
  5   Department  of Vetera ns Affairs
  6   August 201 7
  7   Version 1
  8   User Story  Name:  Al low for Ne gative Dis tributions  to 'claim  not found  in AR'
  9   Sizing: 
  10   Author: Ch ad Morriso n
  11   Story
  12   As an ePay ments user , I need t o enhance  VistA to d istribute  the offset  associate d with a c laim with  a "CLAIM N OT FOUND I N AR" comm ent for al l claims ( VA or non- VA). 
  13   Conversati on
  14   Summary:
  15   The ERA Wo rklist Scr atchpad Sc reen actio n ‘Distrib ute Adj Am ts’  (prot ocol RCDPE  EOB WORKL IST DIST A DJ) is mod ified to a llow PLB a djustments  to be dis tributed t o lines wh ich have n o valid cl aim.
  16   The reason  for this  change is  that payer s occasion ally retur n non-Vist A claim pa yments as  a payment  line with  a balancin g adjustme nt. Curren t function ality does  not allow  these adj ustments t o be distr ibuted to  the non-Vi stA claim  line.  
  17   The change d routine  is DISTADJ ^RCDPEWL6.
  18   The change  does not  apply to A PAR.
  19   Example di alog:
  20   ERA Workli st/Scratch  Pad       Jul 06, 20 17@15:03:2 3           Page:     1 of    1 
  21   ERA Entry  #: 92851               Total Amt  Pd: 186.6 6        C urrent Vie w:
  22   Payer Name /ID: AETNA  -CONTINEN TAL LIFE I NSURANCE C OMPANY OFN O SORT ORD ERBRENTWOO
  23   PAPER CHEC K #: ABC64 47035913                                  U NPOSTED EE OBs ONLY
  24   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  25   1       EE OB Seq # O n ERA: ADJ 1   Net Pa yment Amt:  -177.72
  26          1.0 01***ADJUS TMENT AT E RA LEVEL
  27            P ayment Amt : 0.00   T otal Adjus tments: -1 77.72  Net : -177.72
  28            A DJUSTMENTS :
  29               1.  Non-s pecific re traction ( ref# TEST  ): -177.72
  30   .......... .......... .......... .......... .......... .......... .......... ........
  31   2       EE OB Seq # O n ERA: 2    Net Payme nt Amt: 17 7.72
  32          2.0 01 Claim # : 442-BOGU S Patient/ Last 4: 
  33            * **CLAIM NO T FOUND IN  YOUR AR * **
  34            P ayment Amt : 177.72    Total Adj ustments:  0.00  Net:  177.72
  35   .......... .......... .......... .......... .......... .......... .......... ........
  36   3    (V)EE OB Seq # O n ERA: 1    Net Payme nt Amt: 18 6.66
  37          3.0 01 Claim # : K100005  Patient/La st 4: HEIN E,ALFONSO  LAWRENCE/8 168
  38            C laim Bal:  199.18   B illed Amt:  186.66    Amt To Pos t: 186.66
  39            S vc Dt: 7/1 0/00  COB:  NO   Rx C opay: NON- EXEMPT  Me ans Tst: Y ES
  40            P ayment Amt : 186.66    Total Adj ustments:  0.00  Net:  186.66
  41   .......... .......... .......... .......... .......... .......... .......... ........
  42   Select Act ion: Next  Screen//Di stribute A dj Amts
  43   SELECT A L INE THAT N EEDS AN AD JUSTMENT A MOUNT DIST RIBUTED: 1 .001// 
  44     LINE #:  1.001  AMO UNT NEEDED  TO DISTRI BUTE: -177 .72
  45   SELECT A L INE TO DIS TRIBUTE TH E ADJUSTME NT AMOUNT  TO: ? 
  46   THE FOLLOW ING LINE(S ) HAVE A N ET PAYMENT  THAT CAN  BE USED TO  OFFSET TH E
  47     NEGATIVE  NET PAYME NT FOR LIN E 1.001 (- 177.72):
  48        3.001             186.66
  49        2.001             177.72
  50   SELECT A L INE TO DIS TRIBUTE TH E ADJUSTME NT AMOUNT  TO: 2.001
  51     LINE #:  2.001  LIN E BALANCE:  177.72
  52   ADJUSTMENT  AMOUNT TO  DISTRIBUT E: 177.72/
  53   DECREASE A DJ COMMENT  (1-60 CHA RACTERS): 
  54     > RETRAC TED FOR ER A ADJ #1 R ef: TEST    Replace
  55   ERA Workli st/Scratch  Pad       Jul 06, 20 17@15:10:2 2           Page:     1 of    1 
  56   ERA Entry  #: 92851               Total Amt  Pd: 186.6 6        C urrent Vie w:
  57   Payer Name /ID: AETNA  -CONTINEN TAL LIFE I NSURANCE C OMPANY OFN O SORT ORD ERBRENTWOO
  58   PAPER CHEC K #: ABC64 47035913                                  U NPOSTED EE OBs ONLY
  59   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  60   1       EE OB Seq # O n ERA: ADJ 1   Net Pa yment Amt:  0.00
  61          1.0 01***ADJUS TMENT AT E RA LEVEL
  62            P ayment Amt : 0.00   T otal Adjus tments: 0. 00  Net: 0 .00
  63            A DJUSTMENTS :
  64               1.  Non-s pecific re traction ( ref# TEST  ): -177.72
  65               2.  Adjus tment dist ribution t o balance  receipt: 1 77.72
  66                   RETRA CTED FUNDS  DEDUCTED  FROM OTHER  PAYMENT O N THIS ERA
  67   .......... .......... .......... .......... .......... .......... .......... ........
  68   2       EE OB Seq # O n ERA: 2    Net Payme nt Amt: 0. 00
  69          2.0 01 Claim # : 442-BOGU S Patient/ Last 4: 
  70            * **CLAIM NO T FOUND IN  YOUR AR * **
  71            P ayment Amt : 177.72    Total Adj ustments:  -177.72  N et: 0.00
  72            A DJUSTMENTS :
  73               1.  Distr ibuted adj  dec for r etraction  TEST : -17 7.72
  74                   RETRA CTED FOR E RA ADJ #1  Ref: TEST 
  75   .......... .......... .......... .......... .......... .......... .......... ........
  76   3    (V)EE OB Seq # O n ERA: 1    Net Payme nt Amt: 18 6.66
  77          3.0 01 Claim # : K100005  Patient/La st 4: HEIN E,ALFONSO  LAWRENCE/8 168
  78            C laim Bal:  199.18   B illed Amt:  186.66    Amt To Pos t: 186.66
  79            S vc Dt: 7/1 0/00  COB:  NO   Rx C opay: NON- EXEMPT  Me ans Tst: Y ES
  80            P ayment Amt : 186.66    Total Adj ustments:  0.00  Net:  186.66
  81   .......... .......... .......... .......... .......... .......... .......... ........
  82   EEOB WORKL IST PREVIE W RECEIPT  Jul 06, 20 17@15:14:4 2           Page:     1 of    1 
  83   ERA Entry  #: 92851               Total Amt  Pd: 186.6 6        C urrent Vie w:
  84   Payer Name /ID: AETNA  -CONTINEN TAL LIFE I NSURANCE C OMPANY OFN O SORT ORD ERBRENTWOO
  85   PAPER CHEC K #: ABC64 47035913                                  U NPOSTED EE OBs ONLY
  86    LINE #      ACCOUNT                          AMOUNT                                   
  87   PAYMENTS ( LINES FOR  RECEIPT):                                                        
  88    3.001       442-K100 005                     186.66                                   
  89   ZERO DOLLA R PAYMENTS :                                                                
  90    1.001       **ADJ1                           0.00                                     
  91    2.001       442-BOGU S                       0.00                                     
  92                Dec adj  $177.72 pe nding -                                               
  93                    RETR ACTED FOR  ERA ADJ #1  Ref: TEST                                 
  94              Enter ?? f or more ac tions                                                 
  95     Print Re ceipt Prev iew     Cr eate Recei pt             Exit
  96   Select Act ion: Quit/ / C   Crea te Receipt   
  97   Receipt Pr ofile                 Jul 06, 20 17@15:17:3 3           Page:     1 of    1 
  98      Receipt  #: E17070 600                 T ype of Pay ment: CHEC K/MO PAYME NT
  99      Deposit  #:              ERA  #: 92851   Receipt St atus: OPEN
  100   FMS Docume nt: NOTSEN T                     FMS Doc St atus: NOT  ENTERED
  101    #    Acco unt                       Pay Da te  Open B y  Edit By   Pay Amt   Proc Amt 
  102   1     442- K100005                   07/06/ 17  PH                   186.66       0.00 
  103     WARNING:  Pending P ayments ($  1400.08)  exceed amo unt billed  ($ 199.18 )         
  104                                                                      --------   -------- 
  105         TOTA L DOLLARS  FOR RECEIP T                                   186.66       0.00 
  106   Receipt Hi story                                                                       
  107      Opened  By: HARTLE Y,PETER             D ate/Time     Opened:  JUL 06, 20 17        
  108   Last Edit  By:                            D ate/Time L ast Edit:                       
  109   Processed  By:                            D ate/Time P rocessed:                       
  110              Enter ?? f or more ac tions                                                 
  111   NP New Pay ment             AP A ccount Pro file         PR Proce ss Receipt
  112   EP Edit Pa yment            RR R eprint Rec eipt         21 (215  Report)
  113   CP Cancel  Payment          WL W orklist (E RA)          EA Exit  Action
  114   MP Move Pa yment            CU C ustomize                CR Enter ed Online
  115                               ER E dit Receip t
  116   Select Act ion: Quit/ /
  117   Resolution  – Added C hanged Obj ects 
  118   RoutinesAc tivitiesRo utine Name RCDPEWL6En hancement  Category N ew Modify  Delete No  ChangeRTMR elated Opt ionsRCDPE  EDI LOCKBO X WORKLIST
  119   (protocol  RCDPE EOB  WORKLIST D IST ADJ)Re lated Rout inesRoutin es “Called  By”Routin es “Called ”   RCDPEW L2$$GET1^D IQ           
  120   ^DIR                 
  121   $$IB^IBRUT L         
  122   ADJUST^RCB EADJ      
  123   $$GETABILL ^RCBEUBIL 
  124   NOBATCH^RC DPEWL     
  125   NOEDIT^RCD PEWL      
  126   BLD^RCDPEW L1           NOTAV^RC DPEWL2       
  127   RET^RCDPEW L2        
  128   DISTADJ^RC DPEWL4    
  129   ADDLINES^R CDPEWLA   
  130   NOEDIT^RCD PEWLP     
  131   $$BILL^RCJ IBFN2     
  132   FULL^VALM1           
  133   PAUSE^VALM 1          Current Lo gicRCDPEWL 6 ;ALB/TMK /KML - ELE CTRONIC EO B WORKLIST  ACTIONS ; Jun 06, 20 14@19:11:1 9
  134    ;;4.5;Acc ounts Rece ivable;**1 73,208,222 ,276,298,3 03,318**;M ar 20, 199 5;Build 84
  135    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  136    Q
  137    ;
  138   DISTADJ ;E P - Protoc ol action  - RCDPE EO B WORKLIST  DIST ADJ
  139    ; Distrib ute an adj ustment th at retract s a paymen t to other  bill(s)
  140    ; NOTE: R CSCR is as sumed to b e the IEN  of the ERA  entry in  file 344.4 9
  141    N RCDA,RC DA1,RCAMT, RCADJ,RCQU IT,Z,Z0,Z1 ,DIR,X,Y,C T,RCZ,RCZ1 ,RCZ2,RCAD JOK,TOT,DT OUT,DUOUT
  142    N RCNONSP ,RCACTIVE, RCZZ1,RCZZ 2,RCADJSTR   ; prca27 6 - variab les used t o establis h non-spec ific payme nt adjustm ents and A R BILL cla im status  (fix to ne gative cla im balance  issue)
  143    D FULL^VA LM1
  144    I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D  NOEDIT^RCD PEWLP G DI STQ   ;prc a*4.5*298  auto-poste d ERAs can not enter  dISTRIBUTE  ADJ AMTS  action 
  145    I $G(RCSC R("NOEDIT" )) D NOEDI T^RCDPEWL  G DISTQ
  146    I $G(^TMP ("RCBATCH_ SELECTED", $J)) D NOB ATCH^RCDPE WL G DISTQ
  147    ;
  148    S Z=0,RCA DJOK="" F   S Z=$O(^T MP("RCDPE- EOB_WLDX", $J,Z)) Q:' Z  S Z1=+$ P($G(^(Z)) ,U,2),Z0=$ G(^RCY(344 .49,RCSCR, 1,Z1,0)) D
  149    . I $P(Z0 ,U)'["." S  RCADJOK=( $P(Z0,U,2) ["**ADJ")  Q
  150    . ;;PH778  - 7/5/17  ;;I '$P(Z0 ,U,7),'RCA DJOK Q ; S uspense it em cannot  be used to  adjust
  151    . I $P(Z0 ,U,6)<0 S  RCZ(Z)=$P( Z0,U,6)_U_ Z1 Q
  152    . I $P(Z0 ,U,6)>0 D   Q
  153    .. N Q,ON HLD,IBA
  154    .. S ONHL D=0
  155    .. I $P(Z 0,U,7) I $ $IB^IBRUTL (+$P(Z0,U, 7),1) S Q= 0 F  S Q=$ O(IBA(Q))  Q:'Q  I $P ($G(^IB(+I BA(Q),0)), U,5)=8 S O NHLD=1 Q
  156    .. S RCZ1 (+$P(Z0,U, 6),Z)=Z1_U _ONHLD,RCZ 2(Z)=Z1_U_ $P(Z0,U,6) _U_ONHLD Q
  157    ;
  158    I $O(RCZ( 0))="" D   G DISTQ
  159    . S DIR(0 )="EA",DIR ("A",1)="N O LINES EX IST NEEDIN G ADJUSTME NT DISTRIB UTION",DIR ("A")="PRE SS RETURN  TO CONTINU E" W ! D ^ DIR K DIR
  160    ;
  161    I $O(RCZ1 (0))="" D   G DISTQ
  162    . S DIR(0 )="EA",DIR ("A",1)="N O VALID LI NES EXIST  ON THIS ER A WHERE A  DISTRIBUTI ON CAN BE  MADE",DIR( "A",2)=$$W HAT(RCSCR) ,DIR("A")= "PRESS RET URN TO CON TINUE" W !  D ^DIR K  DIR
  163    ;
  164    S RCQUIT= 0
  165    F  S DIR( 0)="NA^1:9 999:3",DIR ("A")="SEL ECT A LINE  THAT NEED S AN ADJUS TMENT AMOU NT DISTRIB UTED: " D   Q:RCQUIT
  166    . S DIR(" ?",1)="THE  FOLLOWING  LINE(S) H AVE AN ADJ USTMENT TH AT CAUSED  A NEGATIVE  NET PAYME NT.",DIR(" ?",2)="IN  ORDER TO B ALANCE THE  RECEIPT A ND THE DEP OSIT, THES E AMOUNTS  WILL NEED  TO",DIR("? ",3)=" BE  DISTRIBUTE D TO OTHER  LINE(S)", CT=3
  167    . S Z=0
  168    . F  S Z= $O(RCZ(Z))  Q:'Z  S C T=CT+1,DIR ("?",CT)="  "_$J(Z,8) _" "_$J($P (RCZ(Z),U) ,15,2)
  169    . S DIR(" ?")=" "
  170    . I $O(RC Z(0))=$O(R CZ(""),-1)  S DIR("B" )=$O(RCZ(0 ))
  171    . W ! D ^ DIR K DIR
  172    . I $D(DU OUT)!$D(DT OUT)!(Y="" ) S RCQUIT =1,RCDA=""  Q
  173    . I '$D(^ TMP("RCDPE -EOB_WLDX" ,$J,Y)) W  !,"THIS LI NE DOES NO T EXIST FO R THIS ERA " W ! Q
  174    . I '$D(R CZ(Y)) D   Q:Y=""
  175    .. I Y'[" .",$D(RCZ( Y_".001")) ,$O(RCZ(Y+ 1),-1)=(Y_ ".001") S  Y=Y_".001"  Q
  176    .. W !,$S (Y["."!($O (RCZ(Y))\1 '=(Y\1)):" THIS LINE  DOESN'T NE ED AN ADJU STMENT DIS TRIBUTION" ,1:"PLEASE  ENTER THE  ENTIRE LI NE # (Such  as: 1.001 )") W !
  177    .. S Y=""
  178    . W !," L INE #: "_+ Y_" AMOUNT  NEEDED TO  DISTRIBUT E: "_$J(+R CZ(Y),"",2 ),!
  179    . ; RCDA  = the ien  of the lin e in file  344.491
  180    . ; RCDA( 1) = the l ine # RCDA (2) = the  amount to  be adjuste d (+)
  181    . S RCDA= $P(RCZ(Y), U,2),RCDA( 1)=Y,RCQUI T=1,RCDA(2 )=-$P(RCZ( Y),U)
  182    ;
  183    G:$G(RCDA )="" DISTQ
  184    ;
  185    S RCQUIT= 0
  186    ;
  187    ; PRCA*4. 5*303 - Ma y miss if  multiple a mounts are  equal, ch anged calc ulation to  use RCZ2  instead of  RCZ1 
  188    ; Old cod e: S (TOT, Z)=0 F S Z =$O(RCZ1(Z )) Q:'Z S  TOT=TOT+Z
  189    S (TOT,Z) =0 F  S Z= $O(RCZ2(Z) ) Q:'Z  S  TOT=TOT+$P (RCZ2(Z),U ,2)
  190    I TOT<RCD A(2) D  G  DISTQ
  191    . S DIR(0 )="EA",DIR ("A",1)="T HE ERA DOE S NOT HAVE  ENOUGH VA LID PAYMEN TS TO OFFS ET THIS DI STRIBUTION ",DIR("A", 2)=$$WHAT( RCSCR),DIR ("A")="PRE SS RETURN  TO CONTINU E" W ! D ^ DIR K DIR
  192    F  S DIR( 0)="NA^1:9 999:3",DIR ("A")="SEL ECT A LINE  TO DISTRI BUTE THE A DJUSTMENT  AMOUNT TO:  " D  Q:RC QUIT
  193    . S DIR(" ?",1)="THE  FOLLOWING  LINE(S) H AVE A NET  PAYMENT TH AT CAN BE  USED TO OF FSET THE", DIR("?",2) =" NEGATIV E NET PAYM ENT FOR LI NE "_RCDA( 1)_" ("_$J (+$P(RCZ(R CDA(1)),U) ,"",2)_"): ",CT=2
  194    . S Z=""  F  S Z=$O( RCZ1(Z),-1 ) Q:'Z  S  Z0=0 F  S  Z0=$O(RCZ1 (Z,Z0)) Q: 'Z0  S CT= CT+1,DIR(" ?",CT)=" " _$J(Z0,8)_ " "_$J(+Z, 15,2)_$S($ P(RCZ1(Z,Z 0),U,2):"  On hold ex ists",1:"" )
  195    . S DIR(" ?")=" "
  196    . I $O(RC Z2(0))=$O( RCZ2(""),- 1) S DIR(" B")=$O(RCZ 2(0))
  197    . W ! D ^ DIR K DIR
  198    . I $D(DU OUT)!$D(DT OUT)!(Y="" ) S RCQUIT =1,RCDA1=" " Q
  199    . I '$D(^ TMP("RCDPE -EOB_WLDX" ,$J,Y)) W  !,"THIS LI NE DOES NO T EXIST FO R THIS ERA " W ! Q
  200    . I '$D(R CZ2(Y)) D   Q:Y=""
  201    .. I Y'[" .",$D(RCZ2 (Y_".001") ),$O(RCZ2( Y+1),-1)=( Y_".001")  S Y=Y_".00 1" Q
  202    .. I Y'[" .",$O(RCZ2 (Y))\1'=Y  S Y=Y_"."
  203    .. W !,$S (Y[".":"TH IS LINE CA NNOT BE US ED FOR AN  ADJUSTMENT  DISTRIBUT ION",1:"PL EASE ENTER  THE ENTIR E LINE # ( Such as: 1 .001)") W  !
  204    .. S Y=""
  205    . ; prca2 76 - next  few lines  represent  the a fix  to prevent  distribut ions again s collecte d/closed c laims (cla im balance  = zero do llars)
  206    . ;distri butions sh ould only  occur on l ine items  that have  specific p ayments ag ainst acti ve claims 
  207    . S RCZZ1 =$P(^TMP(" RCDPE-EOB_ WLDX",$J,Y ),U,2) ; g et line it em sequenc e # off th e VIEW ord er before  accessing  the scratc hpad
  208    . S (RCZZ 2,RCNONSP) =0 F  S RC ZZ2=$O(^RC Y(344.49,R CSCR,1,RCZ Z1,1,RCZZ2 )) Q:'RCZZ 2  Q:RCNON SP  S RCAD JSTR=$G(^( RCZZ2,0))  S RCNONSP= $S($P(RCAD JSTR,U,2)= 3:1,$P(RCA DJSTR,U,2) =5:1,1:0)  ;identify  if non-spe cific paym ent adjust ments exis t
  209    . ; do no t evaluate  claim sta tus for no n-specific  payment a djustments
  210    . I 'RCNO NSP,$P(^RC Y(344.49,R CSCR,1,RCZ Z1,0),U,7)  D  Q:'RCA CTIVE  ;PH J 778
  211    . . S RCA CTIVE=$$GE T1^DIQ(430 ,$P(^RCY(3 44.49,RCSC R,1,RCZZ1, 0),U,7),8)
  212    . . I (RC ACTIVE'="A CTIVE")&(R CACTIVE'=" OPEN") S R CACTIVE=0  W !,"THIS  IS NOT AN  ACTIVE BIL L !",!,"CA NNOT PERFO RM DISTRIB UTION TO T HIS CLAIM" ,! Q
  213    . . S RCA CTIVE=1
  214    . I $P(RC Z2(Y),U,3)  W !,"Warn ing - on-h old exists  for this  claim",!
  215    . W !," L INE #: "_+ Y_" LINE B ALANCE: "_ $J(+$P(RCZ 2(Y),U,2), "",2),!
  216    . ; RCDA1  = the ien  of the li ne in file  344.491
  217    . ; RCDA1 (1) = the  line # in  the displa y
  218    . S RCDA1 (1)=Y,RCDA 1=+$G(RCZ2 (Y)),RCQUI T=1
  219    . S Z=$O( ^RCY(344.4 9,RCSCR,1, "B",RCDA1( 1)\1,0))
  220    . S RCADJ =0
  221    . I $P($G (^RCY(344. 49,RCSCR,1 ,Z,0)),U,2 )["**ADJ"  S RCADJ=1  W !,"THE L INE SELECT ED IS AN A DDITIONAL  PAYMENT LI NE, NOT SP ECIFIC TO  A CLAIM",! ,"THE AMT  WILL BE DI STRIBUTED,  BUT A DEC REASE ADJU STMENT WIL L NOT BE P ERFORMED", !
  222    ;
  223    G:'$G(RCD A1) DISTQ
  224    ;
  225    S DIR("B" )=$S(RCDA( 2)<$P(RCZ2 (RCDA1(1)) ,U,2):$J(R CDA(2),"", 2),1:$J($P (RCZ2(+RCD A1(1)),U,2 ),"",2))
  226    S DIR(0)= "NA^.01:"_ DIR("B")_" :2",DIR("A ")="ADJUST MENT AMOUN T TO DISTR IBUTE: "
  227    S DIR("?" ,1)="THIS  IS THE AMO UNT OF THE  ADJUSTMEN T THAT SHO ULD BE APP LIED TO TH IS",DIR("? ")="PAYMEN T LINE. TH E AMT ENTE RED MUST B E BETWEEN  .01 AND "_ $J(DIR("B" ),"",2)
  228    D ^DIR K  DIR
  229    ;Modified  Logic (Ch anges are  in bold)RC DPEWL6 ;AL B/TMK/KML  - ELECTRON IC EOB WOR KLIST ACTI ONS ;Jun 0 6, 2014@19 :11:19
  230    ;;4.5;Acc ounts Rece ivable;**1 73,208,222 ,276,298,3 03,318**;M ar 20, 199 5;Build 84
  231    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  232    Q
  233    ;
  234   DISTADJ ;E P - Protoc ol action  - RCDPE EO B WORKLIST  DIST ADJ
  235    ; Distrib ute an adj ustment th at retract s a paymen t to other  bill(s)
  236    ; NOTE: R CSCR is as sumed to b e the IEN  of the ERA  entry in  file 344.4 9
  237    ;
  238    ; Input -  RCSCR - S cratchpad  #344.49 IE N
  239    ;
  240    N RCDA,RC DA1,RCAMT, RCADJ,RCQU IT,Z,Z0,Z1 ,DIR,X,Y,C T,RCZ,RCZ1 ,RCZ2,RCAD JOK,TOT,DT OUT,DUOUT
  241    N RCNONSP ,RCACTIVE, RCZZ1,RCZZ 2,RCADJSTR   ; prca27 6 - variab les used t o establis h non-spec ific payme nt adjustm ents and A R BILL cla im status  (fix to ne gative cla im balance  issue)
  242    D FULL^VA LM1
  243    I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D  NOEDIT^RCD PEWLP G DI STQ   ;prc a*4.5*298  auto-poste d ERAs can not enter  dISTRIBUTE  ADJ AMTS  action 
  244    I $G(RCSC R("NOEDIT" )) D NOEDI T^RCDPEWL  G DISTQ
  245    I $G(^TMP ("RCBATCH_ SELECTED", $J)) D NOB ATCH^RCDPE WL G DISTQ
  246    ;
  247    S Z=0,RCA DJOK="" F   S Z=$O(^T MP("RCDPE- EOB_WLDX", $J,Z)) Q:' Z  S Z1=+$ P($G(^(Z)) ,U,2),Z0=$ G(^RCY(344 .49,RCSCR, 1,Z1,0)) D
  248    . I $P(Z0 ,U)'["." S  RCADJOK=( $P(Z0,U,2) ["**ADJ")  Q
  249    . ; Follo wing valid ation line  removed –  allow dis tribution  to non-VA  claims
  250    . ;I '$P( Z0,U,7),'R CADJOK Q ;  Suspense  item canno t be used  to adjust
  251    . I $P(Z0 ,U,6)<0 S  RCZ(Z)=$P( Z0,U,6)_U_ Z1 Q
  252    . I $P(Z0 ,U,6)>0 D   Q
  253    .. N Q,ON HLD,IBA
  254    .. S ONHL D=0
  255    .. I $P(Z 0,U,7) I $ $IB^IBRUTL (+$P(Z0,U, 7),1) S Q= 0 F  S Q=$ O(IBA(Q))  Q:'Q  I $P ($G(^IB(+I BA(Q),0)), U,5)=8 S O NHLD=1 Q
  256    .. S RCZ1 (+$P(Z0,U, 6),Z)=Z1_U _ONHLD,RCZ 2(Z)=Z1_U_ $P(Z0,U,6) _U_ONHLD Q
  257    ;
  258    I $O(RCZ( 0))="" D   G DISTQ
  259    . S DIR(0 )="EA",DIR ("A",1)="N O LINES EX IST NEEDIN G ADJUSTME NT DISTRIB UTION",DIR ("A")="PRE SS RETURN  TO CONTINU E" W ! D ^ DIR K DIR
  260    ;
  261    I $O(RCZ1 (0))="" D   G DISTQ
  262    . S DIR(0 )="EA",DIR ("A",1)="N O VALID LI NES EXIST  ON THIS ER A WHERE A  DISTRIBUTI ON CAN BE  MADE",DIR( "A",2)=$$W HAT(RCSCR) ,DIR("A")= "PRESS RET URN TO CON TINUE" W !  D ^DIR K  DIR
  263    ;
  264    S RCQUIT= 0
  265    F  S DIR( 0)="NA^1:9 999:3",DIR ("A")="SEL ECT A LINE  THAT NEED S AN ADJUS TMENT AMOU NT DISTRIB UTED: " D   Q:RCQUIT
  266    . S DIR(" ?",1)="THE  FOLLOWING  LINE(S) H AVE AN ADJ USTMENT TH AT CAUSED  A NEGATIVE  NET PAYME NT.",DIR(" ?",2)="IN  ORDER TO B ALANCE THE  RECEIPT A ND THE DEP OSIT, THES E AMOUNTS  WILL NEED  TO",DIR("? ",3)=" BE  DISTRIBUTE D TO OTHER  LINE(S)", CT=3
  267    . S Z=0
  268    . F  S Z= $O(RCZ(Z))  Q:'Z  S C T=CT+1,DIR ("?",CT)="  "_$J(Z,8) _" "_$J($P (RCZ(Z),U) ,15,2)
  269    . S DIR(" ?")=" "
  270    . I $O(RC Z(0))=$O(R CZ(""),-1)  S DIR("B" )=$O(RCZ(0 ))
  271    . W ! D ^ DIR K DIR
  272    . I $D(DU OUT)!$D(DT OUT)!(Y="" ) S RCQUIT =1,RCDA=""  Q
  273    . I '$D(^ TMP("RCDPE -EOB_WLDX" ,$J,Y)) W  !,"THIS LI NE DOES NO T EXIST FO R THIS ERA " W ! Q
  274    . I '$D(R CZ(Y)) D   Q:Y=""
  275    .. I Y'[" .",$D(RCZ( Y_".001")) ,$O(RCZ(Y+ 1),-1)=(Y_ ".001") S  Y=Y_".001"  Q
  276    .. W !,$S (Y["."!($O (RCZ(Y))\1 '=(Y\1)):" THIS LINE  DOESN'T NE ED AN ADJU STMENT DIS TRIBUTION" ,1:"PLEASE  ENTER THE  ENTIRE LI NE # (Such  as: 1.001 )") W !
  277    .. S Y=""
  278    . W !," L INE #: "_+ Y_" AMOUNT  NEEDED TO  DISTRIBUT E: "_$J(+R CZ(Y),"",2 ),!
  279    . ; RCDA  = the ien  of the lin e in file  344.491
  280    . ; RCDA( 1) = the l ine # RCDA (2) = the  amount to  be adjuste d (+)
  281    . S RCDA= $P(RCZ(Y), U,2),RCDA( 1)=Y,RCQUI T=1,RCDA(2 )=-$P(RCZ( Y),U)
  282    ;
  283    G:$G(RCDA )="" DISTQ
  284    ;
  285    S RCQUIT= 0
  286    ;
  287    ; PRCA*4. 5*303 - Ma y miss if  multiple a mounts are  equal, ch anged calc ulation to  use RCZ2  instead of  RCZ1 
  288    ; Old cod e: S (TOT, Z)=0 F S Z =$O(RCZ1(Z )) Q:'Z S  TOT=TOT+Z
  289    S (TOT,Z) =0 F  S Z= $O(RCZ2(Z) ) Q:'Z  S  TOT=TOT+$P (RCZ2(Z),U ,2)
  290    I TOT<RCD A(2) D  G  DISTQ
  291    . S DIR(0 )="EA",DIR ("A",1)="T HE ERA DOE S NOT HAVE  ENOUGH VA LID PAYMEN TS TO OFFS ET THIS DI STRIBUTION ",DIR("A", 2)=$$WHAT( RCSCR),DIR ("A")="PRE SS RETURN  TO CONTINU E" W ! D ^ DIR K DIR
  292    F  S DIR( 0)="NA^1:9 999:3",DIR ("A")="SEL ECT A LINE  TO DISTRI BUTE THE A DJUSTMENT  AMOUNT TO:  " D  Q:RC QUIT
  293    . S DIR(" ?",1)="THE  FOLLOWING  LINE(S) H AVE A NET  PAYMENT TH AT CAN BE  USED TO OF FSET THE", DIR("?",2) =" NEGATIV E NET PAYM ENT FOR LI NE "_RCDA( 1)_" ("_$J (+$P(RCZ(R CDA(1)),U) ,"",2)_"): ",CT=2
  294    . S Z=""  F  S Z=$O( RCZ1(Z),-1 ) Q:'Z  S  Z0=0 F  S  Z0=$O(RCZ1 (Z,Z0)) Q: 'Z0  S CT= CT+1,DIR(" ?",CT)=" " _$J(Z0,8)_ " "_$J(+Z, 15,2)_$S($ P(RCZ1(Z,Z 0),U,2):"  On hold ex ists",1:"" )
  295    . S DIR(" ?")=" "
  296    . I $O(RC Z2(0))=$O( RCZ2(""),- 1) S DIR(" B")=$O(RCZ 2(0))
  297    . W ! D ^ DIR K DIR
  298    . I $D(DU OUT)!$D(DT OUT)!(Y="" ) S RCQUIT =1,RCDA1=" " Q
  299    . I '$D(^ TMP("RCDPE -EOB_WLDX" ,$J,Y)) W  !,"THIS LI NE DOES NO T EXIST FO R THIS ERA " W ! Q
  300    . I '$D(R CZ2(Y)) D   Q:Y=""
  301    .. I Y'[" .",$D(RCZ2 (Y_".001") ),$O(RCZ2( Y+1),-1)=( Y_".001")  S Y=Y_".00 1" Q
  302    .. I Y'[" .",$O(RCZ2 (Y))\1'=Y  S Y=Y_"."
  303    .. W !,$S (Y[".":"TH IS LINE CA NNOT BE US ED FOR AN  ADJUSTMENT  DISTRIBUT ION",1:"PL EASE ENTER  THE ENTIR E LINE # ( Such as: 1 .001)") W  !
  304    .. S Y=""
  305    . ; prca2 76 - next  few lines  represent  the a fix  to prevent  distribut ions again s collecte d/closed c laims (cla im balance  = zero do llars)
  306    . ;distri butions sh ould only  occur on l ine items  that have  specific p ayments ag ainst acti ve claims 
  307    . S RCZZ1 =$P(^TMP(" RCDPE-EOB_ WLDX",$J,Y ),U,2) ; g et line it em sequenc e # off th e VIEW ord er before  accessing  the scratc hpad
  308    . S (RCZZ 2,RCNONSP) =0 F  S RC ZZ2=$O(^RC Y(344.49,R CSCR,1,RCZ Z1,1,RCZZ2 )) Q:'RCZZ 2  Q:RCNON SP  S RCAD JSTR=$G(^( RCZZ2,0))  S RCNONSP= $S($P(RCAD JSTR,U,2)= 3:1,$P(RCA DJSTR,U,2) =5:1,1:0)  ;identify  if non-spe cific paym ent adjust ments exis t
  309    . ; do no t evaluate  claim sta tus for no n-specific  payment a djustments
  310    . ;  or d istributio ns to non- VistA clai ms
  311    . I 'RCNO NSP,$P(^RC Y(344.49,R CSCR,1,RCZ Z1,0),U,7)  D  Q:'RCA CTIVE
  312    . . S RCA CTIVE=$$GE T1^DIQ(430 ,$P(^RCY(3 44.49,RCSC R,1,RCZZ1, 0),U,7),8)
  313    . . I (RC ACTIVE'="A CTIVE")&(R CACTIVE'=" OPEN") S R CACTIVE=0  W !,"THIS  IS NOT AN  ACTIVE BIL L !",!,"CA NNOT PERFO RM DISTRIB UTION TO T HIS CLAIM" ,! Q
  314    . . S RCA CTIVE=1
  315    . I $P(RC Z2(Y),U,3)  W !,"Warn ing - on-h old exists  for this  claim",!
  316    . W !," L INE #: "_+ Y_" LINE B ALANCE: "_ $J(+$P(RCZ 2(Y),U,2), "",2),!
  317    . ; RCDA1  = the ien  of the li ne in file  344.491
  318    . ; RCDA1 (1) = the  line # in  the displa y
  319    . S RCDA1 (1)=Y,RCDA 1=+$G(RCZ2 (Y)),RCQUI T=1
  320    . S Z=$O( ^RCY(344.4 9,RCSCR,1, "B",RCDA1( 1)\1,0))
  321    . S RCADJ =0
  322    . I $P($G (^RCY(344. 49,RCSCR,1 ,Z,0)),U,2 )["**ADJ"  S RCADJ=1  W !,"THE L INE SELECT ED IS AN A DDITIONAL  PAYMENT LI NE, NOT SP ECIFIC TO  A CLAIM",! ,"THE AMT  WILL BE DI STRIBUTED,  BUT A DEC REASE ADJU STMENT WIL L NOT BE P ERFORMED", !
  323    ;
  324    G:'$G(RCD A1) DISTQ
  325    ;
  326    S DIR("B" )=$S(RCDA( 2)<$P(RCZ2 (RCDA1(1)) ,U,2):$J(R CDA(2),"", 2),1:$J($P (RCZ2(+RCD A1(1)),U,2 ),"",2))
  327    S DIR(0)= "NA^.01:"_ DIR("B")_" :2",DIR("A ")="ADJUST MENT AMOUN T TO DISTR IBUTE: "
  328    S DIR("?" ,1)="THIS  IS THE AMO UNT OF THE  ADJUSTMEN T THAT SHO ULD BE APP LIED TO TH IS",DIR("? ")="PAYMEN T LINE. TH E AMT ENTE RED MUST B E BETWEEN  .01 AND "_ $J(DIR("B" ),"",2)
  329    D ^DIR K  DIR
  330    ;