12. EPMO Open Source Coordination Office Redaction File Detail Report

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

12.1 Files compared

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

12.2 Comparison summary

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

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

12.4 Active regular expressions

No regular expressions were active.

12.5 Comparison detail

  1   MCCF EDI T AS US320
  2   System Des ign Docume nt
  3   PRCA*4.5*x xx
  4  
  5   Department  of Vetera ns Affairs
  6   November 2 017
  7   Version 1
  8   User Story  ID: US320
  9   User Story  Name:  ER A Partial  Post Indic ator
  10   Sizing:  3
  11   Epic Taxon omy  eBiz  Compliance  Port Upda te    Incr ease No To uch  TAS A ppsStory
  12   As a...I w ant to...S o that...e Payments u serhave a  partially  posted and  a marked  for auto p ost  ERA i ndicator o n the ERA  worklist I  can see w hich ERAs  on the wor klist have  been part ially auto -posted an d which on es are mar ked for au to-postCon versation  (if desire d by devel opers)
  13   Update fil ter questi on to prom pt for the se additio nal indica tors
  14   Add 'P' pr efix for P ARTIAL pos ted  ERAs 
  15   Add 'M' fo r MARKED f or auto-po st ERAs
  16   Add help t ext for ne w filter p rompts
  17   Three (3)  new error  messages f or new pro mpts
  18   Two (2) ne w error me ssages for  existing  prompts
  19   Summary:
  20   The highli ghted bann er (VALMSG ) of  "|'- ' No scrat chpad|'x'  EXC |'A' a utopost co mplete" in  RCDPEWL7  will be re moved and  the standa rd banner  of “Enter  ?? for mor e actions”  displayed  instead.   
  21   The HELP C ODE field  in list RC DPE WORKLI ST ERA LIS T will be  modified t o use new  code in HE LP^RCDPEWL 7 which wi ll display  the key t o the ERA  prefixes i f ?? is en tered:
  22   ePay Elect ronic Remi ttance Adv ice Status
  23   The follow ing ERA St atus indic ators may  appear to  the left o f ERA numb er:
  24    ‘-‘ = No  scratchpad .
  25   ‘x’ = EXC  exception  exists.
  26   ‘A’ = Auto -post comp lete.
  27   ‘P’ = Auto -post part ially comp leted.
  28   ‘M’ = Mark ed for aut o-post, aw aiting pro cessing.
  29   e.g.
  30   ERA List -  Worklist             Sep 11, 20 17@10:15:4 9           Page:     2 of    5 
  31   SELECTED M ATCH STATU S: BOTH                POST STAT US     : B OTH
  32               DATE RANG E: 9/7/17- 9/11/17     AUTO-POST ING    : B OTH
  33              ALL PAYERS                        PHARMACY/ MEDICAL: B OTH
  34   #       ER A #             Trace #
  35   +            PAYER NA ME/MATCH S TATUS          ERA PA ID DT  TOT  AMT PAID    DT REC'D
  36   4      x92 926        ABC6453338 177                                                   
  37                                                 9/7/17              82.62        9/7/17  
  38                AETNA                              APPROX  # EEOBs:  2                    
  39                MATCHED                            EFT RE CEIPT STAT US: ACCEPT ED BY FMS 
  40                                                                                          
  41   5      A92 927        ABC6453340 987                                                   
  42                                                 9/7/17            1 86.66        9/7/17  
  43                AETNA -C ONTINENTAL  LIFE INSU RA  APPROX  # EEOBs:  1                    
  44                MATCHED                            EFT RE CEIPT STAT US: ACCEPT ED BY FMS 
  45                                                                                          
  46   6      -92 928        ABC6453341 045                                                   
  47                                                 9/7/17            1 86.66        9/7/17  
  48                AETNA -C ONTINENTAL  LIFE INSU RA  APPROX  # EEOBs:  1                    
  49   +       En ter ?? for  more acti ons and he lp                                                
  50       Select  ERA                  View/Print  ERA             EXIT
  51       Sort L ist                   Change Vie w
  52       Mark f or Auto Po st         Manual Mat ch
  53   Select Act ion: Next  Screen//??
  54   The follow ing action s are also  available :
  55   +    Next  Screen           <     Shift Vie w to Left    PS   Pri nt Screen
  56   -    Previ ous Screen       FS    First Scr een          PL   Pri nt List
  57   UP   Up a  Line             LS    Last Scre en           SL   Sea rch List
  58   DN   Down  a Line           GO    Go to Pag e            ADPL Aut o Display( On/Off)
  59   >    Shift  View to R ight  RD    Re Displa y Screen     Q    Qui t
  60   Type <Ente r> to cont inue or '^ ' to exit:
  61   ePay Elect ronic Remi ttance Adv ice Status
  62   The follow ing ERA St atus indic ators may  appear to  the left o f ERA numb er:
  63         '-'  = No scrat chpad.
  64         'x'  = EXC exce ptions exi st.
  65         'A'  = Auto-pos t complete .
  66         'P'  = Auto-pos t partiall y complete d.
  67         'M'  = Marked f or auto-po st, awaiti ng process ing.
  68   Type <Ente r> to cont inue or '^ ' to exit:
  69   A new filt er prompt  will be ad ded to the  ERA Workl ist option  (Added 11 -06-2017)
  70   Select EDI  Lockbox ( ePayments)  <TEST ACC OUNT> Opti on: WL  ER A Worklist
  71   Do you wan t a (L)IST  of ERAs o r a (S)PEC IFIC one?:  LIST// 
  72   Limit the  selection  to a date  range when  the ERA w as receive d?: NO// Y ES
  73   Earliest d ate: T  (O CT 02, 201 7)
  74   Latest dat e: 10/2/17 // T  (OCT  02, 2017)
  75   Select par ameters fo r displayi ng the lis t of ERAs
  76   (Z)ERO, (P )AYMENT, o r (B)OTH:  B// OTH
  77   ERA postin g status:  (U)NPOSTED , (P)OSTED , or (B)OT H: U// NPO STED
  78   Display (A )UTO-POSTI NG, (N)ON  AUTO-POSTI NG, or (B) OTH: B// O TH
  79   Auto-Post  status: (M )ARKED, (P )ARTIAL, ( C)OMPLETE  or (A)LL:  A//
  80   ERA-EFT ma tch status : (N)OT MA TCHED, (M) ATCHED, or  (B)OTH: B // OTH
  81   (M)EDICAL,  (P)HARMAC Y, (T)RICA RE or (A)L L: A// LL
  82   (A)LL paye rs, (R)ANG E of payer  names: A/ / LL
  83   Do you wan t to save  this as yo ur preferr ed view (Y /N)? NO//
  84   The follow ing new er ror messag es will al so be disp layed (^RC DPEWLD):
  85   AUTO-POSTI NG is an i nvalid sel ection for  ZERO ERAs
  86   Auto-post  COMPLETE i s an inval id selecti on for UNP OSTED ERAs
  87   Auto-post  PARTIAL is  an invali d selectio n for UNPO STED ERAs
  88   MARKED for  Auto-post  is an inv alid selec tion for P OSTED ERAs
  89   NOT MATCHE D is an in valid sele ction for  AUTO-POSTI NG ERAs
  90   Filter sel ection (PA RAMS^RCDPE WLD), pref erred view  functions  (^RCDPEWL 0) and wor klist filt ers (FILTE R^RCDPEWL0 ) will be  modified.  A new RCDP E EDI LOCK BOX WORKLI ST paramet er or ‘AUT O-POST STA TUS’ will  also be cr eated to s tore the p referred c ustom view .
  91   The RCDPE  EDI LOCKBO X WORKLIST  parameter  will be m odified to  include t he new fil ter:
  92   NAME: RCDP E EDI LOCK BOX WORKLI ST
  93     DISPLAY  TEXT: ERA  Worklist C hange View  Parameter s
  94     MULTIPLE  VALUED: Y es                    VALUE DATA  TYPE: fre e text
  95     INSTANCE  DATA TYPE : free tex t
  96    DESCRIPTI ON:   
  97    The ERA L ist - Work list scree n within t he ERA Wor klist opti on [RCDPE  EDI LOCKBO X
  98    WORKLIST]   provides  the capab ility to f ilter the  data displ ayed via t he Change
  99    View acti on. The Ch ange View  action all ows users  to change  and save t heir
  100    individua l filter p references .
  101    Below is  a list of  the parame ter/value  pairs (ins tances) fo r the Chan ge View 
  102    action, w hich are s tored usin g this Par ameter Def inition.
  103     Paramete r Instance                Possib le Value
  104     -------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  105     ERA_POST ING_STATUS                'U':Un posted;'P' :Posted;'B ':Both
  106     ERA-EFT_ MATCH_STAT US             'N':No t Matched; 'M':Matche d;'B':Both
  107     ALL_PAYE RS/RANGE_O F_PAYERS       3 fiel ds:A/R;Sta rtWith;GoT o (e.g.,'R ;AE;AEZ')
  108     ERA_AUTO _POSTING                  'A':Au to-Posting ;'N':Non A uto-Postin g;'B':Both
  109     ERA_CLAI M_TYPE                    'M':Me dical;'P': Pharmacy;T :Tricare'A ':All
  110     ERA_PAYM ENT_TYPE                  'Z':Ze ro;'P':Pay ment;'B':B oth
  111     AUTO-POS T_STATUS
  112  
  113       'M':Ma rked;'P':P artial;'C' :Complete; 'A':All
  114    Note: The  second an d third fi elds of AL L_PAYERS/R ANGE_OF_PA YERS are o nly
  115          pre sent When  the first  field is s et to 'R'  (Range of  Payers)
  116   PRECEDENCE : 1                              ENTITY FIL E: USER
  117   Resolution  – Added C hanged Obj ects
  118   RoutinesAc tivitiesRo utine Name RCDPEWL7En hancement  Category N ew Modify  Delete No  ChangeRTMR elated Opt ionsRCDPE  EDI LOCKBO X WORKLIST Related Ro utinesRout ines “Call ed By”Rout ines “Call ed”   RCDP EM2
  119   RCDPEWL
  120   RCDPEWL8
  121   RCDPEWLP
  122   RCDPRUWAIT ^DICD            
  123   $$EXTERNAL ^DILFD    
  124   ^DIR                 
  125   $$UNBAL^RC DPEAP1    
  126   $$UP^RCDPE ARL       
  127   DISP^RCDPE WL        
  128   $$FILTER^R CDPEWL0   
  129   PRERA^RCDP EWL0      
  130   $$HASADJ^R CDPEWL8   
  131   SELBAT^RCD PEWL8     
  132   $$CTEEOB^R CDPEWLB   
  133   $$AGEDEFTS ^RCDPEWLP 
  134   $$PHARM^RC DPEWLP    
  135   $$XCEPT^RC DPEWLP    
  136   EXCDENY^RC DPEWLP    
  137   $$FMSSTAT^ RCDPUREC  
  138   FULL^VALM1           
  139   CLEAN^VALM 10        
  140   EN^VALM2             
  141   $$READ^XGF           
  142   INITKB^XGF           
  143   RESETKB^XG F         
  144   $$FMTE^XLF DT        
  145   DISP^XQORM 1          Current Lo gicRCDPEWL 7 ;ALB/TMK /KML - EDI  LOCKBOX W ORKLIST ER A DISPLAY  SCREEN ;Ju n 06, 2014 @19:11:19
  146    ;;4.5;Acc ounts Rece ivable;**2 08,222,269 ,276,298,3 04,318**;M ar 20, 199 5;Build 10 4
  147    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  148    Q
  149   .
  150   .
  151   EXTRACT(RC SRT1,RCSRT 2,RCT) ; E xtract the  data
  152    ; RCSRT1  = data val ue at 1st  sort level
  153    ; RCSRT2  = data val ue at 2nd  sort level
  154    ; RCT = r unning ent ry counter  - returne d if passe d by ref
  155    N AUTOCOM P,FIRST,RC 0,RCEFT,RC EXCEP,RCPO ST,RCSTAT, RCZ,X,XX,Z ,Z0 ;PRCA* 4.5*318 Va riable XX  added
  156    S RCZ=0 F   S RCZ=$O (^TMP($J," RCERA_LIST ",RCSRT1,R CSRT2,RCZ) ) Q:'RCZ   D
  157    . S RCT=R CT+1,RC0=$ G(^RCY(344 .4,RCZ,0))
  158    . S RCEFT =+$O(^RCY( 344.31,"AE RA",RCZ,0) )
  159    . S RCEXC EP=$$XCEPT ^RCDPEWLP( RCZ) ; prc a*4.5*298  assignment  of ERA ex ception fl ag
  160    . S AUTOC OMP=$S($P( $G(^RCY(34 4.4,RCZ,4) ),U,2)=2:" A",1:"") ; prca*4.5*2 98 AUTO-PO STED COMPL ETE indica tor ("A")
  161    . S RCSTA T=$S('RCEF T:U_$S($P( RC0,U,15)= "CHK":"(CH ECK PAYMEN T EXPECTED )",$P(RC0, U,15)="NON ":"(NO PAY MENT EXPEC TED)",$P(R C0,U,9)=2: "(CHECK PA YMENT CHOS EN)",1:"N/ A"),1:$$FM SSTAT^RCDP UREC(+$P($ G(^RCY(344 .31,RCEFT, 0)),U,9)))
  162    . S RCPOS T=$S(RCEFT :"EFT RECE IPT STATUS : ",1:"")_ $P(RCSTAT, U,2)
  163    . ;prca*4 .5*298 inc lude Auto- Post Compl ete indica tor and ER A exceptio n flag in  $SELECT st atement
  164    . S X=$E( RCT_$J("", 5),1,5)_"  "_$S(RCEXC EP]"":RCEX CEP,AUTOCO MP]"":AUTO COMP,$D(^R CY(344.49, RCZ)):" ", 1:"-")_$E( $P(RC0,U)_ $J("",10), 1,10)_" "_ $E($P(RC0, U,2)_$J("" ,50),1,50)
  165    . D SET(X ,RCT,RCZ)
  166    . S X=$J( "",40)_$J( $$FMTE^XLF DT($P(RC0, U,7),"2D") ,8)_$J("", 5)_$J(+$P( RC0,U,5),1 2,2)
  167    . S $E(X, 73,80)=$$F MTE^XLFDT( $P(RC0,U,7 ),"2D")
  168    . D SET(X ,RCT,RCZ)
  169    . S X=$J( "",12)_$E( $P(RC0,U,6 )_$J("",30 ),1,30)_"  APPROX # E EOBs: "_+$ $CTEEOB^RC DPEWLB(RCZ )
  170    . D SET(X ,RCT,RCZ)
  171    . S XX=$$ EXTERNAL^D ILFD(344.4 ,.09,"",$P (RC0,U,9))
  172    . S:$$UNB AL^RCDPEAP 1(RCZ) XX= XX_" - UNB ALANCED" ; PRCA*4.5*3 18 added l ine 
  173    . S X=$J( "",12)_$E( XX_$J("",3 0),1,30)_"  "_RCPOST  ;PRCA*4.5* 318 modifi ed line 
  174    . D SET(X ,RCT)
  175    . D SET("  ",RCT)
  176    ;.; prca* 4.5*298 pe r patch re quirements , keep cod e related  to
  177    ;. ; crea ting/maint aining bat ches but j ust remove  from exec ution.
  178    ;. ;I $G( ^TMP("RCER A_PARAMS", $J,"BATCHO N")) D
  179    ;.. ;S Z= 0 F S Z=$O (^RCY(344. 49,RCZ,3,Z )) Q:'Z S  Z0=$G(^(Z, 0)) I Z0'= "" D
  180    ;...; S X =$J("",12) _$E("- BAT CH #"_$P(Z 0,U)_$J("" ,4),1,13)_ " "_$E($P( Z0,U,2)_$J ("",30),1, 30)_" "_$S ('$P(Z0,U, 3):"NOT ", 1:"")_"REA DY TO POST "
  181    ;... ;D S ET(X,RCT)
  182    ;
  183    S VALMSG= "|'-' No s cratchpad| 'x' EXC |' A' autopos t complete "
  184    ;
  185    QModified  Logic (Ch anges are  in bold)RC DPEWL7 ;AL B/TMK/KML  - EDI LOCK BOX WORKLI ST ERA DIS PLAY SCREE N ;Jun 06,  2014@19:1 1:19
  186    ;;4.5;Acc ounts Rece ivable;**2 08,222,269 ,276,298,3 04,318,xxx **;Mar 20,  1995;Buil d 104
  187    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  188    Q
  189   .
  190   .
  191   EXTRACT(RC SRT1,RCSRT 2,RCT) ; E xtract the  data
  192    ; RCSRT1  = data val ue at 1st  sort level
  193    ; RCSRT2  = data val ue at 2nd  sort level
  194    ; RCT = r unning ent ry counter  - returne d if passe d by ref
  195    N AUTOCOM P,FIRST,RC 0,RCEFT,RC EXCEP,RCPO ST,RCSTAT, RCZ,X,XX,Z ,Z0 ;PRCA* 4.5*318 Va riable XX  added
  196    S RCZ=0 F   S RCZ=$O (^TMP($J," RCERA_LIST ",RCSRT1,R CSRT2,RCZ) ) Q:'RCZ   D
  197    . S RCT=R CT+1,RC0=$ G(^RCY(344 .4,RCZ,0))
  198    . S RCEFT =+$O(^RCY( 344.31,"AE RA",RCZ,0) )
  199    . S RCEXC EP=$$XCEPT ^RCDPEWLP( RCZ) ; prc a*4.5*298  assignment  of ERA ex ception fl ag
  200    . S AUTOC OMP=$S($P( $G(^RCY(34 4.4,RCZ,4) ),U,2)=2:" A",1:"") ; prca*4.5*2 98 AUTO-PO STED COMPL ETE indica tor ("A")
  201    . S RCSTA T=$S('RCEF T:U_$S($P( RC0,U,15)= "CHK":"(CH ECK PAYMEN T EXPECTED )",$P(RC0, U,15)="NON ":"(NO PAY MENT EXPEC TED)",$P(R C0,U,9)=2: "(CHECK PA YMENT CHOS EN)",1:"N/ A"),1:$$FM SSTAT^RCDP UREC(+$P($ G(^RCY(344 .31,RCEFT, 0)),U,9)))
  202    . S RCPOS T=$S(RCEFT :"EFT RECE IPT STATUS : ",1:"")_ $P(RCSTAT, U,2)
  203    . ;prca*4 .5*298 inc lude Auto- Post Compl ete indica tor and ER A exceptio n flag in  $SELECT st atement
  204    . S X=$E( RCT_$J("", 5),1,5)_"  "_$S(RCEXC EP]"":RCEX CEP,AUTOCO MP]"":AUTO COMP,$D(^R CY(344.49, RCZ)):" ", 1:"-")_$E( $P(RC0,U)_ $J("",10), 1,10)_" "_ $E($P(RC0, U,2)_$J("" ,50),1,50)
  205    . D SET(X ,RCT,RCZ)
  206    . S X=$J( "",40)_$J( $$FMTE^XLF DT($P(RC0, U,7),"2D") ,8)_$J("", 5)_$J(+$P( RC0,U,5),1 2,2)
  207    . S $E(X, 73,80)=$$F MTE^XLFDT( $P(RC0,U,7 ),"2D")
  208    . D SET(X ,RCT,RCZ)
  209    . S X=$J( "",12)_$E( $P(RC0,U,6 )_$J("",30 ),1,30)_"  APPROX # E EOBs: "_+$ $CTEEOB^RC DPEWLB(RCZ )
  210    . D SET(X ,RCT,RCZ)
  211    . S XX=$$ EXTERNAL^D ILFD(344.4 ,.09,"",$P (RC0,U,9))
  212    . S:$$UNB AL^RCDPEAP 1(RCZ) XX= XX_" - UNB ALANCED" ; PRCA*4.5*3 18 added l ine 
  213    . S X=$J( "",12)_$E( XX_$J("",3 0),1,30)_"  "_RCPOST  ;PRCA*4.5* 318 modifi ed line 
  214    . D SET(X ,RCT)
  215    . D SET("  ",RCT)
  216    ;.; prca* 4.5*298 pe r patch re quirements , keep cod e related  to
  217    ;. ; crea ting/maint aining bat ches but j ust remove  from exec ution.
  218    ;. ;I $G( ^TMP("RCER A_PARAMS", $J,"BATCHO N")) D
  219    ;.. ;S Z= 0 F S Z=$O (^RCY(344. 49,RCZ,3,Z )) Q:'Z S  Z0=$G(^(Z, 0)) I Z0'= "" D
  220    ;...; S X =$J("",12) _$E("- BAT CH #"_$P(Z 0,U)_$J("" ,4),1,13)_ " "_$E($P( Z0,U,2)_$J ("",30),1, 30)_" "_$S ('$P(Z0,U, 3):"NOT ", 1:"")_"REA DY TO POST "
  221    ;... ;D S ET(X,RCT)
  222    ;
  223    S VALMSG= "Enter ??  for more a ctions and  help"
  224    ;
  225    Q
  226    ;
  227   HELP ; lis t manager  help
  228    D FULL^VA LM1
  229    S VALMBCK ="R"
  230    W @IOF
  231    W !,"ePay  Electroni c Remittan ce Advice  Status"
  232    W !!,"The  following  ERA Statu s indicato rs may app ear to the  left of E RA number: ",!
  233    ;
  234    W !," '-'  = No scra tchpad."
  235    W !," 'x'  = EXC exc eptions ex ist."
  236    W !," 'A'  = Auto-po st complet e."
  237    W !," 'P'  = Auto-po st partial ly complet ed."
  238    W !," 'M'  = Marked  for Auto-p ost, waiti ng process ing."
  239    D PAUSE^V ALM1
  240    Q
  241   List Manag er Templat eActivitie sTemplate  NameRCDPE  WORKLIST E RA LISTEnh ancement C ategory Ne w Modify D elete No C hangeRTMRe lated Opti onsRCDPE E DI LOCKBOX  WORKLISTN ew Templat e Definiti onNAME: RC DPE WORKLI ST ERA LIS T            TYPE OF  LIST: PROT OCOL
  242     RIGHT MA RGIN: 80                         TOP MARGIN : 7
  243     BOTTOM M ARGIN: 19                        OK TO TRAN SPORT?: OK
  244     USE CURS OR CONTROL : YES                 ENTITY NAM E: #
  245     PROTOCOL  MENU: RCD PE WORKLIS T ERA LIST  MENU
  246     SCREEN T ITLE: ERA  List - Wor klist      ALLOWABLE  NUMBER OF  ACTIONS: 1
  247     AUTOMATI C DEFAULTS : YES                 HIDDEN ACT ION MENU:  VALM HIDDE N ACTIONS
  248     ARRAY NA ME:  ^TMP( "RCDPE-ERA _WL",$J)
  249   ITEM NAME:  DATE_PAID                       COLUMN: 45
  250     WIDTH: 1 1                                DISPLAY TE XT: ERA PA ID DT
  251   ITEM NAME:  TOT_PAID                        COLUMN: 58
  252     WIDTH: 1 2                                DISPLAY TE XT: TOT AM T PAID
  253   ITEM NAME:  DATE_RECE IVED                  COLUMN: 73
  254     WIDTH: 8                                  DISPLAY TE XT: DT REC 'D
  255   ITEM NAME:  PAYER_LN                        COLUMN: 13
  256     WIDTH: 3 2                                DISPLAY TE XT: PAYER  NAME/MATCH  STATUS
  257     EXIT COD E: D FNL^R CDPEWL7               HEADER COD E: D HDR^R CDPEWL7
  258     ENTRY CO DE: D INIT ^RCDPEWL7             HELP CODE:  D HELP^RC DPEWL7Rout inesActivi tiesRoutin e NameRCDP EWLDEnhanc ement Cate gory New M odify Dele te No Chan geRTMRelat ed Options RCDPE EDI  LOCKBOX WO RKLISTRela ted Routin esRoutines  “Called B y”Routines  “Called”     Current  LogicRCDP EWLD ;ALB/ CLT - Cont inuation o f routine  RCDPEWL0 ; 09 DEC 201 6
  259    ;;4.5;Acc ounts Rece ivable;**2 52,317,321 **;Mar 20,  1995;Buil d 8
  260    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  261    Q
  262    ;
  263   PROV(RCSCR ,RCSCR1,RC XM1,RC) ;G et prov da ta from ER A (FILE 34 4.4) and c laim (FILE  399)
  264    N RCXXX,R CYYY,RCDPE PV,RCCLAIM ,RCIEN,RCB ILL,RCID,R CBLANK,RCN PI,DIC,X,Y
  265    N RCPROV, RCEXP,XUSN PI,RCRTN,R CBNM,RCCOM 1,RCCOM2,R CWARN,RCYN ODE3
  266    ;
  267    S RCBLANK ="" F X=1: 1:30 S RCB LANK=RCBLA NK_" "
  268    S RC=RC+1  S RCXM1(R C-1)=RCBLA NK
  269    S RCYNODE 3=$G(^RCY( 344.4,RCSC R,1,RCSCR1 ,3))
  270    ;
  271   LKBOX ;Get  provider  data from  ELECTRONIC  REMITTANC E ADVICE f ile (#344. 4)
  272    S RC=RC+1 ,RCXM1(RC- 1)=$E("**E OB PROVIDE R(S)/NPI"_ $J(" ",39) ,1,39)_"CL AIM PROVID ER(S)/NPI* *"  ;setti ng sub-hea der for wo rklist
  273    S RC=RC+1 ,RCXM1(RC- 1)=$E("--- ---------- --------"_ $J(" ",39) ,1,39)_"-- ---------- ---------- -"
  274    ;
  275    S RCPROV= "BILLING", $P(RCYYY(R CPROV),U,3 )=0 ; piec e 3 initia lize for e rror msgs
  276    I $P(RCYN ODE3,U)'=" " S RCYYY( RCPROV)="/ "_$P(RCYNO DE3,U) ; B illing Pro v NPI 
  277    ;
  278    S RCPROV= "RENDERING "
  279    I $P(RCYN ODE3,U,3)= 2 S RCPROV ="SERVICIN G"
  280    I $P(RCYN ODE3,U,3)= "",($P(RCY NODE3,U,4) '[","),($P (RCYNODE3, U,4)'="")  S RCPROV=" SERVICING"
  281    I $P(RCYN ODE3,U,2)' =""!($P(RC YNODE3,U,4 )'="") S R CYYY(RCPRO V)=$E($P(R CYNODE3,U, 4),1,20)_" /"_$P(RCYN ODE3,U,2)
  282    S $P(RCYY Y(RCPROV), U,3)=0 ; i nitialize  for error  msgs
  283    D NPICHK         ; R CPROV has  to be "REN DERING" or  "SERVICIN G" when th is tag is  called !
  284    ;
  285   CLAIM ;Ret rieve prov ider data  from the c laim
  286    S RCCLAIM =$$GET1^DI Q(361.1,$P (^RCY(344. 4,RCSCR,1, RCSCR1,0), U,2),.01)  ;determine  claim num  based on  entry in 3 44.4
  287    S DIC="^D GCR(399,", DIC(0)="", X=RCCLAIM  D ^DIC S R CCLAIM=+Y       ;find  ien for f ile 399
  288    D GETS^DI Q(399,RCCL AIM,"222*" ,"IE","RCX XX") ;retr ieve prov  informatio n
  289    S RCBILL= $$GET1^DIQ (399,RCCLA IM,.22,"I" ) ;retriev e default  division
  290    S RCBNM=$ $GET1^DIQ( 4,$$GET1^D IQ(40.8,RC BILL,.07," I"),.01) ; get name f rom instit ution file
  291    S RCBILL= $$GET1^DIQ (4,$$GET1^ DIQ(40.8,R CBILL,.07, "I"),41.99 ) ;get NPI  from inst itution fi le
  292    ;
  293    S $P(RCYY Y("BILLING "),U,2)=RC BNM_"/"_RC BILL_"^"_0  ;NPI set  into local  array
  294    I $D(RCXX X) S RCPRO V="" F  S  RCPROV=$O( RCXXX(399. 0222,RCPRO V)) Q:RCPR OV=""  D   ;loop thro ugh claim  providers
  295    . S RCIEN =$P(RCXXX( 399.0222,R CPROV,.02, "I"),";",1 )
  296    . S RCID= $S($P(RCXX X(399.0222 ,RCPROV,.0 2,"I"),";" ,2)["VA(20 0":"Indivi dual_ID",1 :"Non_VA_P rovider_ID ")
  297    . S RCNPI =$$NPI^XUS NPI(RCID,R CIEN) ;ret rieve prov ider NPI
  298    . S $P(RC YYY(RCXXX( 399.0222,R CPROV,.01, "E")),U,2) =$E(RCXXX( 399.0222,R CPROV,.02, "E"),1,20) _"/"_$S(+R CNPI=0:"No  NPI on fi le",+RCNPI =-1:"Can't  look up N PI",1:+RCN PI)
  299    . S:$P(RC YYY(RCXXX( 399.0222,R CPROV,.01, "E")),U,3) ="" $P(RCY YY(RCXXX(3 99.0222,RC PROV,.01," E")),U,3)= 0
  300   LINESET ;S ET THE PRI NT LINES
  301    S (RCWARN ,RCPROV)=" " F  S RCP ROV=$O(RCY YY(RCPROV) ) Q:RCPROV =""  D  ;l oop throug h the foun d provider  types
  302    . S RC=RC +1 ;increm ent line c ounter
  303    . ; build  display d etail line
  304    . S RCXM1 (RC-1)=RCP ROV_": "_$ P(RCYYY(RC PROV),U,1)
  305    . I $L(RC XM1(RC-1)) >39 D
  306    .. S RCXM 1(RC-1)=$E ($P(RCXM1( RC-1),"/") ,1,27)_"/" _$P(RCXM1( RC-1),"/", 2)
  307    . S RCXM1 (RC-1)=$E( RCXM1(RC-1 )_RCBLANK, 1,39)_$P(R CYYY(RCPRO V),U,2)
  308    . I $P(RC YYY(RCPROV ),U,3)'=0  S RCWARN=$ P(RCYYY(RC PROV),U,3)
  309    I RCWARN' ="" D
  310    . S RC=RC +1,RCXM1(R C-1)=" "                             ;Blank  line for  separation
  311    . S RC=RC +1,RCXM1(R C-1)="Rend ering/Serv icing Prov ider NPI W arning:"
  312    . S RC=RC +1,RCXM1(R C-1)=RCWAR N
  313    S RC=RC+1 ,RCXM1(RC- 1)=" "                               ;Blank  line to s eparate fr om possibl e comments
  314    S RCCOM1= $P(RCYNODE 3,U,5),RCC OM2=$P(RCY NODE3,U,6)  D  ;Error  in NPI fo rmat
  315    . I $G(RC COM1)'=""  S RC=RC+1, RCXM1(RC-1 )=RCCOM1
  316    . I $G(RC COM2)'=""  S RC=RC+1, RCXM1(RC-1 )=RCCOM2
  317    Q
  318    ;
  319   NPICHK ;CH ECK THAT T HE NPI RET URNED MATC HES THE EN TITY TYPE  QUALIFIER
  320    S RCEXP=" " Q:$P(RCY NODE3,U,3) =""                ;  ENTITY TYP E QUALIFIE R
  321    ;
  322    S RCCOM2= $P(RCYNODE 3,U,6) ; R en/Serv co mment
  323    S XUSNPI= $P(RCYNODE 3,U,2)
  324    I RCCOM2= "",(XUSNPI ="") S RCE XP="**NO S ERVICING/R ENDERING N PI INCLUDE D IN 835** " D EXPSET  Q
  325    S RCRTN=$ $QI^XUSNPI (XUSNPI)
  326    I $P(RCRT N,U,1)="In dividual_I D" D  Q
  327    . I $P(RC YNODE3,U,3 )'=1 S RCE XP="**NPI  from 835 i ndicated o rganizatio nal but is  associate d with an  individual **" D EXPS ET Q
  328    I $P(RCRT N,U,1)="Or ganization _ID" D  Q
  329    . I $P(RC YNODE3,U,3 )'=2 S RCE XP="**NPI  from 835 i ndicated i ndividual  but is ass ociated wi th an orga nization** " D EXPSET  Q
  330    I $E($P(R CRTN,U,1), 1,3)="Non"  D  Q
  331    . N RCIEN ,RCTYPE S  RCIEN=$P(R CRTN,U,2), RCTYPE=$$G ET1^DIQ(35 5.93,RCIEN ,.02,"I")  Q:$G(RCTYP E)=""
  332    . I $P(RC YNODE3,U,3 )=1,RCTYPE =1 S RCEXP ="**NPI fr om 835 ind icated ind ividual bu t is assoc iated with  an organi zation**"  D EXPSET Q
  333    . I $P(RC YNODE3,U,3 )=2,RCTYPE =2 S RCEXP ="**NPI fr om 835 ind icated org anizationa l but is a ssociated  with an in dividual** " D EXPSET  Q
  334    I RCCOM2= "",(+RCRTN =0) S RCEX P="**The N PI returne d on the 8 35 is not  associated  with this  VistA sys tem**" D E XPSET Q
  335    Q
  336    ;
  337   EXPSET ;SE T THE PRIN T LINE WIT H THE ERRO R AS DEFIN ED IN RCEX P
  338    S $P(RCYY Y(RCPROV), U,3)=RCEXP
  339    Q
  340    ;
  341   PARAMS(RCQ UIT) ;PARA METERS ENT RY CONTINU ED FROM RC DPEWL0
  342    I $G(RCQU IT) K ^TMP ("RCERA_PA RAMS",$J)
  343   PARMSQ ;
  344    Q
  345    ;
  346   PARAMS2()  ;EP from R CDPEWL0
  347    ; PRCA*4. 5*317 - Mo ved due to  routine s ize issues
  348    ; Input:  None
  349    ; Returns : RCQUIT -  1 if user  ^ or time d out, 0 o therwise
  350    S RCQUIT= $$PAYMNT()  ; Ask for  zero/paym ent PRCA*4 .5*321
  351    Q:RCQUIT  1 ; PRCA*4 .5*321
  352    S RCQUIT= $$POSTSTAT () ; Ask P osting Sta tus
  353    Q:RCQUIT  1
  354    S RCQUIT= $$POSTMETH                           ; Ask  Posting Me thod
  355    Q:RCQUIT  1
  356    S RCQUIT= $$MATCHST                            ; Ask  ERA-EFT Ma tching Sta tus
  357    Q:RCQUIT  1
  358    S RCQUIT= $$CLAIMTYP () ; Ask C laim Type
  359    Q:RCQUIT  1
  360    S RCQUIT= $$PAYR() ;  Ask for s elected pa yers
  361    Q RCQUIT
  362    ;
  363   PAYMNT() ;  Payment T ype (Zero/ Payment or  Both) Sel ection ; P RCA*4.5*32 1 this who le subrout ine
  364    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  365    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCPAY MNT") - ER A Posting  Status fil ter
  366    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  367    N DIR,DTO UT,DUOUT,R CTYPEDF
  368    S RCTYPED F=$G(^TMP( "RCERA_PAR AMS",$J,"R CPAYMNT"))
  369    K DIR S D IR(0)="SA^ Z:ZERO;P:P AYMENT;B:B OTH"
  370    S DIR("A" )="(Z)ERO,  (P)AYMENT , or (B)OT H: "
  371    S DIR("B" )="B"
  372    S DIR("?" ,1)="Selec t ZERO to  only see E RAs with a  zero tota l amount p aid."
  373    S DIR("?" ,2)="Selec t PAYMENT  to only se e ERAs wit h a non-ze ro amount  paid."
  374    S DIR("?" )="Select  BOTH to se e both zer o and non- zero amoun t ERAs."
  375    S:RCTYPED F'="" DIR( "B")=RCTYP EDF     ;S tored pref erred valu e, use as  default
  376    W !
  377    D ^DIR
  378    I $D(DTOU T)!$D(DUOU T) Q 1
  379    S ^TMP("R CERA_PARAM S",$J,"RCP AYMNT")=Y
  380    Q 0
  381    ;
  382   POSTSTAT()  ; ERA Pos ting Statu s (Posted/ Unposted/B oth) Selec tion
  383    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  384    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCPOS T")- ERA P osting Sta tus filter
  385    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  386    N DIR,DTO UT,DUOUT,R CPOSTDF
  387    S RCPOSTD F=$G(^TMP( "RCERA_PAR AMS",$J,"R CPOST"))
  388    K DIR S D IR(0)="SA^ U:UNPOSTED ;P:POSTED; B:BOTH"
  389    S DIR("A" )="ERA pos ting statu s: (U)NPOS TED, (P)OS TED, or (B )OTH: "
  390    S DIR("B" )="U"
  391    S DIR("?" ,1)="Selec t UNPOSTED  to only s ee ERAs wi th a statu s of UNPOS TED."
  392    S DIR("?" ,2)="Selec t POSTED t o only see  ERAs with  a status  of POSTED. "
  393    S DIR("?" )="Select  BOTH to se e both unp osted and  posted ERA s."
  394    S:RCPOSTD F'="" DIR( "B")=RCPOS TDF    ; S tored pref erred valu e, use as  default
  395    W !
  396    D ^DIR
  397    I $D(DTOU T)!$D(DUOU T) Q 1
  398    S ^TMP("R CERA_PARAM S",$J,"RCP OST")=Y
  399    Q 0
  400    ;
  401   POSTMETH()  ; PRCA*4. 5*317 move d from RCD PEWL0 beca use of rou tine size  issues
  402    ; ERA Pos ting Metho d (Auto-Po sting/Non  Auto-Posti ng/Both) S election
  403    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  404    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCAUT OP")- ERA  Posting St atus filte r
  405    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  406    N DIR,DTO UT,DUOUT,R CAUTOPDF
  407    S RCAUTOP DF=$G(^TMP ("RCERA_PA RAMS",$J," RCAUTOP"))
  408    K DIR S D IR(0)="SA^ A:AUTO-POS TING;N:NON  AUTO-POST ING;B:BOTH "
  409    S DIR("A" )="Display  (A)UTO-PO STING, (N) ON AUTO-PO STING, or  (B)OTH: "
  410    S DIR("B" )="B"
  411    S DIR("?" ,1)="Selec t AUTO-POS TING to on ly see aut o-posted E RAs."
  412    S DIR("?" ,2)="Selec t NON AUTO -POSTING t o only see  ERAs that  were NOT  auto-poste d."
  413    S DIR("?" )="Select  BOTH to se e both aut o-posted a nd non aut o-posted E RAs."
  414    S:RCAUTOP DF'="" DIR ("B")=RCAU TOPDF    ; Stored pre ferred val ue, use as  default
  415    W !
  416    D ^DIR
  417    I $D(DTOU T)!$D(DUOU T) Q 1
  418    S ^TMP("R CERA_PARAM S",$J,"RCA UTOP")=Y
  419    Q 0
  420    ;
  421   MATCHST()  ; ERA-EFT  Matching S tatus(Matc hed/Unmatc hed/Both)  Selection
  422    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  423    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCMAT CH")- ERA  Posting St atus filte r
  424    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  425    N DIR,DTO UT,DUOUT,R CMATCHD
  426    S RCMATCH D=$G(^TMP( "RCERA_PAR AMS",$J,"R CMATCH"))
  427    K DIR S D IR(0)="SA^ N:NOT MATC HED;M:MATC HED;B:BOTH "
  428    S DIR("A" )="ERA-EFT  match sta tus: (N)OT  MATCHED,  (M)ATCHED,  or (B)OTH : "
  429    S DIR("B" )="B"
  430    S DIR("?" ,1)="Selec t NOT MATC HED to onl y see unma tched ERAs ."
  431    S DIR("?" ,2)="Selec t MATCHED  to only se e matched  ERAs."
  432    S DIR("?" )="Select  BOTH to se e both mat ched and u nmatched E RAs."
  433    S:RCMATCH D'="" DIR( "B")=RCMAT CHD      ; Stored pre ferred val ue, use as  default
  434    W !
  435    D ^DIR
  436    I $D(DTOU T)!$D(DUOU T) Q 1
  437    S ^TMP("R CERA_PARAM S",$J,"RCM ATCH")=Y
  438    Q 0
  439    ;
  440   CLAIMTYP()  ; Claim T ype (Medic al/Pharmac y/Both) Se lection
  441    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  442    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCTYP E") - ERA  Posting St atus filte r
  443    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  444    N DIR,DTO UT,DUOUT,R CTYPEDF
  445    S RCTYPED F=$G(^TMP( "RCERA_PAR AMS",$J,"R CTYPE"))
  446    ; PRCA*4. 5*321 - Ch anged set  of codes a nd help
  447    K DIR S D IR(0)="SA^ M:MEDICAL; P:PHARMACY ;T:TRICARE ;A:ALL"
  448    S DIR("A" )="(M)EDIC AL, (P)HAR MACY, (T)R ICARE or ( A)LL: "
  449    S DIR("B" )="A"
  450    S DIR("?" ,1)="Selec t MEDICAL  to only se e ERAs wit h a payer  type of me dical."
  451    S DIR("?" ,2)="Selec t PHARMACY  to only s ee ERAs wi th a payer  type of p harmacy."
  452    S DIR("?" ,3)="Selec t TRICARE  to only se e ERAs wit h a payer  type of Tr icare."
  453    S DIR("?" )="Select  ALL to see  medical,  pharmacy a nd Tricare  ERAs."
  454    ; PRCA*4. 5*321 - En d modified  code bloc k
  455    S:RCTYPED F'="" DIR( "B")=RCTYP EDF     ;S tored pref erred valu e, use as  default
  456    W !
  457    D ^DIR
  458    I $D(DTOU T)!$D(DUOU T) Q 1
  459    S ^TMP("R CERA_PARAM S",$J,"RCT YPE")=Y
  460    Q 0
  461    ;
  462   PAYR() ; P ayer Selec tion
  463    ; Input:  ^TMP("RCER A_PARAMS", $J) - Glob al array o f preferre d values ( if any)
  464    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCTYP E") - ERA  Posting St atus filte r
  465    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  466    N DIR,DTO UT,DUOUT,P QUIT,RCPAY R,RCPAYRDF
  467    S RCPAYRD F=$G(^TMP( "RCERA_PAR AMS",$J,"R CPAYR"))
  468    S RCQUIT= 0
  469    K DIR S D IR(0)="SA^ A:ALL;R:RA NGE"
  470    S DIR("A" )="(A)LL p ayers, (R) ANGE of pa yer names:  "
  471    S DIR("B" )="ALL"
  472    S DIR("?" ,1)="Enter ing ALL wi ll select  all payers ."
  473    S DIR("?" )="If RANG E is enter ed, you wi ll be prom pted for a  payer ran ge."
  474    S:$P(RCPA YRDF,"^")' ="" DIR("B ")=$P(RCPA YRDF,"^",1 ) ;Stored  preferred  value, use  as defaul t
  475    W !
  476    D ^DIR
  477    I $D(DTOU T)!$D(DUOU T) Q 1
  478    S RCPAYR= Y
  479    I RCPAYR= "A" S ^TMP ("RCERA_PA RAMS",$J," RCPAYR")=Y        ;Al l payers s elected
  480    I RCPAYR= "R" D  G:P QUIT PAYR
  481    . S PQUIT =0
  482    . W !,"Na mes you se lect here  will be th e payer na mes from t he ERA, no t the ins.  file"
  483    . K DIR
  484    . S DIR(" ?")="Enter  a name fr om 1 to 30  character s in UPPER  CASE."
  485    . S DIR(0 )="FA^1:30 ^K:X'?.U X "
  486    . S DIR(" A")="Start  with paye r name: "
  487    . S:$P(RC PAYRDF,"^" ,2)'="" DI R("B")=$P( RCPAYRDF," ^",2) ;Sto red prefer red value,  use as de fault
  488    . W !
  489    . D ^DIR
  490    . I $D(DT OUT)!$D(DU OUT) D  Q
  491    . . S PQU IT=1
  492    . . K ^TM P("RCERA_P ARAMS",$J, "RCPAYR")
  493    . S RCPAY R("FROM")= Y
  494    . K DIR
  495    . S DIR(" ?")="Enter  a name fr om 1 to 30  character s in UPPER  CASE."
  496    . S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="Go to pa yer name:  "
  497    . S DIR(" B")=$E(RCP AYR("FROM" ),1,27)_"Z ZZ"
  498    . S:$P(RC PAYRDF,"^" ,3)'="" DI R("B")=$P( RCPAYRDF," ^",3) ;Sto red prefer red value,  use as de fault
  499    . W !
  500    . D ^DIR
  501    . I $D(DT OUT)!$D(DU OUT) S PQU IT=1 Q
  502    . S ^TMP( "RCERA_PAR AMS",$J,"R CPAYR")=RC PAYR_"^"_R CPAYR("FRO M")_"^"_Y
  503    Q 0
  504    ;Modified  LogicRCDP EWLD ;ALB/ CLT - Cont inuation o f routine  RCDPEWL0 ; 09 DEC 201 6
  505    ;;4.5;Acc ounts Rece ivable;**2 52,317,321 ,xxx**;Mar  20, 1995; Build 8
  506    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  507    Q
  508    ;
  509   PROV(RCSCR ,RCSCR1,RC XM1,RC) ;G et prov da ta from ER A (FILE 34 4.4) and c laim (FILE  399)
  510    N RCXXX,R CYYY,RCDPE PV,RCCLAIM ,RCIEN,RCB ILL,RCID,R CBLANK,RCN PI,DIC,X,Y
  511    N RCPROV, RCEXP,XUSN PI,RCRTN,R CBNM,RCCOM 1,RCCOM2,R CWARN,RCYN ODE3
  512    ;
  513    S RCBLANK ="" F X=1: 1:30 S RCB LANK=RCBLA NK_" "
  514    S RC=RC+1  S RCXM1(R C-1)=RCBLA NK
  515    S RCYNODE 3=$G(^RCY( 344.4,RCSC R,1,RCSCR1 ,3))
  516    ;
  517   LKBOX ;Get  provider  data from  ELECTRONIC  REMITTANC E ADVICE f ile (#344. 4)
  518    S RC=RC+1 ,RCXM1(RC- 1)=$E("**E OB PROVIDE R(S)/NPI"_ $J(" ",39) ,1,39)_"CL AIM PROVID ER(S)/NPI* *"  ;setti ng sub-hea der for wo rklist
  519    S RC=RC+1 ,RCXM1(RC- 1)=$E("--- ---------- --------"_ $J(" ",39) ,1,39)_"-- ---------- ---------- -"
  520    ;
  521    S RCPROV= "BILLING", $P(RCYYY(R CPROV),U,3 )=0 ; piec e 3 initia lize for e rror msgs
  522    I $P(RCYN ODE3,U)'=" " S RCYYY( RCPROV)="/ "_$P(RCYNO DE3,U) ; B illing Pro v NPI 
  523    ;
  524    S RCPROV= "RENDERING "
  525    I $P(RCYN ODE3,U,3)= 2 S RCPROV ="SERVICIN G"
  526    I $P(RCYN ODE3,U,3)= "",($P(RCY NODE3,U,4) '[","),($P (RCYNODE3, U,4)'="")  S RCPROV=" SERVICING"
  527    I $P(RCYN ODE3,U,2)' =""!($P(RC YNODE3,U,4 )'="") S R CYYY(RCPRO V)=$E($P(R CYNODE3,U, 4),1,20)_" /"_$P(RCYN ODE3,U,2)
  528    S $P(RCYY Y(RCPROV), U,3)=0 ; i nitialize  for error  msgs
  529    D NPICHK         ; R CPROV has  to be "REN DERING" or  "SERVICIN G" when th is tag is  called !
  530    ;
  531   CLAIM ;Ret rieve prov ider data  from the c laim
  532    S RCCLAIM =$$GET1^DI Q(361.1,$P (^RCY(344. 4,RCSCR,1, RCSCR1,0), U,2),.01)  ;determine  claim num  based on  entry in 3 44.4
  533    S DIC="^D GCR(399,", DIC(0)="", X=RCCLAIM  D ^DIC S R CCLAIM=+Y       ;find  ien for f ile 399
  534    D GETS^DI Q(399,RCCL AIM,"222*" ,"IE","RCX XX") ;retr ieve prov  informatio n
  535    S RCBILL= $$GET1^DIQ (399,RCCLA IM,.22,"I" ) ;retriev e default  division
  536    S RCBNM=$ $GET1^DIQ( 4,$$GET1^D IQ(40.8,RC BILL,.07," I"),.01) ; get name f rom instit ution file
  537    S RCBILL= $$GET1^DIQ (4,$$GET1^ DIQ(40.8,R CBILL,.07, "I"),41.99 ) ;get NPI  from inst itution fi le
  538    ;
  539    S $P(RCYY Y("BILLING "),U,2)=RC BNM_"/"_RC BILL_"^"_0  ;NPI set  into local  array
  540    I $D(RCXX X) S RCPRO V="" F  S  RCPROV=$O( RCXXX(399. 0222,RCPRO V)) Q:RCPR OV=""  D   ;loop thro ugh claim  providers
  541    . S RCIEN =$P(RCXXX( 399.0222,R CPROV,.02, "I"),";",1 )
  542    . S RCID= $S($P(RCXX X(399.0222 ,RCPROV,.0 2,"I"),";" ,2)["VA(20 0":"Indivi dual_ID",1 :"Non_VA_P rovider_ID ")
  543    . S RCNPI =$$NPI^XUS NPI(RCID,R CIEN) ;ret rieve prov ider NPI
  544    . S $P(RC YYY(RCXXX( 399.0222,R CPROV,.01, "E")),U,2) =$E(RCXXX( 399.0222,R CPROV,.02, "E"),1,20) _"/"_$S(+R CNPI=0:"No  NPI on fi le",+RCNPI =-1:"Can't  look up N PI",1:+RCN PI)
  545    . S:$P(RC YYY(RCXXX( 399.0222,R CPROV,.01, "E")),U,3) ="" $P(RCY YY(RCXXX(3 99.0222,RC PROV,.01," E")),U,3)= 0
  546   LINESET ;S ET THE PRI NT LINES
  547    S (RCWARN ,RCPROV)=" " F  S RCP ROV=$O(RCY YY(RCPROV) ) Q:RCPROV =""  D  ;l oop throug h the foun d provider  types
  548    . S RC=RC +1 ;increm ent line c ounter
  549    . ; build  display d etail line
  550    . S RCXM1 (RC-1)=RCP ROV_": "_$ P(RCYYY(RC PROV),U,1)
  551    . I $L(RC XM1(RC-1)) >39 D
  552    .. S RCXM 1(RC-1)=$E ($P(RCXM1( RC-1),"/") ,1,27)_"/" _$P(RCXM1( RC-1),"/", 2)
  553    . S RCXM1 (RC-1)=$E( RCXM1(RC-1 )_RCBLANK, 1,39)_$P(R CYYY(RCPRO V),U,2)
  554    . I $P(RC YYY(RCPROV ),U,3)'=0  S RCWARN=$ P(RCYYY(RC PROV),U,3)
  555    I RCWARN' ="" D
  556    . S RC=RC +1,RCXM1(R C-1)=" "                             ;Blank  line for  separation
  557    . S RC=RC +1,RCXM1(R C-1)="Rend ering/Serv icing Prov ider NPI W arning:"
  558    . S RC=RC +1,RCXM1(R C-1)=RCWAR N
  559    S RC=RC+1 ,RCXM1(RC- 1)=" "                               ;Blank  line to s eparate fr om possibl e comments
  560    S RCCOM1= $P(RCYNODE 3,U,5),RCC OM2=$P(RCY NODE3,U,6)  D  ;Error  in NPI fo rmat
  561    . I $G(RC COM1)'=""  S RC=RC+1, RCXM1(RC-1 )=RCCOM1
  562    . I $G(RC COM2)'=""  S RC=RC+1, RCXM1(RC-1 )=RCCOM2
  563    Q
  564    ;
  565   NPICHK ;CH ECK THAT T HE NPI RET URNED MATC HES THE EN TITY TYPE  QUALIFIER
  566    S RCEXP=" " Q:$P(RCY NODE3,U,3) =""                ;  ENTITY TYP E QUALIFIE R
  567    ;
  568    S RCCOM2= $P(RCYNODE 3,U,6) ; R en/Serv co mment
  569    S XUSNPI= $P(RCYNODE 3,U,2)
  570    I RCCOM2= "",(XUSNPI ="") S RCE XP="**NO S ERVICING/R ENDERING N PI INCLUDE D IN 835** " D EXPSET  Q
  571    S RCRTN=$ $QI^XUSNPI (XUSNPI)
  572    I $P(RCRT N,U,1)="In dividual_I D" D  Q
  573    . I $P(RC YNODE3,U,3 )'=1 S RCE XP="**NPI  from 835 i ndicated o rganizatio nal but is  associate d with an  individual **" D EXPS ET Q
  574    I $P(RCRT N,U,1)="Or ganization _ID" D  Q
  575    . I $P(RC YNODE3,U,3 )'=2 S RCE XP="**NPI  from 835 i ndicated i ndividual  but is ass ociated wi th an orga nization** " D EXPSET  Q
  576    I $E($P(R CRTN,U,1), 1,3)="Non"  D  Q
  577    . N RCIEN ,RCTYPE S  RCIEN=$P(R CRTN,U,2), RCTYPE=$$G ET1^DIQ(35 5.93,RCIEN ,.02,"I")  Q:$G(RCTYP E)=""
  578    . I $P(RC YNODE3,U,3 )=1,RCTYPE =1 S RCEXP ="**NPI fr om 835 ind icated ind ividual bu t is assoc iated with  an organi zation**"  D EXPSET Q
  579    . I $P(RC YNODE3,U,3 )=2,RCTYPE =2 S RCEXP ="**NPI fr om 835 ind icated org anizationa l but is a ssociated  with an in dividual** " D EXPSET  Q
  580    I RCCOM2= "",(+RCRTN =0) S RCEX P="**The N PI returne d on the 8 35 is not  associated  with this  VistA sys tem**" D E XPSET Q
  581    Q
  582    ;
  583   EXPSET ;SE T THE PRIN T LINE WIT H THE ERRO R AS DEFIN ED IN RCEX P
  584    S $P(RCYY Y(RCPROV), U,3)=RCEXP
  585    Q
  586    ;
  587   PARAMS(RCQ UIT) ;PARA METERS ENT RY CONTINU ED FROM RC DPEWL0
  588    I $G(RCQU IT) K ^TMP ("RCERA_PA RAMS",$J)
  589   PARMSQ ;
  590    Q
  591    ;
  592   PARAMS2()  ;EP from R CDPEWL0
  593    ; PRCA*4. 5*317 - Mo ved due to  routine s ize issues
  594    ; Input:  None
  595    ; Returns : RCQUIT -  1 if user  ^ or time d out, 0 o therwise
  596    S RCQUIT= $$PAYMNT()  ; Ask for  zero/paym ent PRCA*4 .5*321
  597    Q:RCQUIT  1 ; PRCA*4 .5*321
  598    S RCQUIT= $$POSTSTAT () ; Ask P osting Sta tus
  599    Q:RCQUIT  1
  600    S RCQUIT= $$POSTMETH                           ; Ask  Posting Me thod
  601    Q:RCQUIT  1
  602    S RCQUIT= $$MATCHST                            ; Ask  ERA-EFT Ma tching Sta tus
  603    Q:RCQUIT  1
  604    S RCQUIT= $$CLAIMTYP () ; Ask C laim Type
  605    Q:RCQUIT  1
  606    S RCQUIT= $$PAYR() ;  Ask for s elected pa yers
  607    Q RCQUIT
  608    ;
  609   PAYMNT() ;  Payment T ype (Zero/ Payment or  Both) Sel ection ; P RCA*4.5*32 1 this who le subrout ine
  610    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  611    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCPAY MNT") - ER A Posting  Status fil ter
  612    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  613    N DIR,DTO UT,DUOUT,R CTYPEDF
  614    S RCTYPED F=$G(^TMP( "RCERA_PAR AMS",$J,"R CPAYMNT"))
  615    K DIR S D IR(0)="SA^ Z:ZERO;P:P AYMENT;B:B OTH"
  616    S DIR("A" )="(Z)ERO,  (P)AYMENT , or (B)OT H: "
  617    S DIR("B" )="B"
  618    S DIR("?" ,1)="Selec t ZERO to  only see E RAs with a  zero tota l amount p aid."
  619    S DIR("?" ,2)="Selec t PAYMENT  to only se e ERAs wit h a non-ze ro amount  paid."
  620    S DIR("?" )="Select  BOTH to se e both zer o and non- zero amoun t ERAs."
  621    S:RCTYPED F'="" DIR( "B")=RCTYP EDF     ;S tored pref erred valu e, use as  default
  622    W !
  623    D ^DIR
  624    I $D(DTOU T)!$D(DUOU T) Q 1
  625    S ^TMP("R CERA_PARAM S",$J,"RCP AYMNT")=Y
  626    Q 0
  627    ;
  628   POSTSTAT()  ; ERA Pos ting Statu s (Posted/ Unposted/B oth) Selec tion
  629    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  630    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCPOS T")- ERA P osting Sta tus filter
  631    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  632    N DIR,DTO UT,DUOUT,R CPOSTDF
  633    S RCPOSTD F=$G(^TMP( "RCERA_PAR AMS",$J,"R CPOST"))
  634    K DIR S D IR(0)="SA^ U:UNPOSTED ;P:POSTED; B:BOTH"
  635    S DIR("A" )="ERA pos ting statu s: (U)NPOS TED, (P)OS TED, or (B )OTH: "
  636    S DIR("B" )="U"
  637    S DIR("?" ,1)="Selec t UNPOSTED  to only s ee ERAs wi th a statu s of UNPOS TED."
  638    S DIR("?" ,2)="Selec t POSTED t o only see  ERAs with  a status  of POSTED. "
  639    S DIR("?" )="Select  BOTH to se e both unp osted and  posted ERA s."
  640    S:RCPOSTD F'="" DIR( "B")=RCPOS TDF    ; S tored pref erred valu e, use as  default
  641    W !
  642    D ^DIR
  643    I $D(DTOU T)!$D(DUOU T) Q 1
  644    S ^TMP("R CERA_PARAM S",$J,"RCP OST")=Y
  645    Q 0
  646    ;
  647   POSTMETH()  ; PRCA*4. 5*317 move d from RCD PEWL0 beca use of rou tine size  issues
  648    ; ERA Pos ting Metho d (Auto-Po sting/Non  Auto-Posti ng/Both) S election
  649    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  650    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCAUT OP")- ERA  Posting St atus filte r
  651    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  652    N DIR,DTO UT,DUOUT,R CAUTOPDF
  653   P1 S RCAUT OPDF=$G(^T MP("RCERA_ PARAMS",$J ,"RCAUTOP" ))
  654    K DIR S D IR(0)="SA^ A:AUTO-POS TING;N:NON  AUTO-POST ING;B:BOTH "
  655    S DIR("A" )="Display  (A)UTO-PO STING, (N) ON AUTO-PO STING, or  (B)OTH: "
  656    S DIR("B" )="B"
  657    S DIR("?" ,1)="Selec t AUTO-POS TING to on ly see aut o-posted E RAs."
  658    S DIR("?" ,2)="Selec t NON AUTO -POSTING t o only see  ERAs that  were NOT  auto-poste d."
  659    S DIR("?" )="Select  BOTH to se e both aut o-posted a nd non aut o-posted E RAs."
  660    S:RCAUTOP DF'="" DIR ("B")=RCAU TOPDF    ; Stored pre ferred val ue, use as  default
  661    W !
  662    D ^DIR
  663    I $D(DTOU T)!$D(DUOU T) Q 1
  664    G:’$$VALP (Y) P1
  665    S ^TMP("R CERA_PARAM S",$J,"RCA UTOP")=Y
  666    ; If incl uding auto -post ERA  ask for au to-post st atus filte rs
  667    I Y’=”N”  Q $$AUTOPS T()
  668    Q 0
  669    ;
  670   MATCHST()  ; ERA-EFT  Matching S tatus(Matc hed/Unmatc hed/Both)  Selection
  671    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  672    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCMAT CH")- ERA  Posting St atus filte r
  673    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  674    N DIR,DTO UT,DUOUT,R CMATCHD
  675   M1 S RCMAT CHD=$G(^TM P("RCERA_P ARAMS",$J, "RCMATCH") )
  676    K DIR S D IR(0)="SA^ N:NOT MATC HED;M:MATC HED;B:BOTH "
  677    S DIR("A" )="ERA-EFT  match sta tus: (N)OT  MATCHED,  (M)ATCHED,  or (B)OTH : "
  678    S DIR("B" )="B"
  679    S DIR("?" ,1)="Selec t NOT MATC HED to onl y see unma tched ERAs ."
  680    S DIR("?" ,2)="Selec t MATCHED  to only se e matched  ERAs."
  681    S DIR("?" )="Select  BOTH to se e both mat ched and u nmatched E RAs."
  682    S:RCMATCH D'="" DIR( "B")=RCMAT CHD      ; Stored pre ferred val ue, use as  default
  683    W !
  684    D ^DIR
  685    I $D(DTOU T)!$D(DUOU T) Q 1
  686    G:’$$VALM (Y) M1
  687    S ^TMP("R CERA_PARAM S",$J,"RCM ATCH")=Y
  688    Q 0
  689    ;
  690   CLAIMTYP()  ; Claim T ype (Medic al/Pharmac y/Both) Se lection
  691    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  692    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCTYP E") - ERA  Posting St atus filte r
  693    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  694    N DIR,DTO UT,DUOUT,R CTYPEDF
  695    S RCTYPED F=$G(^TMP( "RCERA_PAR AMS",$J,"R CTYPE"))
  696    ; PRCA*4. 5*321 - Ch anged set  of codes a nd help
  697    K DIR S D IR(0)="SA^ M:MEDICAL; P:PHARMACY ;T:TRICARE ;A:ALL"
  698    S DIR("A" )="(M)EDIC AL, (P)HAR MACY, (T)R ICARE or ( A)LL: "
  699    S DIR("B" )="A"
  700    S DIR("?" ,1)="Selec t MEDICAL  to only se e ERAs wit h a payer  type of me dical."
  701    S DIR("?" ,2)="Selec t PHARMACY  to only s ee ERAs wi th a payer  type of p harmacy."
  702    S DIR("?" ,3)="Selec t TRICARE  to only se e ERAs wit h a payer  type of Tr icare."
  703    S DIR("?" )="Select  ALL to see  medical,  pharmacy a nd Tricare  ERAs."
  704    ; PRCA*4. 5*321 - En d modified  code bloc k
  705    S:RCTYPED F'="" DIR( "B")=RCTYP EDF     ;S tored pref erred valu e, use as  default
  706    W !
  707    D ^DIR
  708    I $D(DTOU T)!$D(DUOU T) Q 1
  709    S ^TMP("R CERA_PARAM S",$J,"RCT YPE")=Y
  710    Q 0
  711    ;
  712   PAYR() ; P ayer Selec tion
  713    ; Input:  ^TMP("RCER A_PARAMS", $J) - Glob al array o f preferre d values ( if any)
  714    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCTYP E") - ERA  Posting St atus filte r
  715    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  716    N DIR,DTO UT,DUOUT,P QUIT,RCPAY R,RCPAYRDF
  717    S RCPAYRD F=$G(^TMP( "RCERA_PAR AMS",$J,"R CPAYR"))
  718    S RCQUIT= 0
  719    K DIR S D IR(0)="SA^ A:ALL;R:RA NGE"
  720    S DIR("A" )="(A)LL p ayers, (R) ANGE of pa yer names:  "
  721    S DIR("B" )="ALL"
  722    S DIR("?" ,1)="Enter ing ALL wi ll select  all payers ."
  723    S DIR("?" )="If RANG E is enter ed, you wi ll be prom pted for a  payer ran ge."
  724    S:$P(RCPA YRDF,"^")' ="" DIR("B ")=$P(RCPA YRDF,"^",1 ) ;Stored  preferred  value, use  as defaul t
  725    W !
  726    D ^DIR
  727    I $D(DTOU T)!$D(DUOU T) Q 1
  728    S RCPAYR= Y
  729    I RCPAYR= "A" S ^TMP ("RCERA_PA RAMS",$J," RCPAYR")=Y        ;Al l payers s elected
  730    I RCPAYR= "R" D  G:P QUIT PAYR
  731    . S PQUIT =0
  732    . W !,"Na mes you se lect here  will be th e payer na mes from t he ERA, no t the ins.  file"
  733    . K DIR
  734    . S DIR(" ?")="Enter  a name fr om 1 to 30  character s in UPPER  CASE."
  735    . S DIR(0 )="FA^1:30 ^K:X'?.U X "
  736    . S DIR(" A")="Start  with paye r name: "
  737    . S:$P(RC PAYRDF,"^" ,2)'="" DI R("B")=$P( RCPAYRDF," ^",2) ;Sto red prefer red value,  use as de fault
  738    . W !
  739    . D ^DIR
  740    . I $D(DT OUT)!$D(DU OUT) D  Q
  741    . . S PQU IT=1
  742    . . K ^TM P("RCERA_P ARAMS",$J, "RCPAYR")
  743    . S RCPAY R("FROM")= Y
  744    . K DIR
  745    . S DIR(" ?")="Enter  a name fr om 1 to 30  character s in UPPER  CASE."
  746    . S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="Go to pa yer name:  "
  747    . S DIR(" B")=$E(RCP AYR("FROM" ),1,27)_"Z ZZ"
  748    . S:$P(RC PAYRDF,"^" ,3)'="" DI R("B")=$P( RCPAYRDF," ^",3) ;Sto red prefer red value,  use as de fault
  749    . W !
  750    . D ^DIR
  751    . I $D(DT OUT)!$D(DU OUT) S PQU IT=1 Q
  752    . S ^TMP( "RCERA_PAR AMS",$J,"R CPAYR")=RC PAYR_"^"_R CPAYR("FRO M")_"^"_Y
  753    Q 0
  754    ;
  755   AUTOPST()  ; Auto-pos t Status ( Marked/Par tial/Compl ete/All) S election
  756    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of p referred v alues (if  any)
  757    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,”RCAPS TA”) – Aut o-post Sta tus filter
  758    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  759    N DIR,DTO UT,DUOUT,A PTYPEDF
  760   A1 S APTYP EDF=$G(^TM P("RCERA_P ARAMS",$J, ”RCAPSTA”) )
  761    K DIR S D IR(0)="SA^ M:MARKED;P :PARTIAL;C :COMPLETE; A:ALL"
  762    S DIR("A" )="Auto-Po st status:  (M)ARKED,  (P)ARTIAL , (C)OMPLE TE or (A)L L: "
  763    S DIR("B" )="A"
  764    S DIR("?" ,1)="Selec t MARKED t o only see  ERAs curr ently mark ed for aut opost."
  765    S DIR("?" ,2)="Selec t PARTIAL  to only se e ERAs wit h a partia l auto-pos t status."
  766    S DIR("?" ,3)="Selec t COMPLETE  to only s ee ERAs wi th a compl ete auto-p ost status ."
  767    S DIR("?" )="Select  ALL to see  ERAs with  any autop ost status ."
  768    S:APTYPED F'="" DIR( "B")=APTYP EDF     ;S tored pref erred valu e, use as  default
  769    W !
  770    D ^DIR
  771    I $D(DTOU T)!$D(DUOU T) Q 1
  772    G:’$$VALA (Y) A1
  773    S ^TMP("R CERA_PARAM S",$J,”RCA PSTA”)=Y
  774    Q 0
  775    ;
  776   VALA(INP)  ; Compare  input auto -post stat us filter  to other f ilters
  777    ; Input I NP - Y val ue from ^D IR
  778    ; Output  1 = Valid  0 = Invali d
  779    ;
  780    I INP="C" ,$G(^TMP(" RCERA_PARA MS",$J,"RC POST"))="U " D  Q 0
  781    .W "Auto- post COMPL ETE is an  invalid se lection fo r UNPOSTED  ERAs"
  782    I INP="P" ,$G(^TMP(" RCERA_PARA MS",$J,"RC POST"))="U " D  Q 0
  783    .W "Auto- post PARTI AL is an i nvalid sel ection for  UNPOSTED  ERAs"
  784    I INP="M" ,$G(^TMP(" RCERA_PARA MS",$J,"RC POST"))="P " D  Q 0
  785    .W "MARKE D for Auto -post is a n invalid  selection  for POSTED  ERAs"
  786    Q 1
  787    ;
  788   VALM(INP)  ; Compare  input matc h type fil ter to oth er filters
  789    ; Input I NP - Y val ue from ^D IR
  790    ; Output  1 = Valid  0 = Invali d
  791    ;
  792    I INP="N" ,$G(^TMP(" RCERA_PARA MS",$J,"RC AUTOP"))=" A" D  Q 0
  793    .W "NOT M ATCHED is  an invalid  selection  for AUTO- POSTING ER As"
  794    Q 1
  795    ;
  796   VALP(INP)  ; Compare  input post ing method  filter to  other fil ters
  797    ; Input I NP - Y val ue from ^D IR
  798    ; Output  1 = Valid  0 = Invali d
  799    ;
  800    I INP="A" ,$G(^TMP(" RCERA_PARA MS",$J,"RC PAYMNT"))= "Z" D  Q 0
  801    .W "AUTO- POSTING is  an invali d selectio n for ZERO  ERAs"
  802    Q 1Routin esActiviti esRoutine  NameRCDPEW L0Enhancem ent Catego ry New Mod ify Delete  No Change RTMRelated  OptionsRC DPE EDI LO CKBOX WORK LISTRelate d Routines Routines “ Called By” Routines “ Called”     Current L ogicRCDPEW L0 ;ALB/TM K/PJH - EL ECTRONIC E OB WORKLIS T ACTIONS  ;Jun 06, 2 014@19:11: 19
  803    ;;4.5;Acc ounts Rece ivable;**1 73,208,252 ,269,298,3 17,321**;M ar 20, 199 5;Build 8
  804    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  805    Q
  806    ;
  807   PARAMS(SOU RCE) ; Ret rieve/Edit /Save View  Parameter s for ERA  Worklist
  808    ; Input:  SOURCE - " MO" - Menu  Option
  809    ; "CV" -  Change Vie w Action
  810    ; Output:  Sort/Filt ering Crit eria for t he worklis t sent int o ^TMP("RC ERA_PARAMS ",$J)
  811    ; ^TMP("R CERA_PARAM S",$J,"RCP OST") - ER A Posting  Status ("P ":Posted/" U":Unposte d)
  812    ; ^TMP("R CERA_PARAM S",$J,"RCA UTOP")- Au to-Post st atus 
  813    ; ("A":Au to-Posting /"N":Non A uto-Postin g/"B":Both )
  814    ; ^TMP("R CERA_PARAM S",$J,"RCM ATCH")- ER A Matching  Status (" M":Matched /"U":Unmat ched)
  815    ; ^TMP("R CERA_PARAM S",$J,"RCT YPE") - ER A Claim Ty pe ("M":Me dical/"P": Pharmacy/" B":Both)
  816    ; ^TMP("R CERA_PARAM S",$J,"RCD T") - A1^A 2 Where:
  817    ; A1 - ER A Received  EARLIEST  DATE (Rang e Limited  Only)
  818    ; A2 - ER A Received  LATEST DA TE (Range  Limited On ly)
  819    ; ^TMP("R CERA_PARAM S",$J,"RCP AYR") - B1 ^B2^B3 Whe re:
  820    ; B1 - Al l Payers/R ange of Pa yers
  821    ; ("A": A ll/"R":Ran ge of Paye rs)
  822    ; B2 - ST ART WITH P AYER (e.g. ,'AET')
  823    ; (Range  Limited On ly)
  824    ; B3 - GO  TO PAYER  (e.g.,'AET Z') (Range  Limited O nly)
  825    ;
  826    ; ^TMP("R CERA_PVW", $J) - Same  layout as  ^TMP("RCE RA_PARAMS" ,$J). This  global co ntains
  827    ; the sor t/filters  of the use r's prefer red view ( for ERA ma in page)
  828    ; while ^ TMP("RCERA _PARAMS",$ J) contain s the sort /filters o f what is
  829    ; current ly display ed. They m ay or may  not be the  same valu es.
  830    ;
  831    ; ^TMP("R CSCRATCH_P VW",$J) -  This globa l contains  the sort/ filters of  the user' s preferre d view
  832    ; for the  Scratch P ad. See PA RAMS^RCDPE WLA for th e layout.
  833    ;
  834    ; RCQUIT= 1 if the u ser exited  out, 0 ot herwise
  835    ;
  836    N RCXPAR, USEPVW,X,X X,Y                 ;  PRCA*4.5* 317 Added  USEPVW,XX
  837    S RCQUIT= 0
  838    ;
  839    ; Ask Dat e Range Se lection wh en coming  straight f rom the me nu option
  840    I SOURCE= "MO" D  Q: RCQUIT
  841    . K ^TMP( "RCERA_PAR AMS",$J),^ TMP("RCERA _PVW",$J), ^TMP("RCSC RATCH_PVW" ,$J)
  842    . S RCQUI T=$$DTR()  ; Set date  range fil ter
  843    . Q:RCQUI T
  844    . ;
  845    . ;Retrie ve user's  saved pref erred view  (if any)
  846    . D GETWL PVW(.RCXPA R)
  847    ;
  848    ;Only ask  user if t hey want t o use thei r preferre d view in  the follow ing scenar ios:
  849    ; a) Sour ce is "MO"  and user  has a pref erred view  on file
  850    ; b) Sour ce is "CV"  (change v iew action ), user ha s a prefer red view b ut is
  851    ; not usi ng the pre ferred vie w criteria  at this t ime.
  852    S XX=$$PR EFVW(SOURC E)
  853    I ((XX=1) &(SOURCE=" MO"))!((XX =0)&(SOURC E="CV")) D   Q:USEPVW
  854    . ;
  855    . ; Ask t he user if  they want  to use th e preferre d view
  856    . S USEPV W=$$ASKUVW ()
  857    . I USEPV W=-1 S RCQ UIT=1 Q
  858    . Q:'USEP VW
  859    . ;
  860    . ; Set t he Sort/Fi ltering Cr iteria fro m the pref erred view  
  861    . M ^TMP( "RCERA_PAR AMS",$J)=^ TMP("RCERA _PVW",$J)
  862    ;
  863    W !!,"Sel ect parame ters for d isplaying  the list o f ERAs"
  864    S RCQUIT= $$PARAMS2^ RCDPEWLD()
  865    Q:RCQUIT
  866    D SAVEPVW                                      ; Ask  if they wa nt to save  as prefer red view
  867    Q
  868    ;
  869   GETWLPVW(R CXPAR) ; R etrieves t he preferr ed view se ttings for  the ERA w orklist
  870    ; for the  user
  871    ; Input:  None
  872    ; Output:  RCXPAR()  - Array of  preferred  view sort /filter cr iteria
  873    ; ^TMP("R CERA_PARAM S",$J)- Gl obal array  of prefer red view s ettings
  874    ; ^TMP("R CERA_PVW")  - A copy  of the pre ferred set tings (if  any)
  875    N XX
  876    K RCXPAR
  877    D GETLST^ XPAR(.RCXP AR,"USR"," RCDPE EDI  LOCKBOX WO RKLIST","I ")
  878    D:$D(RCXP AR("ERA_PO STING_STAT US")) PVWS AVE(.RCXPA R)
  879    ;
  880    S XX=$G(R CXPAR("ERA _POSTING_S TATUS"))
  881    S ^TMP("R CERA_PARAM S",$J,"RCP OST")=$S(X X'="":XX,1 :"U")
  882    S XX=$G(R CXPAR("ERA _AUTO_POST ING"))
  883    S ^TMP("R CERA_PARAM S",$J,"RCA UTOP")=$S( XX'="":XX, 1:"B")
  884    S XX=$G(R CXPAR("ERA -EFT_MATCH _STATUS"))
  885    S ^TMP("R CERA_PARAM S",$J,"RCM ATCH")=$S( XX'="":XX, 1:"B")
  886    S XX=$G(R CXPAR("ERA _CLAIM_TYP E"))
  887    ; S ^TMP( "RCERA_PAR AMS",$J,"R CTYPE")=$S (XX'="":XX ,1:"B") ;  PRCA*4.5*3 21
  888    S ^TMP("R CERA_PARAM S",$J,"RCT YPE")=$S(X X'="":XX,1 :"A") ; PR CA*4.5*321  change de fault to ( A)LL
  889    S XX=$G(R CXPAR("ALL _PAYERS/RA NGE_OF_PAY ERS"))
  890    S ^TMP("R CERA_PARAM S",$J,"RCP AYR")=$S(X X'="":$TR( XX,";","^" ),1:"A")
  891    S XX=$G(R CXPAR("ERA _PAYMENT_T YPE")) ; P RCA*4.5*32 1 new filt er
  892    S ^TMP("R CERA_PARAM S",$J,"RCP AYMNT")=$S (XX'="":XX ,1:"B") ;  PRCA*4.5*3 21
  893    Q
  894    ;
  895   PVWSAVE(RC XPAR) ; Sa ve a copy  of the pre ferred vie w on file
  896    ; PRCA*4. 5*317 adde d subrouti ne
  897    ; Input:  RCXPAR - a rray of pr eferred vi ew setting  for the u ser
  898    ; Output:  ^TMP("RCE RA_PVW") -  a copy of  the prefe rred setti ngs
  899    ;
  900    K ^TMP("R CERA_PVW", $J)
  901    ; only co ntinue if  we have an swers to a ll ERA Wor klist rela ted prefer red view p rompts
  902    Q:'$D(RCX PAR("ERA_P OSTING_STA TUS"))
  903    Q:'$D(RCX PAR("ERA_A UTO_POSTIN G"))
  904    Q:'$D(RCX PAR("ERA-E FT_MATCH_S TATUS"))
  905    Q:'$D(RCX PAR("ERA_C LAIM_TYPE" ))
  906    Q:'$D(RCX PAR("ALL_P AYERS/RANG E_OF_PAYER S"))
  907    Q:'$D(RCX PAR("ERA_P AYMENT_TYP E")) ; PRC A*4.5*321
  908    ;
  909    S ^TMP("R CERA_PVW", $J,"RCPOST ")=RCXPAR( "ERA_POSTI NG_STATUS" )
  910    S ^TMP("R CERA_PVW", $J,"RCAUTO P")=RCXPAR ("ERA_AUTO _POSTING")
  911    S ^TMP("R CERA_PVW", $J,"RCMATC H")=RCXPAR ("ERA-EFT_ MATCH_STAT US")
  912    S ^TMP("R CERA_PVW", $J,"RCTYPE ")=RCXPAR( "ERA_CLAIM _TYPE")
  913    S ^TMP("R CERA_PVW", $J,"RCPAYR ")=$TR(RCX PAR("ALL_P AYERS/RANG E_OF_PAYER S"),";","^ ")
  914    S ^TMP("R CERA_PVW", $J,"RCPAYM NT")=RCXPA R("ERA_PAY MENT_TYPE" ) ; PRCA*4 .5*321 new  filter
  915    Q
  916    ;
  917   PREFVW(SOU RCE) ; Che cks to see  if the us er has a p referred v iew
  918    ; PRCA*4. 5*317 adde d subrouti ne
  919    ; When so urce is 'C V', checks  to see if  the prefe rred view  is being u sed
  920    ; Input:  SOURCE - ' MO' - When  called fr om the Wor klist menu
  921    ; option
  922    ; 'CV' -  When calle d from the  Change Vi ew
  923    ; action
  924    ;
  925    ; ^TMP("R CERA_PVW")  - Global  array of p referred v iew settin gs
  926    ; ^TMP("R CERA_PARAM S") - Glob al array o f currentl y in use d efaults
  927    ; Returns : 1 - User  has prefe rred view  if SOURCE  is 'MO' or  is using
  928    ; their p referred v iew if SOU RCE is 'CV '
  929    ; 0 - Use r is not u sing their  preferred  view
  930    ; -1 - Us er does no t have a p referred v iew 
  931    I SOURCE= "MO" Q $S( $D(^TMP("R CERA_PVW", $J)):1,1:- 1)
  932    Q:'$D(^TM P("RCERA_P VW",$J)) - 1 ; No sto red prefer red view
  933    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPOST"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCPOS T")) 0
  934    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCAUTOP")) '=$G(^TMP( "RCERA_PVW ",$J,"RCAU TOP")) 0
  935    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCMATCH")) '=$G(^TMP( "RCERA_PVW ",$J,"RCMA TCH")) 0
  936    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCTYPE"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCTYP E")) 0
  937    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPAYR"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCPAY R")) 0
  938    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPAYMNT") )'=$G(^TMP ("RCERA_PV W",$J,"RCP AYMNT")) 0  ; PRCA*4. 5*321
  939    Q 1
  940    ;
  941   ASKUVW() ; EP from PA RAMS^RCDPE WLA, PARAM S^RCDPEAA1
  942    ; Prompts  the user  to see if  they want  to use the ir preferr ed view
  943    ; PRCA*4. 5*317 adde d function
  944    ; Input:  None
  945    ; Returns : 1 - User  wants to  use their  preferred  view
  946    ; 0 - Use r does not  want to u se their p referred v iew
  947    ; -1 - Us er typed ' ^'
  948    N DIR,DTO UT,DUOUT
  949    S DIR(0)= "Y"
  950    S DIR("A" )="Use pre ferred vie w"
  951    S DIR("B" )="N"
  952    W !
  953    D ^DIR
  954    I $D(DTOU T)!$D(DUOU T) Q -1
  955    Q:Y 1 ; r esponse is  YES
  956    Q 0
  957    ;
  958   SAVEPVW ;  Option to  save as Us er Preferr ed View
  959    ; PRCA*4. 5*317 adde d subrouti ne
  960    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of c urrent wor klist sett ings
  961    ; Output  Current wo rklist set tings set  as preferr ed view (p otentially )
  962    N DIR,DTO UT,DUOUT,R CERROR,XX
  963    K DIR
  964    S DIR(0)= "YA",DIR(" B")="NO"
  965    S DIR("A" )="Do you  want to sa ve this as  your pref erred view  (Y/N)? "
  966    W !
  967    D ^DIR
  968    Q:Y'=1
  969    S XX=^TMP ("RCERA_PA RAMS",$J," RCPOST")
  970    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ POSTING_ST ATUS",XX,. RCERROR)
  971    S XX=^TMP ("RCERA_PA RAMS",$J," RCAUTOP")
  972    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ AUTO_POSTI NG",XX,.RC ERROR)
  973    S XX=^TMP ("RCERA_PA RAMS",$J," RCMATCH")
  974    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA- EFT_MATCH_ STATUS",XX ,.RCERROR)
  975    S XX=^TMP ("RCERA_PA RAMS",$J," RCTYPE")
  976    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ CLAIM_TYPE ",XX,.RCER ROR)
  977    S XX=$TR( ^TMP("RCER A_PARAMS", $J,"RCPAYR "),"^",";" )
  978    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ALL_ PAYERS/RAN GE_OF_PAYE RS",XX,.RC ERROR)
  979    S XX=^TMP ("RCERA_PA RAMS",$J," RCPAYMNT")  ; PRCA*4. 5*321
  980    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ PAYMENT_TY PE",XX,.RC ERROR) ; P RCA*4.5*32 1
  981    ;
  982    K ^TMP("R CERA_PVW", $J)
  983    M ^TMP("R CERA_PVW", $J)=^TMP(" RCERA_PARA MS",$J) ;  capture ne w preferre d settings  for compa rison
  984    Q
  985    ;
  986   DTR() ; Da te Range S election
  987    ; Input:  ^TMP("RCER A_PARAMS", $J,"RCDT")  - Current  selected  Date Range  (if any)
  988    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCDT" ) - Update d Selected  Date Rang e
  989    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  990   DTR1 ;
  991    N DIR,DTO UT,DTQUIT, DUOUT,Y,FR OM,TO,RCDT RNG
  992    S ^TMP("R CERA_PARAM S",$J,"RCD T")="0^"_D T
  993    K DIR S D IR(0)="YA"
  994    S DIR("A" )="Limit t he selecti on to a da te range w hen the ER A was rece ived?: "
  995    S DIR("B" )="NO"
  996    S DIR("?" )="Enter Y ES to spec ify a date  range fil ter."
  997    W !
  998    D ^DIR
  999    I $D(DTOU T)!$D(DUOU T) Q 1
  1000    I Y D  G: DTQUIT DTR 1
  1001    . S DTQUI T=0
  1002    . S FROM= $P($G(^TMP ("RCERA_PA RAMS",$J," RCDT")),"^ ",1)
  1003    . S TO=$P ($G(^TMP(" RCERA_PARA MS",$J,"RC DT")),"^", 2)
  1004    . W !
  1005    . S RCDTR NG=$$DTRAN GE(FROM,TO )
  1006    . I RCDTR NG="^" S D TQUIT=1 Q
  1007    . S ^TMP( "RCERA_PAR AMS",$J,"R CDT")=RCDT RNG
  1008    Q 0
  1009    ;
  1010   DTRANGE(DE FFROM,DEFT O) ; Asks  for and re turns a Da te Range
  1011    ; Input:  DEFFROM -  Default FR OM date
  1012    ; DEFTO -  Default T O date
  1013    ;Output:  From_Date^ To_Date (Y YYMMDD^YYY DDMM) or " ^" (timeou t or ^ ent ered)
  1014    ;
  1015    N DIR,Y,D TOUT,DUOUT ,RCDFR,STA RT
  1016    S RCQUIT= 0
  1017    S DIR(0)= "DAE^:"_DT _":E"
  1018    S DIR("A" )="Earlies t date: "
  1019    S DIR("?" )="Enter t he start o f the date  range."
  1020    S:($G(DEF FROM)) DIR ("B")=$$FM TE^XLFDT(D EFFROM,2)
  1021    D ^DIR
  1022    I $D(DTOU T)!$D(DUOU T) Q "^"
  1023    S RCDFR=Y ,START=$$F MTE^XLFDT( RCDFR,"2DZ ")
  1024    K DIR
  1025    S DIR(0)= "DAE^"_RCD FR_":"_DT_ ":E"
  1026    S DIR("A" )="Latest  date: "
  1027    S DIR("?" ,1)="Enter  the end o f the date  range. Th e ending d ate must b e greater  than "
  1028    S DIR("?" )="or equa l to "_STA RT_"."
  1029    S:($G(DEF TO)) DIR(" B")=$$FMTE ^XLFDT(DEF TO,2)
  1030    D ^DIR
  1031    I $D(DTOU T)!$D(DUOU T) Q "^"
  1032    Q (RCDFR_ "^"_Y)
  1033    ;
  1034   FILTER(IEN 344P4) ; R eturns 1 i f record i n entry IE N344P4 in  344.4 pass es
  1035    ; the edi ts for the  worklist  selection  of ERAs
  1036    ; Paramet ers found  in ^TMP("R CERA_PARAM S",$J)
  1037    N OK,RCPO ST,RCAUTOP ,RCMATCH,R CTYPE,RCDF R,RCDTO,RC PAYFR,RCPA YMNT,RCPAY TO,RCPAYR, RC0,RC4
  1038    S OK=1,RC 0=$G(^RCY( 344.4,IEN3 44P4,0)),R C4=$G(^RCY (344.4,IEN 344P4,4))
  1039    ;
  1040    S RCMATCH =$G(^TMP(" RCERA_PARA MS",$J,"RC MATCH")),R CPOST=$G(^ TMP("RCERA _PARAMS",$ J,"RCPOST" ))
  1041    S RCAUTOP =$G(^TMP(" RCERA_PARA MS",$J,"RC AUTOP")),R CTYPE=$G(^ TMP("RCERA _PARAMS",$ J,"RCTYPE" ))
  1042    S RCDFR=+ $P($G(^TMP ("RCERA_PA RAMS",$J," RCDT")),U) ,RCDTO=+$P ($G(^TMP(" RCERA_PARA MS",$J,"RC DT")),U,2)
  1043    S RCPAYR= $P($G(^TMP ("RCERA_PA RAMS",$J," RCPAYR")), U),RCPAYFR =$P($G(^TM P("RCERA_P ARAMS",$J, "RCPAYR")) ,U,2),RCPA YTO=$P($G( ^TMP("RCER A_PARAMS", $J,"RCPAYR ")),U,3)
  1044    S RCPAYMN T=$G(^TMP( "RCERA_PAR AMS",$J,"R CPAYMNT"))  ; PRCA*4. 5*321
  1045    ;
  1046    ; Post st atus
  1047    I $S(RCPO ST="B":0,R CPOST="U": $P(RC0,U,1 4),1:'$P(R C0,U,14))  S OK=0 G F Q
  1048    ; Auto-Po sting stat us
  1049    I $S(RCAU TOP="B":0, RCAUTOP="A ":($P(RC4, U,2)=""),1 :($P(RC4,U ,2)'=""))  S OK=0 G F Q
  1050    ; Match s tatus
  1051    I $S(RCMA TCH="B":0, RCMATCH="N ":$P(RC0,U ,9),1:'$P( RC0,U,9))  S OK=0 G F Q
  1052    ; Medical /Pharmacy/ Tricare Cl aim
  1053    ; I $S(RC TYPE="B":0 ,RCTYPE="M ":$$PHARM^ RCDPEWLP(I EN344P4),1 :'$$PHARM^ RCDPEWLP(I EN344P4))  S OK=0 G F Q
  1054    I RCTYPE' ="A" D  I  'OK G FQ
  1055    . N RCFLA G
  1056    . I '$$PA YFLAGS^RCD PEWL7(IEN3 44P4,.RCFL AG) S OK=0  Q
  1057    . I RCTYP E="P",'RCF LAG("P") S  OK=0 Q
  1058    . I RCTYP E="T",'RCF LAG("T") S  OK=0 Q
  1059    . I RCTYP E="M",(RCF LAG("P")!R CFLAG("T") ) S OK=0
  1060    ; dt rec' d range
  1061    I $S(RCDF R=0:0,1:$P (RC0,U,7)\ 1<RCDFR) S  OK=0 G FQ
  1062    I $S(RCDT O=DT:0,1:$ P(RC0,U,7) \1>RCDTO)  S OK=0 G F Q
  1063    ; Payer n ame
  1064    I RCPAYR' ="A" D  G: 'OK FQ
  1065    . N Q
  1066    . S Q=$$U P^RCDPEARL ($P(RC0,U, 6))
  1067    . I $S(Q= RCPAYFR:1, Q=RCPAYTO: 1,Q]RCPAYF R:RCPAYTO] Q,1:0) Q
  1068    . S OK=0
  1069    ; PRCA*4. 5*321 - St art modifi ed code bl ock
  1070    ; Zero am ount or pa yment
  1071    I RCPAYMN T'="B" D   ;
  1072    . I RCPAY MNT="Z",$P (RC0,U,5)  S OK=0 Q
  1073    . I RCPAY MNT="P",'$ P(RC0,U,5)  S OK=0
  1074    ; PRCA*4. 5*321 - En d modified  code bloc k
  1075    ;
  1076   FQ Q OK
  1077    ;
  1078   SPLIT ; Sp lit line i n ERA list
  1079    ; input -  RCSCR = i en of 344. 49 and 344 .4
  1080    N RCLINE, RCZ,RCDA,Q ,Q0,Z,Z0,D IR,X,Y,CT, L,L1,RCONE ,RCQUIT
  1081    D FULL^VA LM1
  1082    I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D  NOEDIT^RCD PEWLP G SP LITQ   ;pr ca*4.5*298  auto-post ed ERAs ca nnot enter  Split/Edi t action
  1083    I $G(RCSC R("NOEDIT" )) D NOEDI T^RCDPEWL  G SPLITQ
  1084    W !!,"Sel ect the en try that h as a line  you need t o Split/Ed it",!
  1085    D SEL^RCD PEWL(.RCDA )
  1086    S Z=+$O(R CDA(0)) G: '$G(RCDA(Z )) SPLITQ
  1087    S RCLINE= +RCDA(Z),Z 0=+$O(^TMP ("RCDPE-EO B_WLDX",$J ,Z_".999") ,-1)
  1088    S RCZ=Z F   S RCZ=$O (^TMP("RCD PE-EOB_WLD X",$J,RCZ) ) Q:'RCZ!( RCZ\1'=Z)  D
  1089    . S Q=$P( $G(^TMP("R CDPE-EOB_W LDX",$J,RC Z)),U,2)
  1090    . Q:'Q
  1091    . S RCZ(R CZ)=Q
  1092    . S Q0=0  F  S Q0=$O (^RCY(344. 49,RCSCR,1 ,Q,1,Q0))  Q:'Q0  I " 01"[$P($G( ^(Q0,0)),U ,2) K RCZ( RCZ) Q
  1093    I '$O(RCZ (0)) D  G  SPLITQ
  1094    . S DIR(0 )="EA",DIR ("A",1)="T his entry  has no lin es availab le to Edit /Split",DI R("A")="PR ESS RETURN  TO CONTIN UE " W ! D  ^DIR K DI R
  1095    S RCQUIT= 0
  1096    I $P($G(^ RCY(344.49 ,RCSCR,1,R CLINE,0)), U,13) D  G :RCQUIT SP LITQ
  1097    . S DIR(" A",1)="WAR NING! This  line has  already be en VERIFIE D",DIR("A" )="Are you  sure you  want to co ntinue?: " ,DIR(0)="Y A",DIR("B" )="NO" W !  D ^DIR K  DIR
  1098    . I Y'=1  S RCQUIT=1
  1099    S CT=0,CT =CT+1,DIR( "?",CT)="E nter the l ine # that  you want  to split o r edit:",R CONE=1
  1100    S L=Z F   S L=$O(RCZ (L)) Q:'L   D
  1101    . S L1=+$ G(^TMP("RC DPE-EOB_WL DX",$J,L))
  1102    . S CT=CT +1
  1103    . S DIR(" ?",CT)=$G( ^TMP("RCDP E-EOB_WL", $J,L1,0)), CT=CT+1,DI R("?",CT)= $G(^TMP("R CDPE-EOB_W L",$J,L1+1 ,0)) S RCO NE(1)=$S(R CONE:L,1:" ") S RCONE =0
  1104    S DIR("?" )=" ",Y=-1
  1105    I $G(RCON E(1)) S Y= +RCONE(1)  K DIR G:'Y  SPLITQ
  1106    I '$G(RCO NE(1)) D   K DIR I $D (DTOUT)!$D (DUOUT)!(Y \1'=Z) G S PLITQ
  1107    . F  S DI R(0)="NAO^ "_(Z+.001) _":"_Z0_": 3",DIR("A" )="Which l ine of ent ry "_Z_" d o you want  to Split/ Edit?: " S :$G(RCONE( 1))'="" DI R("B")=RCO NE(1) D ^D IR Q:'Y!$D (DUOUT)!$D (DTOUT) D   Q:Y>0
  1108    .. I '$D( ^TMP("RCDP E-EOB_WLDX ",$J,Y)) W  !!,"Line  "_Y_" does  NOT exist  - TRY AGA IN",! S Y= -1 Q
  1109    .. I '$D( RCZ(Y)) W  !!,"Line " _Y_" has b een used i n a DISTRI BUTE ADJ a ction and  can't be e dited",! S  Y=-1 Q
  1110    .. S Q=+$ O(^RCY(344 .49,RCSCR, 1,"B",Y,0) )
  1111    ;
  1112    K ^TMP("R CDPE_SPLIT _REBLD",$J )
  1113    D SPLIT^R CDPEWL3(RC SCR,+Y)
  1114    I $G(^TMP ("RCDPE_SP LIT_REBLD" ,$J)) K ^T MP("RCDPE_ SPLIT_REBL D",$J) D B LD^RCDPEWL 1($G(^TMP( $J,"RC_SOR TPARM")))
  1115    ;
  1116   SPLITQ S V ALMBCK="R"
  1117    Q
  1118    ;
  1119   PRTERA ; V iew/prt
  1120    N DIC,X,Y ,RCSCR
  1121    S DIC="^R CY(344.4," ,DIC(0)="A EMQ" D ^DI C
  1122    Q:Y'>0
  1123    S RCSCR=+ Y
  1124    D PRERA1
  1125    Q
  1126    ;
  1127   PRERA ; RC SCR is ass umed to be  defined
  1128    D FULL^VA LM1 ; Prot ocol entry
  1129   PRERA1 ; O ption entr y
  1130    N %ZIS,ZT RTN,ZTSAVE ,ZTDESC,PO P,DIR,X,Y, RCERADET
  1131    D EXCWARN ^RCDPEWLP( RCSCR)
  1132    S DIR("?" ,1)="Inclu ding expan ded detail  will sign ificantly  increase t he size of  this repo rt",DIR("? ",2)="IF Y OU CHOOSE  TO INCLUDE  IT, ALL P AYMENT DET AILS FOR E ACH EEOB W ILL BE"
  1133    S DIR("?" )="listed.  If you wa nt just su mmary data  for each  EEOB, do N OT include  it."
  1134    S DIR(0)= "YA",DIR(" A")="Do yo u want to  include ex panded EEO B detail?:  ",DIR("B" )="NO" W !  D ^DIR K  DIR
  1135    I $D(DUOU T)!$D(DTOU T) G PRERA Q
  1136    S RCERADE T=+Y
  1137    S %ZIS="Q M" D ^%ZIS  G:POP PRE RAQ
  1138    I $D(IO(" Q")) D  G  PRERAQ
  1139    . S ZTRTN ="VPERA^RC DPEWL0("_R CSCR_","_R CERADET_") ",ZTDESC=" AR - Print  ERA From  Worklist"
  1140    . D ^%ZTL OAD
  1141    . W !!,$S ($D(ZTSK): "Your task  # "_ZTSK_ " has been  queued.", 1:"Unable  to queue t his job.")
  1142    . K ZTSK, IO("Q") D  HOME^%ZIS
  1143    U IO
  1144    D VPERA(R CSCR,RCERA DET)
  1145    Q
  1146    ;
  1147   VPERA(RCSC R,RCERADET ) ; Queued  entry
  1148    ; RCSCR =  ien of en try in fil e 344.4
  1149    ; RCERADE T = 1 if i nclusion o f all EOB  details fr om file 36 1.1 is
  1150    ; desired , 0 if not
  1151    N Z,Z0,RC STOP,RCZ,R CPG,RCDOT, RCDIQ,RCDI Q1,RCDIQ2, RCXM1,RC,R CSCR1,RC36 11
  1152    K ^TMP($J ,"RC_SUMRA W"),^TMP($ J,"RC_SUMO UT"),^TMP( $J,"RC_SUM ALL")
  1153    S (RCSTOP ,RCPG)=0,R CDOT="",$P (RCDOT,"." ,79)=""
  1154    D GETS^DI Q(344.4,RC SCR_",","* ","IEN","R CDIQ")
  1155    D TXT0^RC DPEX31(RCS CR,.RCDIQ, .RCXM1,.RC ) ; Get to p level 0- node capti oned flds
  1156    I $O(^RCY (344.4,RCS CR,2,0)) S  RC=RC+1,R CXM1(RC)="  **ERA LEV EL ADJUSTM ENTS**"
  1157    S RCSCR1= 0 F  S RCS CR1=$O(^RC Y(344.4,RC SCR,2,RCSC R1)) Q:'RC SCR1  D
  1158    . K RCDIQ 2
  1159    . D GETS^ DIQ(344.42 ,RCSCR1_", "_RCSCR_", ","*","IEN ","RCDIQ2" )
  1160    . D TXT2^ RCDPEX31(R CSCR,RCSCR 1,.RCDIQ2, .RCXM1,.RC ) ; Get to p level ER A adjs
  1161    S RCSCR1= 0 F  S RCS CR1=$O(^RC Y(344.4,RC SCR,1,RCSC R1)) Q:'RC SCR1  D
  1162    . K RCDIQ 1
  1163    . D GETS^ DIQ(344.41 ,RCSCR1_", "_RCSCR_", ","*","IE" ,"RCDIQ1")  ;PRCA*4.5 *298 need  to retriev e all fiel ds even if  null (cha nged "IEN"  to "IE")
  1164    . D TXT00 ^RCDPEX31( RCSCR,RCSC R1,.RCDIQ1 ,.RCXM1,.R C)
  1165    . ;HIPAA  5010
  1166    . N PNAME 4
  1167    . S PNAME 4=$$PNM4^R CDPEWL1(RC SCR,RCSCR1 )
  1168    . I $L(PN AME4)<32 D
  1169    . .S RC=R C+1,RCXM1( RC-1)=$E(" PATIENT: " _PNAME4_$J ("",41),1, 41)_"CLAIM  #: "_$$BI LLREF^RCDP ESR0(RCSCR ,RCSCR1),R CXM1(RC)="  "
  1170    . I $L(PN AME4)>31 D
  1171    . .S RC=R C+1,RCXM1( RC-1)=$J(" ",41)_"CLA IM #: "_$$ BILLREF^RC DPESR0(RCS CR,RCSCR1)
  1172    . .S RC=R C+1,RCXM1( RC-1)=$E(" PATIENT: " _PNAME4,1, 78),RCXM1( RC)=" "
  1173    . D PROV^ RCDPEWLD(R CSCR,RCSCR 1,.RCXM1,. RC)
  1174    . S RC361 1=$P($G(^R CY(344.4,R CSCR,1,RCS CR1,0)),U, 2)
  1175    . I RCERA DET D
  1176    .. I 'RC3 611 D  Q
  1177    ... D DIS P^RCDPESR0 ("^RCY(344 .4,"_RCSCR _",1,"_RCS CR1_",1)", "^TMP($J," "RC_SUMRAW "")",1,"^T MP($J,""RC _SUMOUT"") ",75,1)
  1178    ..;
  1179    .. E  D   ; Detail r ecord is i n 361.1
  1180    ... K ^TM P("PRCA_EO B",$J)
  1181    ... D GET EOB^IBCECS A6(RC3611, 2)
  1182    ... I $O( ^IBM(361.1 ,RC3611,"E RR",0)) D  GETERR^RCD PEDS(RC361 1,+$O(^TMP ("PRCA_EOB ",$J,RC361 1," "),-1) ) ; get fi ling error s
  1183    ... S Z=0  F  S Z=$O (^TMP("PRC A_EOB",$J, RC3611,Z))  Q:'Z  S R C=RC+1,^TM P($J,"RC_S UMOUT",RC) =$G(^TMP(" PRCA_EOB", $J,RC3611, Z))
  1184    ... S RC= RC+2,^TMP( $J,"RC_SUM OUT",RC-1) =" ",^TMP( $J,"RC_SUM OUT",RC)="  "
  1185    ... K ^TM P("PRCA_EO B",$J)
  1186    . I $D(RC DIQ1(344.4 1,RCSCR1_" ,"_RCSCR_" ,",2)) D
  1187    .. S RC=R C+1,RCXM1( RC)=" **EX CEPTION RE SOLUTION L OG DATA**"
  1188    .. S Z=0  F  S Z=$O( RCDIQ1(344 .41,RCSCR1 _","_RCSCR _",",2,Z))  Q:'Z  S R C=RC+1,RCX M1(RC)=RCD IQ1(344.41 ,RCSCR1_", "_RCSCR_", ",2,Z)
  1189    . S RC=RC +1,RCXM1(R C)=" "
  1190    . S Z0=+$ O(^TMP($J, "RC_SUMALL "," "),-1)
  1191    . S Z=0 F   S Z=$O(R CXM1(Z)) Q :'Z  S Z0= Z0+1,^TMP( $J,"RC_SUM ALL",Z0)=R CXM1(Z)
  1192    . K RCXM1  S RC=0
  1193    . S Z=0 F   S Z=$O(^ TMP($J,"RC _SUMOUT",Z )) Q:'Z  S  Z0=Z0+1,^ TMP($J,"RC _SUMALL",Z 0)=$G(^TMP ($J,"RC_SU MOUT",Z))
  1194    S RCSTOP= 0,Z=""
  1195    F  S Z=$O (^TMP($J," RC_SUMALL" ,Z)) Q:'Z   D  Q:RCST OP
  1196    . I $D(ZT QUEUED),$$ S^%ZTLOAD  S (RCSTOP, ZTSTOP)=1  K ZTREQ I  +$G(RCPG)  W !!,"***T ASK STOPPE D BY USER* **" Q
  1197    . I 'RCPG !(($Y+5)>I OSL) D  I  RCSTOP Q
  1198    .. D:RCPG  ASK(.RCST OP) I RCST OP Q
  1199    .. D HDR( .RCPG)
  1200    . W !,$G( ^TMP($J,"R C_SUMALL", Z))
  1201    ;
  1202    I 'RCSTOP ,RCPG D AS K(.RCSTOP)
  1203    ;
  1204    I $D(ZTQU EUED) S ZT REQ="@"
  1205    I '$D(ZTQ UEUED) D ^ %ZISC
  1206    ;
  1207   PRERAQ K ^ TMP($J,"RC _SUMRAW"), ^TMP($J,"R C_SUMOUT") ,^TMP($J," SUMALL")
  1208    S VALMBCK ="R"
  1209    Q
  1210    ;
  1211   HDR(RCPG)  ;Report hd r
  1212    ; RCPG =  last page  #
  1213    I RCPG!($ E(IOST,1,2 )="C-") W  @IOF,*13
  1214    S RCPG=$G (RCPG)+1
  1215    W !,?5,"E DI LOCKBOX  WORKLIST  - ERA DETA IL",?55,$$ FMTE^XLFDT (DT,2),?70 ,"Page: ", RCPG,!,$TR ($J("",IOM )," ","=")
  1216    Q
  1217    ;
  1218   ASK(RCSTOP ) ;
  1219    I $E(IOST ,1,2)'["C- " Q
  1220    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
  1221    S DIR(0)= "E" W ! D  ^DIR
  1222    I ($D(DIR UT))!($D(D UOUT)) S R CSTOP=1 Q
  1223    Q
  1224    ;Modified  Logic (Ch anges are  in bold)RC DPEWL0 ;AL B/TMK/PJH  - ELECTRON IC EOB WOR KLIST ACTI ONS ;Jun 0 6, 2014@19 :11:19
  1225    ;;4.5;Acc ounts Rece ivable;**1 73,208,252 ,269,298,3 17,321**;M ar 20, 199 5;Build 8
  1226    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  1227    Q
  1228    ;
  1229   PARAMS(SOU RCE) ; Ret rieve/Edit /Save View  Parameter s for ERA  Worklist
  1230    ; Input:  SOURCE - " MO" - Menu  Option
  1231    ; "CV" -  Change Vie w Action
  1232    ; Output:  Sort/Filt ering Crit eria for t he worklis t sent int o ^TMP("RC ERA_PARAMS ",$J)
  1233    ; ^TMP("R CERA_PARAM S",$J,"RCP OST") - ER A Posting  Status ("P ":Posted/" U":Unposte d)
  1234    ; ^TMP("R CERA_PARAM S",$J,"RCA UTOP")- Au to-Posting  Queue
  1235    ; ("A":Au to-Posting /"N":Non A uto-Postin g/"B":Both )
  1236    ; ^TMP("R CERA_PARAM S",$J,"RCA PSTA")- Au to-Posting  Status
  1237    ; ("M":Ma rked/"P":P artial/"C" :Complete/ ”A”:All)
  1238    ; ^TMP("R CERA_PARAM S",$J,"RCM ATCH")- ER A Matching  Status (" M":Matched /"U":Unmat ched)
  1239    ; ^TMP("R CERA_PARAM S",$J,"RCT YPE") - ER A Claim Ty pe ("M":Me dical/"P": Pharmacy/" B":Both)
  1240    ; ^TMP("R CERA_PARAM S",$J,"RCD T") - A1^A 2 Where:
  1241    ; A1 - ER A Received  EARLIEST  DATE (Rang e Limited  Only)
  1242    ; A2 - ER A Received  LATEST DA TE (Range  Limited On ly)
  1243    ; ^TMP("R CERA_PARAM S",$J,"RCP AYR") - B1 ^B2^B3 Whe re:
  1244    ; B1 - Al l Payers/R ange of Pa yers
  1245    ; ("A": A ll/"R":Ran ge of Paye rs)
  1246    ; B2 - ST ART WITH P AYER (e.g. ,'AET')
  1247    ; (Range  Limited On ly)
  1248    ; B3 - GO  TO PAYER  (e.g.,'AET Z') (Range  Limited O nly)
  1249    ;
  1250    ; ^TMP("R CERA_PVW", $J) - Same  layout as  ^TMP("RCE RA_PARAMS" ,$J). This  global co ntains
  1251    ; the sor t/filters  of the use r's prefer red view ( for ERA ma in page)
  1252    ; while ^ TMP("RCERA _PARAMS",$ J) contain s the sort /filters o f what is
  1253    ; current ly display ed. They m ay or may  not be the  same valu es.
  1254    ;
  1255    ; ^TMP("R CSCRATCH_P VW",$J) -  This globa l contains  the sort/ filters of  the user' s preferre d view
  1256    ; for the  Scratch P ad. See PA RAMS^RCDPE WLA for th e layout.
  1257    ;
  1258    ; RCQUIT= 1 if the u ser exited  out, 0 ot herwise
  1259    ;
  1260    N RCXPAR, USEPVW,X,X X,Y                 ;  PRCA*4.5* 317 Added  USEPVW,XX
  1261    S RCQUIT= 0
  1262    ;
  1263    ; Ask Dat e Range Se lection wh en coming  straight f rom the me nu option
  1264    I SOURCE= "MO" D  Q: RCQUIT
  1265    . K ^TMP( "RCERA_PAR AMS",$J),^ TMP("RCERA _PVW",$J), ^TMP("RCSC RATCH_PVW" ,$J)
  1266    . S RCQUI T=$$DTR()  ; Set date  range fil ter
  1267    . Q:RCQUI T
  1268    . ;
  1269    . ;Retrie ve user's  saved pref erred view  (if any)
  1270    . D GETWL PVW(.RCXPA R)
  1271    ;
  1272    ;Only ask  user if t hey want t o use thei r preferre d view in  the follow ing scenar ios:
  1273    ; a) Sour ce is "MO"  and user  has a pref erred view  on file
  1274    ; b) Sour ce is "CV"  (change v iew action ), user ha s a prefer red view b ut is
  1275    ; not usi ng the pre ferred vie w criteria  at this t ime.
  1276    S XX=$$PR EFVW(SOURC E)
  1277    I ((XX=1) &(SOURCE=" MO"))!((XX =0)&(SOURC E="CV")) D   Q:USEPVW
  1278    . ;
  1279    . ; Ask t he user if  they want  to use th e preferre d view
  1280    . S USEPV W=$$ASKUVW ()
  1281    . I USEPV W=-1 S RCQ UIT=1 Q
  1282    . Q:'USEP VW
  1283    . ;
  1284    . ; Set t he Sort/Fi ltering Cr iteria fro m the pref erred view  
  1285    . M ^TMP( "RCERA_PAR AMS",$J)=^ TMP("RCERA _PVW",$J)
  1286    ;
  1287    W !!,"Sel ect parame ters for d isplaying  the list o f ERAs"
  1288    S RCQUIT= $$PARAMS2^ RCDPEWLD()
  1289    Q:RCQUIT
  1290    D SAVEPVW                                      ; Ask  if they wa nt to save  as prefer red view
  1291    Q
  1292    ;
  1293   GETWLPVW(R CXPAR) ; R etrieves t he preferr ed view se ttings for  the ERA w orklist
  1294    ; for the  user
  1295    ; Input:  None
  1296    ; Output:  RCXPAR()  - Array of  preferred  view sort /filter cr iteria
  1297    ; ^TMP("R CERA_PARAM S",$J)- Gl obal array  of prefer red view s ettings
  1298    ; ^TMP("R CERA_PVW")  - A copy  of the pre ferred set tings (if  any)
  1299    N XX
  1300    K RCXPAR
  1301    D GETLST^ XPAR(.RCXP AR,"USR"," RCDPE EDI  LOCKBOX WO RKLIST","I ")
  1302    D:$D(RCXP AR("ERA_PO STING_STAT US")) PVWS AVE(.RCXPA R)
  1303    ;
  1304    S XX=$G(R CXPAR("ERA _POSTING_S TATUS"))
  1305    S ^TMP("R CERA_PARAM S",$J,"RCP OST")=$S(X X'="":XX,1 :"U")
  1306    S XX=$G(R CXPAR("ERA _AUTO_POST ING"))
  1307    S ^TMP("R CERA_PARAM S",$J,"RCA UTOP")=$S( XX'="":XX, 1:"B")
  1308    S XX=$G(R CXPAR("ERA -EFT_MATCH _STATUS"))
  1309    S ^TMP("R CERA_PARAM S",$J,"RCM ATCH")=$S( XX'="":XX, 1:"B")
  1310    S XX=$G(R CXPAR("ERA _CLAIM_TYP E"))
  1311    ; S ^TMP( "RCERA_PAR AMS",$J,"R CTYPE")=$S (XX'="":XX ,1:"B") ;  PRCA*4.5*3 21
  1312    S ^TMP("R CERA_PARAM S",$J,"RCT YPE")=$S(X X'="":XX,1 :"A") ; PR CA*4.5*321  change de fault to ( A)LL
  1313    S XX=$G(R CXPAR("ALL _PAYERS/RA NGE_OF_PAY ERS"))
  1314    S ^TMP("R CERA_PARAM S",$J,"RCP AYR")=$S(X X'="":$TR( XX,";","^" ),1:"A")
  1315    S XX=$G(R CXPAR("ERA _PAYMENT_T YPE")) ; P RCA*4.5*32 1 new filt er
  1316    S ^TMP("R CERA_PARAM S",$J,"RCP AYMNT")=$S (XX'="":XX ,1:"B") ;  PRCA*4.5*3 21
  1317    S XX=$G(R CXPAR("AUT O-POST_STA TUS"))
  1318    S ^TMP("R CERA_PARAM S",$J,”RCA PSTA”)=$S( XX'="":XX, 1:"A")
  1319    Q
  1320    ;
  1321   PVWSAVE(RC XPAR) ; Sa ve a copy  of the pre ferred vie w on file
  1322    ; PRCA*4. 5*317 adde d subrouti ne
  1323    ; Input:  RCXPAR - a rray of pr eferred vi ew setting  for the u ser
  1324    ; Output:  ^TMP("RCE RA_PVW") -  a copy of  the prefe rred setti ngs
  1325    ;
  1326    K ^TMP("R CERA_PVW", $J)
  1327    ; only co ntinue if  we have an swers to a ll ERA Wor klist rela ted prefer red view p rompts
  1328    Q:'$D(RCX PAR("ERA_P OSTING_STA TUS"))
  1329    Q:'$D(RCX PAR("ERA_A UTO_POSTIN G"))
  1330    Q:'$D(RCX PAR("ERA-E FT_MATCH_S TATUS"))
  1331    Q:'$D(RCX PAR("ERA_C LAIM_TYPE" ))
  1332    Q:'$D(RCX PAR("ALL_P AYERS/RANG E_OF_PAYER S"))
  1333    Q:'$D(RCX PAR("ERA_P AYMENT_TYP E")) ; PRC A*4.5*321
  1334    Q:'$D(RCX PAR("AUTO- POST_STATU S"))
  1335    ;
  1336    S ^TMP("R CERA_PVW", $J,"RCPOST ")=RCXPAR( "ERA_POSTI NG_STATUS" )
  1337    S ^TMP("R CERA_PVW", $J,"RCAUTO P")=RCXPAR ("ERA_AUTO _POSTING")
  1338    S ^TMP("R CERA_PVW", $J,"RCMATC H")=RCXPAR ("ERA-EFT_ MATCH_STAT US")
  1339    S ^TMP("R CERA_PVW", $J,"RCTYPE ")=RCXPAR( "ERA_CLAIM _TYPE")
  1340    S ^TMP("R CERA_PVW", $J,"RCPAYR ")=$TR(RCX PAR("ALL_P AYERS/RANG E_OF_PAYER S"),";","^ ")
  1341    S ^TMP("R CERA_PVW", $J,"RCPAYM NT")=RCXPA R("ERA_PAY MENT_TYPE" ) ; PRCA*4 .5*321 new  filter
  1342    S ^TMP("R CERA_PVW", $J,"RCPAPS T")=RCXPAR ("AUTO-POS T_STATUS")
  1343    Q
  1344    ;
  1345   PREFVW(SOU RCE) ; Che cks to see  if the us er has a p referred v iew
  1346    ; PRCA*4. 5*317 adde d subrouti ne
  1347    ; When so urce is 'C V', checks  to see if  the prefe rred view  is being u sed
  1348    ; Input:  SOURCE - ' MO' - When  called fr om the Wor klist menu
  1349    ; option
  1350    ; 'CV' -  When calle d from the  Change Vi ew
  1351    ; action
  1352    ;
  1353    ; ^TMP("R CERA_PVW")  - Global  array of p referred v iew settin gs
  1354    ; ^TMP("R CERA_PARAM S") - Glob al array o f currentl y in use d efaults
  1355    ; Returns : 1 - User  has prefe rred view  if SOURCE  is 'MO' or  is using
  1356    ; their p referred v iew if SOU RCE is 'CV '
  1357    ; 0 - Use r is not u sing their  preferred  view
  1358    ; -1 - Us er does no t have a p referred v iew 
  1359    I SOURCE= "MO" Q $S( $D(^TMP("R CERA_PVW", $J)):1,1:- 1)
  1360    Q:'$D(^TM P("RCERA_P VW",$J)) - 1 ; No sto red prefer red view
  1361    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPOST"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCPOS T")) 0
  1362    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCAUTOP")) '=$G(^TMP( "RCERA_PVW ",$J,"RCAU TOP")) 0
  1363    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCMATCH")) '=$G(^TMP( "RCERA_PVW ",$J,"RCMA TCH")) 0
  1364    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCTYPE"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCTYP E")) 0
  1365    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPAYR"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCPAY R")) 0
  1366    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPAYMNT") )'=$G(^TMP ("RCERA_PV W",$J,"RCP AYMNT")) 0  ; PRCA*4. 5*321
  1367    Q:$G(^TMP ("RCERA_PA RAMS",$J,” RCAPSTA”)) '=$G(^TMP( "RCERA_PVW ",$J,”RCAP STA”)) 0
  1368    Q 1
  1369    ;
  1370   ASKUVW() ; EP from PA RAMS^RCDPE WLA, PARAM S^RCDPEAA1
  1371    ; Prompts  the user  to see if  they want  to use the ir preferr ed view
  1372    ; PRCA*4. 5*317 adde d function
  1373    ; Input:  None
  1374    ; Returns : 1 - User  wants to  use their  preferred  view
  1375    ; 0 - Use r does not  want to u se their p referred v iew
  1376    ; -1 - Us er typed ' ^'
  1377    N DIR,DTO UT,DUOUT
  1378    S DIR(0)= "Y"
  1379    S DIR("A" )="Use pre ferred vie w"
  1380    S DIR("B" )="N"
  1381    W !
  1382    D ^DIR
  1383    I $D(DTOU T)!$D(DUOU T) Q -1
  1384    Q:Y 1 ; r esponse is  YES
  1385    Q 0
  1386    ;
  1387   SAVEPVW ;  Option to  save as Us er Preferr ed View
  1388    ; PRCA*4. 5*317 adde d subrouti ne
  1389    ; Input:  ^TMP("RCER A_PARAMS")  - Global  array of c urrent wor klist sett ings
  1390    ; Output  Current wo rklist set tings set  as preferr ed view (p otentially )
  1391    N DIR,DTO UT,DUOUT,R CERROR,XX
  1392    K DIR
  1393    S DIR(0)= "YA",DIR(" B")="NO"
  1394    S DIR("A" )="Do you  want to sa ve this as  your pref erred view  (Y/N)? "
  1395    W !
  1396    D ^DIR
  1397    Q:Y'=1
  1398    S XX=^TMP ("RCERA_PA RAMS",$J," RCPOST")
  1399    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ POSTING_ST ATUS",XX,. RCERROR)
  1400    S XX=^TMP ("RCERA_PA RAMS",$J," RCAUTOP")
  1401    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ AUTO_POSTI NG",XX,.RC ERROR)
  1402    S XX=^TMP ("RCERA_PA RAMS",$J," RCMATCH")
  1403    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA- EFT_MATCH_ STATUS",XX ,.RCERROR)
  1404    S XX=^TMP ("RCERA_PA RAMS",$J," RCTYPE")
  1405    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ CLAIM_TYPE ",XX,.RCER ROR)
  1406    S XX=$TR( ^TMP("RCER A_PARAMS", $J,"RCPAYR "),"^",";" )
  1407    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ALL_ PAYERS/RAN GE_OF_PAYE RS",XX,.RC ERROR)
  1408    S XX=^TMP ("RCERA_PA RAMS",$J," RCPAYMNT")  ; PRCA*4. 5*321
  1409    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ PAYMENT_TY PE",XX,.RC ERROR) ; P RCA*4.5*32 1
  1410    S XX=$TR( ^TMP("RCER A_PARAMS", $J,”RCAPST A”),"^","; ")
  1411    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","AUTO -POST_STAT US",XX,.RC ERROR)
  1412    ;
  1413    K ^TMP("R CERA_PVW", $J)
  1414    M ^TMP("R CERA_PVW", $J)=^TMP(" RCERA_PARA MS",$J) ;  capture ne w preferre d settings  for compa rison
  1415    Q
  1416    ;
  1417   DTR() ; Da te Range S election
  1418    ; Input:  ^TMP("RCER A_PARAMS", $J,"RCDT")  - Current  selected  Date Range  (if any)
  1419    ; Output:  ^TMP("RCE RA_PARAMS" ,$J,"RCDT" ) - Update d Selected  Date Rang e
  1420    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  1421   DTR1 ;
  1422    N DIR,DTO UT,DTQUIT, DUOUT,Y,FR OM,TO,RCDT RNG
  1423    S ^TMP("R CERA_PARAM S",$J,"RCD T")="0^"_D T
  1424    K DIR S D IR(0)="YA"
  1425    S DIR("A" )="Limit t he selecti on to a da te range w hen the ER A was rece ived?: "
  1426    S DIR("B" )="NO"
  1427    S DIR("?" )="Enter Y ES to spec ify a date  range fil ter."
  1428    W !
  1429    D ^DIR
  1430    I $D(DTOU T)!$D(DUOU T) Q 1
  1431    I Y D  G: DTQUIT DTR 1
  1432    . S DTQUI T=0
  1433    . S FROM= $P($G(^TMP ("RCERA_PA RAMS",$J," RCDT")),"^ ",1)
  1434    . S TO=$P ($G(^TMP(" RCERA_PARA MS",$J,"RC DT")),"^", 2)
  1435    . W !
  1436    . S RCDTR NG=$$DTRAN GE(FROM,TO )
  1437    . I RCDTR NG="^" S D TQUIT=1 Q
  1438    . S ^TMP( "RCERA_PAR AMS",$J,"R CDT")=RCDT RNG
  1439    Q 0
  1440    ;
  1441   DTRANGE(DE FFROM,DEFT O) ; Asks  for and re turns a Da te Range
  1442    ; Input:  DEFFROM -  Default FR OM date
  1443    ; DEFTO -  Default T O date
  1444    ;Output:  From_Date^ To_Date (Y YYMMDD^YYY DDMM) or " ^" (timeou t or ^ ent ered)
  1445    ;
  1446    N DIR,Y,D TOUT,DUOUT ,RCDFR,STA RT
  1447    S RCQUIT= 0
  1448    S DIR(0)= "DAE^:"_DT _":E"
  1449    S DIR("A" )="Earlies t date: "
  1450    S DIR("?" )="Enter t he start o f the date  range."
  1451    S:($G(DEF FROM)) DIR ("B")=$$FM TE^XLFDT(D EFFROM,2)
  1452    D ^DIR
  1453    I $D(DTOU T)!$D(DUOU T) Q "^"
  1454    S RCDFR=Y ,START=$$F MTE^XLFDT( RCDFR,"2DZ ")
  1455    K DIR
  1456    S DIR(0)= "DAE^"_RCD FR_":"_DT_ ":E"
  1457    S DIR("A" )="Latest  date: "
  1458    S DIR("?" ,1)="Enter  the end o f the date  range. Th e ending d ate must b e greater  than "
  1459    S DIR("?" )="or equa l to "_STA RT_"."
  1460    S:($G(DEF TO)) DIR(" B")=$$FMTE ^XLFDT(DEF TO,2)
  1461    D ^DIR
  1462    I $D(DTOU T)!$D(DUOU T) Q "^"
  1463    Q (RCDFR_ "^"_Y)
  1464    ;
  1465   FILTER(IEN 344P4) ; R eturns 1 i f record i n entry IE N344P4 in  344.4 pass es
  1466    ; the edi ts for the  worklist  selection  of ERAs
  1467    ; Paramet ers found  in ^TMP("R CERA_PARAM S",$J)
  1468    N OK,RCPO ST,RCAPST, RCAPSTA,RC AUTOP,RCMA TCH,RCTYPE ,RCDFR,RCD TO,RCPAYFR ,RCPAYMNT, RCPAYTO,RC PAYR,RC0,R C4
  1469    S OK=1,RC 0=$G(^RCY( 344.4,IEN3 44P4,0)),R C4=$G(^RCY (344.4,IEN 344P4,4))
  1470    ;
  1471    S RCMATCH =$G(^TMP(" RCERA_PARA MS",$J,"RC MATCH")),R CPOST=$G(^ TMP("RCERA _PARAMS",$ J,"RCPOST" ))
  1472    S RCAUTOP =$G(^TMP(" RCERA_PARA MS",$J,"RC AUTOP")),R CTYPE=$G(^ TMP("RCERA _PARAMS",$ J,"RCTYPE" ))
  1473    S RCDFR=+ $P($G(^TMP ("RCERA_PA RAMS",$J," RCDT")),U) ,RCDTO=+$P ($G(^TMP(" RCERA_PARA MS",$J,"RC DT")),U,2)
  1474    S RCPAYR= $P($G(^TMP ("RCERA_PA RAMS",$J," RCPAYR")), U),RCPAYFR =$P($G(^TM P("RCERA_P ARAMS",$J, "RCPAYR")) ,U,2),RCPA YTO=$P($G( ^TMP("RCER A_PARAMS", $J,"RCPAYR ")),U,3)
  1475    S RCPAYMN T=$G(^TMP( "RCERA_PAR AMS",$J,"R CPAYMNT"))  ; PRCA*4. 5*321
  1476    S RCAPSTA =$G(^TMP(" RCERA_PARA MS",$J,"RC APSTA"))
  1477    ;
  1478    ; Post st atus
  1479    I $S(RCPO ST="B":0,R CPOST="U": $P(RC0,U,1 4),1:'$P(R C0,U,14))  S OK=0 G F Q
  1480    ; Auto-Po sting stat us
  1481    I $S(RCAU TOP="B":0, RCAUTOP="A ":($P(RC4, U,2)=""),1 :($P(RC4,U ,2)'=""))  S OK=0 G F Q
  1482    ;
  1483    ; If ERA  is autopos t and filt ering on s elected Au topost sta tuses chec k status
  1484    I $P(RC4, U,2)’=””,R CAPSTA’=”A ”,(RCAUTOP ="B")!(RCA UTOP="A")  D  G:OK=0  FQ
  1485    .;Auto-po st Status
  1486    .S RCAPST =$$GET1^DI Q(344.4,IE N344P4_”,” ,4.02,”I”)
  1487    .;Complet e filter
  1488    .I RCAPST A=”C” S:RC APST’=2 OK =0 Q
  1489    .;Partial  filter
  1490    .I RCAPST A=”P” S:RC APST’=1 OK =0 Q
  1491    .;Marked  for Auto-p ost filter  – ignores  if not pa rtial post  
  1492    .I RCAPST A=”M”,RCAP ST’=1 S OK =0 Q
  1493    .;Marked  for Auto-p ost filter  – ignores  era if no  lines on  ERA are ma rked but u nprocessed
  1494    .I RCAPST A=”M”,’$O( ^RCY(344.4 ,”AP”,1,IE N344P4,””) ) S OK=0 Q
  1495    ;
  1496    ; Match s tatus
  1497    I $S(RCMA TCH="B":0, RCMATCH="N ":$P(RC0,U ,9),1:'$P( RC0,U,9))  S OK=0 G F Q
  1498    ; Medical /Pharmacy/ Tricare Cl aim
  1499    ; I $S(RC TYPE="B":0 ,RCTYPE="M ":$$PHARM^ RCDPEWLP(I EN344P4),1 :'$$PHARM^ RCDPEWLP(I EN344P4))  S OK=0 G F Q
  1500    I RCTYPE' ="A" D  I  'OK G FQ
  1501    . N RCFLA G
  1502    . I '$$PA YFLAGS^RCD PEWL7(IEN3 44P4,.RCFL AG) S OK=0  Q
  1503    . I RCTYP E="P",'RCF LAG("P") S  OK=0 Q
  1504    . I RCTYP E="T",'RCF LAG("T") S  OK=0 Q
  1505    . I RCTYP E="M",(RCF LAG("P")!R CFLAG("T") ) S OK=0
  1506    ; dt rec' d range
  1507    I $S(RCDF R=0:0,1:$P (RC0,U,7)\ 1<RCDFR) S  OK=0 G FQ
  1508    I $S(RCDT O=DT:0,1:$ P(RC0,U,7) \1>RCDTO)  S OK=0 G F Q
  1509    ; Payer n ame
  1510    I RCPAYR' ="A" D  G: 'OK FQ
  1511    . N Q
  1512    . S Q=$$U P^RCDPEARL ($P(RC0,U, 6))
  1513    . I $S(Q= RCPAYFR:1, Q=RCPAYTO: 1,Q]RCPAYF R:RCPAYTO] Q,1:0) Q
  1514    . S OK=0
  1515    ; PRCA*4. 5*321 - St art modifi ed code bl ock
  1516    ; Zero am ount or pa yment
  1517    I RCPAYMN T'="B" D   ;
  1518    . I RCPAY MNT="Z",$P (RC0,U,5)  S OK=0 Q
  1519    . I RCPAY MNT="P",'$ P(RC0,U,5)  S OK=0
  1520    ; PRCA*4. 5*321 - En d modified  code bloc k
  1521    ;
  1522   FQ Q OK
  1523    ;
  1524   SPLIT ; Sp lit line i n ERA list
  1525    ; input -  RCSCR = i en of 344. 49 and 344 .4
  1526    N RCLINE, RCZ,RCDA,Q ,Q0,Z,Z0,D IR,X,Y,CT, L,L1,RCONE ,RCQUIT
  1527    D FULL^VA LM1
  1528    I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D  NOEDIT^RCD PEWLP G SP LITQ   ;pr ca*4.5*298  auto-post ed ERAs ca nnot enter  Split/Edi t action
  1529    I $G(RCSC R("NOEDIT" )) D NOEDI T^RCDPEWL  G SPLITQ
  1530    W !!,"Sel ect the en try that h as a line  you need t o Split/Ed it",!
  1531    D SEL^RCD PEWL(.RCDA )
  1532    S Z=+$O(R CDA(0)) G: '$G(RCDA(Z )) SPLITQ
  1533    S RCLINE= +RCDA(Z),Z 0=+$O(^TMP ("RCDPE-EO B_WLDX",$J ,Z_".999") ,-1)
  1534    S RCZ=Z F   S RCZ=$O (^TMP("RCD PE-EOB_WLD X",$J,RCZ) ) Q:'RCZ!( RCZ\1'=Z)  D
  1535    . S Q=$P( $G(^TMP("R CDPE-EOB_W LDX",$J,RC Z)),U,2)
  1536    . Q:'Q
  1537    . S RCZ(R CZ)=Q
  1538    . S Q0=0  F  S Q0=$O (^RCY(344. 49,RCSCR,1 ,Q,1,Q0))  Q:'Q0  I " 01"[$P($G( ^(Q0,0)),U ,2) K RCZ( RCZ) Q
  1539    I '$O(RCZ (0)) D  G  SPLITQ
  1540    . S DIR(0 )="EA",DIR ("A",1)="T his entry  has no lin es availab le to Edit /Split",DI R("A")="PR ESS RETURN  TO CONTIN UE " W ! D  ^DIR K DI R
  1541    S RCQUIT= 0
  1542    I $P($G(^ RCY(344.49 ,RCSCR,1,R CLINE,0)), U,13) D  G :RCQUIT SP LITQ
  1543    . S DIR(" A",1)="WAR NING! This  line has  already be en VERIFIE D",DIR("A" )="Are you  sure you  want to co ntinue?: " ,DIR(0)="Y A",DIR("B" )="NO" W !  D ^DIR K  DIR
  1544    . I Y'=1  S RCQUIT=1
  1545    S CT=0,CT =CT+1,DIR( "?",CT)="E nter the l ine # that  you want  to split o r edit:",R CONE=1
  1546    S L=Z F   S L=$O(RCZ (L)) Q:'L   D
  1547    . S L1=+$ G(^TMP("RC DPE-EOB_WL DX",$J,L))
  1548    . S CT=CT +1
  1549    . S DIR(" ?",CT)=$G( ^TMP("RCDP E-EOB_WL", $J,L1,0)), CT=CT+1,DI R("?",CT)= $G(^TMP("R CDPE-EOB_W L",$J,L1+1 ,0)) S RCO NE(1)=$S(R CONE:L,1:" ") S RCONE =0
  1550    S DIR("?" )=" ",Y=-1
  1551    I $G(RCON E(1)) S Y= +RCONE(1)  K DIR G:'Y  SPLITQ
  1552    I '$G(RCO NE(1)) D   K DIR I $D (DTOUT)!$D (DUOUT)!(Y \1'=Z) G S PLITQ
  1553    . F  S DI R(0)="NAO^ "_(Z+.001) _":"_Z0_": 3",DIR("A" )="Which l ine of ent ry "_Z_" d o you want  to Split/ Edit?: " S :$G(RCONE( 1))'="" DI R("B")=RCO NE(1) D ^D IR Q:'Y!$D (DUOUT)!$D (DTOUT) D   Q:Y>0
  1554    .. I '$D( ^TMP("RCDP E-EOB_WLDX ",$J,Y)) W  !!,"Line  "_Y_" does  NOT exist  - TRY AGA IN",! S Y= -1 Q
  1555    .. I '$D( RCZ(Y)) W  !!,"Line " _Y_" has b een used i n a DISTRI BUTE ADJ a ction and  can't be e dited",! S  Y=-1 Q
  1556    .. S Q=+$ O(^RCY(344 .49,RCSCR, 1,"B",Y,0) )
  1557    ;
  1558    K ^TMP("R CDPE_SPLIT _REBLD",$J )
  1559    D SPLIT^R CDPEWL3(RC SCR,+Y)
  1560    I $G(^TMP ("RCDPE_SP LIT_REBLD" ,$J)) K ^T MP("RCDPE_ SPLIT_REBL D",$J) D B LD^RCDPEWL 1($G(^TMP( $J,"RC_SOR TPARM")))
  1561    ;
  1562   SPLITQ S V ALMBCK="R"
  1563    Q
  1564    ;
  1565   PRTERA ; V iew/prt
  1566    N DIC,X,Y ,RCSCR
  1567    S DIC="^R CY(344.4," ,DIC(0)="A EMQ" D ^DI C
  1568    Q:Y'>0
  1569    S RCSCR=+ Y
  1570    D PRERA1
  1571    Q
  1572    ;
  1573   PRERA ; RC SCR is ass umed to be  defined
  1574    D FULL^VA LM1 ; Prot ocol entry
  1575   PRERA1 ; O ption entr y
  1576    N %ZIS,ZT RTN,ZTSAVE ,ZTDESC,PO P,DIR,X,Y, RCERADET
  1577    D EXCWARN ^RCDPEWLP( RCSCR)
  1578    S DIR("?" ,1)="Inclu ding expan ded detail  will sign ificantly  increase t he size of  this repo rt",DIR("? ",2)="IF Y OU CHOOSE  TO INCLUDE  IT, ALL P AYMENT DET AILS FOR E ACH EEOB W ILL BE"
  1579    S DIR("?" )="listed.  If you wa nt just su mmary data  for each  EEOB, do N OT include  it."
  1580    S DIR(0)= "YA",DIR(" A")="Do yo u want to  include ex panded EEO B detail?:  ",DIR("B" )="NO" W !  D ^DIR K  DIR
  1581    I $D(DUOU T)!$D(DTOU T) G PRERA Q
  1582    S RCERADE T=+Y
  1583    S %ZIS="Q M" D ^%ZIS  G:POP PRE RAQ
  1584    I $D(IO(" Q")) D  G  PRERAQ
  1585    . S ZTRTN ="VPERA^RC DPEWL0("_R CSCR_","_R CERADET_") ",ZTDESC=" AR - Print  ERA From  Worklist"
  1586    . D ^%ZTL OAD
  1587    . W !!,$S ($D(ZTSK): "Your task  # "_ZTSK_ " has been  queued.", 1:"Unable  to queue t his job.")
  1588    . K ZTSK, IO("Q") D  HOME^%ZIS
  1589    U IO
  1590    D VPERA(R CSCR,RCERA DET)
  1591    Q
  1592    ;
  1593   VPERA(RCSC R,RCERADET ) ; Queued  entry
  1594    ; RCSCR =  ien of en try in fil e 344.4
  1595    ; RCERADE T = 1 if i nclusion o f all EOB  details fr om file 36 1.1 is
  1596    ; desired , 0 if not
  1597    N Z,Z0,RC STOP,RCZ,R CPG,RCDOT, RCDIQ,RCDI Q1,RCDIQ2, RCXM1,RC,R CSCR1,RC36 11
  1598    K ^TMP($J ,"RC_SUMRA W"),^TMP($ J,"RC_SUMO UT"),^TMP( $J,"RC_SUM ALL")
  1599    S (RCSTOP ,RCPG)=0,R CDOT="",$P (RCDOT,"." ,79)=""
  1600    D GETS^DI Q(344.4,RC SCR_",","* ","IEN","R CDIQ")
  1601    D TXT0^RC DPEX31(RCS CR,.RCDIQ, .RCXM1,.RC ) ; Get to p level 0- node capti oned flds
  1602    I $O(^RCY (344.4,RCS CR,2,0)) S  RC=RC+1,R CXM1(RC)="  **ERA LEV EL ADJUSTM ENTS**"
  1603    S RCSCR1= 0 F  S RCS CR1=$O(^RC Y(344.4,RC SCR,2,RCSC R1)) Q:'RC SCR1  D
  1604    . K RCDIQ 2
  1605    . D GETS^ DIQ(344.42 ,RCSCR1_", "_RCSCR_", ","*","IEN ","RCDIQ2" )
  1606    . D TXT2^ RCDPEX31(R CSCR,RCSCR 1,.RCDIQ2, .RCXM1,.RC ) ; Get to p level ER A adjs
  1607    S RCSCR1= 0 F  S RCS CR1=$O(^RC Y(344.4,RC SCR,1,RCSC R1)) Q:'RC SCR1  D
  1608    . K RCDIQ 1
  1609    . D GETS^ DIQ(344.41 ,RCSCR1_", "_RCSCR_", ","*","IE" ,"RCDIQ1")  ;PRCA*4.5 *298 need  to retriev e all fiel ds even if  null (cha nged "IEN"  to "IE")
  1610    . D TXT00 ^RCDPEX31( RCSCR,RCSC R1,.RCDIQ1 ,.RCXM1,.R C)
  1611    . ;HIPAA  5010
  1612    . N PNAME 4
  1613    . S PNAME 4=$$PNM4^R CDPEWL1(RC SCR,RCSCR1 )
  1614    . I $L(PN AME4)<32 D
  1615    . .S RC=R C+1,RCXM1( RC-1)=$E(" PATIENT: " _PNAME4_$J ("",41),1, 41)_"CLAIM  #: "_$$BI LLREF^RCDP ESR0(RCSCR ,RCSCR1),R CXM1(RC)="  "
  1616    . I $L(PN AME4)>31 D
  1617    . .S RC=R C+1,RCXM1( RC-1)=$J(" ",41)_"CLA IM #: "_$$ BILLREF^RC DPESR0(RCS CR,RCSCR1)
  1618    . .S RC=R C+1,RCXM1( RC-1)=$E(" PATIENT: " _PNAME4,1, 78),RCXM1( RC)=" "
  1619    . D PROV^ RCDPEWLD(R CSCR,RCSCR 1,.RCXM1,. RC)
  1620    . S RC361 1=$P($G(^R CY(344.4,R CSCR,1,RCS CR1,0)),U, 2)
  1621    . I RCERA DET D
  1622    .. I 'RC3 611 D  Q
  1623    ... D DIS P^RCDPESR0 ("^RCY(344 .4,"_RCSCR _",1,"_RCS CR1_",1)", "^TMP($J," "RC_SUMRAW "")",1,"^T MP($J,""RC _SUMOUT"") ",75,1)
  1624    ..;
  1625    .. E  D   ; Detail r ecord is i n 361.1
  1626    ... K ^TM P("PRCA_EO B",$J)
  1627    ... D GET EOB^IBCECS A6(RC3611, 2)
  1628    ... I $O( ^IBM(361.1 ,RC3611,"E RR",0)) D  GETERR^RCD PEDS(RC361 1,+$O(^TMP ("PRCA_EOB ",$J,RC361 1," "),-1) ) ; get fi ling error s
  1629    ... S Z=0  F  S Z=$O (^TMP("PRC A_EOB",$J, RC3611,Z))  Q:'Z  S R C=RC+1,^TM P($J,"RC_S UMOUT",RC) =$G(^TMP(" PRCA_EOB", $J,RC3611, Z))
  1630    ... S RC= RC+2,^TMP( $J,"RC_SUM OUT",RC-1) =" ",^TMP( $J,"RC_SUM OUT",RC)="  "
  1631    ... K ^TM P("PRCA_EO B",$J)
  1632    . I $D(RC DIQ1(344.4 1,RCSCR1_" ,"_RCSCR_" ,",2)) D
  1633    .. S RC=R C+1,RCXM1( RC)=" **EX CEPTION RE SOLUTION L OG DATA**"
  1634    .. S Z=0  F  S Z=$O( RCDIQ1(344 .41,RCSCR1 _","_RCSCR _",",2,Z))  Q:'Z  S R C=RC+1,RCX M1(RC)=RCD IQ1(344.41 ,RCSCR1_", "_RCSCR_", ",2,Z)
  1635    . S RC=RC +1,RCXM1(R C)=" "
  1636    . S Z0=+$ O(^TMP($J, "RC_SUMALL "," "),-1)
  1637    . S Z=0 F   S Z=$O(R CXM1(Z)) Q :'Z  S Z0= Z0+1,^TMP( $J,"RC_SUM ALL",Z0)=R CXM1(Z)
  1638    . K RCXM1  S RC=0
  1639    . S Z=0 F   S Z=$O(^ TMP($J,"RC _SUMOUT",Z )) Q:'Z  S  Z0=Z0+1,^ TMP($J,"RC _SUMALL",Z 0)=$G(^TMP ($J,"RC_SU MOUT",Z))
  1640    S RCSTOP= 0,Z=""
  1641    F  S Z=$O (^TMP($J," RC_SUMALL" ,Z)) Q:'Z   D  Q:RCST OP
  1642    . I $D(ZT QUEUED),$$ S^%ZTLOAD  S (RCSTOP, ZTSTOP)=1  K ZTREQ I  +$G(RCPG)  W !!,"***T ASK STOPPE D BY USER* **" Q
  1643    . I 'RCPG !(($Y+5)>I OSL) D  I  RCSTOP Q
  1644    .. D:RCPG  ASK(.RCST OP) I RCST OP Q
  1645    .. D HDR( .RCPG)
  1646    . W !,$G( ^TMP($J,"R C_SUMALL", Z))
  1647    ;
  1648    I 'RCSTOP ,RCPG D AS K(.RCSTOP)
  1649    ;
  1650    I $D(ZTQU EUED) S ZT REQ="@"
  1651    I '$D(ZTQ UEUED) D ^ %ZISC
  1652    ;
  1653   PRERAQ K ^ TMP($J,"RC _SUMRAW"), ^TMP($J,"R C_SUMOUT") ,^TMP($J," SUMALL")
  1654    S VALMBCK ="R"
  1655    Q
  1656    ;
  1657   HDR(RCPG)  ;Report hd r
  1658    ; RCPG =  last page  #
  1659    I RCPG!($ E(IOST,1,2 )="C-") W  @IOF,*13
  1660    S RCPG=$G (RCPG)+1
  1661    W !,?5,"E DI LOCKBOX  WORKLIST  - ERA DETA IL",?55,$$ FMTE^XLFDT (DT,2),?70 ,"Page: ", RCPG,!,$TR ($J("",IOM )," ","=")
  1662    Q
  1663    ;
  1664   ASK(RCSTOP ) ;
  1665    I $E(IOST ,1,2)'["C- " Q
  1666    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
  1667    S DIR(0)= "E" W ! D  ^DIR
  1668    I ($D(DIR UT))!($D(D UOUT)) S R CSTOP=1 Q
  1669    Q
  1670    ;