20. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/23/2018 6:40:27 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

20.1 Files compared

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

20.2 Comparison summary

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

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

20.4 Active regular expressions

No regular expressions were active.

20.5 Comparison detail

  1   MCCF EDI T AS US748
  2   System Des ign Docume nt
  3   PRCA*4.5*x xx
  4  
  5   Department  of Vetera ns Affairs
  6   July 2017
  7   Version 1
  8   User Story  ID: US748
  9   User Story  Name:  Di splay Perc ent Collec ted on Cla ims
  10   Sizing: 
  11   Author: Ch ad Morriso n
  12   Story
  13   As an ePay ments user , I want t o view the  percent t hat was co llected on  claims. T he percent  collected  should po pulate on  the EP Scr een. The p ercent sho uld calcul ate from t he Account  Profile s creen so t hat users  can view t he percent  collected  without h aving to v iew multip le screens
  14   Conversati on
  15   5/31/17
  16   EP Screen  is found u nder TPJI
  17   Percent pa id is alre ady on the  AR Accoun t Profile  screen, ne eds to car ry over to  the EP ac tion
  18   Coordinate  timing of  implement ing this w ith eBilli ng (patche s)
  19   Revisit th is on 6/07 /17 so ePa y can disc uss this i nternally
  20   6/7/17
  21   Tanya to s end PPT wi th example  to dev te am
  22   Chad to cr eate funct ional desi gn and acc eptance cr iteria fro m ppt and  submit for  approval
  23  
  24   7/5/17
  25   Confirm if  %collecte d is %coll ected from  payer (on  EOB) or a ll payment s made for  the claim  (e.g. pat ient or se condary pa yer amount s) as per  AR Account  Profile s creen
  26   Summary
  27   Routine IB JTEP for e xisting TP JI menu op tion’s EP  – ‘ERA/835 ’ action w ill be mod ified to d isplay an  additional  ‘% Collec ted’ field .
  28   Routine IB JTPE for t he EP -‘ER A/835’  ac tion sub-m enu action  PR – ‘Pri nt EEOB’ w ill be mod ified to d isplay an  additional  ‘% Collec ted’ field
  29   The ‘% Col lected’ va lue on  fr om AR Prof ile Screen  can be re trieved wi th a call  to existin g function  $$BILL^RC JIBFN2 whi ch is supp orted by a n existing  private I A 1452.
  30   ePayments  ERA/EEOB D ata        Jul 14, 20 17@11:57:1 2           Page:     3 of   22 
  31   %K100005   HEINE,ALFO NSO LAWREN   H8168 DO B: 07/15/1 944  Subsc  ID: SUBSC  ID 290613
  32   Svc Date:  07/10/2000   Orig Amt :   186.66   ERA#: 92 754, 92762
  33   +                                                                                      
  34        [susp ense] SUSP ENSE       86.66                                                 
  35        [susp ense] SUSP ENSE       86.66                                                 
  36   CLAIM LEVE L PAY STAT US:                                                              
  37     Total Su bmitted Ch arges :      186.66   Payer Cove red Amount     :      186.66    
  38     Payer Pa id Amount        :      186.66   MEDICARE A llowed Amo unt :        0.00    
  39     Patient  Responsibi lity  :        0.00   % Collecte d              :         100%                                            
  40   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  41   CLAIM LEVE L ADJUSTME NTS:                                                             
  42     -- None  --                                                                          
  43   CLAIM LEVE L REMARKS:                                                                  
  44     -- None  --                                                                          
  45   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  46   +          Enter ?? f or more ac tions                                              >>>
  47   RX  ECME I nformation       CI   Go to Clai m Screen     VP  Poli cy Benefit s
  48   AR  Accoun t Profile        BC   Bill Charg es           EL  Pati ent Eligib ility
  49   CM  Commen t History        IR   Insurance  Reviews      RP  Rece ipt Profil e
  50   PE  Print  EEOB             AD   Additional  835 Data    EX  Exit
  51   Select Act ion: Next  Screen//
  52   Note that  the percen tage value  calculate d includes  all payme nts agains t the clai m, not jus t those re ported by  the payer  on the EEO B.
  53    
  54   Resolution  – Added C hanged Obj ects 
  55   RoutinesAc tivitiesRo utine Name IBJTEPEnha ncement Ca tegory New  Modify De lete No Ch angeRTMRel ated Optio nsIBJ THIR D PARTY JO INT INQUIR Y
  56   Protocol -  IBJT ERA  835 INFORM ATIONRelat ed Routine sRoutines  “Called By ”Routines  “Called”    N/A$$FIND 1^DIC         
  57   $$GET1^DIQ          
  58   GETS^DIQ            
  59   $$ADJU^IBJ TEP1     
  60   $$BILLN^IB JTEP1    
  61   EEOB^IBJTE P1       
  62   GETRX^IBJT EP1      
  63   RESORT^IBJ TEP1     
  64   $$EEOB^IBJ TLA1     
  65   $$BILLREJ^ IBJTU6   
  66   BILL^IBRFN 3        
  67   $$ECME^IBT RE       
  68   $$BN1^PRCA FN       
  69   EN^VALM             
  70   CLEAR^VALM 1        
  71   CLEAN^VALM 10       
  72   SET^VALM10          
  73   $$FMTE^XLF DT       
  74   $$CJ^XLFST R        
  75   $$REPLACE^ XLFSTR   
  76   $$TRIM^XLF STR      
  77   DISP^XQORM 1        C urrent Log icINIT ; - - init var iables and  list arra y
  78    N EPIEN,E PTN,ERAIEN ,EPARR,EPP CT,EOBCT,E OBMX,IBI,I BSHEOB,IBS PEOB,FL,LI NE,II,QQ,R CBAMT,RCRC ,RCOIN,RCD ED,RCERR,R CFLD,RMIEN ,RCRDC,RCR LN,RCXY,RC MD,IBEBERA ,IBRX,AQ,Z
  79    S EOBMX=0
  80    S ERALST= "",$P(SP80 ," ",80)="  "
  81    ; IBIFN c omes in fr om the TPJ I screen a nd will be  cleaned u p there
  82    I '$G(IBI FN) S VALM QUIT="" G  INITQ
  83    K EPARR D  BILL^IBRF N3(IBIFN,. EPARR) ; G et Bill in formation
  84    S EPBILL= EPARR("BN" ) ; K-Bill
  85    S EPPAT=$ $GET1^DIQ( 399,IBIFN_ ",",.02,"I ") ; Get P atient IEN  
  86    S EPNM=$$ GET1^DIQ(3 99,IBIFN_" ,",.02) ;  Get Patien t Name
  87    ; Get Tot al Charges  and justi fy the amo unt
  88    S EPAMT=$ J(EPARR("T CG"),$L(EP ARR("TCG") ),2)
  89    S EPSS=$E (EPNM)_$$G ET1^DIQ(2, EPPAT_",", .364) ; Ge t Short SS N
  90    S EPDOB=$ $GET1^DIQ( 2,EPPAT_", ",.03) ; G et DOB
  91    S EPSID=$ P(EPARR("P IN"),U,6)  ; Get Subs criber ID
  92    S EPDOS=$ $FMTE^XLFD T(EPARR("S TF"),"5DZ" ) ; Get Da te of Serv ice
  93    S:EPARR(" STF")'=EPA RR("STT")  EPDOS=EPDO S_" - "_$$ FMTE^XLFDT (EPARR("ST T"),"5DZ")  ; If Bill  for date  range
  94    ; Check t o see if w e may have  an EEOB i f not repo rt no ERA  Informatio n for this  K-Bill
  95    S EPIEN=$ O(^IBM(361 .1,"B",$G( IBIFN),"") ) I EPIEN= "" S VALMC NT=2 D SET ^VALM10(1, " "),SET^V ALM10(2,"N o ERA Info rmation fo r Bill: "_ EPBILL) G  INITQ
  96    ; Collect  all possi ble EOBs a ssociated  with this  Claim
  97    S IBSHEOB =0,IBI=0 F   S IBI=$O (^IBM(361. 1,"B",IBIF N,IBI)) Q: 'IBI  S IB SHEOB=IBSH EOB+1,IBSH EOB(IBI)=0
  98    ; Loop on  the IEN f or the EEO Bs - exclu de MRAs, b ut include  all insur ances 
  99    S EPIEN=" ",LINE=0,E OBCT=0 F   S EPIEN=$O (IBSHEOB(E PIEN)) Q:E PIEN=""  D
  100    . Q:$P($G (^IBM(361. 1,EPIEN,0) ),U,4)=1 ;  Get next  because th is is an M RA
  101    . S EPTN= $$GET1^DIQ (361.1,EPI EN_",",.07 ),ERAIEN=$ O(^RCY(344 .4,"D",EPT N,""))
  102    . Q:U_ERA LST_U[(U_E RAIEN_U) ;  Quit if w e have alr eady repor ted this E RA #
  103    . S ERAIE N=ERAIEN_" ," K IBEPA R,IBPLB
  104    . D GETS^ DIQ(344.4, ERAIEN,".0 1;.02;.03; .04;.05;.0 6;.07;.08; .09;.1;.11 ;.12;.13;. 14;.15;4.0 2;","E","I BEPAR")
  105    . D GETS^ DIQ(344.4, ERAIEN,"2* ;","E","IB PLB") ; ER A Level Ad justments
  106    . Q:$D(IB EPAR)'>0 ;  No IBEPAR  - no data  done with  this reco rd.
  107    . S ERALS T=$$PUSH(E RALST,ERAI EN) S XLN= "ERA#: "_$ G(IBEPAR(" 344.4",ERA IEN,".01", "E")),XSP= $E(SP80,1, (22-$L(XLN )))
  108    . S EPPCT =$S($G(EPA RR("TCG")) >0:($G(IBE PAR("344.4 ",ERAIEN," .05","E")) /EPARR("TC G"))*100,1 :0)
  109    . D SET(. LINE,"** E RA SUMMARY  DATA ** " )
  110    . D SET(. LINE,XLN_X SP_"TRACE# : "_$G(IBE PAR("344.4 ",ERAIEN," .02","E")) )
  111    . ; Holdi ng onto th e line bel ow because  the chang e of calcu lation 
  112    . ; S XLN ="ERA DATE  (PAYER):  "_$G(IBEPA R("344.4", ERAIEN,".0 4","E"))_"  TOTAL AMT  PD: "_$J( $G(IBEPAR( "344.4",ER AIEN,".05" ,"E")),9)_ " % COLLEC TED: "_$J( EPPCT,6,2)
  113    . S XLN=" ERA DATE ( PAYER): "_ $G(IBEPAR( "344.4",ER AIEN,".04" ,"E"))_" T OTAL AMT P D: "_$J($G (IBEPAR("3 44.4",ERAI EN,".05"," E")),9)
  114    . D SET(. LINE,XLN)
  115    . D SET(. LINE,"PAYE R NAME/TIN : "_$G(IBE PAR("344.4 ",ERAIEN," .06","E")) _"/"_$G(IB EPAR("344. 4",ERAIEN, ".03","E") ))
  116    . D SET(. LINE,"FILE  DATE/TIME : "_$G(IBE PAR("344.4 ",ERAIEN," .07","E")) )
  117    . D SET(. LINE,"EFT  MATCH STAT US: "_$G(I BEPAR("344 .4",ERAIEN ,".09","E" )))
  118    . S XLN=" ERA TYPE:  "_$G(IBEPA R("344.4", ERAIEN,".1 ","E")),XS P=$E(SP80, 1,(40-$L(X LN)))
  119    . D SET(. LINE,XLN_X SP_"INDIVI DUAL EOB C OUNT: "_$G (IBEPAR("3 44.4",ERAI EN,".11"," E")))
  120    . S XLN=" MAIL MESSA GE: "_$G(I BEPAR("344 .4",ERAIEN ,".12","E" )),XSP=$E( SP80,1,(40 -$L(XLN)))
  121    . D SET(. LINE,XLN_X SP_"CHECK# : "_$G(IBE PAR("344.4 ",ERAIEN," .13","E")) )
  122    . S XLN=" DETAIL POS T STATUS:  "_$G(IBEPA R("344.4", ERAIEN,".1 4","E")),X SP=$E(SP80 ,1,(40-$L( XLN)))
  123    . D SET(. LINE,XLN_X SP_"EXPECT ED PAYMENT  METHOD CO DE: "_$G(I BEPAR("344 .4",ERAIEN ,".15","E" )))
  124    . D SET(. LINE," ")
  125    . D SET(. LINE,"**** ****** ERA  LEVEL ADJ USTMENTS * *********" )
  126    . I $D(IB PLB)=0 D S ET(.LINE,"  -- NONE - -")
  127    . D:$D(IB PLB)'=0 ;  If we have  PLB Data  report it
  128    .. S FL=" ",RCF=0 F   S FL=$O(I BPLB(344.4 2,FL)) Q:F L=""  D
  129    ... I RCF '=0 D SET( .LINE," ")
  130    ... S RCF =RCF+1
  131    ... S XLN =" ADJUSTM ENT REASON  CODE: "_I BPLB(344.4 2,FL,.02," E"),XSP=$E (SP80,1,(4 5-$L(XLN)) )
  132    ... I $G( IBPLB(344. 42,FL,.02, "E"))'=""  S ACT=$$FI ND1^DIC(34 5.1,,"B",I BPLB(344.4 2,FL,.02," E")),ACT=$ $GET1^DIQ( 345.1,ACT, .05)
  133    ... D SET (.LINE,XLN _XSP_"ADJU STMENT AMO UNT: "_$J( IBPLB(344. 42,FL,.03, "E"),9))
  134    ... D SET (.LINE," A DJUSTMENT  CODE TEXT:  "_ACT)
  135    ... D SET (.LINE," R EFERENCE:  "_IBPLB(34 4.42,FL,.0 1,"E"))
  136    . D SET(. LINE," ")
  137    . K IBEBE RA S ZZEPI EN=EPIEN D  EEOB^IBJT EP1("IBEBE RA",ERAIEN ,EPBILL,1)
  138    . F EOBCT =1:1:IBEBE RA D
  139    .. K IBEO B,IBGX,IBC L,IBDGCR,I BRX,IBSPL, IBEERR S E PIEN=$O(IB EBERA(EOBC T,""))
  140    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,".01;.02; .03;.04;.0 6;.14;1.01 ;1.02;1.03 ;1.1;1.11; 2.03;2.04; 3.03;3.04; 3.05;3.06; 3.07;","EI ","IBEOB")
  141    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,"10*;","E I","IBGX") ,RESORT^IB JTEP1("IBG X",361.111 ),RESORT^I BJTEP1("IB GX",361.11 ) ; Claim  Level Adju stments
  142    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,"15*;","E I","IBCL")  ; Line Le vel Adjust ments
  143    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,"8*;","EI ","IBSPL")  ; ERA Spl its for th is EEOB
  144    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,"20;","", "IBEERR")  ; EOB Erro rs if they  exist
  145    .. ; Make  it easier  to walk t he data
  146    .. D RESO RT^IBJTEP1 ("IBCL",36 1.11511),R ESORT^IBJT EP1("IBCL" ,361.115), RESORT^IBJ TEP1("IBCL ",361.1151 )
  147    .. D RESO RT^IBJTEP1 ("IBCL",36 1.1152),RE SORT^IBJTE P1("IBCL", 361.1154)
  148    .. D GETS ^DIQ(399,I BEOB(361.1 ,EPIEN_"," ,.01,"I")_ ",","460;" ,"EI","IBD GCR")
  149    .. D SET( .LINE,"*** ******* EO B/835 INFO RMATION (" _EOBCT_" o f "_IBEBER A_") ***** *****")
  150    .. S XLN= " EOB Type : "_$G(IBE OB("361.1" ,EPIEN_"," ,".04","E" )),XSP=$E( SP80,1,(40 -$L(XLN)))
  151    .. D SET( .LINE,XLN_ XSP_"EOB P aid Date:  "_$G(IBEOB ("361.1",E PIEN_","," .06","E")) )
  152    .. S TSDT =$$FMTE^XL FDT($G(IBE OB("361.1" ,EPIEN_"," ,"1.1","I" )),"2Z"),T EDT=$$FMTE ^XLFDT($G( IBEOB("361 .1",EPIEN_ ",","1.11" ,"I")),"2Z "),XLN=" S vc From Da te: "_TSDT ,XSP=$E(SP 80,1,(40-$ L(XLN)))
  153    .. D SET( .LINE,XLN_ XSP_"Svc t o Date: "_ TEDT)
  154    .. D SET( .LINE," IC N: "_$G(IB EOB("361.1 ",EPIEN_", ",".14","E ")))
  155    .. D SET( .LINE," Pa yer Name/T IN: "_$G(I BEOB("361. 1",EPIEN_" ,",".02"," E"))_"/"_$ G(IBEOB("3 61.1",EPIE N_",",".03 ","E")))
  156    .. S XLN= " ERA #: " _$G(IBEPAR ("344.4",E RAIEN,".01 ","E")),XS P=$E(SP80, 1,(40-$L(X LN)))
  157    .. D SET( .LINE,XLN_ XSP_"Auto- Post Statu s: "_$G(IB EPAR("344. 4",ERAIEN, "4.02","E" )))
  158    .. D SET( .LINE," Tr ace #: "_$ G(IBEPAR(" 344.4",ERA IEN,".02", "E")))
  159    .. S TECM E=$P($G(IB DGCR(399,I BEOB(361.1 ,EPIEN_"," ,.01,"I")_ ",",460,"E ")),";",1)
  160    .. D GETR X^IBJTEP1( EPIEN,.IBR X)
  161    .. S TRX= $$GET1^DIQ (52,+TECME _",",".01" )_"/"_$G(I BRX("FILL" ))_"/"_$G( IBRX("RELE ASED STATU S"))
  162    .. I TECM E="" S TRX =""
  163    .. S XLN= " ECME #:  "_TECME,XS P=$E(SP80, 1,(25-$L(X LN))),XSP1 =$E(SP80,1 ,(39-$L(XL N_XSP_"DOS : "_$G(IBR X("DOS"))) ))
  164    .. D SET( .LINE,XLN_ XSP_"DOS:  "_$G(IBRX( "DOS"))_XS P1_"Rx/Fil l/Release  Status: "_ TRX)
  165    .. D SET( .LINE,"--- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------")
  166    .. D:$D(I BSPL)>1 ;  This EEOB  was split  display sp lit paymen t informat ion
  167    ... N SPL
  168    ... D SET (.LINE,"**  A/R CORRE CTED PAYME NT DATA:")
  169    ... D SET (.LINE," T OTAL AMT P D: "_$J(IB EOB(361.1, EPIEN_",", 1.01,"E"), 9,2))
  170    ... S SPL ="" F  S S PL=$O(IBSP L(361.18,S PL)) Q:SPL =""  D
  171    .... D SE T(.LINE,"  "_$S(IBSPL (361.18,SP L,.03,"I") '="":$$BN1 ^PRCAFN(IB SPL(361.18 ,SPL,.03," I"))_$J("" ,8),1:"[su spense] "_ IBSPL(361. 18,SPL,.01 ,"E"))_" " _$J(IBSPL( 361.18,SPL ,.02,"E"), 9,2))
  172    ... D SET (.LINE," " )
  173    .. D SET( .LINE,"CLA IM LEVEL P AY STATUS: ")
  174    .. D SET( .LINE," To tal Submit ted Charge s :"_$J($G (IBEOB("36 1.1",EPIEN _",","2.04 ","E")),11 ,2)_" Paye r Covered  Amount :"_ $J($G(IBEO B("361.1", EPIEN_",", "1.03","E" )),11,2))
  175    .. D SET( .LINE," Pa yer Paid A mount :"_$ J($G(IBEOB ("361.1",E PIEN_","," 1.01","E") ),11,2)_"  MEDICARE A llowed Amo unt :"_$J( $G(IBEOB(" 361.1",EPI EN_",","2. 03","E")), 11,2))
  176    .. D SET( .LINE," Pa tient Resp onsibility  :"_$J($G( IBEOB("361 .1",EPIEN_ ",","1.02" ,"E")),11, 2))
  177    .. D SET( .LINE,"--- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------")
  178    .. D SET( .LINE,"CLA IM LEVEL A DJUSTMENTS :")
  179    .. S AA=" ",ACNT=0 F   S AA=$O( IBGX(361.1 1,AA)) Q:A A=""  S AC NT=ACNT+1, AQ="" D
  180    ... S CC= AA F  S CC =$O(IBGX(3 61.111,CC) ) Q:$E(CC, 1,$L(AA))' =AA  DModi fied Logic  (Changes  are in bol d)INIT ; - - init var iables and  list arra y
  181    N EPIEN,E PTN,ERAIEN ,EPARR,EPP CT,EOBCT,E OBMX,IBAR, IBI,IBCOL, IBSHEOB,IB SPEOB,FL,L INE,II,QQ, RCBAMT  
  182    N RCRC,RC OIN,RCDED, RCERR,RCFL D,RMIEN,RC RDC,RCRLN, RCXY,RCMD, IBEBERA,IB RX,AQ,Z
  183    S EOBMX=0
  184    S ERALST= "",$P(SP80 ," ",80)="  "
  185    ; IBIFN c omes in fr om the TPJ I screen a nd will be  cleaned u p there
  186    I '$G(IBI FN) S VALM QUIT="" G  INITQ
  187    K EPARR D  BILL^IBRF N3(IBIFN,. EPARR) ; G et Bill in formation
  188    S EPBILL= EPARR("BN" ) ; K-Bill
  189    S EPPAT=$ $GET1^DIQ( 399,IBIFN_ ",",.02,"I ") ; Get P atient IEN  
  190    S EPNM=$$ GET1^DIQ(3 99,IBIFN_" ,",.02) ;  Get Patien t Name
  191    ; Get Tot al Charges  and justi fy the amo unt
  192    S EPAMT=$ J(EPARR("T CG"),$L(EP ARR("TCG") ),2)
  193    S EPSS=$E (EPNM)_$$G ET1^DIQ(2, EPPAT_",", .364) ; Ge t Short SS N
  194    S EPDOB=$ $GET1^DIQ( 2,EPPAT_", ",.03) ; G et DOB
  195    S EPSID=$ P(EPARR("P IN"),U,6)  ; Get Subs criber ID
  196    S EPDOS=$ $FMTE^XLFD T(EPARR("S TF"),"5DZ" ) ; Get Da te of Serv ice
  197    S:EPARR(" STF")'=EPA RR("STT")  EPDOS=EPDO S_" - "_$$ FMTE^XLFDT (EPARR("ST T"),"5DZ")  ; If Bill  for date  range
  198    ; Check t o see if w e may have  an EEOB i f not repo rt no ERA  Informatio n for this  K-Bill
  199    S EPIEN=$ O(^IBM(361 .1,"B",$G( IBIFN),"") ) I EPIEN= "" S VALMC NT=2 D SET ^VALM10(1, " "),SET^V ALM10(2,"N o ERA Info rmation fo r Bill: "_ EPBILL) G  INITQ
  200    ; Get % C ollected f rom AR cla im – IA 14 52
  201    S IBAR=$$ BILL^RCJIB FN2(IBIFN) ,IBCOL=$P( IBAR,U,5)
  202    ; Collect  all possi ble EOBs a ssociated  with this  Claim
  203    S IBSHEOB =0,IBI=0 F   S IBI=$O (^IBM(361. 1,"B",IBIF N,IBI)) Q: 'IBI  S IB SHEOB=IBSH EOB+1,IBSH EOB(IBI)=0
  204    ; Loop on  the IEN f or the EEO Bs - exclu de MRAs, b ut include  all insur ances 
  205    S EPIEN=" ",LINE=0,E OBCT=0 F   S EPIEN=$O (IBSHEOB(E PIEN)) Q:E PIEN=""  D
  206    . Q:$P($G (^IBM(361. 1,EPIEN,0) ),U,4)=1 ;  Get next  because th is is an M RA
  207    . S EPTN= $$GET1^DIQ (361.1,EPI EN_",",.07 ),ERAIEN=$ O(^RCY(344 .4,"D",EPT N,""))
  208    . Q:U_ERA LST_U[(U_E RAIEN_U) ;  Quit if w e have alr eady repor ted this E RA #
  209    . S ERAIE N=ERAIEN_" ," K IBEPA R,IBPLB
  210    . D GETS^ DIQ(344.4, ERAIEN,".0 1;.02;.03; .04;.05;.0 6;.07;.08; .09;.1;.11 ;.12;.13;. 14;.15;4.0 2;","E","I BEPAR")
  211    . D GETS^ DIQ(344.4, ERAIEN,"2* ;","E","IB PLB") ; ER A Level Ad justments
  212    . Q:$D(IB EPAR)'>0 ;  No IBEPAR  - no data  done with  this reco rd.
  213    . S ERALS T=$$PUSH(E RALST,ERAI EN) S XLN= "ERA#: "_$ G(IBEPAR(" 344.4",ERA IEN,".01", "E")),XSP= $E(SP80,1, (22-$L(XLN )))
  214    . S EPPCT =$S($G(EPA RR("TCG")) >0:($G(IBE PAR("344.4 ",ERAIEN," .05","E")) /EPARR("TC G"))*100,1 :0)
  215    . D SET(. LINE,"** E RA SUMMARY  DATA ** " )
  216    . D SET(. LINE,XLN_X SP_"TRACE# : "_$G(IBE PAR("344.4 ",ERAIEN," .02","E")) )
  217    . ; Holdi ng onto th e line bel ow because  the chang e of calcu lation 
  218    . ; S XLN ="ERA DATE  (PAYER):  "_$G(IBEPA R("344.4", ERAIEN,".0 4","E"))_"  TOTAL AMT  PD: "_$J( $G(IBEPAR( "344.4",ER AIEN,".05" ,"E")),9)_ " % COLLEC TED: "_$J( EPPCT,6,2)
  219    . S XLN=" ERA DATE ( PAYER): "_ $G(IBEPAR( "344.4",ER AIEN,".04" ,"E"))_" T OTAL AMT P D: "_$J($G (IBEPAR("3 44.4",ERAI EN,".05"," E")),9)
  220    . D SET(. LINE,XLN)
  221    . D SET(. LINE,"PAYE R NAME/TIN : "_$G(IBE PAR("344.4 ",ERAIEN," .06","E")) _"/"_$G(IB EPAR("344. 4",ERAIEN, ".03","E") ))
  222    . D SET(. LINE,"FILE  DATE/TIME : "_$G(IBE PAR("344.4 ",ERAIEN," .07","E")) )
  223    . D SET(. LINE,"EFT  MATCH STAT US: "_$G(I BEPAR("344 .4",ERAIEN ,".09","E" )))
  224    . S XLN=" ERA TYPE:  "_$G(IBEPA R("344.4", ERAIEN,".1 ","E")),XS P=$E(SP80, 1,(40-$L(X LN)))
  225    . D SET(. LINE,XLN_X SP_"INDIVI DUAL EOB C OUNT: "_$G (IBEPAR("3 44.4",ERAI EN,".11"," E")))
  226    . S XLN=" MAIL MESSA GE: "_$G(I BEPAR("344 .4",ERAIEN ,".12","E" )),XSP=$E( SP80,1,(40 -$L(XLN)))
  227    . D SET(. LINE,XLN_X SP_"CHECK# : "_$G(IBE PAR("344.4 ",ERAIEN," .13","E")) )
  228    . S XLN=" DETAIL POS T STATUS:  "_$G(IBEPA R("344.4", ERAIEN,".1 4","E")),X SP=$E(SP80 ,1,(40-$L( XLN)))
  229    . D SET(. LINE,XLN_X SP_"EXPECT ED PAYMENT  METHOD CO DE: "_$G(I BEPAR("344 .4",ERAIEN ,".15","E" )))
  230    . D SET(. LINE," ")
  231    . D SET(. LINE,"**** ****** ERA  LEVEL ADJ USTMENTS * *********" )
  232    . I $D(IB PLB)=0 D S ET(.LINE,"  -- NONE - -")
  233    . D:$D(IB PLB)'=0 ;  If we have  PLB Data  report it
  234    .. S FL=" ",RCF=0 F   S FL=$O(I BPLB(344.4 2,FL)) Q:F L=""  D
  235    ... I RCF '=0 D SET( .LINE," ")
  236    ... S RCF =RCF+1
  237    ... S XLN =" ADJUSTM ENT REASON  CODE: "_I BPLB(344.4 2,FL,.02," E"),XSP=$E (SP80,1,(4 5-$L(XLN)) )
  238    ... I $G( IBPLB(344. 42,FL,.02, "E"))'=""  S ACT=$$FI ND1^DIC(34 5.1,,"B",I BPLB(344.4 2,FL,.02," E")),ACT=$ $GET1^DIQ( 345.1,ACT, .05)
  239    ... D SET (.LINE,XLN _XSP_"ADJU STMENT AMO UNT: "_$J( IBPLB(344. 42,FL,.03, "E"),9))
  240    ... D SET (.LINE," A DJUSTMENT  CODE TEXT:  "_ACT)
  241    ... D SET (.LINE," R EFERENCE:  "_IBPLB(34 4.42,FL,.0 1,"E"))
  242    . D SET(. LINE," ")
  243    . K IBEBE RA S ZZEPI EN=EPIEN D  EEOB^IBJT EP1("IBEBE RA",ERAIEN ,EPBILL,1)
  244    . F EOBCT =1:1:IBEBE RA D
  245    .. K IBEO B,IBGX,IBC L,IBDGCR,I BRX,IBSPL, IBEERR S E PIEN=$O(IB EBERA(EOBC T,""))
  246    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,".01;.02; .03;.04;.0 6;.14;1.01 ;1.02;1.03 ;1.1;1.11; 2.03;2.04; 3.03;3.04; 3.05;3.06; 3.07;","EI ","IBEOB")
  247    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,"10*;","E I","IBGX") ,RESORT^IB JTEP1("IBG X",361.111 ),RESORT^I BJTEP1("IB GX",361.11 ) ; Claim  Level Adju stments
  248    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,"15*;","E I","IBCL")  ; Line Le vel Adjust ments
  249    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,"8*;","EI ","IBSPL")  ; ERA Spl its for th is EEOB
  250    .. D GETS ^DIQ(361.1 ,EPIEN_"," ,"20;","", "IBEERR")  ; EOB Erro rs if they  exist
  251    .. ; Make  it easier  to walk t he data
  252    .. D RESO RT^IBJTEP1 ("IBCL",36 1.11511),R ESORT^IBJT EP1("IBCL" ,361.115), RESORT^IBJ TEP1("IBCL ",361.1151 )
  253    .. D RESO RT^IBJTEP1 ("IBCL",36 1.1152),RE SORT^IBJTE P1("IBCL", 361.1154)
  254    .. D GETS ^DIQ(399,I BEOB(361.1 ,EPIEN_"," ,.01,"I")_ ",","460;" ,"EI","IBD GCR")
  255    .. D SET( .LINE,"*** ******* EO B/835 INFO RMATION (" _EOBCT_" o f "_IBEBER A_") ***** *****")
  256    .. S XLN= " EOB Type : "_$G(IBE OB("361.1" ,EPIEN_"," ,".04","E" )),XSP=$E( SP80,1,(40 -$L(XLN)))
  257    .. D SET( .LINE,XLN_ XSP_"EOB P aid Date:  "_$G(IBEOB ("361.1",E PIEN_","," .06","E")) )
  258    .. S TSDT =$$FMTE^XL FDT($G(IBE OB("361.1" ,EPIEN_"," ,"1.1","I" )),"2Z"),T EDT=$$FMTE ^XLFDT($G( IBEOB("361 .1",EPIEN_ ",","1.11" ,"I")),"2Z "),XLN=" S vc From Da te: "_TSDT ,XSP=$E(SP 80,1,(40-$ L(XLN)))
  259    .. D SET( .LINE,XLN_ XSP_"Svc t o Date: "_ TEDT)
  260    .. D SET( .LINE," IC N: "_$G(IB EOB("361.1 ",EPIEN_", ",".14","E ")))
  261    .. D SET( .LINE," Pa yer Name/T IN: "_$G(I BEOB("361. 1",EPIEN_" ,",".02"," E"))_"/"_$ G(IBEOB("3 61.1",EPIE N_",",".03 ","E")))
  262    .. S XLN= " ERA #: " _$G(IBEPAR ("344.4",E RAIEN,".01 ","E")),XS P=$E(SP80, 1,(40-$L(X LN)))
  263    .. D SET( .LINE,XLN_ XSP_"Auto- Post Statu s: "_$G(IB EPAR("344. 4",ERAIEN, "4.02","E" )))
  264    .. D SET( .LINE," Tr ace #: "_$ G(IBEPAR(" 344.4",ERA IEN,".02", "E")))
  265    .. S TECM E=$P($G(IB DGCR(399,I BEOB(361.1 ,EPIEN_"," ,.01,"I")_ ",",460,"E ")),";",1)
  266    .. D GETR X^IBJTEP1( EPIEN,.IBR X)
  267    .. S TRX= $$GET1^DIQ (52,+TECME _",",".01" )_"/"_$G(I BRX("FILL" ))_"/"_$G( IBRX("RELE ASED STATU S"))
  268    .. I TECM E="" S TRX =""
  269    .. S XLN= " ECME #:  "_TECME,XS P=$E(SP80, 1,(25-$L(X LN))),XSP1 =$E(SP80,1 ,(39-$L(XL N_XSP_"DOS : "_$G(IBR X("DOS"))) ))
  270    .. D SET( .LINE,XLN_ XSP_"DOS:  "_$G(IBRX( "DOS"))_XS P1_"Rx/Fil l/Release  Status: "_ TRX)
  271    .. D SET( .LINE,"--- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------")
  272    .. D:$D(I BSPL)>1 ;  This EEOB  was split  display sp lit paymen t informat ion
  273    ... N SPL
  274    ... D SET (.LINE,"**  A/R CORRE CTED PAYME NT DATA:")
  275    ... D SET (.LINE," T OTAL AMT P D: "_$J(IB EOB(361.1, EPIEN_",", 1.01,"E"), 9,2))
  276    ... S SPL ="" F  S S PL=$O(IBSP L(361.18,S PL)) Q:SPL =""  D
  277    .... D SE T(.LINE,"  "_$S(IBSPL (361.18,SP L,.03,"I") '="":$$BN1 ^PRCAFN(IB SPL(361.18 ,SPL,.03," I"))_$J("" ,8),1:"[su spense] "_ IBSPL(361. 18,SPL,.01 ,"E"))_" " _$J(IBSPL( 361.18,SPL ,.02,"E"), 9,2))
  278    ... D SET (.LINE," " )
  279    .. D SET( .LINE,"CLA IM LEVEL P AY STATUS: ")
  280    .. D SET( .LINE," To tal Submit ted Charge s :"_$J($G (IBEOB("36 1.1",EPIEN _",","2.04 ","E")),11 ,2)_" Paye r Covered  Amount :"_ $J($G(IBEO B("361.1", EPIEN_",", "1.03","E" )),11,2))
  281    .. D SET( .LINE," Pa yer Paid A mount :"_$ J($G(IBEOB ("361.1",E PIEN_","," 1.01","E") ),11,2)_"  MEDICARE A llowed Amo unt :"_$J( $G(IBEOB(" 361.1",EPI EN_",","2. 03","E")), 11,2))
  282    .. D SET( .LINE," Pa tient Resp onsibility  :"_$J($G( IBEOB("361 .1",EPIEN_ ",","1.02" ,"E")),11, 2)) _ " %  Collected  :"_$J(+IBC OL,11,0)_” %”
  283    .. D SET( .LINE,"--- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------")
  284    .. D SET( .LINE,"CLA IM LEVEL A DJUSTMENTS :")
  285    .. S AA=" ",ACNT=0 F   S AA=$O( IBGX(361.1 1,AA)) Q:A A=""  S AC NT=ACNT+1, AQ="" D
  286    ... S CC= AA F  S CC =$O(IBGX(3 61.111,CC) ) Q:$E(CC, 1,$L(AA))' =AA  D
  287   RoutinesAc tivitiesRo utine Name IBJTPEEnha ncement Ca tegory New  Modify De lete No Ch angeRTMRel ated Optio nsIBJ THIR D PARTY JO INT INQUIR Y
  288   Protocol -  IBJT ERA  835 PRINT  EEOBRelate d Routines Routines “ Called By” Routines “ Called”    N/A^%ZIS                 
  289   HOME^%ZIS            
  290   ^%ZTLOAD             
  291   $$STATUS^B PSOSRX    
  292   $$FIND1^DI C         
  293   $$GET1^DIQ           
  294   GETS^DIQ             
  295   ^DIR                 
  296   DLN^IBJTEP           
  297   $$ADJU^IBJ TEP1      
  298   $$BILLN^IB JTEP1     
  299   EEOB^IBJTE P1        
  300   RESORT^IBJ TEP1      
  301   $$BN1^PRCA FN        
  302   $$DOS^PSOB PSU1      
  303   $$LSTRFL^P SOBPSU1   
  304   EN^VALM                 
  305   FULL^VALM1           
  306   $$FMTE^XLF DT        
  307   $$NOW^XLFD T         
  308   $$CJ^XLFST R         
  309   $$REPLACE^ XLFSTR    
  310   DISP^XQORM 1          Current Lo gicEBO ; D isplay the  EOB DATA  for IBEIEN
  311    S SP80=$J ("",IOM),I BDT=$$FMTE ^XLFDT($$N OW^XLFDT,1 ) ; Date f ormat Mon  dd, yyyy@h h:mm:ss se e kernel d ocumentati on
  312    I (IBSL=0 )&(IBPG=0)  D RHDR(IB PERA,IBDT, .IBPG)
  313    I IBREPG= 1 S IBREPG =0 D RHDR( IBPERA,IBD T,.IBPG)
  314    K IBEOB,I BGX,IBCL,I BDGCR,IBEP AR,IBSPL,I BEERR
  315    D GETS^DI Q(361.1,IB EIEN_","," .01;.02;.0 3;.04;.06; .14;1.01;1 .02;1.03;1 .1;1.11;2. 03;2.04;3. 03;3.04;3. 05;3.06;3. 07;","EI", "IBEOB")
  316    D GETS^DI Q(361.1,IB EIEN_","," 10*;","EI" ,"IBGX"),R ESORT^IBJT EP1("IBGX" ,361.111), RESORT^IBJ TEP1("IBGX ",361.11)  ; Claim Le vel Adjust ments
  317    D GETS^DI Q(361.1,IB EIEN_","," 15*;","EI" ,"IBCL") ;  Line Leve l Adjustme nts
  318    D GETS^DI Q(361.1,IB EIEN_","," 8*;","EI", "IBSPL") ;  ERA Split s for this  EEOB
  319    D GETS^DI Q(361.1,IB EIEN_","," 20;","","I BEERR") ;  EOB Errors  if they e xist
  320    ; Make it  easier to  walk the  data
  321    D RESORT^ IBJTEP1("I BCL",361.1 1511),RESO RT^IBJTEP1 ("IBCL",36 1.115),RES ORT^IBJTEP 1("IBCL",3 61.1151)
  322    D RESORT^ IBJTEP1("I BCL",361.1 152),RESOR T^IBJTEP1( "IBCL",361 .1154)
  323    D GETS^DI Q(399,IBEO B(361.1,IB EIEN_",",. 01,"I")_", ","460;"," EI","IBDGC R")
  324    D GETS^DI Q(344.4,IB PERA_","," .01;.02;.0 3;.04;.05; .06;.07;.0 8;.09;.1;. 11;.12;.13 ;.14;.15;4 .02;","E", "IBEPAR")
  325    ;
  326    D SET("** ******** E OB/835 INF ORMATION ( "_BB_" of  "_IBEBERA_ ") ******* ***") Q:IB QUIT
  327    S XLN=" E OB Type: " _$G(IBEOB( "361.1",IB EIEN_","," .04","E")) ,XSP=$E(SP 80,1,(40-$ L(XLN)))
  328    D SET(XLN _XSP_"EOB  Paid Date:  "_$G(IBEO B("361.1", IBEIEN_"," ,".06","E" ))) Q:IBQU IT
  329    S TSDT=$$ FMTE^XLFDT ($G(IBEOB( "361.1",IB EIEN_","," 1.1","I")) ,"2Z"),TED T=$$FMTE^X LFDT($G(IB EOB("361.1 ",IBEIEN_" ,","1.11", "I")),"2Z" ),XLN=" Sv c From Dat e: "_TSDT, XSP=$E(SP8 0,1,(40-$L (XLN)))
  330    D SET(XLN _XSP_"Svc  to Date: " _TEDT) Q:I BQUIT
  331    D SET(" I CN: "_$G(I BEOB("361. 1",IBEIEN_ ",",".14", "E"))) Q:I BQUIT
  332    D SET(" P ayer Name/ TIN: "_$G( IBEOB("361 .1",IBEIEN _",",".02" ,"E"))_"/" _$G(IBEOB( "361.1",IB EIEN_","," .03","E")) ) Q:IBQUIT
  333    S XLN=" E RA #: "_$G (IBEPAR("3 44.4",IBPE RA_",",".0 1","E")),X SP=$E(SP80 ,1,(40-$L( XLN)))
  334    D SET(XLN _XSP_"Auto -Post Stat us: "_$G(I BEPAR("344 .4",IBPERA _",","4.02 ","E"))) Q :IBQUIT
  335    D SET(" T race #: "_ $G(IBEPAR( "344.4",IB PERA_","," .02","E")) ) Q:IBQUIT
  336    ; Access  to PSOORDE R supporte d by DBIA  #1878
  337    S TECME=$ P($G(IBDGC R(399,IBEO B(361.1,IB EIEN_",",. 01,"I")_", ",460,"E") ),";",1),T DOS=$$FMTE ^XLFDT($$D OS^PSOBPSU 1(+TECME), "2Z")
  338    ;Referenc e to $$STA TUS^BPSOSR X supporte d by IA 44 12
  339    S TRX=$$G ET1^DIQ(52 ,+TECME_", ",".01")
  340    S TSTAT=$ P($$STATUS ^BPSOSRX(T RX,$$LSTRF L^PSOBPSU1 (+TECME)), "^")
  341    S TRX=TRX _"/"_$$LST RFL^PSOBPS U1(+TECME) _"/"_TSTAT
  342    I TECME=" " S TDOS=" ",TRX=""
  343    S XLN=" E CME #: "_T ECME,XSP=$ E(SP80,1,( 25-$L(XLN) )),XSP1=$E (SP80,1,(3 9-$L(XLN_X SP_"DOS: " _TDOS)))
  344    D SET(XLN _XSP_"DOS:  "_TDOS_XS P1_"Rx/Fil l/Release  Status: "_ TRX) Q:IBQ UIT
  345    D SET("-- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --------")  Q:IBQUIT
  346    D:$D(IBSP L)>1 Q:IBQ UIT  ; Thi s EEOB was  split dis play split  payment i nformation
  347    . N SPL
  348    . D SET(" ** A/R COR RECTED PAY MENT DATA: ") Q:IBQUI T
  349    . D SET("  TOTAL AMT  PD: "_$J( IBEOB(361. 1,IBEIEN_" ,",1.01,"E "),9,2)) Q :IBQUIT
  350    . S SPL=" " F  S SPL =$O(IBSPL( 361.18,SPL )) Q:SPL=" "  D  Q:IB QUIT
  351    .. D SET( " "_$S(IBS PL(361.18, SPL,.03,"I ")'="":$$B N1^PRCAFN( IBSPL(361. 18,SPL,.03 ,"I"))_$J( "",8),1:"[ suspense]  "_IBSPL(36 1.18,SPL,. 01,"E"))_"  "_$J(IBSP L(361.18,S PL,.02,"E" ),9,2)) Q: IBQUIT
  352    . D SET("  ") Q:IBQU IT
  353    D SET("CL AIM LEVEL  PAY STATUS :") Q:IBQU IT
  354    D SET(" T otal Submi tted Charg es :"_$J($ G(IBEOB("3 61.1",IBEI EN_",","2. 04","E")), 11,2)_" Pa yer Covere d Amount : "_$J($G(IB EOB("361.1 ",IBEIEN_" ,","1.03", "E")),11,2 )) Q:IBQUI T
  355    D SET(" P ayer Paid  Amount :"_ $J($G(IBEO B("361.1", IBEIEN_"," ,"1.01","E ")),11,2)_ " MEDICARE  Allowed A mount :"_$ J($G(IBEOB ("361.1",I BEIEN_",", "2.03","E" )),11,2))  Q:IBQUIT
  356    D SET(" P atient Res ponsibilit y :"_$J($G (IBEOB("36 1.1",IBEIE N_",","1.0 2","E")),1 1,2)) Q:IB QUIT
  357    D SET("-- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --------")  Q:IBQUIT
  358    D SET("CL AIM LEVEL  ADJUSTMENT S:") Q:IBQ UIT
  359    S AA="",A CNT=0 F  S  AA=$O(IBG X(361.11,A A)) Q:AA=" "  S ACNT= ACNT+1,AQ= "" D  Q:IB QUIT
  360    . S CC=AA  F  S CC=$ O(IBGX(361 .111,CC))  Q:$E(CC,1, $L(AA))'=A A  D  Q:IB QUIT
  361    .. I AQ=" " S AQ=$J( ACNT,3)_")  "Modified  Logic (Ch anges are  in bold)EB O ; Displa y the EOB  DATA for I BEIEN
  362    S SP80=$J ("",IOM),I BDT=$$FMTE ^XLFDT($$N OW^XLFDT,1 ) ; Date f ormat Mon  dd, yyyy@h h:mm:ss se e kernel d ocumentati on
  363    I (IBSL=0 )&(IBPG=0)  D RHDR(IB PERA,IBDT, .IBPG)
  364    I IBREPG= 1 S IBREPG =0 D RHDR( IBPERA,IBD T,.IBPG)
  365    K IBEOB,I BGX,IBCL,I BDGCR,IBEP AR,IBSPL,I BEERR
  366    D GETS^DI Q(361.1,IB EIEN_","," .01;.02;.0 3;.04;.06; .14;1.01;1 .02;1.03;1 .1;1.11;2. 03;2.04;3. 03;3.04;3. 05;3.06;3. 07;","EI", "IBEOB")
  367    D GETS^DI Q(361.1,IB EIEN_","," 10*;","EI" ,"IBGX"),R ESORT^IBJT EP1("IBGX" ,361.111), RESORT^IBJ TEP1("IBGX ",361.11)  ; Claim Le vel Adjust ments
  368    D GETS^DI Q(361.1,IB EIEN_","," 15*;","EI" ,"IBCL") ;  Line Leve l Adjustme nts
  369    D GETS^DI Q(361.1,IB EIEN_","," 8*;","EI", "IBSPL") ;  ERA Split s for this  EEOB
  370    D GETS^DI Q(361.1,IB EIEN_","," 20;","","I BEERR") ;  EOB Errors  if they e xist
  371    ; Get % C ollected f rom AR cla im – IA 14 52
  372    N IBAR,IB COL
  373    S IBAR=$$ BILL^RCJIB FN2($G(IBE OB(361.1,I BEIEN_",", .01,"I"))) ,IBCOL=$P( IBAR,U,5)
  374    ; Make it  easier to  walk the  data
  375    D RESORT^ IBJTEP1("I BCL",361.1 1511),RESO RT^IBJTEP1 ("IBCL",36 1.115),RES ORT^IBJTEP 1("IBCL",3 61.1151)
  376    D RESORT^ IBJTEP1("I BCL",361.1 152),RESOR T^IBJTEP1( "IBCL",361 .1154)
  377    D GETS^DI Q(399,IBEO B(361.1,IB EIEN_",",. 01,"I")_", ","460;"," EI","IBDGC R")
  378    D GETS^DI Q(344.4,IB PERA_","," .01;.02;.0 3;.04;.05; .06;.07;.0 8;.09;.1;. 11;.12;.13 ;.14;.15;4 .02;","E", "IBEPAR")
  379    ;
  380    D SET("** ******** E OB/835 INF ORMATION ( "_BB_" of  "_IBEBERA_ ") ******* ***") Q:IB QUIT
  381    S XLN=" E OB Type: " _$G(IBEOB( "361.1",IB EIEN_","," .04","E")) ,XSP=$E(SP 80,1,(40-$ L(XLN)))
  382    D SET(XLN _XSP_"EOB  Paid Date:  "_$G(IBEO B("361.1", IBEIEN_"," ,".06","E" ))) Q:IBQU IT
  383    S TSDT=$$ FMTE^XLFDT ($G(IBEOB( "361.1",IB EIEN_","," 1.1","I")) ,"2Z"),TED T=$$FMTE^X LFDT($G(IB EOB("361.1 ",IBEIEN_" ,","1.11", "I")),"2Z" ),XLN=" Sv c From Dat e: "_TSDT, XSP=$E(SP8 0,1,(40-$L (XLN)))
  384    D SET(XLN _XSP_"Svc  to Date: " _TEDT) Q:I BQUIT
  385    D SET(" I CN: "_$G(I BEOB("361. 1",IBEIEN_ ",",".14", "E"))) Q:I BQUIT
  386    D SET(" P ayer Name/ TIN: "_$G( IBEOB("361 .1",IBEIEN _",",".02" ,"E"))_"/" _$G(IBEOB( "361.1",IB EIEN_","," .03","E")) ) Q:IBQUIT
  387    S XLN=" E RA #: "_$G (IBEPAR("3 44.4",IBPE RA_",",".0 1","E")),X SP=$E(SP80 ,1,(40-$L( XLN)))
  388    D SET(XLN _XSP_"Auto -Post Stat us: "_$G(I BEPAR("344 .4",IBPERA _",","4.02 ","E"))) Q :IBQUIT
  389    D SET(" T race #: "_ $G(IBEPAR( "344.4",IB PERA_","," .02","E")) ) Q:IBQUIT
  390    ; Access  to PSOORDE R supporte d by DBIA  #1878
  391    S TECME=$ P($G(IBDGC R(399,IBEO B(361.1,IB EIEN_",",. 01,"I")_", ",460,"E") ),";",1),T DOS=$$FMTE ^XLFDT($$D OS^PSOBPSU 1(+TECME), "2Z")
  392    ;Referenc e to $$STA TUS^BPSOSR X supporte d by IA 44 12
  393    S TRX=$$G ET1^DIQ(52 ,+TECME_", ",".01")
  394    S TSTAT=$ P($$STATUS ^BPSOSRX(T RX,$$LSTRF L^PSOBPSU1 (+TECME)), "^")
  395    S TRX=TRX _"/"_$$LST RFL^PSOBPS U1(+TECME) _"/"_TSTAT
  396    I TECME=" " S TDOS=" ",TRX=""
  397    S XLN=" E CME #: "_T ECME,XSP=$ E(SP80,1,( 25-$L(XLN) )),XSP1=$E (SP80,1,(3 9-$L(XLN_X SP_"DOS: " _TDOS)))
  398    D SET(XLN _XSP_"DOS:  "_TDOS_XS P1_"Rx/Fil l/Release  Status: "_ TRX) Q:IBQ UIT
  399    D SET("-- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --------")  Q:IBQUIT
  400    D:$D(IBSP L)>1 Q:IBQ UIT  ; Thi s EEOB was  split dis play split  payment i nformation
  401    . N SPL
  402    . D SET(" ** A/R COR RECTED PAY MENT DATA: ") Q:IBQUI T
  403    . D SET("  TOTAL AMT  PD: "_$J( IBEOB(361. 1,IBEIEN_" ,",1.01,"E "),9,2)) Q :IBQUIT
  404    . S SPL=" " F  S SPL =$O(IBSPL( 361.18,SPL )) Q:SPL=" "  D  Q:IB QUIT
  405    .. D SET( " "_$S(IBS PL(361.18, SPL,.03,"I ")'="":$$B N1^PRCAFN( IBSPL(361. 18,SPL,.03 ,"I"))_$J( "",8),1:"[ suspense]  "_IBSPL(36 1.18,SPL,. 01,"E"))_"  "_$J(IBSP L(361.18,S PL,.02,"E" ),9,2)) Q: IBQUIT
  406    . D SET("  ") Q:IBQU IT
  407    D SET("CL AIM LEVEL  PAY STATUS :") Q:IBQU IT
  408    D SET(" T otal Submi tted Charg es :"_$J($ G(IBEOB("3 61.1",IBEI EN_",","2. 04","E")), 11,2)_" Pa yer Covere d Amount : "_$J($G(IB EOB("361.1 ",IBEIEN_" ,","1.03", "E")),11,2 )) Q:IBQUI T
  409    D SET(" P ayer Paid  Amount :"_ $J($G(IBEO B("361.1", IBEIEN_"," ,"1.01","E ")),11,2)_ " MEDICARE  Allowed A mount :"_$ J($G(IBEOB ("361.1",I BEIEN_",", "2.03","E" )),11,2))  Q:IBQUIT
  410    D SET(" P atient Res ponsibilit y :"_$J($G (IBEOB("36 1.1",IBEIE N_",","1.0 2","E")),1 1,2))_ " %  Collected  :"_$J(+IB COL,11,0)_ ”%” Q:IBQU IT
  411  
  412    D SET("-- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --------")  Q:IBQUIT
  413    D SET("CL AIM LEVEL  ADJUSTMENT S:") Q:IBQ UIT
  414    S AA="",A CNT=0 F  S  AA=$O(IBG X(361.11,A A)) Q:AA=" "  S ACNT= ACNT+1,AQ= "" D  Q:IB QUIT
  415    . S CC=AA  F  S CC=$ O(IBGX(361 .111,CC))  Q:$E(CC,1, $L(AA))'=A A  D  Q:IB QUIT
  416    .. I AQ=" " S AQ=$J( ACNT,3)_")  "