3. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 3/2/2018 12:46:57 PM Central Standard 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.

3.1 Files compared

# Location File Last Modified
1 PRCA_IB_EPAYMENTS_BUNDLE_2_0_V25.zip\PRCA_4_5_326 Documents TAS ePay US321 SDD.doc Fri Mar 2 17:47:18 2018 UTC
2 PRCA_IB_EPAYMENTS_BUNDLE_2_0_V25.zip\PRCA_4_5_326 Documents TAS ePay US321 SDD.doc Fri Mar 2 18:36:10 2018 UTC

3.2 Comparison summary

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

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

3.4 Active regular expressions

No regular expressions were active.

3.5 Comparison detail

  1   System Des ign Docume ntMCCF EDI  TAS US321 1449
  2   System Des ign Docume nt
  3   PRCA*4.5*x xx
  4  
  5   Department  of Vetera ns Affairs
  6   March 2017
  7   Version 1
  8   User Story  Number: U S321 - Upd ate Daily  Activity R eport to D isplay EFT s with Deb it Voucher s 1449
  9   Story
  10   As a user  I need to  be able to  view only  EFTs with  debit vou chers on t he Daily A ctivity Re port. 
  11   Update Dai ly Activit y Report t o Display  EFTs with  Debit Vouc hers, base d on the B PR03 field  in the EF T. 
  12   As a user,  I need th e ability  to select  a Payer Na me that is  greater t han 30 cha racters lo ng when sp ecifying a  range of  payers on  the 835 CA RC Data Re port [RCDP E CARC COD E PAYER RE PORT], the  EFT/ERA T rending Re port [RCDP E EFT-ERA  TRENDING R EPORT] and  the Provi der Level  Adjustment s Report [ RCDPE PROV IDER LVL A DJ REPORT] .  Additio nally,  I  should be  allowed to  select pa yer names  that conta in ‘:’, ‘, ’ or a ‘-‘  as part o f the name  when sele cting paye r ranges i n the repo rts listed  above.  F inally, I  should be  able to di splay paye r names/TI Ns on the  above repo rts withou t the text  wrapping  to the nex t line.
  13   Conversati on:
  14   Debit indi cator need s to displ ay on the  daily acti vity repor t
  15   D indicato r for EFTs  with debi ts BPR03,  FSC curren tly sends  this indic ator
  16   Update the  Daily Act ivity repo rt to disp lay the D  and create  a filter  for EFTs w ith debit  vouchers
  17   Requires c hange to t he testing  tool to a ccount for  debit dat a
  18   On the rep orts liste d above, i f I enter  ‘ALL’ at t he  ‘Selec t (A)ll or  (R)ange o f 835 Paye r TINs?: A LL//’ prom pt, every  payer that  contains  the select ed data wi ll appear  on the rep ort regard less of th e number o f characte rs in the  payer’s na me.  Howev er, I chos e a range  selection  at the pro mpt above  and select  a range t hat includ es a payer  name with  more than  30 charac ters, it w ill not ap pear on th e report.   Additiona lly, if a  payer name  in a spec ified paye r range co ntains a ‘ :’, ‘-‘ or  a ‘,’  th e range is  not prope rly create d and cons ists of ei ther more  or less pa yers than  expected.   Finally,  when displ aying paye r names/TI Ns on the  reports li sted above , the paye r name/TIN  may wrap  to the nex t line for  payers wi th long na mes and/or  long TINs .
  19   Summary:
  20   Data field s needed b y user sto ry:
  21   344.316,.0 120     DE BIT/CREDIT  FLAGPAYER  NAME              3; 0;41 FREE  TEXT (Requ ired)
  22                  INPUT  TRANSFORM:   K:$L(X)> 160!($L(X) <13)!'((X' ?1P.E”D”))  X
  23                  LAST E DITED:       JAN 08,  2014 
  24                  HELP-P ROMPT:       Answer m ust be 13  to 60 char acters. Th is field 
  25                                      should o nly be pop ulated pro grammatica lly. 
  26                  DESCRI PTION:       This fie ld contain s a ‘D’ if  the EFT i s ais the  payer name  whose set tings are
  27                                      Ddebit E FTfined by  this entr y. This fi eld is
  28                                      programm atically 
  29                                      generate d and shou ld never b e
  30                                      updated  by 
  31                                     a user.  
  32                  CROSS- REFERENCE:   344.6^B 
  33                                      1)= S ^R CY(344.6," B",$E(X,1, 60),DA)=""
  34                                      2)= K ^R CY(344.6," B",$E(X,1, 60),DA)
  35                  RECORD  INDEXES:    CPID (#1 042)
  36   Changed Ro utines:
  37   RCDEPARPRU  – Existin g routine
  38   Subroutine  RPT – Mod ified to a dd a call  to the new  DBTONLY s ubrouti st ore the re sult in th e DONLY va riable.  T his variab le is then  passed to  the EN su broutine a nd the LMH DR subrout ine of RCD PEDA3. 
  39   Subroutine  DBTONLYGE TRNG – New  subroutin ewas  to a sk the new  Debit Onl y filter q uestion mo dified to  return pay er name an d payer TI N ranges u sing a del imiter of  ‘~:~’ inst ead of ‘:’  to accoun t for poss ible ‘:’s  in the pay er name or  TIN. 
  40   Subroutine  ENRNG – M odified to  set DONLY  variable  into INPUT  variable  and also t o filter o ut any EFT s that do  not have a  DEBIT/CRE DIT FLAG v alue of ‘D ’ when the  user only  wants to  see EFTs t hat are de bits.was c hanged to  only conve rt ‘-‘s to  ‘:’s if n ot process ing a paye r name or  payer TIN  range. Als o changed  to use ‘
  41   ~:~’ as th e delimite r when pro cessing pa yer name o r payer TI N ranges.
  42   RCDPEDA2RC  –  Existi ng Routine
  43   Subroutine  EFTDTL –  Modified t o display   the value  of the DE BIT/CREDIT  FLAG fiel d of the E DT for the  new Debit  column.
  44   Modified -   Display  of Payer n ame/TIN in  subroutin e PRTREP.   Changed t o first di splay ‘Pay er 
  45   Name/TIN’  label on   a separate  line to g ive more r oom to dis play the v alue.  Add ed code to  
  46   make sure  the value  can be dis played on  the line a nd truncat e the paye r name as  necessary  if it can’ t.
  47   RCDPEDA3NR 2 – Existi ng Routine
  48   Subroutine  LMHDR – M odified to  take new  parameter  DONLY and  use it to  display th e filter s etting in  the header  of the re port when  it is disp layed  in  listman.   Also modif ied to inc lude the n ew ‘Debit’  column wh ich is use d when dis playing EF T detail.
  49   Subroutine  HDR – Mod ified to t ake new pa rameter DO NLY and us e it to di splay the  filter set ting in th e header o f the repo rt when it  is displa yed  to sc reen or pa per.  Also  modified  to include  the new ‘ Debit’ col umn which  is used wh en display ing EFT de tail.
  50   Modified -   Display  of Payer n ame/TIN in  subroutin e PRINTINS .  Changed  to first  display ‘P ayer 
  51   Name/TIN’  label on   a separate  line to g ive more r oom to dis play the v alue.  Add ed code to  
  52   make sure  the value  can be dis played on  the line a nd truncat e the paye r name as  necessary  if it can’ t.
  53   RCDPESR3PL B – Existi ng Routine
  54   Subroutine  EFTIN – M odified to  store the  value of  the new DE BIT/CREDIT  Flag fiel d.
  55   Modified -   Display  of Payer n ame/TIN in  subroutin e REPORT.   Changed t o first di splay ‘Pay er 
  56   Name/TIN’  label on   a separate  line to g ive more r oom to dis play the v alue.  Add ed code to  
  57   make sure  the value  can be dis played on  the line a nd truncat e the paye r name as  necessary  if it can’ t.
  58   RCDPEAR1 –  Existing  Routine
  59   Modified -   Display  of Payer n ame/TIN in  subroutin e XXX.  Ch anged to f irst displ ay ‘Payer 
  60   Name/TIN’   8 charact ers to the  left to g ive more r oom to dis play the v alue.  Add ed code to  
  61   make sure  the value  can be dis played on  the line a nd truncat e the paye r name as  necessary  if it can’ t. Finally  moved the  ERA DATE  to the fol lowing lin e as the h eader indi cates.  Cu rrently, i t incorrec tly displa ys on the  Payer name /TIN line.
  62   Current –  835 CARC D ataDaily a ctivity Re port
  63   Select div ision: ALL // 
  64   (S)UMMARY  OR (D)ETAI L?: D// ET AIL AND TO TALS
  65   START DATE : T-30  (M AR 01, 201 7)
  66   END DATE:  MAR 1,2017 // T  (MAR  31, 2017)
  67   RUN REPORT  FOR (A)LL , (S)PECIF IC, OR (R) ANGE OF IN SURANCE CO MPANIES?:  ALL// 
  68   Display in  List Mana ger format ? (Y/N): N O// 
  69   DEVICE: HO ME//   HOM E  (CRT)     Right Ma rgin: 80//  
  70                      ED I LOCKBOX  EFT DAILY  ACTIVITY D ETAIL REPO RT       P age: 1   
  71                               RUN  DATE: 03/3 1/17@08:21 :52
  72                                       DIVISIO NS: ALL
  73                                        PAYERS : ALL
  74   DATE RANGE : 03/01/17  - 03/31/1 7 (Date De posit Adde d)        
  75   DEP #       DEPOSIT D T                       DEP AMOU NT           FMS DEPO SIT STAT
  76     EFT #                        D ATE PD   P AYMENT AMO UNT  ERA M ATCH STATU S
  77       EFT PA YER TRACE  #                                   CR #
  78         PAYM ENT FROM
  79      TR #
  80                                                   DEP RE CEIPT #    DEP RECEIP T STATUS 
  81   ========== ========== ========== ========== ========== ========== ========== =========
  82                           DATE EFT  DEPOSIT R ECEIVED: 0 3/01/17
  83   T334787     03/01/17                          194.00                QUEUED            
  84     2131                           03/01/17   194.00           MATC HED/ERA #9 2622  
  85       ABC643 4334723                                        CR-442K 5A0A7D 
  86         AETN A/10660334 92                                                               
  87                   EDI L OCKBOX 835  CARC DATA  REPORT -  SUMMARY FO RMAT          Page: 6
  88                     SOR T BY: CARC   RUN DATE : Mar 29,  2017@07:58 :39
  89                                Div isions: AL L CARCs: A LL
  90                           835 PAYE RS: ALL 83 5 PAYER TI Ns: ALL
  91                         EOB PAID D ATE RANGE:  01/01/12  - 03/29/17
  92   ========== ========== ========== ========== ========== ========== ========== =========
  93     -------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  94     PAYER NA ME/TIN: GL OBE LIFE &  ACCIDENT/ 1731128555
  95     #CLAIMS:     7 ADJ:   8% [ADJ:      162.8 1/BILLED:     1988.47 ] PAID:      852.88
  96     -------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  97   New Daily  Activity R eportPropo sed – 835  CARC Data  Report
  98   Select div ision: ALL // 
  99   (S)UMMARY  OR (D)ETAI L?: D// ET AIL AND TO TALS
  100   START DATE : T-30  (M AR 01, 201 7)
  101   END DATE:  MAR 1,2017 // T  (MAR  31, 2017)
  102   RUN REPORT  FOR (A)LL , (S)PECIF IC, OR (R) ANGE OF IN SURANCE CO MPANIES?:  ALL// 
  103   Show EFTs  with debit s only? NO // YES
  104   Display in  List Mana ger format ? (Y/N): N O// 
  105   DEVICE: HO ME//   HOM E  (CRT)     Right Ma rgin: 80//  
  106                      ED I LOCKBOX  EFT DAILY  ACTIVITY D ETAIL REPO RT       P age: 1   
  107                               RUN  DATE: 03/3 1/17@08:21 :52
  108                                       DIVISIO NS: ALL
  109                                        PAYERS : ALL
  110   DATE RANGE : 03/01/17  - 03/31/1 7 (Date De posit Adde d)         Debit Only  EFTs: YES
  111   DEP #       DEPOSIT D T                       DEP AMOU NT           FMS DEPO SIT STAT
  112     EFT #                        D ATE PD   P AYMENT AMO UNT  ERA M ATCH STATU S
  113       EFT PA YER TRACE  #                                   CR #
  114         PAYM ENT FROM
  115      TR #
  116                                          Debi t   DEP RE CEIPT #    DEP RECEIP T STATUS 
  117   ========== ========== ========== ========== ========== ========== ========== =========
  118                           DATE EFT  DEPOSIT R ECEIVED: 0 3/01/17
  119   T334787     03/01/17                          194.00                QUEUED            
  120     2131                           03/01/17   194.00           MATC HED/ERA #9 2622  
  121       ABC643 4334723                                        CR-442K 5A0A7D 
  122         AETN A/10660334 92                                                               
  123                   EDI L OCKBOX 835  CARC DATA  REPORT -  SUMMARY FO RMAT          Page: 6
  124                     SOR T BY: CARC   RUN DATE : Mar 29,  2017@07:58 :39
  125                                Div isions: AL L CARCs: A LL
  126                           835 PAYE RS: ALL 83 5 PAYER TI Ns: ALL
  127                         EOB PAID D ATE RANGE:  01/01/12  - 03/29/17
  128   ========== ========== ========== ========== ========== ========== ========== =========
  129     -------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  130     PAYER NA ME/TIN
  131       GLOBE  LIFE & ACC IDENT/1731 128555
  132     #CLAIMS:     7 ADJ:   8% [ADJ:      162.8 1/BILLED:     1988.47 ] PAID:      852.88
  133     -------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  134   Current –  EFT/ERA Tr ending  Re port
  135   EFT/ERA TR ENDING REP ORT                                                    PAGE     1
  136        ALL D IVISIONS              ALL PAYERS                       ALL TINS
  137        DATE  RANGE: 1/1 /12 - 3/29 /17                    RUN DATE:  3/29/17@1 0:06:45
  138   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  139   PAYER NAME /TIN: AETN A/10660334 92
  140   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  141   ********** *********      ERA MA TCHED TO A N EFT      ********** *********
  142   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  143   CLAIM#                 DOS       AMT BILLED  AMT PAID    BILLED    ERA/EOB R EC'D EFT/P
  144   MT REC'D                                                                               
  145            P OSTED                                                                       
  146                      TR ACE #                                                            
  147                                  A UTOPOST/MA NUAL
  148        ETRAN S TYPE ERA #       #E EOBS     E FT#        #DAYS:(BIL L/ERA) #DA YS:(ERA/EF
  149   T)                                                                                     
  150      #DAYS:( ERA+EFT/PO STED)                                                            
  151                               TOTA L #DAYS(BI LL/POSTED)
  152   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  153   Proposed –  EFT/ERA T rending  R eport
  154   EFT/ERA TR ENDING REP ORT                                                    PAGE     1
  155        ALL D IVISIONS              ALL PAYERS                       ALL TINS
  156        DATE  RANGE: 1/1 /12 - 3/29 /17                    RUN DATE:  3/29/17@1 0:06:45
  157   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  158   PAYER NAME /TIN
  159     AETNA/10 66033492
  160   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  161   ********** *********      ERA MA TCHED TO A N EFT      ********** *********
  162   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  163   CLAIM#                 DOS       AMT BILLED  AMT PAID    BILLED    ERA/EOB R EC'D EFT/P
  164   MT REC'D                                                                               
  165            P OSTED                                                                       
  166                      TR ACE #                                                            
  167                                  A UTOPOST/MA NUAL
  168        ETRAN S TYPE ERA #       #E EOBS     E FT#        #DAYS:(BIL L/ERA) #DA YS:(ERA/EF
  169   T)                                                                                     
  170      #DAYS:( ERA+EFT/PO STED)                                                            
  171                               TOTA L #DAYS(BI LL/POSTED)
  172   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  173   Current –  Provider L evel Balan ce  Report
  174       EDI LO CKBOX 835  PROVIDER L EVEL ADJUS TMENT (PLB ) REPORT -  SUMMARY     Page: 1 
  175               SORT by P LB CODES   REPORT RUN  DATE: Mar  29, 2017@ 10:11:19
  176                                 DI VISION: AL L Codes: A LL
  177                           835 PAYE RS: ALL 83 5 PAYER TI Ns: ALL
  178                         EOB PAID D ATE RANGE:  01/01/12  - 03/29/17
  179   ========== ========== ========== ========== ========== ========== ========== =========
  180   GRAND TOTA LS FOR ALL  PLB CODES  & PAYERS  ON REPORT
  181      TOTAL # ERAs:    1 109  ADJ:   16% [TOT  AMT ADJUST ED / TOT A MT BILLED]
  182      AMT ADJ UST: $  39 9386.68  A MT BILLED:  $ 2537781 .68  AMT P AID: $  88 3788.63
  183   ========== ========== ========== ========== ========== ========== ========== =========
  184   ADJ CODE:  50  # ERAs :    12  A DJ:   9% [ TOT AMT AD JUSTED / T OT AMT BIL LED]
  185      AMT ADJ UST:   253 .00  AMT B ILLED:   2 707.77  AM T PAID:    2908.77
  186   ADJ CODE T EXT: Late  Charge
  187   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  188     PAYER NA ME/TIN: AE TNA -CONTI NENTAL LIF E INSURANC E COMPANY  OF BRENTWO OD/1621181
  189   209
  190     #ERAs:     3  ADJ:   -6% [ADJ:    -22.00/  BILLED:     350.17]  PAID:    2 76.17
  191     -------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  192   Proposed –  Provider  Level Bala nce  Repor t
  193       EDI LO CKBOX 835  PROVIDER L EVEL ADJUS TMENT (PLB ) REPORT -  SUMMARY     Page: 1 
  194               SORT by P LB CODES   REPORT RUN  DATE: Mar  29, 2017@ 10:11:19
  195                                 DI VISION: AL L Codes: A LL
  196                           835 PAYE RS: ALL 83 5 PAYER TI Ns: ALL
  197                         EOB PAID D ATE RANGE:  01/01/12  - 03/29/17
  198   ========== ========== ========== ========== ========== ========== ========== =========
  199   GRAND TOTA LS FOR ALL  PLB CODES  & PAYERS  ON REPORT
  200      TOTAL # ERAs:    1 109  ADJ:   16% [TOT  AMT ADJUST ED / TOT A MT BILLED]
  201      AMT ADJ UST: $  39 9386.68  A MT BILLED:  $ 2537781 .68  AMT P AID: $  88 3788.63
  202   ========== ========== ========== ========== ========== ========== ========== =========
  203   ADJ CODE:  50  # ERAs :    12  A DJ:   9% [ TOT AMT AD JUSTED / T OT AMT BIL LED]
  204      AMT ADJ UST:   253 .00  AMT B ILLED:   2 707.77  AM T PAID:    2908.77
  205   ADJ CODE T EXT: Late  Charge
  206   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  207     PAYER NA ME/TIN
  208       AETNA  -CONTINENT AL LIFE IN SURANCE CO MPANY OF B RENTWOOD/1 621181209
  209     #ERAs:     3  ADJ:   -6% [ADJ:    -22.00/  BILLED:     350.17]  PAID:    2 76.17
  210     -------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  211   Current –  ERA Unmatc hed Aging  Report
  212                               ERA  UNMATCHED  AGING REPO RT           Page: 3
  213                                RUN  DATE: 3/2 1/17@11:41 :57
  214                                       DIVISIO NS: ALL
  215                                        PAYERS : ALL
  216    DATE RANG E: 07/23/1 5 - 07/23/ 15 (ERA FI LE DATE)     CHAMPVA:  NO    TRI CARE: NO
  217   AGED
  218   DAYS  TRAC E #
  219              PAYMENT FR OM/ID
  220                    FILE  DATE       AMOUNT PA ID  EEOB C NT   ERA #             ERA DATE
  221   ========== ========== ========== ========== ========== ========== ========== =========
  222           EE OB Seq #:  1  EEOB on  file for  K5042RN  2 .26
  223    607  3315 4549                                            
  224              LOYAL AM/C ONT GEN/UN TD TEACHER /GRT AMER/ PROV AMER/ CENTRL RE   7/18/15 
  225                    7/23 /15              109. 53  2           91909
  226   Proposed –  ERA Unmat ched Aging  Report
  227                               ERA  UNMATCHED  AGING REPO RT           Page: 3
  228                                RUN  DATE: 3/2 1/17@11:41 :57
  229                                       DIVISIO NS: ALL
  230                                        PAYERS : ALL
  231    DATE RANG E: 07/23/1 5 - 07/23/ 15 (ERA FI LE DATE)     CHAMPVA:  NO    TRI CARE: NO
  232   AGED
  233   DAYS  TRAC E #
  234     PAYMENT  FROM/ID
  235  
  236                    FILE  DATE       AMOUNT PA ID  EEOB C NT   ERA #             ERA DATE
  237   ========== ========== ========== ========== ========== ========== ========== =========
  238           EE OB Seq #:  1  EEOB on  file for  K5042RN  2 .26
  239   607   3315 4549                                            
  240     LOYAL AM /CONT GEN/ UNTD TEACH ER/GRT AME R/PROV AME R/CENTRL/1 234567890   7/18/15
  241    
  242                    7/23 /15              109. 53  2           91909             07/18/15
  243   Resolution  – Added C hanged Obj ects
  244   RoutinesAc tivitiesRo utine Name RCDPEDARAR CEnhanceme nt Categor y New Modi fy Delete  No ChangeR TMRelated  OptionsRCD PE EDI LOC KBOX ACT R EPORTCARC  CODE PAYER  REPORT Re lated Rout inesRoutin es “Called  By”Routin es “Called ”   RCDPEA R1PLB
  245   RCDPEAR2
  246   RCDPELAR
  247   RCDPEM1RUA SKLM^RCDPE ARLGCARC^R CDPCRR
  248   $$ENDORPRT ^RCDPEARLC HECKDT^RCD PRU
  249   ASK^RCDPEA RL$$DATE^R CDPRU
  250   LMRPT^RCDP EARL$$GETP AY^RCDPRU
  251   RPT2^R$$NO W^RCDPEDA2 RU
  252   $$VALHDR^R CDPEDA3RU
  253   LMHDRASK^R CDPEDA3RU
  254   SLRNG^RCDP EDA3ARU
  255   TOTSDAYSUM ^RCDPEDA3R U
  256   TOTSFDIVIS ION^RCDPED A3VAUTOMA
  257   $$ERASTA^R CDPEM3
  258   $$GETPAY^R CDPEM9
  259   DIVISION^V AUTOMACurr ent Logic.
  260   .
  261   .
  262    ;
  263    ; Get ins urance com pany to be  used as f ilter
  264    ; PRCA*4. 5*284 - RC NP is Type  of Respon se (1=Rang e,2=All,3= Specific)  ^ From Ran ge^ Thru R ange
  265    S RCNP=$$ GETPAY^RCD PEM9(344.3 1)
  266    Q:+RCNP=- 1 ; No Ins urance Com pany selec ted S RCLS TMGR=$$ASK LM^RCDPEAR L ; Ask to  Display i n Listman  Template
  267    S RCLSTMG R=$$ASKLM^ RCDPEARL ;  Ask to Di splay in L istman Tem plate
  268    Q:RCLSTMG R<0 ; '^'  or timeout
  269    ;
  270    I RCLSTMG R=1 D  Q                             ; List Man Templa te format,  put in ar ray
  271    . S RCTMP ND="RCDPE_ DAR"
  272    . K ^TMP( $J,RCTMPND )
  273    . D EN(RC DET,RCDT1, RCDT2,RCLS TMGR)
  274    . D LMHDR ^ZZFARCDPE DA3b2(.RCS TOP,RCDET, 1,RCDT1,RC DT2,.RCHDR )
  275    . D LMRPT ^RCDPEARL( .RCHDR,$NA (^TMP($J,R CTMPND)))  ; Generate  ListMan d isplay
  276    . K ^TMP( $J,RCTMPND )
  277    ;
  278   .
  279   .
  280   .
  281    U IO
  282    D EN(RCDE T,RCDT1,RC DT2,RCLSTM GR)
  283    Q
  284    ;
  285   RTYPE() ;  Allows the  user to s elect the  report typ e (Summary /Detail)
  286   .
  287   .
  288   .
  289   EN(RCDET,R CDT1,RCDT2 ,RCLSTMGR)  ; Entry p oint for r eport, mig ht be queu ed
  290    ; Input:  RCDET - 1  - Detail R eport, 0 -  Summary
  291    ; RCDT1 -  Internal  Fileman St art date
  292    ; RCDT2 -  Internal  Fileman En d date
  293    ; RCLSTMG R - 1 disp lay in lis t manager,  0 otherwi se
  294    ; Optiona l, default s to 0
  295    ; RCNP -  A1^A2^A3 W here:
  296    ; A1 - 1  - Range of  Payers
  297    ; 2 - All  Payers se lected
  298    ; 3 - Spe cific paye rs
  299    ; A2 - Fr om Range ( When a fro m/thru ran ge is sele cted by us er)
  300    ; A3 - Th ru Range ( When a fro m/thru ran ge is sele cted by us er)
  301    ; RCPYRSE L - Array  of selecte d payers ( Only prese nt if A1=3  above
  302    ; VAUTD -  1 - All s elected di visions OR  an array  of selecte d division s
  303    N DFLG,DT ADD,IEN344 3,IEN34431 ,INPUT,RCF LG,RCJOB,R CT,XX,Z
  304    N:$G(ZTSK ) ZTSTOP                             ; Job  was tasked , ZTSTOP =  flag to s top
  305    S:'$D(RCL STMGR) RCL STMGR=0
  306    ;
  307    ; PRCA*4. 5*284 - Qu eued job n eeds to re load payer  selection  list
  308    I $D(RCPY RSEL) D
  309    . K ^TMP( "RCSELPAY" ,$J)
  310    . M ^TMP( "RCSELPAY" ,$J)=RCPYR SEL
  311    ;
  312    S XX=$S(R CLSTMGR:1, 1:0)
  313    S INPUT=X X_"^"_RCLS TMGR_"^"_+ RCDET
  314    S RCNP=+R CNP,RCJOB= $J
  315    K ^TMP("R CDAILYACT" ,$J)
  316    K ^TMP($J ,"TOTALS")  ; Initial ize Totals  temp work space
  317    ;
  318    ; Loop th rough all  of the EDI  LOCKBOX D EPOSIT rec ords in th e selected  date
  319    ; range a nd add any  that pass  the payer  and divis ion filter s into ^TM P
  320    ; by the  internal d ate added
  321    S DTADD=R CDT1-.0001 ,RCT=0
  322    S $P(INPU T,"^",4)=0  ; Current  Page Numb er
  323    S $P(INPU T,"^",5)=0  ; Stop Fl ag
  324    F  D  Q:' DTADD  Q:D TADD>(RCDT 2_".9999")  Q:$P(INPU T,"^",5)=1
  325    . S DTADD =$O(^RCY(3 44.3,"AREC DT",DTADD) )
  326    . Q:'DTAD D
  327    . Q:DTADD >(RCDT2_". 9999")
  328    . S IEN34 43=0
  329    . F  D  Q :'IEN3443   Q:$P(INPU T,"^",5)=1
  330    . . S IEN 3443=$O(^R CY(344.3," ARECDT",DT ADD,IEN344 3))
  331    . . Q:'IE N3443
  332    . . S IEN 34431="",R CFLG=0
  333    . . F  D   Q:IEN3443 1=""
  334    . . . S I EN34431=$O (^RCY(344. 31,"B",IEN 3443,IEN34 431))
  335    . . . Q:I EN34431=""
  336    . . . Q:' $$CHKPYR(I EN34431,0, RCJOB,RCNP ) ; Not a  selected p ayer PRCA* 4.5(318 ad ded ,RCNP
  337    . . . Q:' $$CHKDIV(I EN34431,0, .VAUTD) ;  Not a sele cted stati on/divisio n
  338    . . . S R CFLG=1
  339    . . . S ^ TMP("RCDAI LYACT",$J, DTADD\1,IE N3443,"EFT ",IEN34431 )=""
  340    . . ;
  341   .
  342   .
  343   . ; DATA =  the Repor t informat ion; SUMM  = Summary,  Grand tot als;
  344    ; SORT =  What is th e major so rt order f or DATA, C ARC or Pay er
  345   PRTREP(DAT A,SUMM,SOR T,CD,RA,RC STOP) ; Pr int report  data out  of the "RE PORT" suba rray
  346    N IX,IY,T IX,TIY,IEN ,CL,LN,LN2 ,DLN,AMTA, AMTB,AMTP, TIN,DESC,D X0,DZ,PAY, CZ,PCT,X,D IWL,DIWR,R CSL
  347    S $P(LN," -",80)="", $P(DLN,"=" ,80)="",$P (LN2,"-",7 8)="",LN2= " "_LN2,RC SL=8
  348    ; Do Gran d totals -  moved to  top of rep ort per Su san on 7/1 6/2015
  349    S DX0=$G( @SUMM@("CL AIMS")),PC T=0
  350    S:+$P(DX0 ,U,2)'=0 P CT=$J(($P( DX0,U,4)/$ P(DX0,U,2) )*100,3,0)
  351    S:+$P(DX0 ,U,2)=0 PC T="ERR"
  352    I RCSL>=( IOSL-4) S  RCSTOP=$$N EWPG(.RCPG ,1,.RCSL,C D,RA) Q:RC STOP
  353    W !
  354    W "GRAND  TOTAL ALL  CARCS / AL L PAYERS O N REPORT", !
  355    W " TOTAL  #CLAIMS:  ",$J($P(DX 0,U,1),6,0 )," ADJ: " ,PCT,"% [T OT AMT ADJ USTED / TO T AMT BILL ED]",!
  356    W " AMT A DJUST: $", $J($P(DX0, U,4),11,2) ," AMT BIL LED: $",$J ($P(DX0,U, 2),11,2),"  AMT PAID:  $",$J($P( DX0,U,3),1 1,2),!
  357    W !,DLN,! ! S RCSL=R CSL+5
  358    ;
  359    S IX="",I EN="",CL=0 ,AMTB=0,AM TP=0,DESC= "Empty Des cription"
  360    F  S IX=$ O(@DATA@(I X)) Q:IX=" "!RCSTOP   S TIX=$G(@ DATA@(IX)) ,IY="" D   Q:RCSTOP 
  361    . D:SORT= "C"  Q:RCS TOP  ; CAR C Sorted o utput IX = > CARC; IY  => Payer  Name
  362    .. S DX0= $G(@DATA@( IX,"~~SUM" )),CL=$P(D X0,U,1),AM TB=$P(DX0, U,2),AMTP= $P(DX0,U,3 ),AMTA=$P( DX0,U,4),D ESC=$P(DX0 ,U,5),PCT= (AMTA/AMTB )*100
  363    .. W "CAR C: ",$J(IX ,4)," TOTA L #CLAIMS:  ",$J(CL,5 ,0)," ADJ: ",$J(PCT,3 ,0),"% [TO T AMT ADJU STED / TOT  AMT BILLE D]",! S RC SL=RCSL+1
  364    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  365    .. W " AM T ADJUST:  ",$J(AMTA, 11,2)," AM T BILLED:  ",$J(AMTB, 12,2)," AM T PAID: ", $J(AMTP,12 ,2),! S RC SL=RCSL+1
  366    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  367    .. S X="D esc: "_$E( DESC,1,73) ,DIWL=1,DI WR=80 K ^U TILITY($J, "W") D ^DI WP,^DIWW S  RCSL=RCSL +1
  368    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  369    .. W LN,!  S RCSL=RC SL+1
  370    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  371    .. S CZ=0 ,PAY="" F   S PAY=$O( @DATA@(IX, "~~SUM",PA Y)) Q:PAY= ""!RCSTOP   S CZ=CZ+1  D  Q:RCST OP
  372    ... S DZ= @DATA@(IX, "~~SUM",PA Y),PCT=$S( (+$P(DZ,U, 2)'=0):($P (DZ,U,4)/$ P(DZ,U,2)* 100),1:"ER ROR")
  373    ... I CZ> 1 W LN2,!  S RCSL=RCS L+1
  374    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  375    ... W " P AYER NAME/ TIN: ",PAY ,! S RCSL= RCSL+1
  376    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  377    ... W " # CLAIMS: ", $J($P(DZ,U ,1),4,0),"  ADJ:",$J( PCT,3,0)," % [ADJ: ", $J($P(DZ,U ,4),10,2), "/BILLED:  ",$J($P(DZ ,U,2),10,2 ),"] PAID:  ",$J($P(D Z,U,3),10, 2),! S RCS L=RCSL+1
  378    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  379    ... D:RCD ET DETAIL( DATA,IX,PA Y,.RCSL,.R CSTOP) Q:R CSTOP  ; D ata array,  CARC, Pay er/TIN
  380    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  381    .. Q:RCST OP  W LN,!  S RCSL=RC SL+1 ; Rem oved "!,"  in front o f "LN"
  382    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  383    . Q:RCSTO P
  384    . D:SORT= "P"  Q:RCS TOP  ; Pay er Sorted  output IX  => Payer N ame; IY =>  CARC
  385    .. W "PAY ER NAME/TI N: ",IX,!  S RCSL=RCS L+1
  386    .. S DX0= $G(@DATA@( IX,"~~SUM" )),CL=$P(D X0,U,1),AM TB=$P(DX0, U,2),AMTP= $P(DX0,U,3 ),AMTA=$P( DX0,U,4),P CT=(AMTA/A MTB)*100
  387    .. W "#CL AIMS: ",$J (CL,4,0),"  ADJ: ",$J (PCT,3,0), "% [ADJ:", $J(AMTA,10 ,2),"/BILL ED:",$J(AM TB,11,2)," ] PAID:",$ J(AMTP,11, 2),! S RCS L=RCSL+1
  388    .. W LN,! ! S RCSL=R CSL+2
  389    .. S CZ=0 ,IY="" F   S IY=$O(@D ATA@(IX,"~ ~SUM",IY))  Q:IY=""   S CZ=CZ+1  D  Q:RCSTO P
  390    ... S DZ= @DATA@(IX, "~~SUM",IY )
  391    ... I CZ> 1 W LN2,!  S RCSL=RCS L+1
  392    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  393    ... S PCT =$S((+$P(D Z,U,2)'=0) :($P(DZ,U, 4)/$P(DZ,U ,2)*100),1 :"ERROR")
  394    ... W ?2, "CARC: ",$ J(IY,4),?1 4,"#CLAIMS : ",$J($P( DZ,U,1),5, 0),?30,"AD J: ",$J(PC T,3,0),"%  [AMT ADJUS TED / AMT  BILLED]",!  S RCSL=RC SL+1
  395    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  396    ... W ?2, "AMT ADJUS T: ",$J($P (DZ,U,4),1 1,2),?26,"  BILLED: " ,$J($P(DZ, U,2),12,2) ,?56," PAI D: ",$J($P (DZ,U,3),1 2,2),! S R CSL=RCSL+1
  397    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  398    ... S X=" Desc: "_$E ($P(DZ,U,5 ),1,68),DI WL=3,DIWR= 80 K ^UTIL ITY($J,"W" ) D ^DIWP, ^DIWW S RC SL=RCSL+1
  399    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  400    ... D:RCD ET DETAIL( DATA,IX,IY ,.RCSL,.RC STOP) Q:RC STOP  ; Da ta array,  Payer/TIN,  CARC
  401    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  402    .. Q:RCST OP  W LN,!  S RCSL=RC SL+1 ; Rem oved "!,"  in front o f LN
  403    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  404    Q
  405    ; Modifie d Logic (C hanges are  in bold).
  406   .
  407   .
  408    ;
  409    ; Get ins urance com pany to be  used as f ilter
  410    ; PRCA*4. 5*284 - RC NP is Type  of Respon se (1=Rang e,2=All,3= Specific)  ^ From Ran ge^ Thru R ange
  411    S RCNP=$$ GETPAY^RCD PEM9(344.3 1)
  412    Q:+RCNP=- 1 ; No Ins urance Com pany selec ted
  413    S DONLY=$ $DBTONLY()  ; Debit O nly filter
  414    Q:DONLY=- 1 ; '^' or  time out  ;
  415    S RCLSTMG R=$$ASKLM^ RCDPEARL ;  Ask to Di splay in L istman Tem plate
  416    Q:RCLSTMG R<0 ; '^'  or timeout
  417    ;
  418    I RCLSTMG R=1 D  Q                             ; List Man Templa te format,  put in ar ray
  419    . S RCTMP ND="RCDPE_ DAR"
  420    . K ^TMP( $J,RCTMPND )
  421    . D EN(RC DET,RCDT1, RCDT2,RCLS TMGR,DONLY )
  422    . D LMHDR ^ZZFARCDPE DA3b2(.RCS TOP,RCDET, 1,RCDT1,RC DT2,.RCHDR ,DONLY)
  423    . D LMRPT ^RCDPEARL( .RCHDR,$NA (^TMP($J,R CTMPND)))  ; Generate  ListMan d isplay
  424    . K ^TMP( $J,RCTMPND )
  425    ;
  426   .
  427   .
  428   .
  429    U IO
  430    D EN(RCDE T,RCDT1,RC DT2,RCLSTM GR,DONLY)
  431    Q
  432    ;
  433   DBTONLY()  ; Allows t he user to  select fi lter to on ly show EF Ts with de bits
  434    ; Input:  None
  435    ; Returns : 0 - All  EFTs to di splay
  436    ; 1 - Onl y EFTs wit h debits t o be displ ayed
  437    ; -1 - Us er up-arro wed or tim ed out
  438    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
  439    S DIR("A" )="Show EF Ts with de bits only?  "
  440    S DIR(0)= "SA^Y:YES; N:NO"
  441    S DIR("B" )="NO"
  442    S DIR("?" ,1)="Enter  'YES' to  only show  EFTs with  a debit fl ag of 'D'. "
  443    S DIR("?" )="Enter ' NO' to sho w all EFTs ." 
  444    D ^DIR
  445    I $D(DTOU T)!$D(DUOU T)!(Y="")  Q -1
  446    Q $E(Y,1) ="Y"
  447    ;
  448   RTYPE() ;  Allows the  user to s elect the  report typ e (Summary /Detail)
  449   .
  450   .
  451   .
  452   EN(RCDET,R CDT1,RCDT2 ,RCLSTMGR, DONLY) ; E ntry point  for repor t, might b e queued
  453    ; Input:  RCDET - 1  - Detail R eport, 0 -  Summary
  454    ; RCDT1 -  Internal  Fileman St art date
  455    ; RCDT2 -  Internal  Fileman En d date
  456    ; RCLSTMG R - 1 disp lay in lis t manager,  0 otherwi se
  457    ; Optiona l, default s to 0
  458    ; DONLY -  1 only di splay EFTs  with a de bit flag o f 'D'
  459    ; 0 displ ay all EFT s
  460    ; RCNP -  A1^A2^A3 W here:
  461    ; A1 - 1  - Range of  Payers
  462    ; 2 - All  Payers se lected
  463    ; 3 - Spe cific paye rs
  464    ; A2 - Fr om Range ( When a fro m/thru ran ge is sele cted by us er)
  465    ; A3 - Th ru Range ( When a fro m/thru ran ge is sele cted by us er)
  466    ; RCPYRSE L - Array  of selecte d payers ( Only prese nt if A1=3  above
  467    ; VAUTD -  1 - All s elected di visions OR  an array  of selecte d division s
  468    N DFLG,DT ADD,IEN344 3,IEN34431 ,INPUT,RCF LG,RCJOB,R CT,XX,Z
  469    N:$G(ZTSK ) ZTSTOP                             ; Job  was tasked , ZTSTOP =  flag to s top
  470    S:'$D(RCL STMGR) RCL STMGR=0
  471    ;
  472    ; PRCA*4. 5*284 - Qu eued job n eeds to re load payer  selection  list
  473    I $D(RCPY RSEL) D
  474    . K ^TMP( "RCSELPAY" ,$J)
  475    . M ^TMP( "RCSELPAY" ,$J)=RCPYR SEL
  476    ;
  477    S XX=$S(R CLSTMGR:1, 1:0)
  478    S INPUT=X X_"^"_RCLS TMGR_"^"_+ RCDET
  479    S RCNP=+R CNP,RCJOB= $J
  480    K ^TMP("R CDAILYACT" ,$J)
  481    K ^TMP($J ,"TOTALS")  ; Initial ize Totals  temp work space
  482    ;
  483    ; Loop th rough all  of the EDI  LOCKBOX D EPOSIT rec ords in th e selected  date
  484    ; range a nd add any  that pass  the payer  and divis ion filter s into ^TM P
  485    ; by the  internal d ate added
  486    S DTADD=R CDT1-.0001 ,RCT=0
  487    S $P(INPU T,"^",4)=0  ; Current  Page Numb er
  488    S $P(INPU T,"^",5)=0  ; Stop Fl ag
  489    S $P(INPU T,"^",10)= DONLY
  490    F  D  Q:' DTADD  Q:D TADD>(RCDT 2_".9999")  Q:$P(INPU T,"^",5)=1
  491    . S DTADD =$O(^RCY(3 44.3,"AREC DT",DTADD) )
  492    . Q:'DTAD D
  493    . Q:DTADD >(RCDT2_". 9999")
  494    . S IEN34 43=0
  495    . F  D  Q :'IEN3443   Q:$P(INPU T,"^",5)=1
  496    . . S IEN 3443=$O(^R CY(344.3," ARECDT",DT ADD,IEN344 3))
  497    . . Q:'IE N3443
  498    . . S IEN 34431="",R CFLG=0
  499    . . F  D   Q:IEN3443 1=""
  500    . . . S I EN34431=$O (^RCY(344. 31,"B",IEN 3443,IEN34 431))
  501    . . . Q:I EN34431=""
  502    . . . Q:' $$CHKPYR(I EN34431,0, RCJOB,RCNP ) ; Not a  selected p ayer PRCA* 4.5(318 ad ded ,RCNP
  503    . . . Q:' $$CHKDIV(I EN34431,0, .VAUTD) ;  Not a sele cted stati on/divisio n
  504    . . . I D ONLY D  Q: DFLG'="D"                 ; Not  a EFT with  a debit f lag of 'D'
  505    . . . . S  DFLG=$$GE T1^DIQ(344 .31,IEN344 31,.20,"E" )
  506    . . . S R CFLG=1
  507    . . . S ^ TMP("RCDAI LYACT",$J, DTADD\1,IE N3443,"EFT ",IEN34431 )=""
  508    . . ;
  509   .
  510   .
  511   . ; DATA =  the Repor t informat ion; SUMM  = Summary,  Grand tot als;
  512    ; SORT =  What is th e major so rt order f or DATA, C ARC or Pay er
  513   PRTREP(DAT A,SUMM,SOR T,CD,RA,RC STOP) ; Pr int report  data out  of the "RE PORT" suba rray
  514    ; Input:  DATA - Com piled repo rt data in  ^TMP("RCD PARC_REPOR T",$J)
  515    ; SUM - C ompiled gr and totals  in ^TMP(" RCDPARC_RE PORT",$J," ~~SUM")
  516    ; SORT -  Selected S ort Option
  517    ; CD - 'D ' - Detail  report, ' S' - Summa ry report
  518    ; RA - Al ways 0 for  now to no t display  CARCS on r eport
  519    ; Output:  RCSTOP -  1 if user  quit out o f the disp lay, 0 oth erwise
  520    N AMTA,AM TB,AMTP,CL ,CZ,DESC,D IWL,DIWR,D LN,DX0,DZ, IX,IY,LN,L N2,PAY,PCT ,RCSL
  521    N TIN,TIX ,TIY,X,XX, YY,ZZ
  522    N IX,IY,T IX,TIY,IEN ,CL,LN,LN2 ,DLN,AMTA, AMTB,AMTP, TIN,DESC,D X0,DZ,PAY, CZ,PCT,X,D IWL,DIWR,R CSL
  523    S $P(LN," -",80)="", $P(DLN,"=" ,80)="",$P (LN2,"-",7 8)="",LN2= " "_LN2,RC SL=8
  524    ; Do Gran d totals -  moved to  top of rep ort per Su san on 7/1 6/2015
  525    S DX0=$G( @SUMM@("CL AIMS")),PC T=0
  526    S:+$P(DX0 ,U,2)'=0 P CT=$J(($P( DX0,U,4)/$ P(DX0,U,2) )*100,3,0)
  527    S:+$P(DX0 ,U,2)=0 PC T="ERR"
  528    I RCSL>=( IOSL-4) S  RCSTOP=$$N EWPG(.RCPG ,1,.RCSL,C D,RA) Q:RC STOP
  529    W !
  530    W "GRAND  TOTAL ALL  CARCS / AL L PAYERS O N REPORT", !
  531    W " TOTAL  #CLAIMS:  ",$J($P(DX 0,U,1),6,0 )," ADJ: " ,PCT,"% [T OT AMT ADJ USTED / TO T AMT BILL ED]",!
  532    W " AMT A DJUST: $", $J($P(DX0, U,4),11,2) ," AMT BIL LED: $",$J ($P(DX0,U, 2),11,2),"  AMT PAID:  $",$J($P( DX0,U,3),1 1,2),!
  533    W !,DLN,! ! S RCSL=R CSL+5
  534    ;
  535    S IX="",I EN="",CL=0 ,AMTB=0,AM TP=0,DESC= "Empty Des cription"
  536    F  S IX=$ O(@DATA@(I X)) Q:IX=" "!RCSTOP   S TIX=$G(@ DATA@(IX)) ,IY="" D   Q:RCSTOP 
  537    . D:SORT= "C"  Q:RCS TOP  ; CAR C Sorted o utput IX = > CARC; IY  => Payer  Name
  538    .. S DX0= $G(@DATA@( IX,"~~SUM" )),CL=$P(D X0,U,1),AM TB=$P(DX0, U,2),AMTP= $P(DX0,U,3 ),AMTA=$P( DX0,U,4),D ESC=$P(DX0 ,U,5),PCT= (AMTA/AMTB )*100
  539    .. W "CAR C: ",$J(IX ,4)," TOTA L #CLAIMS:  ",$J(CL,5 ,0)," ADJ: ",$J(PCT,3 ,0),"% [TO T AMT ADJU STED / TOT  AMT BILLE D]",! S RC SL=RCSL+1
  540    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  541    .. W " AM T ADJUST:  ",$J(AMTA, 11,2)," AM T BILLED:  ",$J(AMTB, 12,2)," AM T PAID: ", $J(AMTP,12 ,2),! S RC SL=RCSL+1
  542    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  543    .. S X="D esc: "_$E( DESC,1,73) ,DIWL=1,DI WR=80 K ^U TILITY($J, "W") D ^DI WP,^DIWW S  RCSL=RCSL +1
  544    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  545    .. W LN,!  S RCSL=RC SL+1
  546    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  547    .. S CZ=0 ,PAY="" F   S PAY=$O( @DATA@(IX, "~~SUM",PA Y)) Q:PAY= ""!RCSTOP   S CZ=CZ+1  D  Q:RCST OP
  548    ... S DZ= @DATA@(IX, "~~SUM",PA Y),PCT=$S( (+$P(DZ,U, 2)'=0):($P (DZ,U,4)/$ P(DZ,U,2)* 100),1:"ER ROR")
  549    ... I CZ> 1 W LN2,!  S RCSL=RCS L+1
  550    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  551    ... W " P AYER NAME/ TIN: ",PAY ,! S RCSL= RCSL+1
  552    ... W " P AYER NAME/ TIN",!
  553    ... S RCS L=RCSL+1
  554    ... I $L( PAY)>76 D
  555    .... S ZZ =$L(PAY,"/ "),XX=$P(P AY,"/",1,Z Z-1),YY=$P (PAY,"/",Z Z)
  556    .... S XX =$E(XX,1,$ L(XX)-($L( PAY)-76)), PAY=XX_"/" _YY
  557    ... W " " ,PAY,!
  558    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  559    ... W " # CLAIMS: ", $J($P(DZ,U ,1),4,0),"  ADJ:",$J( PCT,3,0)," % [ADJ: ", $J($P(DZ,U ,4),10,2), "/BILLED:  ",$J($P(DZ ,U,2),10,2 ),"] PAID:  ",$J($P(D Z,U,3),10, 2),! S RCS L=RCSL+1
  560    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  561    ... D:RCD ET DETAIL( DATA,IX,PA Y,.RCSL,.R CSTOP) Q:R CSTOP  ; D ata array,  CARC, Pay er/TIN
  562    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  563    .. Q:RCST OP  W LN,!  S RCSL=RC SL+1 ; Rem oved "!,"  in front o f "LN"
  564    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  565    . Q:RCSTO P
  566    . D:SORT= "P"  Q:RCS TOP  ; Pay er Sorted  output IX  => Payer N ame; IY =>  CARC
  567    .. W "PAY ER NAME/TI N: ",IX,!  S RCSL=RCS L+1
  568    .. W " PA YER NAME/T IN",!
  569    .. S RCSL =RCSL+1
  570    .. I $L(I X)>76 D
  571    ... S ZZ= $L(IX,"/") ,XX=$P(IX, "/",1,ZZ-1 ),YY=$P(IX ,"/",ZZ)
  572    ... S XX= $E(XX,1,$L (XX)-($L(I X)-76)),IX =XX_"/"_YY
  573    .. W " ", IX,!
  574    .. S DX0= $G(@DATA@( IX,"~~SUM" )),CL=$P(D X0,U,1),AM TB=$P(DX0, U,2),AMTP= $P(DX0,U,3 ),AMTA=$P( DX0,U,4),P CT=(AMTA/A MTB)*100
  575    .. W "#CL AIMS: ",$J (CL,4,0),"  ADJ: ",$J (PCT,3,0), "% [ADJ:", $J(AMTA,10 ,2),"/BILL ED:",$J(AM TB,11,2)," ] PAID:",$ J(AMTP,11, 2),! S RCS L=RCSL+1
  576    .. W LN,! ! S RCSL=R CSL+2
  577    .. S CZ=0 ,IY="" F   S IY=$O(@D ATA@(IX,"~ ~SUM",IY))  Q:IY=""   S CZ=CZ+1  D  Q:RCSTO P
  578    ... S DZ= @DATA@(IX, "~~SUM",IY )
  579    ... I CZ> 1 W LN2,!  S RCSL=RCS L+1
  580    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  581    ... S PCT =$S((+$P(D Z,U,2)'=0) :($P(DZ,U, 4)/$P(DZ,U ,2)*100),1 :"ERROR")
  582    ... W ?2, "CARC: ",$ J(IY,4),?1 4,"#CLAIMS : ",$J($P( DZ,U,1),5, 0),?30,"AD J: ",$J(PC T,3,0),"%  [AMT ADJUS TED / AMT  BILLED]",!  S RCSL=RC SL+1
  583    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  584    ... W ?2, "AMT ADJUS T: ",$J($P (DZ,U,4),1 1,2),?26,"  BILLED: " ,$J($P(DZ, U,2),12,2) ,?56," PAI D: ",$J($P (DZ,U,3),1 2,2),! S R CSL=RCSL+1
  585    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  586    ... S X=" Desc: "_$E ($P(DZ,U,5 ),1,68),DI WL=3,DIWR= 80 K ^UTIL ITY($J,"W" ) D ^DIWP, ^DIWW S RC SL=RCSL+1
  587    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  588    ... D:RCD ET DETAIL( DATA,IX,IY ,.RCSL,.RC STOP) Q:RC STOP  ; Da ta array,  Payer/TIN,  CARC
  589    ... I RCS L>=(IOSL-2 ) S RCSTOP =$$NEWPG(. RCPG,0,.RC SL,CD,RA)  Q:RCSTOP
  590    .. Q:RCST OP  W LN,!  S RCSL=RC SL+1 ; Rem oved "!,"  in front o f LN
  591    .. I RCSL >=(IOSL-2)  S RCSTOP= $$NEWPG(.R CPG,0,.RCS L,CD,RA) Q :RCSTOP
  592    Q
  593    ; Routine sActivitie sRoutine N ameRCDPEDA 2NR2Enhanc ement Cate gory New M odify Dele te No Chan geRTMRelat ed Options RCDPE EDI  LOCKBOX AC T REPORTRC DPE EFT-ER A TRENDING  REPORTRel ated Routi nesRoutine s “Called  By”Routine s “Called”    RCDPEDA RNR1
  594   RCDPENR3
  595   RCDPENR4
  596   RCDPENRY
  597   ASK^RCDPEA DP
  598   $$STATUS^G ECSSGETEND OFROT^RCDP EARL
  599   EFTERRS^RC DPEDA3$$DI VTXT^RCDPE NR1
  600   SL^RCDPEDA 3$$INITARC H^RCDPENR1
  601   $$PAYERTXT ^RCDPENR1
  602   SAVEDATA^R CDPENR1
  603   COMPILE^RC DPENR3
  604   GETEFT^RCD PENR3
  605   $$INTRSCT^ RCDPENR4
  606   GETERA^RCD PENR4
  607   TINARY^RCD PENR4
  608   $$XM^RCDPE NRU
  609   PYARRY^RCD PENRU
  610   $$DISPTY^R CDPRU
  611   $$GETPAY^R CDPRU
  612   $$GETTIN^R CDPRU
  613   INFO^RCDPR U
  614   DIVISION^V AUTOMACurr ent Logic.
  615   .
  616   .
  617   RPT2(INPUT ) ; Entry  point from  RCDPEDAR
  618    ; Loop th rough EDI  LOCKBOX DE POSIT entr ies
  619    ; Input:  INPUT - A1 ^A2^A3^... ^An Where:
  620    ; A1 - 1  - Called b y nightly  job, 0 oth erwise
  621    ; A2 - 1  - Display  to list ma nager, 0 o therwise
  622    ; A3 - 1  - Detail r eport, 0 -  Summary r eport
  623    ; A4 - Cu rrent Page  Number
  624    ; A5 - St op Flag
  625    ; A6 - St art of Dat e Range
  626    ; A7 - En d of Date  Range
  627    ; A8 - Cu rrent Line  Number
  628    ; A9 - In ternal Dat e being pr ocessed
  629    ; 0 - Dis play all E FTs
  630    ; ^TMP(B1 ,$J,B2,B3)  = ""
  631    ; ^TMP(B1 ,$J,B2,B3, "EFT",B4)  = "" Where :
  632    ; B1 - "R CDAILYACT"
  633    ; B2 - In ternal Dat e from DAT E/TIME ADD ED
  634    ; (344.3,  .13)
  635    ; B3 - In ternal IEN  for 344.3
  636    ; B4 - In ternal IEN  for file  344.31
  637    ; Output:  INPUT - A 1^A2^A3^.. .^An - The  following  pieces 
  638    ; may be  updated
  639    ; A4 - Up dated Page  Number
  640    ; A5 - St op Flag
  641    ; A6 - Up dated Line  number
  642    ; ^TMP($J ,"TOTALS", "DEP",C1)  - Total #  of deposit s by Inter nal date ( C1)
  643    ; ^TMP($J ,"TOTALS", "DEP",C1)  - Total #  of deposit s by Inter nal date ( C1)
  644    ; ^TMP($J ,"TOTALS", "DEPA",C1)  - Total D eposit Amo unt by Int ernal date  (C1)
  645    ; ^TMP($J ,"TOTALS", "EFT","D")  - Total D eposit Amo unt by EFT s for date
  646    ; ^TMP($J ,"TOTALS", "FMS") - F MS Documen t Status o r "NO FMS  DOC"
  647    ; ^TMP($J ,"TOTALS", "FMS","D", -1) - Tota l Deposit  Amount by  FMS Docume nt
  648    ; ^TMP($J ,"TOTALS", "FMS","D", 0) - Total  Amount fo r Error/Re jected doc uments
  649    ; ^TMP($J ,"TOTALS", "FMS","D", 1") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs
  650    ; ^TMP($J ,"TOTALS", "FMS","D", 2") - Tota l Amount f or queued  docs
  651    ; ^TMP($J ,"TOTALS", "FMSTOT")  - Updated  Total Depo sit Amount  for date  range
  652    ; ^TMP($J ,"TOTALS", "MATCH","D ") - Curre nt Total m atched EFT s for date
  653    N CRDOC,D ETL,DTADD, IEN344,IEN 3443,IEN34 431,TOTDEP ,Q,X,XX,YY
  654    S DETL=$P (INPUT,"^" ,3),DTADD= $P(INPUT," ^",9)
  655    ;
  656    ; Clear t he followi ng daily t otals
  657    K ^TMP($J ,"TOTALS", "EFT","D")
  658    K ^TMP($J ,"TOTALS", "FMS","D")
  659    K ^TMP($J ,"TOTALS", "MATCH","D ")
  660    S IEN3443 =""
  661   .
  662   .
  663   .
  664   PROCEFT(IN PUT,IEN344 3) ; Entry  Point fro m RCDPEDAR
  665   .
  666   .
  667   .
  668    ; IEN3443  - Interna l IEN for  file 344.3
  669    ; ^TMP($J ,"TOTALS", "EFT","D")  - Current  Total Dep osit Amoun t by EFTs  for date
  670    ; ^TMP($J ,"TOTALS", "MATCH","D ") - Curre nt Total m atched EFT s for date
  671    ; ^TMP($J ,"TOTALS", "FMSTOT")  - Current  Total Depo sit Amount  for date  range
  672    ; Output:  INPUT - A 1^A2^A3^.. .^An - The  following  pieces
  673    ; may be  updated
  674    ; A5 - Up dated Page  Number
  675    ; A6 - St op Flag
  676    ; A8 - Up dated Line  Counter
  677    ; ^TMP($J ,"TOTALS", "FMSTOT")  - Updated  Total Depo sit Amount  for date  range
  678    ; ^TMP($J ,"TOTALS", "EFT","D")  - Updated  Total Dep osit Amoun t by EFTs  for date
  679    ; ^TMP($J ,"TOTALS", "MATCH","D ") - Updat ed Total m atched EFT s for date
  680    N DETL,DT ADD,IEN344 31,PAMT,RC FMS1,TRDOC ,X,XX,YY
  681    S ^TMP($J ,"TOTALS", "FMSTOT")= 0
  682    S DTADD=$ P(INPUT,"^ ",9)
  683    S RCFMS1= "NO FMS DO C"
  684    S DETL=$P (INPUT,"^" ,3)
  685    S IEN3443 1=""
  686    F  D  Q:I EN34431=""   Q:$P(INP UT,"^",5)= 1
  687    . S IEN34 431=$O(^TM P("RCDAILY ACT",$J,DT ADD,IEN344 3,"EFT",IE N34431))
  688    . Q:IEN34 431=""
  689    . S XX=$G (^TMP($J," TOTALS","E FT","D"))+ 1
  690    . S ^TMP( $J,"TOTALS ","EFT","D ")=XX                  ; Total #  EFTs for  date
  691    . S XX=+$ $GET1^DIQ( 344.31,IEN 34431,.09, "I") ; Rec eipt # fro m 344.31
  692    . S XX=+$ $GET1^DIQ( 344.31,IEN 34431,.09, "I") ; Rec eipt # fro m 344.31
  693    . S TRDOC =$$GET1^DI Q(344,XX,2 00,"I") ;  FMS Docume nt #
  694    . S X=$S( TRDOC'="": $$STATUS^G ECSSGET(TR DOC),1:"")
  695    . I X'="" ,X'=-1,$E( X,1)'="R", $E(X,1)'=" E" D
  696    . . S XX= $G(^TMP($J ,"TOTALS", "FMSTOT"))
  697    . . S YY= $$GET1^DIQ (344.31,IE N34431,.07 ,"I") ; Am ount of Pa yment
  698    . . S ^TM P($J,"TOTA LS","FMSTO T")=XX+YY
  699    . . S RCF MS1=$S($E( X,1)="Q":" QUEUED TO  POST",1:"P OSTED")
  700   .
  701   .
  702   .
  703   EFTDTL(INP UT,IEN3443 ,IEN34431, RCFMS1) ;  Display EF T Detail
  704   .
  705   .
  706   .
  707    ; PRCA*4. 5*318 add  TR #s to d etail rpt
  708    D GETTR(I EN34431,.I NPUT) ; Ga ther & dis play all T R Doc #s f or EFT det ail record  
  709    S X=""
  710    ;
  711    ; PRCA*4. 5*304 - le ngthen rec eipt numbe r display  to 12
  712    S XX=$$GE T1^DIQ(344 .31,IEN344 31,.09,"I" ) ; Receip t IEN
  713    I XX'=""  D
  714    . S YY=$$ GET1^DIQ(3 44,XX,.01, "I") ; Rec eipt Numbe r
  715    . S X=$$S ETSTR^VALM 1(YY,X,46, 12)
  716   .
  717   .
  718   ..
  719   .
  720   .
  721    ; Print t he insuran ce header  line
  722   PRINTINS(R CINS) ; 
  723    N RCSTOP, XX,YY,ZZ
  724    ; undecla red parame ter
  725    ; RCLINE  - line of  "-" for re port forma ting
  726    ;
  727    S RCSTOP= 0
  728    I $Y>(IOS L-7) D
  729    . D ASK^R CDPEADP(.R CSTOP,0)
  730    . Q:RCSTO P
  731    . D HEADE R
  732    I RCSTOP  Q RCSTOP
  733    W "PAYER  NAME/TIN:  ",RCINS,!
  734    W RCLINE, !
  735    Q RCSTOP
  736    ;
  737   .
  738   .
  739   .Modified  Logic (Cha nges are i n bold).
  740   .
  741   .
  742   RPT2(INPUT ) ; Entry  point from  RCDPEDAR
  743    ; Loop th rough EDI  LOCKBOX DE POSIT entr ies
  744    ; Input:  INPUT - A1 ^A2^A3^... ^An Where:
  745    ; A1 - 1  - Called b y nightly  job, 0 oth erwise
  746    ; A2 - 1  - Display  to list ma nager, 0 o therwise
  747    ; A3 - 1  - Detail r eport, 0 -  Summary r eport
  748    ; A4 - Cu rrent Page  Number
  749    ; A5 - St op Flag
  750    ; A6 - St art of Dat e Range
  751    ; A7 - En d of Date  Range
  752    ; A8 - Cu rrent Line  Number
  753    ; A9 - In ternal Dat e being pr ocessed
  754    ; A10- 1  - Only Dis play EFTs  with a deb it flag of  'D'
  755    ; 0 - Dis play all E FTs
  756    ; ^TMP(B1 ,$J,B2,B3)  = ""
  757    ; ^TMP(B1 ,$J,B2,B3, "EFT",B4)  = "" Where :
  758    ; B1 - "R CDAILYACT"
  759    ; B2 - In ternal Dat e from DAT E/TIME ADD ED
  760    ; (344.3,  .13)
  761    ; B3 - In ternal IEN  for 344.3
  762    ; B4 - In ternal IEN  for file  344.31
  763    ; Output:  INPUT - A 1^A2^A3^.. .^An - The  following  pieces 
  764    ; may be  updated
  765    ; A4 - Up dated Page  Number
  766    ; A5 - St op Flag
  767    ; A6 - Up dated Line  number
  768    ; ^TMP($J ,"TOTALS", "DEBIT") -  Current T otal # of  debits for  date rang e
  769    ; ^TMP($J ,"TOTALS", "DEBIT","D ") - Total  # of debi ts for Int ernal date
  770    ; ^TMP($J ,"TOTALS", "DEBITA")  - Current  Total Debi t Amount f or date ra nge
  771    ; ^TMP($J ,"TOTALS", "DEBITA"," D") - Tota l Debit Am ount for I nternal da te
  772    ; ^TMP($J ,"TOTALS", "DEP",C1)  - Total #  of deposit s by Inter nal date ( C1)
  773    ; ^TMP($J ,"TOTALS", "DEPA",C1)  - Total D eposit Amo unt by Int ernal date  (C1)
  774    ; ^TMP($J ,"TOTALS", "EFT","D")  - Total D eposit Amo unt by EFT s for date
  775    ; ^TMP($J ,"TOTALS", "FMS") - F MS Documen t Status o r "NO FMS  DOC"
  776    ; ^TMP($J ,"TOTALS", "FMS","D", -1) - Tota l Deposit  Amount by  FMS Docume nt
  777    ; ^TMP($J ,"TOTALS", "FMS","D", 0) - Total  Amount fo r Error/Re jected doc uments
  778    ; ^TMP($J ,"TOTALS", "FMS","D", 1") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs
  779    ; ^TMP($J ,"TOTALS", "FMS","D", 2") - Tota l Amount f or queued  docs
  780    ; ^TMP($J ,"TOTALS", "FMSTOT")  - Updated  Total Depo sit Amount  for date  range
  781    ; ^TMP($J ,"TOTALS", "MATCH","D ") - Curre nt Total m atched EFT s for date
  782    N CRDOC,D ETL,DTADD, IEN344,IEN 3443,IEN34 431,TOTDEP ,Q,X,XX,YY
  783    S DETL=$P (INPUT,"^" ,3),DTADD= $P(INPUT," ^",9)
  784    ;
  785    ; Clear t he followi ng daily t otals
  786    K ^TMP($J ,"TOTALS", "EFT","D")
  787    K ^TMP($J ,"TOTALS", "FMS","D")
  788    K ^TMP($J ,"TOTALS", "MATCH","D ")
  789    K ^TMP($J ,"TOTALS", "DEBIT","D ")
  790    K ^TMP($J ,"TOTALS", "DEBITA"," D")
  791    S IEN3443 =""
  792   .
  793   .
  794   .
  795   PROCEFT(IN PUT,IEN344 3) ; Entry  Point fro m RCDPEDAR
  796   .
  797   .
  798   .
  799    ; IEN3443  - Interna l IEN for  file 344.3
  800    ; ^TMP($J ,"TOTALS", "DEBIT","D ") - Curre nt Total #  of Debit  EFTs for d ate
  801    ; ^TMP($J ,"TOTALS", "DEBITA"," D") - Curr ent Total  Amount of  Debit EFTs  for dat
  802    ; ^TMP($J ,"TOTALS", "EFT","D")  - Current  Total Dep osit Amoun t by EFTs  for date
  803    ; ^TMP($J ,"TOTALS", "MATCH","D ") - Curre nt Total m atched EFT s for date
  804    ; ^TMP($J ,"TOTALS", "FMSTOT")  - Current  Total Depo sit Amount  for date  range
  805    ; Output:  INPUT - A 1^A2^A3^.. .^An - The  following  pieces
  806    ; may be  updated
  807    ; A5 - Up dated Page  Number
  808    ; A6 - St op Flag
  809    ; A8 - Up dated Line  Counter
  810    ; ^TMP($J ,"TOTALS", "DEBIT","D ") - Updat ed Total #  of Debit  EFTs for d ate
  811    ; ^TMP($J ,"TOTALS", "DEBITA"," D") - Upda ted Total  Amount of  Debit EFTs  for date
  812    ; ^TMP($J ,"TOTALS", "FMSTOT")  - Updated  Total Depo sit Amount  for date  range
  813    ; ^TMP($J ,"TOTALS", "EFT","D")  - Updated  Total Dep osit Amoun t by EFTs  for date
  814    ; ^TMP($J ,"TOTALS", "MATCH","D ") - Updat ed Total m atched EFT s for date
  815    N DETL,DF LG,DTADD,I EN34431,PA MT,RCFMS1, TRDOC,X,XX ,YY  ;**FA **
  816    S ^TMP($J ,"TOTALS", "FMSTOT")= 0
  817    S DTADD=$ P(INPUT,"^ ",9)
  818    S RCFMS1= "NO FMS DO C"
  819    S DETL=$P (INPUT,"^" ,3)
  820    S IEN3443 1=""
  821    F  D  Q:I EN34431=""   Q:$P(INP UT,"^",5)= 1
  822    . S IEN34 431=$O(^TM P("RCDAILY ACT",$J,DT ADD,IEN344 3,"EFT",IE N34431))
  823    . Q:IEN34 431=""
  824    . S XX=$G (^TMP($J," TOTALS","E FT","D"))+ 1
  825    . S ^TMP( $J,"TOTALS ","EFT","D ")=XX                  ; Total #  EFTs for  date
  826    . S YY=$$ GET1^DIQ(3 44.31,,IEN 34431,.20, "E") ; Deb it/Credit  flag
  827    . S DFLG= $S(YY="D": 1,1:0) ; * *FA**
  828    . S PAMT= $$GET1^DIQ (344.31,IE N34431,.07 ,"I") ; Am ount of Pa yment
  829    . I DFLG  D
  830    . . S XX= $G(^TMP($J ,"TOTALS", "DEBIT","D "))+1
  831    . . S ^TM P($J,"TOTA LS","DEBIT ","D")=XX              ; Total #  Debit EFT s for date
  832    . . S XX= $G(^TMP($J ,"TOTALS", "DEBITA"," D")) ; Tot al Debit A mounts for  date
  833    . . S ^TM P($J,"TOTA LS","DEBIT A","D")=XX +PAMT
  834    . . S XX= $G(^TMP($J ,"TOTALS", "DEBIT","D ")) ; Tota l # Debit  EFTs for d ate
  835    . . S ^TM P($J,"TOTA LS","DEBIT ","D")=XX+ 1
  836    . S XX=+$ $GET1^DIQ( 344.31,IEN 34431,.09, "I") ; Rec eipt # fro m 344.31
  837    . S XX=+$ $GET1^DIQ( 344.31,IEN 34431,.09, "I") ; Rec eipt # fro m 344.31
  838    . S TRDOC =$$GET1^DI Q(344,XX,2 00,"I") ;  FMS Docume nt #
  839    . S X=$S( TRDOC'="": $$STATUS^G ECSSGET(TR DOC),1:"")
  840    . I X'="" ,X'=-1,$E( X,1)'="R", $E(X,1)'=" E" D
  841    . . S XX= $G(^TMP($J ,"TOTALS", "FMSTOT"))
  842    . . S ^TM P($J,"TOTA LS","FMSTO T")=XX+PAM T
  843    . . S RCF MS1=$S($E( X,1)="Q":" QUEUED TO  POST",1:"P OSTED")
  844   .
  845   .
  846   EFTDTL(INP UT,IEN3443 ,IEN34431, RCFMS1) ;  Display EF T Detail
  847   .
  848   .
  849   .
  850    ; PRCA*4. 5*318 add  TR #s to d etail rpt
  851    D GETTR(I EN34431,.I NPUT) ; Ga ther & dis play all T R Doc #s f or EFT det ail record  
  852    S X=""
  853    S XX=$$GE T1^DIQ(344 .31,IEN344 31,.20,"E" ) ; Debit  Flag
  854    S X=$$SET STR^VALM1( XX,X,39,1)
  855    ;
  856    ; PRCA*4. 5*304 - le ngthen rec eipt numbe r display  to 12
  857    S XX=$$GE T1^DIQ(344 .31,IEN344 31,.09,"I" ) ; Receip t IEN
  858    I XX'=""  D
  859    . S YY=$$ GET1^DIQ(3 44,XX,.01, "I") ; Rec eipt Numbe r
  860    . S X=$$S ETSTR^VALM 1(YY,X,45, 12)
  861   .
  862   .
  863   ..
  864   .
  865   .
  866   PRINTINS(R CINS) ; Pr int the in surance he ader line
  867    ; Input:  RCINS - Pa yer Name/T IN to be d isplayed
  868    ; RCLINE  - line of  dashes use d for sepa ration
  869    ; Returns  1 - User  quit out o f report,  0 otherwis e
  870    N RCSTOP, XX,YY,ZZ
  871    ; undecla red parame ter
  872    ; RCLINE  - line of  "-" for re port forma ting
  873    ;
  874    S RCSTOP= 0
  875    I $Y>(IOS L-7) D
  876    . D ASK^R CDPEADP(.R CSTOP,0)
  877    . Q:RCSTO P
  878    . D HEADE R
  879    I RCSTOP  Q RCSTOP
  880    W "PAYER  NAME/TIN", !
  881    I $L(RCIN S)>78 D
  882    . S ZZ=$L (RCINS,"/" ),XX=$P(RC INS,"/",1, ZZ-1),YY=$ P(RCINS,"/ ",ZZ)
  883    . S XX=$E (XX,1,$L(X X)-($L(RCI NS)-78)),R CINS=XX_"/ "_YY
  884    W " ",RCI NS,!
  885    W RCLINE, !
  886    Q RCSTOP
  887    ;
  888   .
  889   .
  890   .RoutinesA ctivitiesR outine Nam eRCDPEDA3E AR1Enhance ment Categ ory New Mo dify Delet e No Chang eRTMRelate d OptionsR CDPE EDI L OCKBOX ACT  REPORTRCD PE EFT-ERA  TRENDING  REPORTRela ted Routin esRoutines  “Called B y”Routines  “Called”    RCDPEDA2 AR
  891   RCCPEDARAR 2
  892   RCDPEM9$$A SKLM^RCDPE ARL
  893   $$CLMCHMPV ^RCDPEARL
  894   $$CLMTRICR ^RCDPEARL
  895   $$ENDOFRPT ^RCDPEARL
  896   $$INTRICAR ^RCDPEARL
  897   $$NOW^RCDP EARL
  898   $$ASK^RCDP EARL
  899   HDRLST^RCD PEARL
  900   LMRPT^RCDP EARL
  901   SL^RCDPEAR L
  902   $$DISPTY^R CDPEM3
  903   $$DTRNG^RC DPEM4
  904   ERASTA^RCD PEM4
  905   INFO^RCDPE M6
  906   $$GETPAY^R CDPEM9
  907   DISP^RCDPE 0
  908   $$ADJ^RCDP EU
  909   $$HASCERA^ RCDPEU
  910   $$XCEPT^RC DPEWLP
  911   DIVISION^V AUTOMACurr ent Logic.
  912   .
  913   .
  914   LMHDR(RCST OP,RCDET,R CNJ,RCDT1, RCDT2,RCHD R) ; Entry  Point fro m RCDPEDAR  
  915    ; ListMan  report he ading
  916    ;
  917    ; Input:  RCDET - 1  to display  detail, 0  otherwise
  918    ; RCNJ -  Set 1, ind icates rep ort was ca lled from  the nightl y
  919    ; process  OR displa ying to li stman. Use d to set l ines
  920    ; into a  ^TMP array  instead o f displayi ng them.
  921    ; RCDT1 -  Internal  Start Date  of date r ange
  922    ; RCDT2 -  Internal  End Date o f date ran ge
  923    ; RCNP -  Payer Sele ction flag  A1^A2^A3  Where:
  924   .
  925   .
  926   .
  927    ;
  928    I 'RCDET  D
  929    . S RCCT= RCCT+1,RCH DR(RCCT)=" "
  930    S Z="DATE  RANGE: "_ $$FMTE^XLF DT(RCDT1," 2Z")_" - "
  931    S Z=Z_$$F MTE^XLFDT( RCDT2,"2Z" )_" (Date  Deposit Ad ded)"
  932    I 'RCDET  D
  933   .
  934   .
  935   .
  936    . S Z=$$S ETSTR^VALM 1($J("",6) _"PAYMENT  FROM","",1 ,30)
  937    . S Z=$$S ETSTR^VALM 1("DEP REC EIPT #",Z, 31,30) 
  938    . S Z=$$S ETSTR^VALM 1("DEP REC EIPT STATU S",Z,61,19 )
  939   .
  940   .
  941   .
  942    ;
  943   HDR(INPUT)  ; Display s report h eader
  944    ; Input:  INPUT - A1 ^A2^A3^... ^An Where:
  945    ; A1 - 1  if called  from Night ly Process , 0 otherw ise
  946    ; A2 - 1  if display ing to Lis tman, 0 ot herwise
  947    ; A3 - 1  if Detail  report, 0  if summary  report
  948    ; A4 - Cu rrent Page  Number
  949    ; A5 - St op Flag
  950    ; A6 - St art of Dat e Range
  951    ; A7 - En d of Date  Range
  952    ; A9 - Cu rrent line  count
  953    ; 0 - Dis play all E FTs
  954    ; Output:  INPUT - A 1^A2^A3^.. .^An - The  following  pieces ma y be updat ed
  955    ; A4 - Cu rrent Page  Number
  956    ; A5 - St op Flag
  957    ; A8 - Up dated line  count
  958    N CURPG,D ETL,DONLY, DTST,DTEND ,NJ,STOP,X ,XX,Y,Z,Z0 ,Z1   ;**F A**
  959    S DETL=$P (INPUT,"^" ,3)
  960    S STOP=$P (INPUT,"^" ,5)
  961    S DTST=$P (INPUT,"^" ,6) ; Date  Range Sta rt
  962    S DTEND=$ P(INPUT,"^ ",7) ; Dat e Range En d
  963    S NJ=$P(I NPUT,"^",1 ),CURPG=$P (INPUT,"^" ,4)
  964   .
  965   .
  966   .
  967    ;
  968    ; PRCA276  add date  filter to  header
  969    S Z="DATE  RANGE: "_ $$FMTE^XLF DT(DTST,"2 Z")_" - "_ $$FMTE^XLF DT(DTEND," 2Z")
  970    S Z=$J("" ,80-$L(Z)\ 2)_Z
  971    D SL(.INP UT,Z)
  972    I DETL D
  973   .
  974   .
  975   .
  976    . D SL(.I NPUT,Z) ;  TR DOC hea der
  977    . S XX=$J ("",45)_"D EP RECEIPT  #"
  978    . S Z=$$S ETSTR^VALM 1(XX,"",1, $L(XX))
  979    . S Z=$$S ETSTR^VALM 1("DEP REC EIPT STATU S",Z,61,19 )
  980    . D SL(.I NPUT,Z)
  981    D SL(.INP UT,$TR($J( "",IOM-1), " ","="))
  982    Q
  983    ;
  984   TOTSDAY(IN PUT) ; Ent ry Point f rom RCDPED AR
  985    ; Display  the total s for the  specified  date
  986    ; Input:  INPUT - A1 ^A2^A3^... ^An Where:
  987    ; A1 - 1  if called  from Night ly Process , 0 otherw ise
  988    ; A2 - 1  if display ing to Lis tman, 0 ot herwise
  989    ; A3 - 1  if Detail  report, 0  if summary  report
  990    ; A4 - Cu rrent Page  Number
  991    ; A5 - St op Flag
  992    ; A6 - St art of Dat e Range
  993    ; A7 - En d of Date  Range
  994    ; A8 - Cu rrent Line  Counter
  995    ; A9 - In ternal Dat e being pr ocessed
  996    ; ^TMP($J ,"TOTALS", "DEP") - C urrent Tot al # of de posits for  date rang e
  997    ; ^TMP($J ,"TOTALS", "DEP",C1)  - Total #  of deposit s for Inte rnal date  (C1)
  998    ; ^TMP($J ,"TOTALS", "DEPA") -  Current To tal Deposi t Amount f or date ra nge
  999    ; ^TMP($J ,"TOTALS", "DEPA",C1)  - Total D eposit Amo unt for In ternal dat e (C1)
  1000    ; ^TMP($J ,"TOTALS", "EFT","D")  - Total D eposit Amo unt by EFT s for date
  1001    ; ^TMP($J ,"TOTALS", "EFT","T")  - Current  Total Dep osit Amoun t by EFTs  for range
  1002    ; ^TMP($J ,"TOTALS", "FMS") - F MS Documen t Status o r "NO FMS  DOC"
  1003    ; ^TMP($J ,"TOTALS", "FMS","D", -1) - Tota l Deposit  Amount by  FMS Docume nt
  1004    ; ^TMP($J ,"TOTALS", "FMS","D", 0) - Total  Amount fo r Error/Re jected doc uments
  1005    ; ^TMP($J ,"TOTALS", "FMS","D", 1") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs
  1006    ; ^TMP($J ,"TOTALS", "FMS","D", 2") - Tota l Amount f or queued  docs
  1007    ; ^TMP($J ,"TOTALS", "FMS","T", -1) - Tota l Deposit  Amount by  FMS Docume nt for ran ge
  1008    ; ^TMP($J ,"TOTALS", "FMS","T", 0) - Total  Amount fo r Error/Re jected doc s for rang e
  1009    ; ^TMP($J ,"TOTALS", "FMS","T", 1") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs ran ge
  1010    ; ^TMP($J ,"TOTALS", "FMS","T", 2") - Tota l Amount f or queued  docs for r ange
  1011    ; ^TMP($J ,"TOTALS", "FMSTOT")  - Updated  Total Depo sit Amount  for date  range
  1012    ; ^TMP($J ,"TOTALS", "MATCH","D ") - Curre nt Total m atched EFT s for date
  1013    ; ^TMP($J ,"TOTALS", "MATCH","T ") - Curre nt Total m atched EFT s for date  range
  1014    ; Output:  INPUT - A 1^A2^A3^.. .^An - The  following  pieces ma y be updat ed
  1015    ; A4 - Up dated Page  Number
  1016    ; A5 - St op Flag
  1017    ; A8 - Up dated Line  Counter
  1018    ; ^TMP($J ,"TOTALS", "DEP") - U pdated Tot al # of de posits for  date rang e
  1019   .
  1020   .
  1021   .
  1022    S XX=$J(" ",37)_"NOT  IN FMS: $ "_$J(YY,"" ,2)
  1023    D SL(.INP UT,XX)
  1024    D SL(.INP UT," ")
  1025    S YY=+$G( ^TMP($J,"T OTALS","EF T","D"))
  1026   .
  1027   .
  1028   .
  1029   .
  1030   .
  1031   .
  1032   TOTSF(INPU T) ; Entry  Point fro m RCDPEDAR
  1033    ; Display  Final Tot als
  1034    ; Input:  INPUT - A1 ^A2^A3^... ^An Where:
  1035    ; A1 - 1  if called  from Night ly Process , 0 otherw ise
  1036    ; A2 - 1  if display ing to Lis tman, 0 ot herwise
  1037    ; A3 - 1  if Detail  report, 0  if summary  report
  1038    ; A4 - Cu rrent Page  Number
  1039    ; A5 - St op Flag
  1040    ; A6 - St art of Dat e Range
  1041    ; A7 - En d of Date  Range
  1042    ; A8 - Cu rrent Line  Counter
  1043    ; A9 - In ternal Dat e being pr ocessed
  1044    ; ^TMP($J ,"TOTALS", "EFT","T")  - Total D eposit Amo unt by EFT s for rang e
  1045   .
  1046   .
  1047   .
  1048    S XX=$J(" ",37)_"NOT  IN FMS: $ "_$J(YY,"" ,2)
  1049    D SL(.INP UT,XX)
  1050    D SL(.INP UT," ")
  1051    S YY=+$G( ^TMP($J,"T OTALS","EF T","T"))
  1052   .
  1053   .
  1054   .Modified  Logic.
  1055   .
  1056   .
  1057   LMHDR(RCST OP,RCDET,R CNJ,RCDT1, RCDT2,RCHD R,DONLY) ;  Entry Poi nt from RC DPEDAR
  1058    ; ListMan  report he ading
  1059    ;
  1060    ; Input:  RCDET - 1  to display  detail, 0  otherwise
  1061    ; RCNJ -  Set 1, ind icates rep ort was ca lled from  the nightl y
  1062    ; process  OR displa ying to li stman. Use d to set l ines
  1063    ; into a  ^TMP array  instead o f displayi ng them.
  1064    ; RCDT1 -  Internal  Start Date  of date r ange
  1065    ; RCDT2 -  Internal  End Date o f date ran ge
  1066    ; DONLY -  1 - Only  EFTs with  debits, 0  - display  all EFTs
  1067    ; RCNP -  Payer Sele ction flag  A1^A2^A3  Where:
  1068   .
  1069   .
  1070   .
  1071    ;
  1072    I 'RCDET  D
  1073    . S RCCT= RCCT+1,RCH DR(RCCT)=" "
  1074    S Z="DATE  RANGE: "_ $$FMTE^XLF DT(RCDT1," 2Z")_" - "
  1075    S Z=Z_$$F MTE^XLFDT( RCDT2,"2Z" )_" (Date  Deposit Ad ded)"
  1076    S Z=Z_" D ebit Only  EFTs: "_$S (DONLY=1:" YES",1:"NO ")
  1077    I 'RCDET  D
  1078   .
  1079   .
  1080   .
  1081    . S Z=$$S ETSTR^VALM 1($J("",6) _"PAYMENT  FROM","",1 ,30)
  1082    . S Z=$$S ETSTR^VALM 1("Debit", Z,37,5) 
  1083    . S Z=$$S ETSTR^VALM 1("DEP REC EIPT #",Z, 45,30) 
  1084    . S Z=$$S ETSTR^VALM 1("DEP REC EIPT STATU S",Z,61,19 )
  1085   .
  1086   .
  1087   .
  1088    ;
  1089   HDR(INPUT)  ; Display s report h eader
  1090    ; Input:  INPUT - A1 ^A2^A3^... ^An Where:
  1091    ; A1 - 1  if called  from Night ly Process , 0 otherw ise
  1092    ; A2 - 1  if display ing to Lis tman, 0 ot herwise
  1093    ; A3 - 1  if Detail  report, 0  if summary  report
  1094    ; A4 - Cu rrent Page  Number
  1095    ; A5 - St op Flag
  1096    ; A6 - St art of Dat e Range
  1097    ; A7 - En d of Date  Range
  1098    ; A9 - Cu rrent line  count
  1099    ; A10- 1  - Only Dis play EFTs  with a deb it flag of  'D'
  1100    ; 0 - Dis play all E FTs
  1101    ; Output:  INPUT - A 1^A2^A3^.. .^An - The  following  pieces ma y be updat ed
  1102    ; A4 - Cu rrent Page  Number
  1103    ; A5 - St op Flag
  1104    ; A8 - Up dated line  count
  1105    N CURPG,D ETL,DONLY, DTST,DTEND ,NJ,STOP,X ,XX,Y,Z,Z0 ,Z1
  1106    S DETL=$P (INPUT,"^" ,3)
  1107    S STOP=$P (INPUT,"^" ,5)
  1108    S DTST=$P (INPUT,"^" ,6) ; Date  Range Sta rt
  1109    S DTEND=$ P(INPUT,"^ ",7) ; Dat e Range En d
  1110    S DONLY=$ P(INPUT,"^ ",10) ; EF Ts with De bits Only
  1111    S NJ=$P(I NPUT,"^",1 ),CURPG=$P (INPUT,"^" ,4)
  1112   .
  1113   .
  1114   .
  1115    ;
  1116    ; PRCA276  add date  filter to  header
  1117    S Z="DATE  RANGE: "_ $$FMTE^XLF DT(DTST,"2 Z")_" - "_ $$FMTE^XLF DT(DTEND," 2Z")
  1118    S Z=Z_" ( Date Depos it Added)  Debit Only  EFTs: "
  1119    S Z=Z_$S( DONLY:"YES ",1:"NO")
  1120    S Z=$J("" ,80-$L(Z)\ 2)_Z
  1121    D SL(.INP UT,Z)
  1122    I DETL D
  1123   .
  1124   .
  1125   .
  1126    . D SL(.I NPUT,Z) ;  TR DOC hea der
  1127    . S XX=$J ("",36)_"D ebit DEP R ECEIPT #"
  1128    . S Z=$$S ETSTR^VALM 1(XX,"",1, $L(XX))
  1129    . S Z=$$S ETSTR^VALM 1("DEP REC EIPT STATU S",Z,61,19 )
  1130    . D SL(.I NPUT,Z)
  1131    D SL(.INP UT,$TR($J( "",IOM-1), " ","="))
  1132    Q
  1133    ;
  1134   TOTSDAY(IN PUT) ; Ent ry Point f rom RCDPED AR
  1135    ; Display  the total s for the  specified  date
  1136    ; Input:  INPUT - A1 ^A2^A3^... ^An Where:
  1137    ; A1 - 1  if called  from Night ly Process , 0 otherw ise
  1138    ; A2 - 1  if display ing to Lis tman, 0 ot herwise
  1139    ; A3 - 1  if Detail  report, 0  if summary  report
  1140    ; A4 - Cu rrent Page  Number
  1141    ; A5 - St op Flag
  1142    ; A6 - St art of Dat e Range
  1143    ; A7 - En d of Date  Range
  1144    ; A8 - Cu rrent Line  Counter
  1145    ; A9 - In ternal Dat e being pr ocessed
  1146    ; ^TMP($J ,"TOTALS", "DEBIT") -  Current T otal # of  debits for  date rang e
  1147    ; ^TMP($J ,"TOTALS", "DEBIT","D ") - Total  # of debi ts for Int ernal date  (C1)
  1148    ; ^TMP($J ,"TOTALS", "DEBITA")  - Current  Total Debi t Amount f or date ra nge
  1149    ; ^TMP($J ,"TOTALS", "DEBITA"," D") - Tota l Debit Am ount for I nternal da te (C1)
  1150    ; ^TMP($J ,"TOTALS", "DEP") - C urrent Tot al # of de posits for  date rang e
  1151    ; ^TMP($J ,"TOTALS", "DEP",C1)  - Total #  of deposit s for Inte rnal date  (C1)
  1152    ; ^TMP($J ,"TOTALS", "DEPA") -  Current To tal Deposi t Amount f or date ra nge
  1153    ; ^TMP($J ,"TOTALS", "DEPA",C1)  - Total D eposit Amo unt for In ternal dat e (C1)
  1154    ; ^TMP($J ,"TOTALS", "EFT","D")  - Total D eposit Amo unt by EFT s for date
  1155    ; ^TMP($J ,"TOTALS", "EFT","T")  - Current  Total Dep osit Amoun t by EFTs  for range
  1156    ; ^TMP($J ,"TOTALS", "FMS") - F MS Documen t Status o r "NO FMS  DOC"
  1157    ; ^TMP($J ,"TOTALS", "FMS","D", -1) - Tota l Deposit  Amount by  FMS Docume nt
  1158    ; ^TMP($J ,"TOTALS", "FMS","D", 0) - Total  Amount fo r Error/Re jected doc uments
  1159    ; ^TMP($J ,"TOTALS", "FMS","D", 1") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs
  1160    ; ^TMP($J ,"TOTALS", "FMS","D", 2") - Tota l Amount f or queued  docs
  1161    ; ^TMP($J ,"TOTALS", "FMS","T", -1) - Tota l Deposit  Amount by  FMS Docume nt for ran ge
  1162    ; ^TMP($J ,"TOTALS", "FMS","T", 0) - Total  Amount fo r Error/Re jected doc s for rang e
  1163    ; ^TMP($J ,"TOTALS", "FMS","T", 1") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs ran ge
  1164    ; ^TMP($J ,"TOTALS", "FMS","T", 2") - Tota l Amount f or queued  docs for r ange
  1165    ; ^TMP($J ,"TOTALS", "FMSTOT")  - Updated  Total Depo sit Amount  for date  range
  1166    ; ^TMP($J ,"TOTALS", "MATCH","D ") - Curre nt Total m atched EFT s for date
  1167    ; ^TMP($J ,"TOTALS", "MATCH","T ") - Curre nt Total m atched EFT s for date  range
  1168    ; Output:  INPUT - A 1^A2^A3^.. .^An - The  following  pieces ma y be updat ed
  1169    ; A4 - Up dated Page  Number
  1170    ; A5 - St op Flag
  1171    ; A8 - Up dated Line  Counter
  1172    ; ^TMP($J ,"TOTALS", "DEBIT") -  Updated T otal # of  debits for  date rang e
  1173    ; ^TMP($J ,"TOTALS", "DEBIT","D ") - Updat ed Total #  of debits  for Inter nal date
  1174    ; ^TMP($J ,"TOTALS", "DEBITA")  - Updated  Total Debi t Amount f or date ra nge
  1175    ; ^TMP($J ,"TOTALS", "DEBITA"," D") - Upda ted Total  Debit Amou nt for Int ernal date
  1176    ; ^TMP($J ,"TOTALS", "DEP") - U pdated Tot al # of de posits for  date rang e
  1177   .
  1178   .
  1179   .
  1180    S XX=$J(" ",37)_"NOT  IN FMS: $ "_$J(YY,"" ,2)
  1181    D SL(.INP UT,XX)
  1182    D SL(.INP UT," ")
  1183    ;
  1184    S XX=$G(^ TMP($J,"TO TALS","DEB IT")) ; Cu rrent Tota l # of deb it EFTs fo r date ran ge
  1185    S YY=$G(^ TMP($J,"TO TALS","DEB IT","D"))  ; Total #  of debit E FTs for da te
  1186    S ^TMP($J ,"TOTALS", "DEBIT")=X X+YY           ; Upda ted Total  # of debit  EFTs for  range
  1187    S XX=$G(^ TMP($J,"TO TALS","DEB ITA")) ; C urrent Tot al amount  of debit E FTs for da te range
  1188    S YY=$G(^ TMP($J,"TO TALS","DEB ITA","D"))  ; Total a mount of d ebit EFTs  for date
  1189    S ^TMP($J ,"TOTALS", "DEBITA")= XX+YY          ; Upda ted Total  amount of  debit EFTs  for range
  1190    S YY=+$G( ^TMP($J,"T OTALS","DE BIT","D"))
  1191    S XX=$J(" ",27)_"# E FT DEBIT V OUCHERS: " _YY
  1192    D SL(.INP UT,XX)
  1193    S YY=+$G( ^TMP($J,"T OTALS","DE BITA","D") )
  1194    S XX=$J(" ",27)_"TOT AL DEBIT V OUCHERS: $ "_$J(YY,"" ,2)
  1195    D SL(.INP UT,XX)
  1196    D SL(.INP UT," ")
  1197    ;
  1198    S YY=+$G( ^TMP($J,"T OTALS","EF T","D"))
  1199   .
  1200   .
  1201   .
  1202   TOTSF(INPU T) ; Entry  Point fro m RCDPEDAR
  1203    ; Display  Final Tot als
  1204    ; Input:  INPUT - A1 ^A2^A3^... ^An Where:
  1205    ; A1 - 1  if called  from Night ly Process , 0 otherw ise
  1206    ; A2 - 1  if display ing to Lis tman, 0 ot herwise
  1207    ; A3 - 1  if Detail  report, 0  if summary  report
  1208    ; A4 - Cu rrent Page  Number
  1209    ; A5 - St op Flag
  1210    ; A6 - St art of Dat e Range
  1211    ; A7 - En d of Date  Range
  1212    ; A8 - Cu rrent Line  Counter
  1213    ; A9 - In ternal Dat e being pr ocessed
  1214    ; ^TMP($J ,"TOTALS", "DEP") - T otal # of  deposits f or date ra nge
  1215    ; ^TMP($J ,"TOTALS", "DEPA") -  Total Depo sit Amount  for date  range
  1216    ; ^TMP($J ,"TOTALS", "EFT","T")  - Total D eposit Amo unt by EFT s for rang e
  1217    ;
  1218   .
  1219   .
  1220   .
  1221    S XX=$J(" ",37)_"NOT  IN FMS: $ "_$J(YY,"" ,2)
  1222    D SL(.INP UT,XX)
  1223    D SL(.INP UT," ")
  1224    ;
  1225    S YY=+$G( ^TMP($J,"T OTALS","DE BIT"))
  1226    S XX=$J(" ",21)_"TOT AL # EFT D EBIT VOUCH ERS: "_YY
  1227    D SL(.INP UT,XX)
  1228    S YY=+$G( ^TMP($J,"T OTALS","DE BITA"))
  1229    S XX=$J(" ",27)_"TOT AL DEBIT V OUCHERS: $ "_$J(YY,"" ,2)
  1230    D SL(.INP UT,XX)
  1231    D SL(.INP UT," ")
  1232    ;
  1233    S YY=+$G( ^TMP($J,"T OTALS","EF T","T"))
  1234   .
  1235   .
  1236   .RoutinesA ctivitiesR outine Nam eRCDPESR3P LBEnhancem ent Catego ry New Mod ify Delete  No Change RTMRelated  OptionsRC DPE PROVID ER LVL ADJ  REPORTRel ated Routi nesRoutine s “Called  By”Routine s “Called”    RCDPEM
  1237   RCDPESR2
  1238   RCDPESRVN/ ABULLEFTER ASTA^RCDPS REM04
  1239   $$CHECKDTE RRUPD^RCDP ESRU1
  1240   TAXERR$$GE TPAY^RCDPE SR1U
  1241   BULL2^RCDP ESR5$$GETT IN^RCDPRU
  1242   $$NOWDISP^ RCDPESR8U
  1243   $$FDTUP^RC DPESRU9
  1244   $$ZEROVAL^ RCDPESRU9
  1245   ASK^RCDPRU
  1246   RNG^RCDPRU
  1247   SUMIT^RCDP RU
  1248   DIVISION^V AUTOMACurr ent Logic.
  1249   .
  1250   .
  1251    ;
  1252   EFTIN(RCTX N,RCD,XMZ, RCGBL,RCEF LG) ; Adds  a new EFT  record to  AR file 3 44.3
  1253    ; from Lo ckbox EFT  msg
  1254    ; RCTXN =  the data  on the hea der record  of the me ssage text
  1255    ; RCD = a rray conta ining form atted mail  message h eader data
  1256    ; XMZ = t he mail me ssage numb er
  1257    ; RCGBL =  the name  of the arr ay or glob al where t he message  is stored
  1258    ; RCEFLG  = error fl ag returne d if passe d by refer ence
  1259    ;
  1260    N CT,RC,R C1,RCLAST, RCEFT,RCTD A,RCERR,RC TYP1,DA,DI K,RCZ,Z,Z0 ,DLAYGO
  1261    ;
  1262    ; Take da ta out of  mail messa ge
  1263    S (RCEFLG ,RCLAST)=0 ,CT=0,RCTY P1="835EFT "
  1264    F  X XMRE C Q:XMER<0  D  Q:RCLA ST
  1265    . I +XMRG =99,$P(XMR G,U,2)="$"  S RCLAST= 1 Q
  1266    . S:XMRG' ="" CT=CT+ 1,@RCGBL@( 2,"D",CT)= XMRG
  1267    ;
  1268    I 'RCLAST ,'$G(RCERR ) K @RCGBL  S RCERR=2  ;No $ as  last chara cter of ms g
  1269    ;
  1270    I $G(RCER R)>0 D  G  EFTQ
  1271    . D ERRUP D^RCDPESR1 (RCGBL,.RC D,RCTYP1,. RCERR)
  1272    . S RCEFL G=1
  1273    ;
  1274    ; Add top -level ent ry to file  344.3
  1275    S RCEFT=$ $ADDEFT(RC TXN,XMZ,RC GBL,.RCERR )
  1276    ;
  1277    I $G(RCER R) D  G EF TQ ; 'BAD'  EFT's
  1278    . D ERRUP D^RCDPESR1 (RCGBL,.RC D,RCTYP1,. RCERR)
  1279    . S RCEFL G=1
  1280    ;
  1281    G:'RCEFT  EFTQ
  1282    ;
  1283    ; Add the  detail da ta to file  344.31 fo r this EFT  record
  1284    S Z=0 F   S Z=$O(^RC Y(344.31," B",RCEFT,Z )) Q:'Z  S  DA=Z,DIK= "^RCY(344. 31," D ^DI K ; Delete  any detai l data alr eady there
  1285    ;
  1286    S (RC,RC1 ,RCZ)=0
  1287    F  S RCZ= $O(@RCGBL@ (2,"D",RCZ )) Q:'RCZ   S Z0=$G(^ (RCZ)) I Z 0'="" D  Q :$G(RCERR)
  1288    . I $P(Z0 ,U)="01" D   ; Each p ayer's dat a
  1289    .. N DA,D IE,DR,X,Y, DO,DD,DIC
  1290    .. S X=RC EFT
  1291    .. S DIC( "DR")=".11 ////0;.04/ ///"_$P(Z0 ,U,2)_";.0 8////0"_$S ($P(Z0,U,5 )'="":";.0 2////"_$P( Z0,U,5),1: "")_$S($P( Z0,U,6)'=" ":";.03/// /"_$P(Z0,U ,6),1:"")_ ";.07////" _$J(+$P(Z0 ,U,4)/100, "",2)_";.0 6////"_$S( $P(Z0,U,8) '="":1,1:0 )
  1292    .. S DIC( "DR")=DIC( "DR")_";.1 2///"_$$FD T^RCDPESR9 ($P(Z0,U,3 ))_";.13// //"_DT_$S( $P(Z0,U,7) '="":";.05 ////"_$P(Z 0,U,7),1:" ")_$S($P(Z 0,U,9)'="" :";.15//// "_$P(Z0,U, 9),1:"")
  1293    .. ;
  1294   .
  1295   .
  1296   ..
  1297   .
  1298   .
  1299   REPORT ; P rint out t he report
  1300    ; Set up  Division H eader Text  and PLB C ode Header  Text
  1301    S RCSL=0
  1302    S:VAUTD=1  DIVHDR="A LL" D:VAUT D=0
  1303    . N I S D IVHDR="",I ="" F  S I =$O(VAUTD( I)) Q:I=""   S:DIVHDR '="" DIVHD R=DIVHDR_" , "_VAUTD( I) S:DIVHD R="" DIVHD R=VAUTD(I)
  1304    S CRHDR=R CODE
  1305    ; Trim in formation  so it will  fit on an  80 or IOM  character  line
  1306    D:($L(DIV HDR)+$L(CR HDR))>(IOM -25)
  1307    . N VAL,D H,CH,R1,R2  S DH=0,CH =0,R1=0,R2 =0,VAL=(IO M-25)\2 ;  get half o f the scre en length
  1308    . S:$L(DI VHDR)>VAL  DH=1 S:$L( CRHDR)>VAL  CH=1 S:DH =0 R1=VAL- $L(DIVHDR)  S:CH=0 R2 =VAL-$L(CR HDR)
  1309    . I $L(DI VHDR)>(VAL +R2) S DIV HDR=$E(DIV HDR,1,(VAL +R2))_"... "
  1310    . I $L(CR HDR)>(VAL+ R1) S CRHD R=$E(CRHDR ,1,(VAL+R2 ))_"..."
  1311    ;
  1312    I 'RCEXCE L D
  1313    . S RCPG= RCPG+1 W @ IOF
  1314    . D HDRP( $$HDR(RCDE T),1,"Page : "_RCPG_"  ")
  1315    . D HDRP( "SORT by " _$S($E(RCS ORT,1)="C" :"PLB CODE S",1:"PAYE R NAMES")_ " REPORT R UN DATE: " _RCNOW,1)
  1316    . D HDRP( "DIVISION:  "_DIVHDR_ " Codes: " _CRHDR,1)
  1317    . D HDRP( "835 PAYER S: "_$S(RC PAY="ALL": "ALL",1:"S elected")_ " 835 PAYE R TINs: "_ $S($E(RCTI N)="A":"AL L",1:"Sele cted"),1)
  1318    . D HDRP( "EOB PAID  DATE RANGE : "_$$DATE ^RCDPRU(RC DT1)_" - " _$$DATE^RC DPRU(RCDT2 ),1)
  1319    . W !,RCH R,!
  1320    E  D
  1321    . ; Excel  Report
  1322    . W "CODE ^PAYER^TIN ^REP_DATE^ AMOUNT",!
  1323    ;
  1324    S $P(ZLN, "-",80)="" ,$P(ZDLN," =",80)="", $P(ZLN2,"- ",78)="",Z LN2=" "_ZL N2,RCSL=7
  1325    ; Do Gran d totals f irst - per  Susan 7/1 6/2015
  1326    S DX0=$G( ^TMP("RCDP PLB_REPORT ",$J,"TOTA LS")),PCT= 0
  1327    S:+$P(DX0 ,U,5)'=0 P CT=$J(($P( DX0,U,1)/$ P(DX0,U,5) )*100,3,0)
  1328    S:+$P(DX0 ,U,5)=0 PC T="ERR"
  1329    I RCSL>=( IOSL-4) S  RCQUIT=$$N EWPG(.RCPG ,1,.RCSL,R CSORT) Q:R CQUIT
  1330    W ! S RCS L=RCSL+1
  1331    W "GRAND  TOTALS FOR  ALL PLB C ODES & PAY ERS ON REP ORT",! S R CSL=RCSL+1
  1332    W " TOTAL  #ERAs: ", $J($P(DX0, U,3),6,0), " ADJ: ",P CT,"% [TOT  AMT ADJUS TED / TOT  AMT BILLED ]",! S RCS L=RCSL+1
  1333    W " AMT A DJUST: $", $J($P(DX0, U,1),11,2) ," AMT BIL LED: $",$J ($P(DX0,U, 5),11,2),"  AMT PAID:  $",$J($P( DX0,U,2),1 1,2),! S R CSL=RCSL+1
  1334    W !,ZDLN, !! S RCSL= RCSL+1
  1335    I RCSL>=( IOSL-2) S  RCQUIT=$$N EWPG(.RCPG ,0,.RCSL,R CSORT) G:R CQUIT PLBQ
  1336    ;
  1337    S ZZ="" F   S ZZ=$O( ^TMP("RCDP PLB_REPORT ",$J,"SUMM ARY",ZZ))  Q:ZZ=""  S  ZDAT=^TMP ("RCDPPLB_ REPORT",$J ,"SUMMARY" ,ZZ) D  Q: RCQUIT
  1338    . D:RCSOR T="C"  Q:R CQUIT
  1339    .. W "ADJ  CODE: ",Z Z," # ERAs : ",$J($P( ZDAT,U,3), 5)," ADJ:  ",$S(+$P(Z DAT,U,5)>0 :$J((($P(Z DAT,U,1)/$ P(ZDAT,U,5 ))*100),3, 0),1:"ERR" ),"% [TOT  AMT ADJUST ED / TOT A MT BILLED] ",! S RCSL =RCSL+1
  1340    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1341    .. W " AM T ADJUST:  ",$J($P(ZD AT,U,1),8, 2)," AMT B ILLED: ",$ J($P(ZDAT, U,5),9,2), " AMT PAID : ",$J($P( ZDAT,U,2), 9,2),! S R CSL=RCSL+1
  1342    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1343    .. W "ADJ  CODE TEXT : ",$P(ZDA T,U,4),! S  RCSL=RCSL +1
  1344    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1345    .. W ZLN, ! S RCSL=R CSL+1
  1346    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1347    .. S PY=" ",CZ=0 F   S PY=$O(^T MP("RCDPPL B_REPORT", $J,"SUMMAR Y",ZZ,PY))  Q:PY=""   S ZPY=^TMP ("RCDPPLB_ REPORT",$J ,"SUMMARY" ,ZZ,PY) D   Q:RCQUIT   S CZ=CZ+1
  1348    ... S:+($ P(ZPY,U,5) )'=0 ZPPY= $J((($P(ZP Y,U,1)/$P( ZPY,U,5))* 100),3,0)
  1349    ... S:+($ P(ZPY,U,5) )=0 ZPPY=" ERR"
  1350    ... I CZ> 0 W ZLN2,!  S RCSL=RC SL+1
  1351    ... W " P AYER NAME/ TIN: ",PY, ! S RCSL=R CSL+1
  1352    ... I RCS L>=(IOSL-2 ) S RCQUIT =$$NEWPG(. RCPG,0,.RC SL,RCSORT)  Q:RCQUIT
  1353    ... W " # ERAs: ",$J ($P(ZPY,U, 3),4)," AD J: ",ZPPY, "% [ADJ: " ,$J($P(ZPY ,U,1),8,2) ,"/ BILLED : ",$J($P( ZPY,U,5),9 ,2),"] PAI D: ",$J($P (ZPY,U,2), 9,2),! S R CSL=RCSL+1
  1354    ... D:RCD ET DETAIL( RCSORT,ZZ, PY,$NA(^TM P("RCDPPLB _REPORT",$ J))) Q:RCQ UIT
  1355    .. W:'RCQ UIT ZLN,!  S RCSL=RCS L+1
  1356    . D:RCSOR T="P"  Q:R CQUIT
  1357    .. W "PAY ER NAME/TI N: ",ZZ,!  S RCSL=RCS L+1
  1358    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1359    .. W "# E RAs:",$J($ P(ZDAT,U,3 ),5)," ADJ : ",$S(+$P (ZDAT,U,5) >0:$J((($P (ZDAT,U,1) /$P(ZDAT,U ,5))*100), 3,0),1:"ER R"),"% [AM T ADJ:",$J ($P(ZDAT,U ,1),8,2)," / BILLED:" ,$J($P(ZDA T,U,5),9,2 ),"] PAID: ",$J($P(ZD AT,U,2),9, 2),! S RCS L=RCSL+1
  1360    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1361    .. W ZLN, ! S RCSL=R CSL+1
  1362    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1363    .. S PY=" ",CZ=0 F   S PY=$O(^T MP("RCDPPL B_REPORT", $J,"SUMMAR Y",ZZ,PY))  Q:PY=""   S ZPY=^TMP ("RCDPPLB_ REPORT",$J ,"SUMMARY" ,ZZ,PY) D   Q:RCQUIT   S CZ=CZ+1
  1364    ... S ZPP Y=$S(+$P(Z PY,U,5)'=0 :$J((($P(Z PY,U,1)/$P (ZPY,U,5)) *100),3,0) ,1:"ERR")
  1365    ... I CZ> 0 W ZLN2,!  S RCSL=RC SL+1
  1366    ... W " A DJ CODE: " ,PY," ADJ  CODE TXT:  ",$P(ZPY,U ,4),! S RC SL=RCSL+1
  1367    ... I RCS L>=(IOSL-2 ) S RCQUIT =$$NEWPG(. RCPG,0,.RC SL,RCSORT)  Q:RCQUIT
  1368    ... W " # ERAs: ",$J ($P(ZPY,U, 3),4)," AD J: ",ZPPY, "% [ADJ: " ,$J($P(ZPY ,U,1),8,2) ,"/ BILLED : ",$J($P( ZPY,U,5),9 ,2),"] PAI D: ",$J($P (ZPY,U,2), 9,2),! S R CSL=RCSL+1
  1369    ... D:RCD ET DETAIL( RCSORT,ZZ, PY,$NA(^TM P("RCDPPLB _REPORT",$ J))) Q:RCQ UIT
  1370    .. I 'RCQ UIT W ZLN, ! S RCSL=R CSL+1
  1371    D:'RCQUIT  ASK^RCDPR U(.RCQUIT)
  1372   PLBQ ;
  1373    K RCQUIT, VAUTD,ZDAT ,ZLN,ZDLN, ZLN2
  1374    K ^TMP("R CDPPLB_REP ORT",$J)
  1375    Q
  1376    ;
  1377   .
  1378   .
  1379   .Modified  Logic (Cha nges are i n bold).
  1380   .
  1381   .
  1382    ;
  1383   EFTIN(RCTX N,RCD,XMZ, RCGBL,RCEF LG) ; Adds  a new EFT  record to  AR file 3 44.3
  1384    ; from Lo ckbox EFT  msg
  1385    ; RCTXN =  the data  on the hea der record  of the me ssage text
  1386    ; RCD = a rray conta ining form atted mail  message h eader data
  1387    ; XMZ = t he mail me ssage numb er
  1388    ; RCGBL =  the name  of the arr ay or glob al where t he message  is stored
  1389    ; RCEFLG  = error fl ag returne d if passe d by refer ence
  1390    ;
  1391    N CT,RC,R C1,RCLAST, RCEFT,RCTD A,RCERR,RC TYP1,DA,DI K,RCZ,Z,Z0 ,DLAYGO
  1392    ;
  1393    ; Take da ta out of  mail messa ge
  1394    S (RCEFLG ,RCLAST)=0 ,CT=0,RCTY P1="835EFT "
  1395    F  X XMRE C Q:XMER<0  D  Q:RCLA ST
  1396    . I +XMRG =99,$P(XMR G,U,2)="$"  S RCLAST= 1 Q
  1397    . S:XMRG' ="" CT=CT+ 1,@RCGBL@( 2,"D",CT)= XMRG
  1398    ;
  1399    I 'RCLAST ,'$G(RCERR ) K @RCGBL  S RCERR=2  ;No $ as  last chara cter of ms g
  1400    ;
  1401    I $G(RCER R)>0 D  G  EFTQ
  1402    . D ERRUP D^RCDPESR1 (RCGBL,.RC D,RCTYP1,. RCERR)
  1403    . S RCEFL G=1
  1404    ;
  1405    ; Add top -level ent ry to file  344.3
  1406    S RCEFT=$ $ADDEFT(RC TXN,XMZ,RC GBL,.RCERR )
  1407    ;
  1408    I $G(RCER R) D  G EF TQ ; 'BAD'  EFT's
  1409    . D ERRUP D^RCDPESR1 (RCGBL,.RC D,RCTYP1,. RCERR)
  1410    . S RCEFL G=1
  1411    ;
  1412    G:'RCEFT  EFTQ
  1413    ;
  1414    ; Add the  detail da ta to file  344.31 fo r this EFT  record
  1415    S Z=0 F   S Z=$O(^RC Y(344.31," B",RCEFT,Z )) Q:'Z  S  DA=Z,DIK= "^RCY(344. 31," D ^DI K ; Delete  any detai l data alr eady there
  1416    ;
  1417    S (RC,RC1 ,RCZ)=0
  1418    F  S RCZ= $O(@RCGBL@ (2,"D",RCZ )) Q:'RCZ   S Z0=$G(^ (RCZ)) I Z 0'="" D  Q :$G(RCERR)
  1419    . I $P(Z0 ,U)="01" D   ; Each p ayer's dat a
  1420    .. N DA,D IE,DR,X,Y, DO,DD,DIC
  1421    .. S X=RC EFT
  1422    .. S DIC( "DR")=".11 ////0;.04/ ///"_$P(Z0 ,U,2)_";.0 8////0"_$S ($P(Z0,U,5 )'="":";.0 2////"_$P( Z0,U,5),1: "")_$S($P( Z0,U,6)'=" ":";.03/// /"_$P(Z0,U ,6),1:"")_ ";.07////" _$J(+$P(Z0 ,U,4)/100, "",2)_";.0 6////"_$S( $P(Z0,U,8) '="":1,1:0 )
  1423    .. S DIC( "DR")=DIC( "DR")_";.1 2///"_$$FD T^RCDPESR9 ($P(Z0,U,3 ))_";.13// //"_DT_$S( $P(Z0,U,7) '="":";.05 ////"_$P(Z 0,U,7),1:" ")_$S($P(Z 0,U,9)'="" :";.15//// "_$P(Z0,U, 9),1:"")
  1424    .. ;
  1425    .. S DIC( "DR")=".11 ////0;.04/ ///"_$P(Z0 ,U,2)_";.0 8////0"
  1426    .. S DIC( "DR")=DIC( "DR")_$S($ P(Z0,U,5)' ="":";.02/ ///"_$P(Z0 ,U,5),1:"" )
  1427    .. S DIC( "DR")=DIC( "DR")_$S($ P(Z0,U,6)' ="":";.03/ ///"_$P(Z0 ,U,6),1:"" )
  1428    .. S DIC( "DR")=DIC( "DR")_";.0 7////"_$J( +$P(Z0,U,4 )/100,"",2 )
  1429    .. S DIC( "DR")=DIC( "DR")_";.0 6////"_$S( $P(Z0,U,8) '="":1,1:0 )
  1430    .. S DIC( "DR")=DIC( "DR")_";.1 2///"_$$FD T^RCDPESR9 ($P(Z0,U,3 ))
  1431    .. S DIC( "DR")=DIC( "DR")_";.1 3////"_DT_ $S($P(Z0,U ,7)'="":"; .05////"_$ P(Z0,U,7), 1:"")
  1432    .. S DIC( "DR")=DIC( "DR")_$S($ P(Z0,U,9)' ="":";.15/ ///"_$P(Z0 ,U,9),1:"" )
  1433    .. S XX=$ S($P(Z0,U, 10)="D":"D ",$P(Z0,U, 10)="-":"D ",1:"")
  1434    .. S DIC( "DR")=DIC( "DR")_";.2 0////"_XX
  1435   .
  1436   .
  1437   ..
  1438   .
  1439   .
  1440   REPORT ; P rint out t he report
  1441    ; Set up  Division H eader Text  and PLB C ode Header  Text
  1442    S RCSL=0
  1443    S:VAUTD=1  DIVHDR="A LL" D:VAUT D=0
  1444    . N I S D IVHDR="",I ="" F  S I =$O(VAUTD( I)) Q:I=""   S:DIVHDR '="" DIVHD R=DIVHDR_" , "_VAUTD( I) S:DIVHD R="" DIVHD R=VAUTD(I)
  1445    S CRHDR=R CODE
  1446    ; Trim in formation  so it will  fit on an  80 or IOM  character  line
  1447    D:($L(DIV HDR)+$L(CR HDR))>(IOM -25)
  1448    . N VAL,D H,CH,R1,R2  S DH=0,CH =0,R1=0,R2 =0,VAL=(IO M-25)\2 ;  get half o f the scre en length
  1449    . S:$L(DI VHDR)>VAL  DH=1 S:$L( CRHDR)>VAL  CH=1 S:DH =0 R1=VAL- $L(DIVHDR)  S:CH=0 R2 =VAL-$L(CR HDR)
  1450    . I $L(DI VHDR)>(VAL +R2) S DIV HDR=$E(DIV HDR,1,(VAL +R2))_"... "
  1451    . I $L(CR HDR)>(VAL+ R1) S CRHD R=$E(CRHDR ,1,(VAL+R2 ))_"..."
  1452    ;
  1453    I 'RCEXCE L D
  1454    . S RCPG= RCPG+1 W @ IOF
  1455    . D HDRP( $$HDR(RCDE T),1,"Page : "_RCPG_"  ")
  1456    . D HDRP( "SORT by " _$S($E(RCS ORT,1)="C" :"PLB CODE S",1:"PAYE R NAMES")_ " REPORT R UN DATE: " _RCNOW,1)
  1457    . D HDRP( "DIVISION:  "_DIVHDR_ " Codes: " _CRHDR,1)
  1458    . D HDRP( "835 PAYER S: "_$S(RC PAY="ALL": "ALL",1:"S elected")_ " 835 PAYE R TINs: "_ $S($E(RCTI N)="A":"AL L",1:"Sele cted"),1)
  1459    . D HDRP( "EOB PAID  DATE RANGE : "_$$DATE ^RCDPRU(RC DT1)_" - " _$$DATE^RC DPRU(RCDT2 ),1)
  1460    . W !,RCH R,!
  1461    E  D
  1462    . ; Excel  Report
  1463    . W "CODE ^PAYER^TIN ^REP_DATE^ AMOUNT",!
  1464    ;
  1465    S $P(ZLN, "-",80)="" ,$P(ZDLN," =",80)="", $P(ZLN2,"- ",78)="",Z LN2=" "_ZL N2,RCSL=7
  1466    ; Do Gran d totals f irst - per  Susan 7/1 6/2015
  1467    S DX0=$G( ^TMP("RCDP PLB_REPORT ",$J,"TOTA LS")),PCT= 0
  1468    S:+$P(DX0 ,U,5)'=0 P CT=$J(($P( DX0,U,1)/$ P(DX0,U,5) )*100,3,0)
  1469    S:+$P(DX0 ,U,5)=0 PC T="ERR"
  1470    I RCSL>=( IOSL-4) S  RCQUIT=$$N EWPG(.RCPG ,1,.RCSL,R CSORT) Q:R CQUIT
  1471    W ! S RCS L=RCSL+1
  1472    W "GRAND  TOTALS FOR  ALL PLB C ODES & PAY ERS ON REP ORT",! S R CSL=RCSL+1
  1473    W " TOTAL  #ERAs: ", $J($P(DX0, U,3),6,0), " ADJ: ",P CT,"% [TOT  AMT ADJUS TED / TOT  AMT BILLED ]",! S RCS L=RCSL+1
  1474    W " AMT A DJUST: $", $J($P(DX0, U,1),11,2) ," AMT BIL LED: $",$J ($P(DX0,U, 5),11,2),"  AMT PAID:  $",$J($P( DX0,U,2),1 1,2),! S R CSL=RCSL+1
  1475    W !,ZDLN, !! S RCSL= RCSL+1
  1476    I RCSL>=( IOSL-2) S  RCQUIT=$$N EWPG(.RCPG ,0,.RCSL,R CSORT) G:R CQUIT PLBQ
  1477    ;
  1478    S ZZ="" F   S ZZ=$O( ^TMP("RCDP PLB_REPORT ",$J,"SUMM ARY",ZZ))  Q:ZZ=""  S  ZDAT=^TMP ("RCDPPLB_ REPORT",$J ,"SUMMARY" ,ZZ) D  Q: RCQUIT
  1479    . D:RCSOR T="C"  Q:R CQUIT
  1480    .. W "ADJ  CODE: ",Z Z," # ERAs : ",$J($P( ZDAT,U,3), 5)," ADJ:  ",$S(+$P(Z DAT,U,5)>0 :$J((($P(Z DAT,U,1)/$ P(ZDAT,U,5 ))*100),3, 0),1:"ERR" ),"% [TOT  AMT ADJUST ED / TOT A MT BILLED] ",! S RCSL =RCSL+1
  1481    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1482    .. W " AM T ADJUST:  ",$J($P(ZD AT,U,1),8, 2)," AMT B ILLED: ",$ J($P(ZDAT, U,5),9,2), " AMT PAID : ",$J($P( ZDAT,U,2), 9,2),! S R CSL=RCSL+1
  1483    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1484    .. W "ADJ  CODE TEXT : ",$P(ZDA T,U,4),! S  RCSL=RCSL +1
  1485    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1486    .. W ZLN, ! S RCSL=R CSL+1
  1487    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1488    .. S PY=" ",CZ=0 F   S PY=$O(^T MP("RCDPPL B_REPORT", $J,"SUMMAR Y",ZZ,PY))  Q:PY=""   S ZPY=^TMP ("RCDPPLB_ REPORT",$J ,"SUMMARY" ,ZZ,PY) D   Q:RCQUIT   S CZ=CZ+1
  1489    ... S:+($ P(ZPY,U,5) )'=0 ZPPY= $J((($P(ZP Y,U,1)/$P( ZPY,U,5))* 100),3,0)
  1490    ... S:+($ P(ZPY,U,5) )=0 ZPPY=" ERR"
  1491    ... I CZ> 0 W ZLN2,!  S RCSL=RC SL+1
  1492    ... W " P AYER NAME/ TIN: ",PY, ! S RCSL=R CSL+1
  1493    ... W " P AYER NAME/ TIN",!
  1494    ... S RCS L=RCSL+1
  1495    ... I $L( PY)>76 D
  1496    .... S ZZ =$L(PY,"/" ),XX=$P(PY ,"/",1,ZZ- 1),YY=$P(P Y,"/",ZZ)
  1497    .... S XX =$E(XX,1,6 0-($L(PAY) -76)),PY=X X_"/"_YY
  1498    ... W " " ,PY,!
  1499    ... S RCS L=RCSL+1
  1500    ... I RCS L>=(IOSL-2 ) S RCQUIT =$$NEWPG(. RCPG,0,.RC SL,RCSORT)  Q:RCQUIT
  1501    ... W " # ERAs: ",$J ($P(ZPY,U, 3),4)," AD J: ",ZPPY, "% [ADJ: " ,$J($P(ZPY ,U,1),8,2) ,"/ BILLED : ",$J($P( ZPY,U,5),9 ,2),"] PAI D: ",$J($P (ZPY,U,2), 9,2),! S R CSL=RCSL+1
  1502    ... D:RCD ET DETAIL( RCSORT,ZZ, PY,$NA(^TM P("RCDPPLB _REPORT",$ J))) Q:RCQ UIT
  1503    .. W:'RCQ UIT ZLN,!  S RCSL=RCS L+1
  1504    . D:RCSOR T="P"  Q:R CQUIT
  1505    .. W "PAY ER NAME/TI N: ",ZZ,!  S RCSL=RCS L+1
  1506    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1507    .. W "# E RAs:",$J($ P(ZDAT,U,3 ),5)," ADJ : ",$S(+$P (ZDAT,U,5) >0:$J((($P (ZDAT,U,1) /$P(ZDAT,U ,5))*100), 3,0),1:"ER R"),"% [AM T ADJ:",$J ($P(ZDAT,U ,1),8,2)," / BILLED:" ,$J($P(ZDA T,U,5),9,2 ),"] PAID: ",$J($P(ZD AT,U,2),9, 2),! S RCS L=RCSL+1
  1508    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1509    .. W ZLN, ! S RCSL=R CSL+1
  1510    .. I RCSL >=(IOSL-2)  S RCQUIT= $$NEWPG(.R CPG,0,.RCS L,RCSORT)  Q:RCQUIT
  1511    .. S PY=" ",CZ=0 F   S PY=$O(^T MP("RCDPPL B_REPORT", $J,"SUMMAR Y",ZZ,PY))  Q:PY=""   S ZPY=^TMP ("RCDPPLB_ REPORT",$J ,"SUMMARY" ,ZZ,PY) D   Q:RCQUIT   S CZ=CZ+1
  1512    ... S ZPP Y=$S(+$P(Z PY,U,5)'=0 :$J((($P(Z PY,U,1)/$P (ZPY,U,5)) *100),3,0) ,1:"ERR")
  1513    ... I CZ> 0 W ZLN2,!  S RCSL=RC SL+1
  1514    ... W " A DJ CODE: " ,PY," ADJ  CODE TXT:  ",$P(ZPY,U ,4),! S RC SL=RCSL+1
  1515    ... I RCS L>=(IOSL-2 ) S RCQUIT =$$NEWPG(. RCPG,0,.RC SL,RCSORT)  Q:RCQUIT
  1516    ... W " # ERAs: ",$J ($P(ZPY,U, 3),4)," AD J: ",ZPPY, "% [ADJ: " ,$J($P(ZPY ,U,1),8,2) ,"/ BILLED : ",$J($P( ZPY,U,5),9 ,2),"] PAI D: ",$J($P (ZPY,U,2), 9,2),! S R CSL=RCSL+1
  1517    ... D:RCD ET DETAIL( RCSORT,ZZ, PY,$NA(^TM P("RCDPPLB _REPORT",$ J))) Q:RCQ UIT
  1518    .. I 'RCQ UIT W ZLN, ! S RCSL=R CSL+1
  1519    D:'RCQUIT  ASK^RCDPR U(.RCQUIT)
  1520   PLBQ ;
  1521    K RCQUIT, VAUTD,ZDAT ,ZLN,ZDLN, ZLN2
  1522    K ^TMP("R CDPPLB_REP ORT",$J)
  1523    Q
  1524    ;
  1525   .
  1526   .
  1527   .RoutinesA ctivitiesR outine Nam eRCDPRUEnh ancement C ategory Ne w Modify D elete No C hangeRTMRe lated Opti onsRCDPE C ARC CODE P AYER REPOR
  1528   RCDPE EFT- ERA TRENDI NG REPORT 
  1529   RCDPE PROV IDER LVL A DJ REPORT  Related Ro utinesRout ines “Call ed By”Rout ines “Call ed”   RCDP ARC
  1530   RCDPCRR
  1531   RCDPEAPS
  1532   RCDPEM2
  1533   RCDPENR2
  1534   RCDPESP1
  1535   RCDPESP5
  1536   RCDPPLB
  1537   RCDPTAR
  1538   RCDPTAR1$$ SEL^RCPEWL 7
  1539       Curren t Logic.
  1540   .
  1541   .
  1542    ; Pass RC PAY by ref erence
  1543   GETPAY(RCP AY) ; Get  payer info rmation
  1544    N EX,RCLP AY S EX=1  ; Exit sta tus
  1545    S DIR("A" )="Select  (A)ll or ( R)ange of  835 Payer  Names?: ", DIR(0)="SA ^A:All Pay er Names;R :Range or  List of Pa yer Names"
  1546    S DIR("B" )="ALL" D  ^DIR K DIR
  1547    I $D(DTOU T)!$D(DUOU T)!(Y="")  S EX=0 Q E X
  1548    S RCLPAY= Y I $G(Y)= "A" S RCPA Y="ALL",RC PAY("DATA" )="ALL" G  GPO
  1549    ; Get Ran ge of 835  Payers
  1550    ;I RCLPAY ="R" D GLI ST(344.6," B",$NA(^TM P("RCDPARC _P",$J))), GETPAYR("R CPAY",$NA( ^TMP("RCDP ARC_P",$J) )) S EX=RT NFLG
  1551    I RCLPAY= "R" S EX=$ $GETRNG(.R CPAY,"P"), RCPAY="R"
  1552   GPO ;
  1553    Q EX
  1554    ;
  1555    ; Pass RC TIN by ref erence
  1556   GETTIN(RCT IN) ; Get  Payer TIN  informatio n
  1557    N EX,RCTL IST,DIR,DI ROUT,DIRUT ,DTOUT,DUO UT,X,Y S E X=1 ; Exit  status
  1558    S DIR("A" )="Select  (A)ll or ( R)ange of  835 Payer  TINs?: ",D IR(0)="SA^ A:All Paye r TINs;R:R ange or Li st of Paye r TINs"
  1559    S DIR("B" )="ALL" D  ^DIR K DIR
  1560    I $D(DTOU T)!$D(DUOU T)!(Y="")  S EX=0 Q E X
  1561    S RCTLIST =Y I $G(Y) ="A" S RCT IN="ALL",R CTIN("DATA ")="ALL" G  GTO
  1562    ; Get Ran ge of 835  Payer TINs
  1563    I RCTLIST ="R" S EX= $$GETRNG(. RCTIN,"T") ,RCTIN="R"
  1564   GTO ;
  1565    Q EX
  1566    ; RTNARR  - Indirect  Return ar ray
  1567    ; TYPE -  The type o f lookup " P" - Payer ; "T" - TI N
  1568   GETRNG(RTN ARR,TYPE)  ;
  1569    N DIC,D,R CDTN,RCDN, RCPT,DTOUT ,DUOUT,DIR UT,DIROUT, X,Y,IDX
  1570    I $G(TYPE )=""!("PT" '[$G(TYPE) ) S RTNARR ="ERROR" Q   ; Quit i f TYPE not  correct
  1571    S IDX=$S( TYPE="P":" B",TYPE="T ":"C")
  1572    K DIC S D IC="^RCY(3 44.6,",DIC (0)="AES", D=IDX
  1573    S DIC("A" )="Start w ith 835 "_ $S(TYPE="P ":"Payer N ame",TYPE= "T":"Payer  TIN")_":  "
  1574    I TYPE="P " S DIC("W ")="D EN^D DIOL($P(^( 0),U,2),," "?35"")"
  1575    E  S DIC( "W")="D EN ^DDIOL($P( ^(0),U,1), ,""?35"")"
  1576    D IX^DIC  I $D(DTOUT )!$D(DUOUT )!(Y="")!( Y=-1) Q 0
  1577    S RCDN=$O (^RCY(344. 6,IDX,X,"" ))
  1578    S RTNARR( "START")=R CDN_U_X_U_ Y,RTNARR(" DATA")=X
  1579    ;
  1580    K DIC S D IC="^RCY(3 44.6,",DIC (0)="AES", D=IDX
  1581    S DIC("A" )="Go to w ith 835 "_ $S(TYPE="P ":"Payer N ame",TYPE= "T":"Payer  TIN")_":  "
  1582    I TYPE="P " S DIC("W ")="D EN^D DIOL($P(^( 0),U,2),," "?35"")"
  1583    E  S DIC( "W")="D EN ^DDIOL($P( ^(0),U,1), ,""?35"")"
  1584    D IX^DIC  I $D(DTOUT )!$D(DUOUT )!(Y="")!( Y=-1) Q 0
  1585    S RCDN=$O (^RCY(344. 6,IDX,X,"" ))
  1586    S RTNARR( "END")=RCD N_U_X_U_Y
  1587    I TYPE="P " S RTNARR ("DATA")=$ P(RTNARR(" START"),U, 4)_":"_$P( RTNARR("EN D"),U,4)
  1588    I TYPE="T " S RTNARR ("DATA")=$ P(RTNARR(" START"),U, 2)_":"_$P( RTNARR("EN D"),U,2)
  1589    Q 1
  1590    ;
  1591   .
  1592   .
  1593   .
  1594    ; Collect  data in a  list or r ange to an  array, AR RAY passed  by refere nce
  1595   RNG(TYPE,I TEM,ARRAY)  ;
  1596    ; Take ev erything f or this TY PE if item  is all an d quit out
  1597    I $G(ITEM )="ALL"!($ G(ITEM)="A ") S ARRAY (TYPE)="AL L" Q
  1598    N X1,X2,N W,I,ELEM
  1599    S NW=$TR( ITEM,";"," :"),NW=$TR (NW,"-",": ") ; Fix " ;" or "-"  to ":" (co lons) for  parsing
  1600    F I=1:1 S  ELEM=$P(N W,",",I) Q :ELEM=""   D
  1601    . ; Singl e element  set into a rray 
  1602    . I ELEM' [":" S ARR AY(TYPE,EL EM)=1
  1603    . E  D RN GIT(TYPE,E LEM,.ARRAY )
  1604    Q
  1605    ; Process  ranges fo r CARC/PLB /PAYER/TIN
  1606    ; ZAR pas sed by ref erence
  1607   RNGIT(TYPE ,ITEM,ZAR)  ;
  1608    N X1,X2,E LEM,O1,ZGB L,IDX,FILE
  1609    ; Set fil e # and in dex for th e range lo okup
  1610    S FILE=$S (TYPE="CAR C":345,TYP E="PAYER": 344.6,TYPE ="TIN":344 .6,TYPE="P LB":345.1, 1:0)
  1611    S IDX=$S( TYPE="CARC ":"B",TYPE ="PAYER":" B",TYPE="T IN":"C",TY PE="PLB":" B",1:0)
  1612    ; Get clo sed root o f the Glob al
  1613    S ZGBL=$$ ROOT^DILFD (FILE,"",1 ,"")
  1614    I ZGBL=""  Q
  1615    ; Process  range of  things in  ITEM
  1616    S X1=$P(I TEM,":",1) ,X2=$P(ITE M,":",2)
  1617    S O1=$O(@ ZGBL@(IDX, X1),-1) ;  Set the st art
  1618    F  S O1=$ O(@ZGBL@(I DX,O1)) Q: (O1="")!($ $AFTER(O1, X2)) S ZAR (TYPE,O1)= 1
  1619    Q
  1620    ;
  1621   .
  1622   .
  1623   .Modified  Logic (Cha nges are i n bold).
  1624   .
  1625   .
  1626    ; Pass RC PAY by ref erence
  1627   GETPAY(RCP AY) ; Get  payer info rmation EP
  1628    N EX,RCLP AY S EX=1  ; Exit sta tus
  1629    ; Get sel ected paye rs using f ile 344.6
  1630    ; Note: S imilar to  GETPAY^RCD PEM9 excep t that met hod uses 3 44.4 or 34 4.31
  1631    ; Input:  None
  1632    ; Output:  RCPAY - A LL if all  payers sel ected
  1633    ; RCPAY(D ATA) - 'AL L' - all p ayers sele cted
  1634    ; Returns : 1 - Paye r selectio n made, 0  otherwise
  1635    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,EX,RCLPA Y,Y
  1636    S EX=1 ;  Exit statu s
  1637    S DIR("A" )="Select  (A)ll or ( R)ange of  835 Payer  Names?: ", DIR(0)="SA ^A:All Pay er Names;R :Range or  List of Pa yer Names"
  1638    S DIR("B" )="ALL" D  ^DIR K DIR
  1639    S DIR("A" )="Select  (A)ll or ( R)ange of  835 Payer  Names?: "
  1640    S DIR(0)= "SA^A:All  Payer Name s;R:Range  or List of  Payer Nam es"
  1641    S DIR("B" )="ALL" 
  1642    D ^DIR
  1643    K DIR
  1644    I $D(DTOU T)!$D(DUOU T)!(Y="")  S EX=0 Q E X
  1645    S RCLPAY= Y I $G(Y)= "A" S RCPA Y="ALL",RC PAY("DATA" )="ALL" G  GPO
  1646    S RCLPAY= Y
  1647    I $G(Y)=" A" S RCPAY ="ALL",RCP AY("DATA") ="ALL" Q E X
  1648    ;
  1649    ; Get Ran ge of 835  Payers
  1650    ;I RCLPAY ="R" D GLI ST(344.6," B",$NA(^TM P("RCDPARC _P",$J))), GETPAYR("R CPAY",$NA( ^TMP("RCDP ARC_P",$J) )) S EX=RT NFLG
  1651    I RCLPAY= "R" S EX=$ $GETRNG(.R CPAY,"P"), RCPAY="R"
  1652   GPO ;
  1653    Q EX
  1654    ;
  1655    ; Pass RC TIN by ref erence
  1656   GETTIN(RCT IN) ; Get  Payer TIN  informatio n EP
  1657    N EX,RCTL IST,DIR,DI ROUT,DIRUT ,DTOUT,DUO UT,X,Y S E X=1 ; Exit  status
  1658    ; Get sel ected Paye r TINs
  1659    ; Input:  None
  1660    ; Output:  RCTIN - A LL if all  payer TINs  selected
  1661    ; RCPAY(D ATA) - 'AL L' - all p ayer TINs  selected
  1662    ; Returns : 1 - Paye r selectio n made, 0  otherwise
  1663    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,EX,RCTLI ST,X,Y
  1664    S EX=1 ;  Exit statu s
  1665    S DIR("A" )="Select  (A)ll or ( R)ange of  835 Payer  TINs?: ",D IR(0)="SA^ A:All Paye r TINs;R:R ange or Li st of Paye r TINs"
  1666    S DIR("A" )="Select  (A)ll or ( R)ange of  835 Payer  TINs?: "
  1667    S DIR(0)= "SA^A:All  Payer TINs ;R:Range o r List of  Payer TINs "
  1668    S DIR("B" )="ALL" D  ^DIR K DIR
  1669    S DIR("B" )="ALL"
  1670    D ^DIR
  1671    K DIR
  1672    I $D(DTOU T)!$D(DUOU T)!(Y="")  S EX=0 Q E X
  1673    S RCTLIST =Y I $G(Y) ="A" S RCT IN="ALL",R CTIN("DATA ")="ALL" G  GTO
  1674    S RCTLIST =Y
  1675    I $G(Y)=" A" S RCTIN ="ALL",RCT IN("DATA") ="ALL" Q E X
  1676    ;
  1677    ; Get Ran ge of 835  Payer TINs
  1678    I RCTLIST ="R" S EX= $$GETRNG(. RCTIN,"T") ,RCTIN="R"
  1679   GTO ;
  1680    Q EX
  1681    ; RTNARR  - Indirect  Return ar ray
  1682    ; TYPE -  The type o f lookup " P" - Payer ; "T" - TI N
  1683   GETRNG(RTN ARR,TYPE)  ;  Allows  the user t o specify  a payer na me or TIN  range
  1684    N DIC,D,R CDTN,RCDN, RCPT,DTOUT ,DUOUT,DIR UT,DIROUT, X,Y,IDX
  1685    ; Input:  TYPE - 'P'  - Payer N ame range  selection
  1686    ; 'T' - P ayer TIN r ange selec tion
  1687    ; Output:  RTNARR -  'ERROR' -  Invalid TY PE of rang e selected
  1688    ; RTNARR( DATA) - A1 ~:~A2 Wher e:
  1689    ; A1 - Ex ternal Pay er Name or  TIN of se lected 
  1690    ; 344.6 P ayer for r ange start
  1691    ; A2 - Ex ternal Pay er Name or  TIN of se lected
  1692    ; 344.6 P ayer for r ange end
  1693    ; RTNARR( START) - S tarting Ra nge Value  A1^A2^A3^A 4 Where:
  1694    ; A1 - In ternal IEN  of select ed 344.6 P ayer for
  1695    ; range s tart
  1696    ; A2 - Ex ternal Pay er Name or  TIN for r ange start
  1697    ; A3 - In ternal IEN  of select ed 344.6 P ayer for
  1698    ; range s tart
  1699    ; A4 - Ex ternal Pay er Name or  TIN for r ange end
  1700    ; RTNARR( END) - End ing Range  Value A1^A 2^A3^A4 Wh ere:
  1701    ; A1 - In ternal IEN  of select ed 344.6 P ayer for 
  1702    ; range e nd
  1703    ; A2 - Ex ternal Pay er Name or  TIN for r ange end
  1704    ; A3 - In ternal IEN  of select ed 344.6 f or range e nd
  1705    ; A4 - Ex ternal Pay er Name or  TIN for r ange end
  1706    B "L+"
  1707    N D,DIC,D IROUT,DIRU T,DTOUT,DU OUT,IDX,RC DTN,RCDN,R CPT,X,Y
  1708    I $G(TYPE )=""!("PT" '[$G(TYPE) ) S RTNARR ="ERROR" Q   ; Quit i f TYPE not  correct
  1709    S IDX=$S( TYPE="P":" B",TYPE="T ":"C")
  1710    K DIC S D IC="^RCY(3 44.6,",DIC (0)="AES", D=IDX
  1711    K DIC
  1712    S DIC="^R CY(344.6," ,DIC(0)="A ES",D=IDX
  1713    S DIC("A" )="Start w ith 835 "_ $S(TYPE="P ":"Payer N ame",TYPE= "T":"Payer  TIN")_":  "
  1714    I TYPE="P " S DIC("W ")="D EN^D DIOL($P(^( 0),U,2),," "?35"")"
  1715    E  S DIC( "W")="D EN ^DDIOL($P( ^(0),U,1), ,""?35"")"
  1716    D IX^DIC  I $D(DTOUT )!$D(DUOUT )!(Y="")!( Y=-1) Q 0
  1717    D IX^DIC
  1718    I $D(DTOU T)!$D(DUOU T)!(Y="")! (Y=-1) Q 0
  1719    S RCDN=$O (^RCY(344. 6,IDX,X,"" ))
  1720    S RTNARR( "START")=R CDN_U_X_U_ Y,RTNARR(" DATA")=X
  1721    ;
  1722    K DIC S D IC="^RCY(3 44.6,",DIC (0)="AES", D=IDX
  1723    K DIC
  1724    S DIC="^R CY(344.6," ,DIC(0)="A ES",D=IDX
  1725    S DIC("A" )="Go to w ith 835 "_ $S(TYPE="P ":"Payer N ame",TYPE= "T":"Payer  TIN")_":  "
  1726    I TYPE="P " S DIC("W ")="D EN^D DIOL($P(^( 0),U,2),," "?35"")"
  1727    E  S DIC( "W")="D EN ^DDIOL($P( ^(0),U,1), ,""?35"")"
  1728    D IX^DIC  I $D(DTOUT )!$D(DUOUT )!(Y="")!( Y=-1) Q 0
  1729    D IX^DIC
  1730    I $D(DTOU T)!$D(DUOU T)!(Y="")! (Y=-1) Q 0
  1731    S RCDN=$O (^RCY(344. 6,IDX,X,"" ))
  1732    S RTNARR( "END")=RCD N_U_X_U_Y
  1733    I TYPE="P " S RTNARR ("DATA")=$ P(RTNARR(" START"),U, 4)_":"_$P( RTNARR("EN D"),U,4)
  1734    I TYPE="T " S RTNARR ("DATA")=$ P(RTNARR(" START"),U, 2)_":"_$P( RTNARR("EN D"),U,2)
  1735    I TYPE="P " S RTNARR ("DATA")=$ P(RTNARR(" START"),U, 4)_"~:~"_$ P(RTNARR(" END"),U,4)
  1736    I TYPE="T " S RTNARR ("DATA")=$ P(RTNARR(" START"),U, 2)_"~:~"_$ P(RTNARR(" END"),U,2)
  1737    Q 1
  1738    ;
  1739   .
  1740   .
  1741   .
  1742    ; Collect  data in a  list or r ange to an  array, AR RAY passed  by refere nce
  1743   RNG(TYPE,I TEM,ARRAY)  ;EP
  1744    ; Take ev erything f or this TY PE if item  is all an d quit out
  1745    ; Collect  data in a  list or r ange to an  array
  1746    ; Input:  TYPE - Typ e of data  being coll ected
  1747    ; CARC -  Carc codes
  1748    ; PAYER -  Payer nam es
  1749    ; PLB - P rovider Le vel Balanc e Codes
  1750    ; TIN - P ayer IDs
  1751    ; ITEM -  Comma deli mitted lis t of codes  and/or ra nges to pa rse
  1752    ; Ouput:  ARRAY - Ar ray contai ning all o f the data  parsed fr om ITEM
  1753    I $G(ITEM )="ALL"!($ G(ITEM)="A ") S ARRAY (TYPE)="AL L" Q
  1754    N X1,X2,N W,I,ELEM
  1755    S NW=$TR( ITEM,";"," :"),NW=$TR (NW,"-",": ") ; Fix " ;" or "-"  to ":" (co lons) for  parsing
  1756    N DELIM,E LEM,I,NW,X 1,X2
  1757    ;
  1758    ; Before  processing  CARC and  PLB Codes,  translate  any dashe s found in  ranges
  1759    ; to colo ns
  1760    I TYPE'=" PAYER",TYP E'="TIN" D
  1761    . S NW=$T R(ITEM,";" ,":"),NW=$ TR(NW,"-", ":"),DELIM =”:”
  1762   E  S DELIM =”~:~”
  1763    F I=1:1 S  ELEM=$P(N W,",",I) Q :ELEM=""   D
  1764    . ; Singl e element  set into a rray 
  1765    . I ELEM' [DELIM S A RRAY(TYPE, ELEM)=1
  1766    . E  D RN GIT(TYPE,E LEM,DELIM, .ARRAY)
  1767    Q
  1768    ; Process  ranges fo r CARC/PLB /PAYER/TIN
  1769    ; ZAR pas sed by ref erence
  1770   RNGIT(TYPE ,ITEM.DELI M,ZAR) ;   Process ra nges for C ARC/PLB/PA YER/TIN
  1771    N X1,X2,E LEM,O1,ZGB L,IDX,FILE
  1772    ; Input:  TYPE - Typ e of data  being coll ected
  1773    ; CARC -  Carc codes
  1774    ; PAYER -  Payer nam es
  1775    ; PLB - P rovider Le vel Balanc e Codes
  1776    ; TIN - P ayer IDs
  1777    ; ITEM -  Code or Co de range b eing proce ssed
  1778    ; DELIM -  Range del imitter to  use
  1779    ; Ouput:  ZAR - Arra y containi ng all of  the data p arsed from  ITEM
  1780    N ELEM,FI LE,IDX,O1, X1,X2,ZGBL
  1781    ; Set fil e # and in dex for th e range lo okup
  1782    S FILE=$S (TYPE="CAR C":345,TYP E="PAYER": 344.6,TYPE ="TIN":344 .6,TYPE="P LB":345.1, 1:0)
  1783    S IDX=$S( TYPE="CARC ":"B",TYPE ="PAYER":" B",TYPE="T IN":"C",TY PE="PLB":" B",1:0)
  1784    ; Get clo sed root o f the Glob al
  1785    S ZGBL=$$ ROOT^DILFD (FILE,"",1 ,"")
  1786    I ZGBL=""  Q
  1787    ; Process  range of  things in  ITEM
  1788    S X1=$P(I TEM,DELIM, 1),X2=$P(I TEM,DELIM, 2)
  1789    S O1=$O(@ ZGBL@(IDX, X1),-1) ;  Set the st art
  1790    F  S O1=$ O(@ZGBL@(I DX,O1)) Q: (O1="")!($ $AFTER(O1, X2)) S ZAR (TYPE,O1)= 1
  1791    Q
  1792    ;
  1793   .
  1794   .
  1795   .�Move 8 c haracters  to the lef t
  1796   �Moved to  line below
  1797