EPAYMENTS_5010.KID

KIDS Distribution saved on Jul 01, 2011@16:28:58
ePayments 5010 TEST v13 - 07/01/11
**KIDS**:PRCA IB BUNDLE 1.0^IB*2.0*431^PRCA*4.5*269^

**INSTALL NAME**
PRCA IB BUNDLE 1.0
"BLD",8137,0)
PRCA IB BUNDLE 1.0^^1^3110701^y
"BLD",8137,1,0)
^^7^7^3100820^
"BLD",8137,1,1,0)
This multi-build distribution includes changes to ePayments application
"BLD",8137,1,2,0)
(formerly EDI Lockbox) to meet the new standard for X12 835 interface
"BLD",8137,1,3,0)
required by the Healthcare Insurance Portability and Accountability Act 
"BLD",8137,1,4,0)
(HIPAA) version 5010.
"BLD",8137,1,5,0)
  
"BLD",8137,1,6,0)
Two patches will be released in a KIDS multi-build distribution 
"BLD",8137,1,7,0)
containing: IB*2*431 and PRCA*4.5*269.
"BLD",8137,6.3)
69
"BLD",8137,10,0)
^9.63^1^2
"BLD",8137,10,1,0)
IB*2.0*431^1
"BLD",8137,10,2,0)
PRCA*4.5*269^1
"BLD",8137,10,"B","IB*2.0*431",1)

"BLD",8137,10,"B","PRCA*4.5*269",2)

"BLD",8137,"KRN",0)
^9.67PA
"MBREQ")
0
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"VER")
8.0^22.0
**INSTALL NAME**
IB*2.0*431
"BLD",8057,0)
IB*2.0*431^INTEGRATED BILLING^0^3110701^y
"BLD",8057,1,0)
^^1^1^3100609^
"BLD",8057,1,1,0)
FMS 5010 CHANGES
"BLD",8057,4,0)
^9.64PA^361.1^1
"BLD",8057,4,361.1,0)
361.1
"BLD",8057,4,361.1,2,0)
^9.641^361.11512^2
"BLD",8057,4,361.1,2,361.1,0)
EXPLANATION OF BENEFITS  (File-top level)
"BLD",8057,4,361.1,2,361.1,1,0)
^9.6411^25.06^12
"BLD",8057,4,361.1,2,361.1,1,.07,0)
TRACE NUMBER
"BLD",8057,4,361.1,2,361.1,1,.08,0)
CROSSED OVER NAME
"BLD",8057,4,361.1,2,361.1,1,.14,0)
ICN
"BLD",8057,4,361.1,2,361.1,1,1.12,0)
CLAIM RECEIVED DATE
"BLD",8057,4,361.1,2,361.1,1,1.13,0)
COVERAGE EXPIRATION DATE
"BLD",8057,4,361.1,2,361.1,1,1.14,0)
CORRECTED PRIORITY PAYER NAME
"BLD",8057,4,361.1,2,361.1,1,1.15,0)
CORRECTED PRIORITY PAYER TYPE
"BLD",8057,4,361.1,2,361.1,1,1.16,0)
CORRECTED PRIORITY PAYER ID
"BLD",8057,4,361.1,2,361.1,1,1.17,0)
OTHER SUBSCRIBER NAME
"BLD",8057,4,361.1,2,361.1,1,25.02,0)
CONTACT NUMBER 1
"BLD",8057,4,361.1,2,361.1,1,25.04,0)
CONTACT NUMBER 2
"BLD",8057,4,361.1,2,361.1,1,25.06,0)
CONTACT NUMBER 3
"BLD",8057,4,361.1,2,361.11512,0)
PAYER POLICY REFERENCE  (sub-file)
"BLD",8057,4,361.1,2,361.11512,1,0)
^9.6411^^
"BLD",8057,4,361.1,222)
y^y^p^^^^n^^n
"BLD",8057,4,361.1,224)

"BLD",8057,4,"APDD",361.1,361.1)

"BLD",8057,4,"APDD",361.1,361.1,.07)

"BLD",8057,4,"APDD",361.1,361.1,.08)

"BLD",8057,4,"APDD",361.1,361.1,.14)

"BLD",8057,4,"APDD",361.1,361.1,1.12)

"BLD",8057,4,"APDD",361.1,361.1,1.13)

"BLD",8057,4,"APDD",361.1,361.1,1.14)

"BLD",8057,4,"APDD",361.1,361.1,1.15)

"BLD",8057,4,"APDD",361.1,361.1,1.16)

"BLD",8057,4,"APDD",361.1,361.1,1.17)

"BLD",8057,4,"APDD",361.1,361.1,25.02)

"BLD",8057,4,"APDD",361.1,361.1,25.04)

"BLD",8057,4,"APDD",361.1,361.1,25.06)

"BLD",8057,4,"APDD",361.1,361.11512)

"BLD",8057,4,"B",361.1,361.1)

"BLD",8057,6.3)
106
"BLD",8057,"ABPKG")
n
"BLD",8057,"INIT")
POST^IBP431
"BLD",8057,"KRN",0)
^9.67PA^779.2^20
"BLD",8057,"KRN",.4,0)
.4
"BLD",8057,"KRN",.4,"NM",0)
^9.68A^^
"BLD",8057,"KRN",.401,0)
.401
"BLD",8057,"KRN",.402,0)
.402
"BLD",8057,"KRN",.403,0)
.403
"BLD",8057,"KRN",.5,0)
.5
"BLD",8057,"KRN",.84,0)
.84
"BLD",8057,"KRN",3.6,0)
3.6
"BLD",8057,"KRN",3.8,0)
3.8
"BLD",8057,"KRN",9.2,0)
9.2
"BLD",8057,"KRN",9.8,0)
9.8
"BLD",8057,"KRN",9.8,"NM",0)
^9.68A^12^11
"BLD",8057,"KRN",9.8,"NM",1,0)
IBP431^^0^B8517081
"BLD",8057,"KRN",9.8,"NM",2,0)
IBCEOB^^0^B81821331
"BLD",8057,"KRN",9.8,"NM",3,0)
IBCEOB0^^0^B83008311
"BLD",8057,"KRN",9.8,"NM",4,0)
IBCEOB00^^0^B76540225
"BLD",8057,"KRN",9.8,"NM",5,0)
IBCE835^^0^B40332409
"BLD",8057,"KRN",9.8,"NM",6,0)
IBCE835A^^0^B9804553
"BLD",8057,"KRN",9.8,"NM",8,0)
IBCECSA6^^0^B133569108
"BLD",8057,"KRN",9.8,"NM",9,0)
IBCEMRAA^^0^B59972826
"BLD",8057,"KRN",9.8,"NM",10,0)
IBJTTC^^0^B51819511
"BLD",8057,"KRN",9.8,"NM",11,0)
IBCEOB1^^0^B69809131
"BLD",8057,"KRN",9.8,"NM",12,0)
IBCEMRAB^^0^B49859211
"BLD",8057,"KRN",9.8,"NM","B","IBCE835",5)

"BLD",8057,"KRN",9.8,"NM","B","IBCE835A",6)

"BLD",8057,"KRN",9.8,"NM","B","IBCECSA6",8)

"BLD",8057,"KRN",9.8,"NM","B","IBCEMRAA",9)

"BLD",8057,"KRN",9.8,"NM","B","IBCEMRAB",12)

"BLD",8057,"KRN",9.8,"NM","B","IBCEOB",2)

"BLD",8057,"KRN",9.8,"NM","B","IBCEOB0",3)

"BLD",8057,"KRN",9.8,"NM","B","IBCEOB00",4)

"BLD",8057,"KRN",9.8,"NM","B","IBCEOB1",11)

"BLD",8057,"KRN",9.8,"NM","B","IBJTTC",10)

"BLD",8057,"KRN",9.8,"NM","B","IBP431",1)

"BLD",8057,"KRN",19,0)
19
"BLD",8057,"KRN",19.1,0)
19.1
"BLD",8057,"KRN",101,0)
101
"BLD",8057,"KRN",409.61,0)
409.61
"BLD",8057,"KRN",771,0)
771
"BLD",8057,"KRN",779.2,0)
779.2
"BLD",8057,"KRN",870,0)
870
"BLD",8057,"KRN",8989.51,0)
8989.51
"BLD",8057,"KRN",8989.52,0)
8989.52
"BLD",8057,"KRN",8994,0)
8994
"BLD",8057,"KRN","B",.4,.4)

"BLD",8057,"KRN","B",.401,.401)

"BLD",8057,"KRN","B",.402,.402)

"BLD",8057,"KRN","B",.403,.403)

"BLD",8057,"KRN","B",.5,.5)

"BLD",8057,"KRN","B",.84,.84)

"BLD",8057,"KRN","B",3.6,3.6)

"BLD",8057,"KRN","B",3.8,3.8)

"BLD",8057,"KRN","B",9.2,9.2)

"BLD",8057,"KRN","B",9.8,9.8)

"BLD",8057,"KRN","B",19,19)

"BLD",8057,"KRN","B",19.1,19.1)

"BLD",8057,"KRN","B",101,101)

"BLD",8057,"KRN","B",409.61,409.61)

"BLD",8057,"KRN","B",771,771)

"BLD",8057,"KRN","B",779.2,779.2)

"BLD",8057,"KRN","B",870,870)

"BLD",8057,"KRN","B",8989.51,8989.51)

"BLD",8057,"KRN","B",8989.52,8989.52)

"BLD",8057,"KRN","B",8994,8994)

"BLD",8057,"QUES",0)
^9.62^^
"BLD",8057,"REQB",0)
^9.611^7^3
"BLD",8057,"REQB",4,0)
IB*2.0*407^2
"BLD",8057,"REQB",6,0)
IB*2.0*417^2
"BLD",8057,"REQB",7,0)
IB*2.0*400^2
"BLD",8057,"REQB","B","IB*2.0*400",7)

"BLD",8057,"REQB","B","IB*2.0*407",4)

"BLD",8057,"REQB","B","IB*2.0*417",6)

"FIA",361.1)
EXPLANATION OF BENEFITS
"FIA",361.1,0)
^IBM(361.1,
"FIA",361.1,0,0)
361.1PI
"FIA",361.1,0,1)
y^y^p^^^^n^^n
"FIA",361.1,0,10)

"FIA",361.1,0,11)

"FIA",361.1,0,"RLRO")

"FIA",361.1,0,"VR")
2.0^IB
"FIA",361.1,361.1)
1
"FIA",361.1,361.1,.07)

"FIA",361.1,361.1,.08)

"FIA",361.1,361.1,.14)

"FIA",361.1,361.1,1.12)

"FIA",361.1,361.1,1.13)

"FIA",361.1,361.1,1.14)

"FIA",361.1,361.1,1.15)

"FIA",361.1,361.1,1.16)

"FIA",361.1,361.1,1.17)

"FIA",361.1,361.1,25.02)

"FIA",361.1,361.1,25.04)

"FIA",361.1,361.1,25.06)

"FIA",361.1,361.1151)
1
"FIA",361.1,361.1151,2)

"FIA",361.1,361.11512)
0
"INIT")
POST^IBP431
"IX",361.1,361.1,"ATRID",0)
361.1^ATRID^Xref by bank trace # and ins co id for uniqueness^R^^R^IR^I^361.1^^^^^S
"IX",361.1,361.1,"ATRID",1)
S ^IBM(361.1,"ATRID",$E(X(1),1,50),$E(X(2),1,30),DA)=""
"IX",361.1,361.1,"ATRID",1.4)
I 'X(3)
"IX",361.1,361.1,"ATRID",2)
K ^IBM(361.1,"ATRID",$E(X(1),1,50),$E(X(2),1,30),DA)
"IX",361.1,361.1,"ATRID",2.5)
K ^IBM(361.1,"ATRID")
"IX",361.1,361.1,"ATRID",11.1,0)
^.114IA^3^3
"IX",361.1,361.1,"ATRID",11.1,1,0)
1^F^361.1^.07^50^1^F
"IX",361.1,361.1,"ATRID",11.1,1,3)

"IX",361.1,361.1,"ATRID",11.1,2,0)
2^F^361.1^.03^30^2^F
"IX",361.1,361.1,"ATRID",11.1,2,3)

"IX",361.1,361.1,"ATRID",11.1,3,0)
3^F^361.1^.04^^^F
"IX",361.1,361.1,"ATRID",11.1,3,3)

"MBREQ")
1
"PKG",200,-1)
1^1
"PKG",200,0)
INTEGRATED BILLING^IB^INTEGRATED BILLING
"PKG",200,20,0)
^9.402P^1^1
"PKG",200,20,1,0)
2^^IBAXDR
"PKG",200,20,1,1)

"PKG",200,20,"B",2,1)

"PKG",200,22,0)
^9.49I^1^1
"PKG",200,22,1,0)
2.0^2940321^2990406^2447
"PKG",200,22,1,"PAH",1,0)
431^3110701^123457061
"PKG",200,22,1,"PAH",1,1,0)
^^1^1^3110701
"PKG",200,22,1,"PAH",1,1,1,0)
FMS 5010 CHANGES
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
11
"RTN","IBCE835")
0^5^B40332409
"RTN","IBCE835",1,0)
IBCE835 ;ALB/TMP/PJH - 835 EDI EXPLANATION OF BENEFITS MSG PROCESSING ; 7/15/10 4:40pm
"RTN","IBCE835",2,0)
 ;;2.0;INTEGRATED BILLING;**137,135,155,377,431**;21-MAR-94;Build 106
"RTN","IBCE835",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCE835",4,0)
 ;
"RTN","IBCE835",5,0)
 Q
"RTN","IBCE835",6,0)
 ;
"RTN","IBCE835",7,0)
 ; MESSAGE HEADER DATA STRING =
"RTN","IBCE835",8,0)
 ;   type of message^msg queue^msg #^bill #^^date/time
"RTN","IBCE835",9,0)
 ;
"RTN","IBCE835",10,0)
HDR(IBCLNO,IBD) ;Process header data
"RTN","IBCE835",11,0)
 ; INPUT:
"RTN","IBCE835",12,0)
 ;   IBCLNO = claim #
"RTN","IBCE835",13,0)
 ;
"RTN","IBCE835",14,0)
 ;   ^TMP("IBMSGH",$J,0) = header message text
"RTN","IBCE835",15,0)
 ;
"RTN","IBCE835",16,0)
 ; OUTPUT:
"RTN","IBCE835",17,0)
 ;   IBD array returned with processed data
"RTN","IBCE835",18,0)
 ;      "LINE"  = The last line # populated in the message
"RTN","IBCE835",19,0)
 ;      "DATE"  = Date/Time of EOB (Fileman format)
"RTN","IBCE835",20,0)
 ;      "MRA"   = 1 if MRA, 0 if not
"RTN","IBCE835",21,0)
 ;      "X12"   = 1 if X12, 0 if not
"RTN","IBCE835",22,0)
 ;
"RTN","IBCE835",23,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,0)=MESSAGE HEADER DATA STRING
"RTN","IBCE835",24,0)
 ;                                  ,"D",0,1)=header record raw data
"RTN","IBCE835",25,0)
 ;                                  ,"D1",1,0)=header record raw data
"RTN","IBCE835",26,0)
 ;                                  ,line #)=EOB message lines
"RTN","IBCE835",27,0)
 ;
"RTN","IBCE835",28,0)
 N CT,IB399,IBD0,IBBILL,LINE,L,X,Y,Z,%DT
"RTN","IBCE835",29,0)
 S IBD0=$G(^TMP("IBMSGH",$J,0)),IBD("LINE")=0
"RTN","IBCE835",30,0)
 Q:IBD0=""
"RTN","IBCE835",31,0)
 S X=$P(IBD0,U,3),X=$E(X,5,8)_$E(X,1,4)_"@"_$P(IBD0,U,4)
"RTN","IBCE835",32,0)
 I X S %DT="XTS" D ^%DT
"RTN","IBCE835",33,0)
 S IBD("DATE")=$S(Y>0:Y,1:"")
"RTN","IBCE835",34,0)
 S IBD("MRA")=$P(IBD0,U,5)
"RTN","IBCE835",35,0)
 S IBD("X12")=($P(IBD0,U,2)="X")
"RTN","IBCE835",36,0)
 S CT=0
"RTN","IBCE835",37,0)
 ;
"RTN","IBCE835",38,0)
 I $P(IBD0,U,6)'="" S CT=CT+1 S LINE(CT)=$G(LINE(CT))_"Payer Name: "_$P(IBD0,U,6)
"RTN","IBCE835",39,0)
 ;
"RTN","IBCE835",40,0)
 I CT D
"RTN","IBCE835",41,0)
 . S (L,Z)=0
"RTN","IBCE835",42,0)
 . F  S Z=$O(LINE(Z)) Q:'Z  S L=L+1,^TMP("IBMSG",$J,"CLAIM",IBCLNO,L)=LINE(Z)
"RTN","IBCE835",43,0)
 . S IBD("LINE")=IBD("LINE")+CT
"RTN","IBCE835",44,0)
 ;
"RTN","IBCE835",45,0)
 S IB399=+$O(^DGCR(399,"B",$$GETCLM^IBCE277(IBCLNO),""),-1)
"RTN","IBCE835",46,0)
 ;
"RTN","IBCE835",47,0)
 S IBBILL=$$LAST364^IBCEF4(IB399)
"RTN","IBCE835",48,0)
 ;
"RTN","IBCE835",49,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLNO,0)="835EOB"_U_$G(IBD("MSG#"))_U_$G(IBD("SUBJ"))_U_IBBILL_U_U_IBD("DATE")
"RTN","IBCE835",50,0)
 ;
"RTN","IBCE835",51,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLNO,"D",0,1)="##RAW DATA: "_IBD0
"RTN","IBCE835",52,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLNO,"D1",1,0)="##RAW DATA: "_IBD0
"RTN","IBCE835",53,0)
 Q
"RTN","IBCE835",54,0)
 ;
"RTN","IBCE835",55,0)
5(IBD) ; Process claim patient ID data
"RTN","IBCE835",56,0)
 ; INPUT:
"RTN","IBCE835",57,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835",58,0)
 ;
"RTN","IBCE835",59,0)
 ; OUTPUT:
"RTN","IBCE835",60,0)
 ;   IBD array
"RTN","IBCE835",61,0)
 ;      "LINE" = the last line # populated in the message
"RTN","IBCE835",62,0)
 ;
"RTN","IBCE835",63,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,line#)=claim pt id message lines
"RTN","IBCE835",64,0)
 ;                                  ,"D",5,msg seq #)=
"RTN","IBCE835",65,0)
 ;                                  ,"D1",msg seq #,5)=
"RTN","IBCE835",66,0)
 ;                                       claim pt id message raw data
"RTN","IBCE835",67,0)
 ;
"RTN","IBCE835",68,0)
 N IBBILL
"RTN","IBCE835",69,0)
 S IBBILL=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835",70,0)
 ;
"RTN","IBCE835",71,0)
 I '$D(^TMP("IBMSG",$J,"CLAIM",IBBILL)) D HDR(IBBILL,.IBD) ;Process header data if not already done for claim
"RTN","IBCE835",72,0)
 ;
"RTN","IBCE835",73,0)
 I $P(IBD,U,9) D  ;Statement dates
"RTN","IBCE835",74,0)
 . S IBD("LINE")=$G(IBD("LINE"))+1
"RTN","IBCE835",75,0)
 . S ^TMP("IBMSG",$J,"CLAIM",IBBILL,IBD("LINE"))="Statement Dates: "_$$DATE^IBCE277($P(IBD,U,9))_" - "_$$DATE^IBCE277($P(IBD,U,10))
"RTN","IBCE835",76,0)
 ;
"RTN","IBCE835",77,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBBILL,"D",5,1)="##RAW DATA: "_IBD
"RTN","IBCE835",78,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBBILL,"D1",1,5)="##RAW DATA: "_IBD
"RTN","IBCE835",79,0)
 Q
"RTN","IBCE835",80,0)
 ;
"RTN","IBCE835",81,0)
6(IBD) ; Process 06 record type for corrected name and/or ID# - IB*2*377 - 1/14/08
"RTN","IBCE835",82,0)
 NEW IBCLM,Z
"RTN","IBCE835",83,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835",84,0)
 Q:IBCLM=""
"RTN","IBCE835",85,0)
 I '$D(^TMP("IBMSG",$J,"CLAIM",IBCLM)) D HDR(IBCLM,.IBD)   ;Process header data if not already done for claim
"RTN","IBCE835",86,0)
 ;
"RTN","IBCE835",87,0)
 S Z=$G(IBD("LINE"))
"RTN","IBCE835",88,0)
 I $P(IBD,U,3)'="" S Z=Z+1,^TMP("IBMSG",$J,"CLAIM",IBCLM,Z)="Corrected Patient Last Name: "_$P(IBD,U,3)
"RTN","IBCE835",89,0)
 I $P(IBD,U,4)'="" S Z=Z+1,^TMP("IBMSG",$J,"CLAIM",IBCLM,Z)="Corrected Patient First Name: "_$P(IBD,U,4)
"RTN","IBCE835",90,0)
 I $P(IBD,U,5)'="" S Z=Z+1,^TMP("IBMSG",$J,"CLAIM",IBCLM,Z)="Corrected Patient Middle Name: "_$P(IBD,U,5)
"RTN","IBCE835",91,0)
 I $P(IBD,U,6)'="" S Z=Z+1,^TMP("IBMSG",$J,"CLAIM",IBCLM,Z)="Corrected Patient ID#: "_$P(IBD,U,6)
"RTN","IBCE835",92,0)
 S IBD("LINE")=Z
"RTN","IBCE835",93,0)
 ;
"RTN","IBCE835",94,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",6,1)="##RAW DATA: "_IBD
"RTN","IBCE835",95,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",1,6)="##RAW DATA: "_IBD
"RTN","IBCE835",96,0)
 Q
"RTN","IBCE835",97,0)
 ;
"RTN","IBCE835",98,0)
10(IBD) ; Process claim status data
"RTN","IBCE835",99,0)
 ; INPUT:
"RTN","IBCE835",100,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835",101,0)
 ;
"RTN","IBCE835",102,0)
 ; OUTPUT:
"RTN","IBCE835",103,0)
 ;   IBD array returned with processed data
"RTN","IBCE835",104,0)
 ;      "CLAIM" = The claim #
"RTN","IBCE835",105,0)
 ;      "LINE" = The last line # populated in the message
"RTN","IBCE835",106,0)
 ;
"RTN","IBCE835",107,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,line#)=claim status message lines
"RTN","IBCE835",108,0)
 ;                                  ,"D",10,msg seq #)=
"RTN","IBCE835",109,0)
 ;                                  ,"D1",msg seq #,10)=
"RTN","IBCE835",110,0)
 ;                                       claim status raw data
"RTN","IBCE835",111,0)
 ;
"RTN","IBCE835",112,0)
 N IBCLM,CT,LINE,L,Z,Z0,IBDATA,IBSTAT
"RTN","IBCE835",113,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835",114,0)
 Q:IBCLM=""
"RTN","IBCE835",115,0)
 ;
"RTN","IBCE835",116,0)
 I '$D(^TMP("IBMSG",$J,"CLAIM",IBCLM)) D HDR(IBCLM,.IBD) ;Process header data if not already done for claim
"RTN","IBCE835",117,0)
 ;
"RTN","IBCE835",118,0)
 S CT=0
"RTN","IBCE835",119,0)
 F Z=3:1:6 I $P(IBD,U,Z)="Y" D  Q  ;Claim status
"RTN","IBCE835",120,0)
 . S IBSTAT=(Z-2)
"RTN","IBCE835",121,0)
 . S CT=CT+1,LINE(CT)="CLAIM STATUS: "_$P("PROCESSED^DENIED^PENDED^REVERSAL",U,IBSTAT)
"RTN","IBCE835",122,0)
 I '$G(IBSTAT) D
"RTN","IBCE835",123,0)
 . S CT=CT+1,LINE(CT)="CLAIM STATUS: "_$P(IBD,U,7)_" (OTHER)"
"RTN","IBCE835",124,0)
 ;
"RTN","IBCE835",125,0)
 I $P(IBD,U,8)'="" D  ;Crossed over info
"RTN","IBCE835",126,0)
 . S CT=CT+1,LINE(CT)="Crossed over to: "_$P(IBD,U,9)_"  "_$P(IBD,U,8)
"RTN","IBCE835",127,0)
 ;
"RTN","IBCE835",128,0)
 I CT D
"RTN","IBCE835",129,0)
 . S L=$G(IBD("LINE")),Z=0
"RTN","IBCE835",130,0)
 . F  S Z=$O(LINE(Z)) Q:'Z  S L=L+1,^TMP("IBMSG",$J,"CLAIM",IBCLM,L)=LINE(Z)
"RTN","IBCE835",131,0)
 . S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",10,1)="##RAW DATA: "_IBD
"RTN","IBCE835",132,0)
 . S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",1,10)="##RAW DATA: "_IBD
"RTN","IBCE835",133,0)
 . S IBD("LINE")=$G(IBD("LINE"))+CT
"RTN","IBCE835",134,0)
 Q
"RTN","IBCE835",135,0)
 ;
"RTN","IBCE835",136,0)
15(IBD) ; Process claim status data
"RTN","IBCE835",137,0)
 ; INPUT:
"RTN","IBCE835",138,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835",139,0)
 ;
"RTN","IBCE835",140,0)
 ; OUTPUT:
"RTN","IBCE835",141,0)
 ;   IBD array
"RTN","IBCE835",142,0)
 ;      "LINE" = The last line # populated in the message
"RTN","IBCE835",143,0)
 ;
"RTN","IBCE835",144,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D",15,msg seq #)=
"RTN","IBCE835",145,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D1",msg seq #,15)=
"RTN","IBCE835",146,0)
 ;                                       claim status raw data
"RTN","IBCE835",147,0)
 ;
"RTN","IBCE835",148,0)
 N IBCLM,Z,Z0,IBDATA
"RTN","IBCE835",149,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835",150,0)
 Q:IBCLM=""
"RTN","IBCE835",151,0)
 ;
"RTN","IBCE835",152,0)
 I '$D(^TMP("IBMSG",$J,"CLAIM",IBCLM)) D HDR(IBCLM,.IBD) ;Process header data if not already done for claim
"RTN","IBCE835",153,0)
 ;
"RTN","IBCE835",154,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",15,1)="##RAW DATA: "_IBD
"RTN","IBCE835",155,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",1,15)="##RAW DATA: "_IBD
"RTN","IBCE835",156,0)
 Q
"RTN","IBCE835",157,0)
 ;
"RTN","IBCE835",158,0)
20(IBD) ; Process claim level adjustment data
"RTN","IBCE835",159,0)
 ; Claim must have been referenced by a previous '05' level
"RTN","IBCE835",160,0)
 ;
"RTN","IBCE835",161,0)
 ; INPUT:
"RTN","IBCE835",162,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835",163,0)
 ;
"RTN","IBCE835",164,0)
 ; OUTPUT:
"RTN","IBCE835",165,0)
 ;    IBD("LINE") = The last line # populated in the message
"RTN","IBCE835",166,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,line #)=claim level adjustment
"RTN","IBCE835",167,0)
 ;                                  ,"D",20,seq#)=
"RTN","IBCE835",168,0)
 ;                                  ,"D1",seq#,20)=
"RTN","IBCE835",169,0)
 ;                                          claim level adjust. raw data
"RTN","IBCE835",170,0)
 ;
"RTN","IBCE835",171,0)
 N IBCLM
"RTN","IBCE835",172,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835",173,0)
 Q:'$D(^TMP("IBMSG",$J,"CLAIM",IBCLM))
"RTN","IBCE835",174,0)
 S IBD("LINE")=$G(IBD("LINE"))+1
"RTN","IBCE835",175,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,IBD("LINE"))="ADJUSTMENT GROUP: "_$P(IBD,U,3)_"  QTY: "_+$P(IBD,U,6)_", AMT: "_($P(IBD,U,5)/100)
"RTN","IBCE835",176,0)
 S IBD("LINE")=IBD("LINE")+1
"RTN","IBCE835",177,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,IBD("LINE"))="   REASON: ("_$P(IBD,U,4)_")  "_$P(IBD,U,7)
"RTN","IBCE835",178,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",20,IBD("LINE"))="##RAW DATA: "_IBD
"RTN","IBCE835",179,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",IBD("LINE"),20)="##RAW DATA: "_IBD
"RTN","IBCE835",180,0)
 Q
"RTN","IBCE835",181,0)
 ;
"RTN","IBCE835",182,0)
37(IBD) ; Process claim level adjustment data for Inpatient MEDICARE
"RTN","IBCE835",183,0)
 D 37^IBCE835A(.IBD)
"RTN","IBCE835",184,0)
 Q
"RTN","IBCE835",185,0)
 ;
"RTN","IBCE835",186,0)
40(IBD) ; Process service line data
"RTN","IBCE835",187,0)
 D 40^IBCE835A(.IBD)
"RTN","IBCE835",188,0)
 Q
"RTN","IBCE835",189,0)
 ;
"RTN","IBCE835",190,0)
45(IBD) ; Process service line adjustment data
"RTN","IBCE835",191,0)
 D 45^IBCE835A(.IBD)
"RTN","IBCE835",192,0)
 Q
"RTN","IBCE835",193,0)
 ;
"RTN","IBCE835",194,0)
11(IBD) ; Process claim status rendering provider data segment
"RTN","IBCE835",195,0)
 D XX(.IBD,11)
"RTN","IBCE835",196,0)
 Q
"RTN","IBCE835",197,0)
 ;
"RTN","IBCE835",198,0)
12(IBD) ; Process claim status corrected priority payer data segment
"RTN","IBCE835",199,0)
 D XX(.IBD,12)
"RTN","IBCE835",200,0)
 Q
"RTN","IBCE835",201,0)
 ;
"RTN","IBCE835",202,0)
13(IBD) ; Process claim status other subscriber data segment
"RTN","IBCE835",203,0)
 D XX(.IBD,13)
"RTN","IBCE835",204,0)
 Q
"RTN","IBCE835",205,0)
 ;
"RTN","IBCE835",206,0)
17(IBD) ; Process claim contact data segment
"RTN","IBCE835",207,0)
 D XX(.IBD,17)
"RTN","IBCE835",208,0)
 Q
"RTN","IBCE835",209,0)
 ;
"RTN","IBCE835",210,0)
30(IBD) ; Process MEDICARE inpatient adjudication data (part 1)
"RTN","IBCE835",211,0)
 D XX(.IBD,30)
"RTN","IBCE835",212,0)
 Q
"RTN","IBCE835",213,0)
 ;
"RTN","IBCE835",214,0)
35(IBD) ; Process MEDICARE inpatient adjudication data (part 2)
"RTN","IBCE835",215,0)
 D XX(.IBD,35)
"RTN","IBCE835",216,0)
 Q
"RTN","IBCE835",217,0)
 ;
"RTN","IBCE835",218,0)
41(IBD) ; Process service line data (part 2)
"RTN","IBCE835",219,0)
 D XX(.IBD,41)
"RTN","IBCE835",220,0)
 Q
"RTN","IBCE835",221,0)
 ;
"RTN","IBCE835",222,0)
42(IBD) ; Process service line data (part 3)
"RTN","IBCE835",223,0)
 D XX(.IBD,42)
"RTN","IBCE835",224,0)
 Q
"RTN","IBCE835",225,0)
 ;
"RTN","IBCE835",226,0)
46(IBD) ; Process Adjustment Policy Reference segment
"RTN","IBCE835",227,0)
 D 46^IBCE835A(.IBD)
"RTN","IBCE835",228,0)
 Q
"RTN","IBCE835",229,0)
 ;
"RTN","IBCE835",230,0)
99(IBD) ; Process trailer record for non-MRA EOB
"RTN","IBCE835",231,0)
 D XX(.IBD,99)
"RTN","IBCE835",232,0)
 Q
"RTN","IBCE835",233,0)
 ;
"RTN","IBCE835",234,0)
XX(IBD,IBID) ; Store non-displayed data nodes in TMP array
"RTN","IBCE835",235,0)
 ;
"RTN","IBCE835",236,0)
 ; INPUT:
"RTN","IBCE835",237,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835",238,0)
 ;   IBID = record id for generic store
"RTN","IBCE835",239,0)
 ;
"RTN","IBCE835",240,0)
 ; OUTPUT:
"RTN","IBCE835",241,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D",IBID,msg seq #)=
"RTN","IBCE835",242,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D1",msg seq #,IBID)=
"RTN","IBCE835",243,0)
 ;                                       claim status raw data
"RTN","IBCE835",244,0)
 ;    IBD("LINE") = The last line # populated in the message
"RTN","IBCE835",245,0)
 ;
"RTN","IBCE835",246,0)
 N IBCLM
"RTN","IBCE835",247,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835",248,0)
 ;
"RTN","IBCE835",249,0)
 S IBD("LINE")=$G(IBD("LINE"))+1
"RTN","IBCE835",250,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",IBID,IBD("LINE"))="##RAW DATA: "_IBD
"RTN","IBCE835",251,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",IBD("LINE"),IBID)="##RAW DATA: "_IBD
"RTN","IBCE835",252,0)
 ;
"RTN","IBCE835",253,0)
 Q
"RTN","IBCE835",254,0)
 ;
"RTN","IBCE835A")
0^6^B9804553
"RTN","IBCE835A",1,0)
IBCE835A ;ALB/ESG/PJH - 835 EDI EOB PROCESSING CONTINUED ; 7/15/10 7:02pm
"RTN","IBCE835A",2,0)
 ;;2.0;INTEGRATED BILLING;**135,431**;21-MAR-94;Build 106
"RTN","IBCE835A",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCE835A",4,0)
 Q
"RTN","IBCE835A",5,0)
 ; Continue processing of IBCE835 since that routine grew too large
"RTN","IBCE835A",6,0)
 ;
"RTN","IBCE835A",7,0)
37(IBD) ; Process claim level adjustment data for Inpatient MEDICARE
"RTN","IBCE835A",8,0)
 ; Claim must have been referenced by a previous '05' level
"RTN","IBCE835A",9,0)
 ;
"RTN","IBCE835A",10,0)
 ; INPUT:
"RTN","IBCE835A",11,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835A",12,0)
 ;
"RTN","IBCE835A",13,0)
 ; OUTPUT:
"RTN","IBCE835A",14,0)
 ;    IBD("LINE") = The last line # populated in the message
"RTN","IBCE835A",15,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,line #)=claim level adjustment msg
"RTN","IBCE835A",16,0)
 ;                                  ,"D",37,seq#)=
"RTN","IBCE835A",17,0)
 ;                                  ,"D1",seq#,37)=
"RTN","IBCE835A",18,0)
 ;                                          claim level adjust. raw data
"RTN","IBCE835A",19,0)
 ;
"RTN","IBCE835A",20,0)
 N IBCLM
"RTN","IBCE835A",21,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835A",22,0)
 Q:'$D(^TMP("IBMSG",$J,"CLAIM",IBCLM))
"RTN","IBCE835A",23,0)
 S IBD("LINE")=$G(IBD("LINE"))+1
"RTN","IBCE835A",24,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,IBD("LINE"))=$S($D(^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",37)):$J("",34),1:"MEDICARE ADJUDICATION MESSAGE(S): ")_"("_$P(IBD,U,4)_")  "_$P(IBD,U,5)
"RTN","IBCE835A",25,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",37,IBD("LINE"))="##RAW DATA: "_IBD
"RTN","IBCE835A",26,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",IBD("LINE"),37)="##RAW DATA: "_IBD
"RTN","IBCE835A",27,0)
 Q
"RTN","IBCE835A",28,0)
 ;
"RTN","IBCE835A",29,0)
40(IBD) ; Process service line data
"RTN","IBCE835A",30,0)
 ;
"RTN","IBCE835A",31,0)
 ; INPUT:
"RTN","IBCE835A",32,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835A",33,0)
 ;
"RTN","IBCE835A",34,0)
 ; OUTPUT:
"RTN","IBCE835A",35,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D",40,msg seq #)=
"RTN","IBCE835A",36,0)
 ;                                   "D1",msg seq #,40)=
"RTN","IBCE835A",37,0)
 ;                                       claim status raw data
"RTN","IBCE835A",38,0)
 ;    IBD("LINE") = The last line # populated in the message
"RTN","IBCE835A",39,0)
 ;
"RTN","IBCE835A",40,0)
 N IBCLM
"RTN","IBCE835A",41,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835A",42,0)
 S IBD("LINE")=$G(IBD("LINE"))+1
"RTN","IBCE835A",43,0)
 ;
"RTN","IBCE835A",44,0)
 I '$D(^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",40)) D
"RTN","IBCE835A",45,0)
 . S ^TMP("IBMSG",$J,"CLAIM",IBCLM,IBD("LINE"))="Line level detail exists for this claim"
"RTN","IBCE835A",46,0)
 . S IBD("LINE")=IBD("LINE")+1
"RTN","IBCE835A",47,0)
 ;
"RTN","IBCE835A",48,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",40,IBD("LINE"))="##RAW DATA: "_IBD
"RTN","IBCE835A",49,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",IBD("LINE"),40)="##RAW DATA: "_IBD
"RTN","IBCE835A",50,0)
 ;
"RTN","IBCE835A",51,0)
 Q
"RTN","IBCE835A",52,0)
 ;
"RTN","IBCE835A",53,0)
45(IBD) ; Process service line adjustment data
"RTN","IBCE835A",54,0)
 ;
"RTN","IBCE835A",55,0)
 ; INPUT:
"RTN","IBCE835A",56,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835A",57,0)
 ;
"RTN","IBCE835A",58,0)
 ; OUTPUT:
"RTN","IBCE835A",59,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D",45,msg seq #)=
"RTN","IBCE835A",60,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D1",msg seq #,45)=
"RTN","IBCE835A",61,0)
 ;                                       claim status raw data
"RTN","IBCE835A",62,0)
 ;    IBD("LINE") = The last line # populated in the message
"RTN","IBCE835A",63,0)
 ;
"RTN","IBCE835A",64,0)
 N IBCLM
"RTN","IBCE835A",65,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835A",66,0)
 S IBD("LINE")=$G(IBD("LINE"))+1
"RTN","IBCE835A",67,0)
 ;
"RTN","IBCE835A",68,0)
 I '$D(^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",45)) D
"RTN","IBCE835A",69,0)
 . S ^TMP("IBMSG",$J,"CLAIM",IBCLM,IBD("LINE"))="Line level adjustments exist for this claim"
"RTN","IBCE835A",70,0)
 . S IBD("LINE")=IBD("LINE")+1
"RTN","IBCE835A",71,0)
 ;
"RTN","IBCE835A",72,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",45,IBD("LINE"))="##RAW DATA: "_IBD
"RTN","IBCE835A",73,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",IBD("LINE"),45)="##RAW DATA: "_IBD
"RTN","IBCE835A",74,0)
 ;
"RTN","IBCE835A",75,0)
 Q
"RTN","IBCE835A",76,0)
 ;
"RTN","IBCE835A",77,0)
46(IBD) ; Process service line adjustment data
"RTN","IBCE835A",78,0)
 ;
"RTN","IBCE835A",79,0)
 ; INPUT:
"RTN","IBCE835A",80,0)
 ;   IBD must be passed by reference = entire message line
"RTN","IBCE835A",81,0)
 ;
"RTN","IBCE835A",82,0)
 ; OUTPUT:
"RTN","IBCE835A",83,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D",46,msg seq #)=
"RTN","IBCE835A",84,0)
 ;   ^TMP("IBMSG",$J,"CLAIM",claim #,"D1",msg seq #,46)=
"RTN","IBCE835A",85,0)
 ;                                       claim status raw data
"RTN","IBCE835A",86,0)
 ;    IBD("LINE") = The last line # populated in the message
"RTN","IBCE835A",87,0)
 ;
"RTN","IBCE835A",88,0)
 N IBCLM
"RTN","IBCE835A",89,0)
 S IBCLM=$$GETCLM^IBCE277($P(IBD,U,2))
"RTN","IBCE835A",90,0)
 S IBD("LINE")=$G(IBD("LINE"))+1
"RTN","IBCE835A",91,0)
 ;
"RTN","IBCE835A",92,0)
 I '$D(^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",46)) D
"RTN","IBCE835A",93,0)
 . S ^TMP("IBMSG",$J,"CLAIM",IBCLM,IBD("LINE"))="Line level adjustments exist for this claim"
"RTN","IBCE835A",94,0)
 . S IBD("LINE")=IBD("LINE")+1
"RTN","IBCE835A",95,0)
 ;
"RTN","IBCE835A",96,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D",46,IBD("LINE"))="##RAW DATA: "_IBD
"RTN","IBCE835A",97,0)
 S ^TMP("IBMSG",$J,"CLAIM",IBCLM,"D1",IBD("LINE"),46)="##RAW DATA: "_IBD
"RTN","IBCE835A",98,0)
 ;
"RTN","IBCE835A",99,0)
 Q
"RTN","IBCECSA6")
0^8^B133569108
"RTN","IBCECSA6",1,0)
IBCECSA6 ;ALB/CXW/PJH - VIEW EOB SCREEN ; 4/25/11 5:23pm
"RTN","IBCECSA6",2,0)
 ;;2.0;INTEGRATED BILLING;**137,135,155,417,431**;21-MAR-1994;Build 106
"RTN","IBCECSA6",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCECSA6",4,0)
 ;
"RTN","IBCECSA6",5,0)
BLD ;build EOB data display
"RTN","IBCECSA6",6,0)
 D GETEOB(IBCNT,0)
"RTN","IBCECSA6",7,0)
 Q
"RTN","IBCECSA6",8,0)
 ;
"RTN","IBCECSA6",9,0)
GETEOB(IBCNT,IBSRC,IBFULL,IBJTIBLN) ; Get EOB data in display format
"RTN","IBCECSA6",10,0)
 ; IBCNT = the ien of the entry in file 361.1
"RTN","IBCECSA6",11,0)
 ; IBSRC = 1 if called from AR, 0 if List Manager format needed
"RTN","IBCECSA6",12,0)
 ;       = 2 if called from AR and header data is desired
"RTN","IBCECSA6",13,0)
 ;   If IBSRC > 0  ^TMP("PRCA_EOB",$J,IBCNT,n)=line n's text is ret'd
"RTN","IBCECSA6",14,0)
 ; IBFULL = 1 if no check should be made to eliminate a fld whose value=0
"RTN","IBCECSA6",15,0)
 ; IBJTIBLN = line number to start VALMCNT with (optional)
"RTN","IBCECSA6",16,0)
 ;            used by IBJTBA1
"RTN","IBCECSA6",17,0)
 ;
"RTN","IBCECSA6",18,0)
 N IBREC,IBTYP,CNT,IBREM
"RTN","IBCECSA6",19,0)
 S IBFULL=$G(IBFULL),IBSRC=$G(IBSRC)
"RTN","IBCECSA6",20,0)
 I IBSRC N VALMBG,VALMCNT
"RTN","IBCECSA6",21,0)
 S VALMCNT=0,VALMBG=1,CNT=0
"RTN","IBCECSA6",22,0)
 I $G(IBJTIBLN)>0 S VALMCNT=IBJTIBLN
"RTN","IBCECSA6",23,0)
 S IBREC=$G(^IBM(361.1,IBCNT,0)),IBTYP=$P(IBREC,U,4)
"RTN","IBCECSA6",24,0)
 I IBSRC K ^TMP("PRCA_EOB",$J,IBCNT)
"RTN","IBCECSA6",25,0)
 ; Once we're displaying a single EOB, remove the multiple EOB header of 
"RTN","IBCECSA6",26,0)
 ; the View EOB screen that was set in HDR^IBCEOB2 - VALMHDR(4).
"RTN","IBCECSA6",27,0)
 I 'IBSRC,$G(VALMHDR(4))'="" S VALMHDR(4)=""
"RTN","IBCECSA6",28,0)
 D GEN,PAY,ARCP^IBCECSA7,CLVL,CLVLA,MIN^IBCECSA5,MOUT,LLVLA^IBCECSA7,RDATA^IBCECSA7
"RTN","IBCECSA6",29,0)
 Q
"RTN","IBCECSA6",30,0)
 ;
"RTN","IBCECSA6",31,0)
SEL(IB,ONE) ;
"RTN","IBCECSA6",32,0)
 N IBDA
"RTN","IBCECSA6",33,0)
 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
"RTN","IBCECSA6",34,0)
 S IBDA=0 S IBDA=$O(VALMY(IBDA)) Q:'IBDA  D
"RTN","IBCECSA6",35,0)
 . S IB=$P($G(^TMP("IBCECSD",$J,IBDA)),U,2)
"RTN","IBCECSA6",36,0)
 . S IBONE=1
"RTN","IBCECSA6",37,0)
 Q
"RTN","IBCECSA6",38,0)
 ;
"RTN","IBCECSA6",39,0)
ACT ; Reposition display using actions
"RTN","IBCECSA6",40,0)
 I '$G(IBONE) D SEL(.IBCNT,1) D BLD:$G(IBCNT)
"RTN","IBCECSA6",41,0)
 S VALMBG=$G(^TMP("IBCECSD",$J,"X",+$G(IBACT))) S:'VALMBG VALMBG=1
"RTN","IBCECSA6",42,0)
 S VALMBCK="R"
"RTN","IBCECSA6",43,0)
 Q
"RTN","IBCECSA6",44,0)
 ;
"RTN","IBCECSA6",45,0)
SET(IBSRC,X,CNT,IBCNT) ;set list manager arrays
"RTN","IBCECSA6",46,0)
 S VALMCNT=VALMCNT+1,IBSRC=$G(IBSRC)
"RTN","IBCECSA6",47,0)
 ;
"RTN","IBCECSA6",48,0)
 I IBSRC D  Q
"RTN","IBCECSA6",49,0)
 . S ^TMP("PRCA_EOB",$J,IBCNT,VALMCNT)=X
"RTN","IBCECSA6",50,0)
 ;
"RTN","IBCECSA6",51,0)
 S ^TMP("IBCECSD",$J,VALMCNT,0)=X
"RTN","IBCECSA6",52,0)
 S ^TMP("IBCECSD",$J,"IDX",VALMCNT,CNT)=""
"RTN","IBCECSA6",53,0)
 S ^TMP("IBCECSD",$J,CNT)=VALMCNT_U_IBCNT
"RTN","IBCECSA6",54,0)
 Q
"RTN","IBCECSA6",55,0)
 ;
"RTN","IBCECSA6",56,0)
GEN ;
"RTN","IBCECSA6",57,0)
 S IBSRC=$G(IBSRC) Q:IBSRC=1
"RTN","IBCECSA6",58,0)
 N IBREC1,IBTMP,IBSPL
"RTN","IBCECSA6",59,0)
 S IBSPL=+$O(^IBM(361.1,IBCNT,8,0)),IBSPL=(+$O(^(IBSPL))'=IBSPL)
"RTN","IBCECSA6",60,0)
 S IB=$$SETSTR^VALM1("EOB GENERAL INFORMATION:","",1,50)
"RTN","IBCECSA6",61,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",62,0)
 I 'IBSRC D
"RTN","IBCECSA6",63,0)
 . D CNTRL^VALM10(VALMCNT,1,24,IORVON,IORVOFF)
"RTN","IBCECSA6",64,0)
 . S ^TMP("IBCECSD",$J,"X",1)=VALMCNT
"RTN","IBCECSA6",65,0)
 S IB=$$SETSTR^VALM1("Type        : "_$S(IBTYP:"MEDICARE MRA",1:"NORMAL EOB")_$S(IBSPL:" (SPLIT IN A/R)",1:""),"",2,39)
"RTN","IBCECSA6",66,0)
 S IB=$$SETSTR^VALM1("EOB Paid DT  : "_$$DAT1^IBOUTL($P(IBREC,U,6),1),IB,41,38)
"RTN","IBCECSA6",67,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",68,0)
 I IBSRC D
"RTN","IBCECSA6",69,0)
 . S IB=$$SETSTR^VALM1($S(IBSRC:"Entry Dt/Tm :"_$$DAT1^IBOUTL($P(IBREC,U,5),1),1:""),"",2,39)
"RTN","IBCECSA6",70,0)
 . S IBTMP=$P(IBREC,U,13)
"RTN","IBCECSA6",71,0)
 . S IB=$$SETSTR^VALM1("Claim Status : "_$$EXTERNAL^DILFD(361.1,.13,"",IBTMP),IB,41,38)
"RTN","IBCECSA6",72,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",73,0)
 . S IBTMP=$P(IBREC,U,16)
"RTN","IBCECSA6",74,0)
 . S IB=$$SETSTR^VALM1("Review Status: "_$$EXTERNAL^DILFD(361.1,.16,"",IBTMP),IB,41,38)
"RTN","IBCECSA6",75,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",76,0)
 . S IB=$$SETSTR^VALM1("Entered By  : "_$P($G(^VA(200,+$P(IBREC,U,18),0)),U),"",2,39)
"RTN","IBCECSA6",77,0)
 . S IBTMP=$P(IBREC,U,15)
"RTN","IBCECSA6",78,0)
 . S IB=$$SETSTR^VALM1("Insurance Seq: "_$$EXTERNAL^DILFD(361.1,.15,"",IBTMP),IB,41,38)
"RTN","IBCECSA6",79,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",80,0)
 I 'IBSRC D
"RTN","IBCECSA6",81,0)
 . S IB=$$SETSTR^VALM1($S($P(IBREC,U,17):"Manual Entry: YES",1:""),"",2,39)
"RTN","IBCECSA6",82,0)
 . S IBTMP=$P(IBREC,U,13)
"RTN","IBCECSA6",83,0)
 . S IB=$$SETSTR^VALM1("Claim Status : "_$$EXTERNAL^DILFD(361.1,.13,"",IBTMP),IB,41,38)
"RTN","IBCECSA6",84,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",85,0)
 . S IBTMP=$P(IBREC,U,15)
"RTN","IBCECSA6",86,0)
 . S IB=$$SETSTR^VALM1("Insurance Seq: "_$$EXTERNAL^DILFD(361.1,.15,"",IBTMP),"",41,38)
"RTN","IBCECSA6",87,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",88,0)
 S IBREC1=$G(^IBM(361.1,IBCNT,100))
"RTN","IBCECSA6",89,0)
 I $S($G(IBFULL):1,1:$P(IBREC1,U,4)'=""!($P(IBREC1,U,3)'="")) D
"RTN","IBCECSA6",90,0)
 . S IB=$$SETSTR^VALM1("Last Edited : "_$$DAT1^IBOUTL($P(IBREC1,U,4),1),"",2,39)
"RTN","IBCECSA6",91,0)
 . S IB=$$SETSTR^VALM1("Last Edit By : "_$P($G(^VA(200,+$P(IBREC1,U,3),0)),U),IB,41,38)
"RTN","IBCECSA6",92,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",93,0)
 ;
"RTN","IBCECSA6",94,0)
 D INSINF^IBCECSA7(+IBREC,CNT,IBCNT)
"RTN","IBCECSA6",95,0)
 ;
"RTN","IBCECSA6",96,0)
 ;Additional fields for HIPAA 5010
"RTN","IBCECSA6",97,0)
 I IBSRC D
"RTN","IBCECSA6",98,0)
 .N IBOSN,IBOSN1,IBREC50,IBREC51
"RTN","IBCECSA6",99,0)
 .S IBREC50=$G(^IBM(361.1,IBCNT,50)),IBREC51=$G(^IBM(361.1,IBCNT,51))
"RTN","IBCECSA6",100,0)
 .S IB=$$SETSTR^VALM1("Claim Rec'd Date     : "_$$DAT1^IBOUTL($P(IBREC50,U),1),"",2,39)
"RTN","IBCECSA6",101,0)
 .D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",102,0)
 .S IBOSN=$E($P(IBREC51,U),1,56),IBOSN1=$E($P(IBREC51,U),57,112)
"RTN","IBCECSA6",103,0)
 .S IB=$$SETSTR^VALM1("Other Subscriber Name: "_IBOSN,"",2,79)
"RTN","IBCECSA6",104,0)
 .D SET(IBSRC,IB,CNT,IBCNT) Q:IBOSN1=""
"RTN","IBCECSA6",105,0)
 .S IB=$$SETSTR^VALM1("                       "_IBOSN1,"",2,79)
"RTN","IBCECSA6",106,0)
 .D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",107,0)
 ;
"RTN","IBCECSA6",108,0)
 I $S($G(IBFULL):1,1:$P($G(^IBM(361.1,IBCNT,6)),U)'=""!($P($G(^IBM(361.1,IBCNT,6)),U,2)'="")) D
"RTN","IBCECSA6",109,0)
 . S IB=$$SETSTR^VALM1("New Pat. Nm.: "_$P($G(^IBM(361.1,IBCNT,6)),U),"",2,39)
"RTN","IBCECSA6",110,0)
 . S IB=$$SETSTR^VALM1("New Pat. Id  : "_$P($G(^IBM(361.1,IBCNT,6)),U,2),IB,41,38)
"RTN","IBCECSA6",111,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",112,0)
 D:IBSRC SET(IBSRC,"",CNT,IBCNT)
"RTN","IBCECSA6",113,0)
 Q
"RTN","IBCECSA6",114,0)
 ;
"RTN","IBCECSA6",115,0)
PAY ;
"RTN","IBCECSA6",116,0)
 S IBSRC=$G(IBSRC) Q:IBSRC=1
"RTN","IBCECSA6",117,0)
 N IBREC1,IBTMP
"RTN","IBCECSA6",118,0)
 S IB=$$SETSTR^VALM1("PAYER INFORMATION:","",1,50)
"RTN","IBCECSA6",119,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",120,0)
 I 'IBSRC D
"RTN","IBCECSA6",121,0)
 . D CNTRL^VALM10(VALMCNT,1,18,IORVON,IORVOFF)
"RTN","IBCECSA6",122,0)
 . S ^TMP("IBCECSD",$J,"X",2)=VALMCNT
"RTN","IBCECSA6",123,0)
 ; KL - HIPAA 5010 - moved the write of the Payer ID on the next line down from the payer name to accommodate
"RTN","IBCECSA6",124,0)
 ; the increased length of the PAYER NAME from 35 to 60 characters.  modified length parameter to $$SETSTR function for
"RTN","IBCECSA6",125,0)
 ; Payer ID and ICN to accommodate increased length of additional 20 characters. 
"RTN","IBCECSA6",126,0)
 S IB=$$SETSTR^VALM1("Payer Name   : "_$P($G(^DIC(36,+$P(IBREC,U,2),0)),U),"",2,60)
"RTN","IBCECSA6",127,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",128,0)
 S IB=$$SETSTR^VALM1("Payer Id     : "_$P(IBREC,U,3),IB,2,38)
"RTN","IBCECSA6",129,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",130,0)
 S IB=$$SETSTR^VALM1("ICN          : "_$P(IBREC,U,14),"",2,60)
"RTN","IBCECSA6",131,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",132,0)
 ;Additional fields for HIPA 5010
"RTN","IBCECSA6",133,0)
 N I,IBREC25,IBCON,IBCONTXT,IBCTYP,IBPAYNAM,IBWEB3,IBWEB
"RTN","IBCECSA6",134,0)
 ; Display PAYER CONTACT NAME, file #361.1, or CONTACT NAME, file #344; .4, (whichever is available)
"RTN","IBCECSA6",135,0)
 S IBREC25=$G(^IBM(361.1,IBCNT,25))
"RTN","IBCECSA6",136,0)
 S IBPAYNAM=$P(IBREC25,U)
"RTN","IBCECSA6",137,0)
 I IBPAYNAM="",+$G(RCSCR)>0 S IBPAYNAM=$P($G(^RCY(344.4,RCSCR,3)),U)
"RTN","IBCECSA6",138,0)
 I IBPAYNAM'="" D
"RTN","IBCECSA6",139,0)
 .S IB=$$SETSTR^VALM1("Payer Contact: "_IBPAYNAM,IB,2,60)
"RTN","IBCECSA6",140,0)
 .D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",141,0)
 I $TR($P(IBREC25,U,2,7),U,"")'="" D
"RTN","IBCECSA6",142,0)
 .F I=2,4,6 D
"RTN","IBCECSA6",143,0)
 ..S IBCON=$P(IBREC25,U,I),IBCTYP=$P(IBREC25,U,I+1) Q:IBCON=""
"RTN","IBCECSA6",144,0)
 ..S IBCONTXT=$S(IBCTYP="TE":"Contact Phone  : ",IBCTYP="FX":"Contact Fax    : ",IBCTYP="EM":"Contact e-Mail : ",1:"Invalid type :")
"RTN","IBCECSA6",145,0)
 ..S IB=$$SETSTR^VALM1(IBCONTXT_IBCON,"",2,50)
"RTN","IBCECSA6",146,0)
 ..D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",147,0)
 I $G(RCSCR)'="" D
"RTN","IBCECSA6",148,0)
 .S IBWEB=$P($G(^RCY(344.4,RCSCR,5)),U) Q:IBWEB=""
"RTN","IBCECSA6",149,0)
 .S IB=$$SETSTR^VALM1("Payer Web Site : "_$E(IBWEB,1,60),"",2,78)
"RTN","IBCECSA6",150,0)
 .D SET(IBSRC,IB,CNT,IBCNT) Q:$L(IBWEB)<61
"RTN","IBCECSA6",151,0)
 .S IB=$$SETSTR^VALM1($E(IBWEB,61,115),"",19,78)
"RTN","IBCECSA6",152,0)
 .D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",153,0)
 ;Payer Policy References
"RTN","IBCECSA6",154,0)
 D PPR
"RTN","IBCECSA6",155,0)
 N IBREC51
"RTN","IBCECSA6",156,0)
 S IBREC51=$G(^IBM(361.1,IBCNT,51))
"RTN","IBCECSA6",157,0)
 I $P(IBREC,U,9)'=""!($P(IBREC51,U,2)'="") D
"RTN","IBCECSA6",158,0)
 . S IB=$$SETSTR^VALM1("Cross Ovr ID : "_$P(IBREC,U,9),"",2,39)
"RTN","IBCECSA6",159,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",160,0)
 . S IB=$$SETSTR^VALM1("Cross Ovr Nm: "_$P(IBREC51,U,2),"",2,76)
"RTN","IBCECSA6",161,0)
 . D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",162,0)
 D:IBSRC SET(IBSRC,"",CNT,IBCNT)
"RTN","IBCECSA6",163,0)
 Q
"RTN","IBCECSA6",164,0)
 ;
"RTN","IBCECSA6",165,0)
CLVL ;
"RTN","IBCECSA6",166,0)
 N IBREC1,IBTMP,IBRL
"RTN","IBCECSA6",167,0)
 S IB=$$SETSTR^VALM1("CLAIM LEVEL PAY STATUS:","",1,50),IBSRC=$G(IBSRC)
"RTN","IBCECSA6",168,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",169,0)
 I 'IBSRC D
"RTN","IBCECSA6",170,0)
 . D CNTRL^VALM10(VALMCNT,1,23,IORVON,IORVOFF)
"RTN","IBCECSA6",171,0)
 . S ^TMP("IBCECSD",$J,"X",3)=VALMCNT
"RTN","IBCECSA6",172,0)
 I '$D(^IBM(361.1,IBCNT,2)),'$D(^IBM(361.1,IBCNT,1)) D SET(IBSRC," NONE",CNT,IBCNT) Q
"RTN","IBCECSA6",173,0)
 S IB=$$SETSTR^VALM1("Tot Submitted Chrg: "_$$A10($P($G(^IBM(361.1,IBCNT,2)),U,4)),"",2,39)
"RTN","IBCECSA6",174,0)
 S IBREC1=$G(^IBM(361.1,IBCNT,1))
"RTN","IBCECSA6",175,0)
 S IB=$$SETSTR^VALM1("Covered Amt       : "_$$A10($P(IBREC1,U,3)),IB,41,38)
"RTN","IBCECSA6",176,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",177,0)
 S IB=$$SETSTR^VALM1("Payer Paid Amt    : "_$$A10($P(IBREC1,U)),"",2,39)
"RTN","IBCECSA6",178,0)
 S IB=$$SETSTR^VALM1("Patient Resp. Amt : "_$$A10($S($D(^IBM(361.1,IBCNT,"ERR")):0,IBSRC:$P(IBREC1,U,2),$$FT^IBCEF(+IBREC)=3:$$PTRESPI^IBCECOB1(IBCNT),1:$P($G(^IBM(361.1,IBCNT,1)),"^",2))),IB,41,38)
"RTN","IBCECSA6",179,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",180,0)
 S (IB,IBRL)=""
"RTN","IBCECSA6",181,0)
 I $S(IBFULL:1,1:$P(IBREC1,U,4)) S IB=$$SETSTR^VALM1("Discount Amt      : "_$$A10($P(IBREC1,U,4)),"",2,39),IBRL=1
"RTN","IBCECSA6",182,0)
 I $S(IBFULL:1,1:$P(IBREC1,U,5)) S IB=$$SETSTR^VALM1("Per Day Limit Amt : "_$$A10($P(IBREC1,U,5)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
"RTN","IBCECSA6",183,0)
 I $S(IBFULL:1,1:$P(IBREC1,U,8)) S IB=$$SETSTR^VALM1("Tax Amt           : "_$$A10($P(IBREC1,U,8)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
"RTN","IBCECSA6",184,0)
 I $S(IBFULL:1,1:$P(IBREC1,U,9)) S IB=$$SETSTR^VALM1("Tot Before Tax Amt: "_$$A10($P(IBREC1,U,9)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
"RTN","IBCECSA6",185,0)
 I $S(IBFULL:1,1:$P($G(^IBM(361.1,IBCNT,2)),U,3)) S IB=$$SETSTR^VALM1("Total Allowed Amt : "_$$A10($P($G(^IBM(361.1,IBCNT,2)),U,3)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
"RTN","IBCECSA6",186,0)
 I $S(IBFULL:1,1:$P($G(^IBM(361.1,IBCNT,2)),U,5)) S IB=$$SETSTR^VALM1("Negative Reimb Amt: "_$$A10($P($G(^IBM(361.1,IBCNT,2)),U,5)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
"RTN","IBCECSA6",187,0)
 I $G(IBSRC) I $S(IBFULL:1,1:$P(IBREC,U,12)) S IB=$$SETSTR^VALM1("Discharge Fraction: "_$$A10($P(IBREC,U,12)),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
"RTN","IBCECSA6",188,0)
 I $S(IBFULL:1,1:$P(IBREC,U,10)) S IB=$$SETSTR^VALM1("DRG Code Used     :"_$$RJ^XLFSTR($P(IBREC,U,10),11," "),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1) I IBRL=0 D SET(IBSRC,IB,CNT,IBCNT) S IB=""
"RTN","IBCECSA6",189,0)
 I $S(IBFULL:1,1:$P(IBREC,U,11)) S IB=$$SETSTR^VALM1("DRG Weight Used   :"_$$RJ^XLFSTR($P(IBREC,U,11),11," "),IB,$S('IBRL:2,1:41),$S('IBRL:39,1:38)),IBRL=$S(IBRL:0,1:1)
"RTN","IBCECSA6",190,0)
 D:IBRL'="" SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",191,0)
 D:IBSRC SET(IBSRC,"",CNT,IBCNT)
"RTN","IBCECSA6",192,0)
 Q
"RTN","IBCECSA6",193,0)
 ;
"RTN","IBCECSA6",194,0)
MOUT ;
"RTN","IBCECSA6",195,0)
 N IBREC1,IBRL
"RTN","IBCECSA6",196,0)
 S IBREC1=$G(^IBM(361.1,IBCNT,3)),IBSRC=$G(IBSRC)
"RTN","IBCECSA6",197,0)
 I 'IBSRC,$$INPAT^IBCEF(+IBREC),$TR(IBREC1,"0^")="" Q
"RTN","IBCECSA6",198,0)
 I IBREC1="" D:'$D(^IBM(361.1,IBCNT,4)) SET(IBSRC,"  NONE",CNT,IBCNT) D:'IBSRC SET(IBSRC,"",CNT,IBCNT),REMARK^IBCECSA5 Q
"RTN","IBCECSA6",199,0)
 D SET(IBSRC," OUTPATIENT:",CNT,IBCNT)
"RTN","IBCECSA6",200,0)
 S IBRL=""
"RTN","IBCECSA6",201,0)
 I $S(IBFULL:1,1:$P(IBREC1,U)) S IB=$$SETSTR^VALM1("Reimburse Rate    : "_$$P10($P(IBREC1,U)),"",$S('IBRL:4,1:40),$S('IBRL:41,1:38)),IBRL=$S(IBRL:0,1:1)
"RTN","IBCECSA6",202,0)
 I $S(IBFULL:1,1:$P(IBREC1,U,2)) S IB=$$SETSTR^VALM1("HCPCS Pay Amt     : "_$$A10($P(IBREC1,U,2)),IB,$S('IBRL:4,1:40),$S('IBRL:41,1:38)),IBRL=$S(IBRL:0,1:1)
"RTN","IBCECSA6",203,0)
 D:IBRL=0 SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",204,0)
 I $S(IBFULL:1,1:$P(IBREC1,U,8)) S IB=$$SETSTR^VALM1("Esrd Paid Amt     : "_$$A10($P(IBREC1,U,8)),"",$S('IBRL:4,1:40),$S('IBRL:41,1:38)),IBRL=$S(IBRL:0,1:1)
"RTN","IBCECSA6",205,0)
 D:IBRL=0 SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",206,0)
 I $S(IBFULL:1,1:$P(IBREC1,U,9)) S IB=$$SETSTR^VALM1("Non-Pay Prof Comp : "_$$A10($P(IBREC1,U,9)),IB,$S('IBRL:4,1:40),$S('IBRL:41,1:38)),IBRL=$S(IBRL:0,1:1)
"RTN","IBCECSA6",207,0)
 D:IBRL'="" SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",208,0)
 D REMARK^IBCECSA5
"RTN","IBCECSA6",209,0)
 D SET(IBSRC,"",CNT,IBCNT)
"RTN","IBCECSA6",210,0)
 Q
"RTN","IBCECSA6",211,0)
 ;
"RTN","IBCECSA6",212,0)
CLVLA ;
"RTN","IBCECSA6",213,0)
 N IBREC,IBFLG,GR,RSN,Z,I
"RTN","IBCECSA6",214,0)
 S IB=$$SETSTR^VALM1("CLAIM LEVEL ADJUSTMENTS:","",1,50),IBSRC=$G(IBSRC)
"RTN","IBCECSA6",215,0)
 D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",216,0)
 I 'IBSRC D
"RTN","IBCECSA6",217,0)
 . D CNTRL^VALM10(VALMCNT,1,24,IORVON,IORVOFF)
"RTN","IBCECSA6",218,0)
 . S ^TMP("IBCECSD",$J,"X",4)=VALMCNT
"RTN","IBCECSA6",219,0)
 S (Y,IBFLG)=0 F  S Y=$O(^IBM(361.1,IBCNT,10,Y)) Q:'Y  D
"RTN","IBCECSA6",220,0)
 . S IBREC=$G(^IBM(361.1,IBCNT,10,Y,0)),GR=$P(IBREC,U,1)
"RTN","IBCECSA6",221,0)
 . I GR="OA",$P($G(^IBM(361.1,IBCNT,10,Y,1,0)),U,4)=1,$D(^IBM(361.1,IBCNT,10,Y,1,"B","AB3")) Q   ; kludge
"RTN","IBCECSA6",222,0)
 . S IBREC=$$EXTERNAL^DILFD(361.11,.01,"",GR),IBFLG=1
"RTN","IBCECSA6",223,0)
 . D SET(IBSRC," GROUP CODE: "_IBREC,CNT,IBCNT)
"RTN","IBCECSA6",224,0)
 . S Z=0 F  S Z=$O(^IBM(361.1,IBCNT,10,Y,1,Z)) Q:'Z  D
"RTN","IBCECSA6",225,0)
 .. S IBREC=$G(^IBM(361.1,IBCNT,10,Y,1,Z,0)),RSN=$P(IBREC,U,1)
"RTN","IBCECSA6",226,0)
 .. I GR="OA",RSN="AB3" Q   ; kludge
"RTN","IBCECSA6",227,0)
 .. S IB=$$SETSTR^VALM1("REASON CODE: "_RSN_"  "_$P(IBREC,U,4),"",3,77)
"RTN","IBCECSA6",228,0)
 .. D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",229,0)
 .. S IB=$$SETSTR^VALM1("Amount: "_$$A10($P(IBREC,U,2)),"",3,40)
"RTN","IBCECSA6",230,0)
 .. S IB=$$SETSTR^VALM1("Quantity: "_$P(IBREC,U,3),IB,41,38)
"RTN","IBCECSA6",231,0)
 .. D SET(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",232,0)
 D:IBSRC SET(IBSRC,"",CNT,IBCNT)
"RTN","IBCECSA6",233,0)
 I 'IBFLG D SET(IBSRC," NONE",CNT,IBCNT)
"RTN","IBCECSA6",234,0)
 Q
"RTN","IBCECSA6",235,0)
 ;
"RTN","IBCECSA6",236,0)
A10(X) ; returns a dollar amount right justified to 10 characters
"RTN","IBCECSA6",237,0)
 Q $$RJ^XLFSTR($FN(X,"",2),10," ")
"RTN","IBCECSA6",238,0)
 ;
"RTN","IBCECSA6",239,0)
P10(X) ; returns a % right just 10
"RTN","IBCECSA6",240,0)
 ; X is a decimal between 0-1
"RTN","IBCECSA6",241,0)
 Q $$RJ^XLFSTR((X*100)_"%",10," ")
"RTN","IBCECSA6",242,0)
 ;
"RTN","IBCECSA6",243,0)
PPR ;Display Payer Policy References
"RTN","IBCECSA6",244,0)
 ;
"RTN","IBCECSA6",245,0)
 N I,IBARR,IBX,IBX2,IBX3,IBPY,IBPCNT,IBDISP,IBTXT
"RTN","IBCECSA6",246,0)
 S IBX=0
"RTN","IBCECSA6",247,0)
 ;Get next Adjustment
"RTN","IBCECSA6",248,0)
 F  S IBX=$O(^IBM(361.1,IBCNT,15,IBX)) Q:'IBX  D
"RTN","IBCECSA6",249,0)
 .;Get next Line Level
"RTN","IBCECSA6",250,0)
 .S IBX2=0
"RTN","IBCECSA6",251,0)
 .F  S IBX2=$O(^IBM(361.1,IBCNT,15,IBX,1,IBX2)) Q:'IBX2  D
"RTN","IBCECSA6",252,0)
 ..;Get Adjustment line references (up to 5)
"RTN","IBCECSA6",253,0)
 ..S IBX3=0
"RTN","IBCECSA6",254,0)
 ..F  S IBX3=$O(^IBM(361.1,IBCNT,15,IBX,1,IBX2,2,IBX3)) Q:'IBX3  D
"RTN","IBCECSA6",255,0)
 ...S IBPY=$P($G(^IBM(361.1,IBCNT,15,IBX,1,IBX2,2,IBX3,0)),U) Q:IBPY=""
"RTN","IBCECSA6",256,0)
 ...S IBARR(IBPY)=""
"RTN","IBCECSA6",257,0)
 ;Concatenate Adjustment references
"RTN","IBCECSA6",258,0)
 S IBPY="",IBPCNT=0
"RTN","IBCECSA6",259,0)
 F  S IBPY=$O(IBARR(IBPY)) Q:IBPY=""  D  Q:IBPCNT=5
"RTN","IBCECSA6",260,0)
 .S IBPCNT=IBPCNT+1,$P(IBDISP,";",IBPCNT)=IBPY
"RTN","IBCECSA6",261,0)
 ;Format display
"RTN","IBCECSA6",262,0)
 Q:'IBPCNT
"RTN","IBCECSA6",263,0)
 S IB=$$SETSTR^VALM1("Policy Reference: Check Payer policies referenced on Payer website","",2,78)
"RTN","IBCECSA6",264,0)
 D SET^IBCECSA6(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",265,0)
 S IB=$$SETSTR^VALM1("for the following: "_$E(IBDISP,1,50),"",2,78)
"RTN","IBCECSA6",266,0)
 D SET^IBCECSA6(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",267,0)
 F I=50:50:250 S IBTXT=$E(IBDISP,I+1,I+50) Q:IBTXT=""  D
"RTN","IBCECSA6",268,0)
 .S IB=$$SETSTR^VALM1($J("",19)_IBTXT,"",2,78)
"RTN","IBCECSA6",269,0)
 .D SET^IBCECSA6(IBSRC,IB,CNT,IBCNT)
"RTN","IBCECSA6",270,0)
 Q
"RTN","IBCEMRAA")
0^9^B59972826
"RTN","IBCEMRAA",1,0)
IBCEMRAA ;ALB/DSM/PJH - MEDICARE REMITTANCE ADVICE DETAIL-PART A ; 8/2/10 9:12pm
"RTN","IBCEMRAA",2,0)
 ;;2.0;INTEGRATED BILLING;**155,323,349,400,431**;21-MAR-94;Build 106
"RTN","IBCEMRAA",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCEMRAA",4,0)
 ;
"RTN","IBCEMRAA",5,0)
 Q  ; must call an entry point
"RTN","IBCEMRAA",6,0)
 ;
"RTN","IBCEMRAA",7,0)
 ;  This routine prints MRA Report for UB-04 (Part A) Form Type
"RTN","IBCEMRAA",8,0)
 ;
"RTN","IBCEMRAA",9,0)
MRA(IBIFN) ;;Module - Entry point to print ALL MRA reports, for a given IBIFN.
"RTN","IBCEMRAA",10,0)
 ; This entry point doesn't ask for a Bill Number, it must pass IBIFN as Input.
"RTN","IBCEMRAA",11,0)
 ; It will prompt the user for a device.
"RTN","IBCEMRAA",12,0)
 ;
"RTN","IBCEMRAA",13,0)
 ; Input   IBIFN  = ien of Bill Number (required)
"RTN","IBCEMRAA",14,0)
 ;
"RTN","IBCEMRAA",15,0)
 N IBQUIT,IBPGN S IBQUIT=0
"RTN","IBCEMRAA",16,0)
 D ENT1
"RTN","IBCEMRAA",17,0)
 Q  ;MRA
"RTN","IBCEMRAA",18,0)
 ;
"RTN","IBCEMRAA",19,0)
ENT ; Menu Option Entry Point
"RTN","IBCEMRAA",20,0)
 N IBQUIT,IBEOB,IBIFN,FRMTYP,IBPGN
"RTN","IBCEMRAA",21,0)
 S IBQUIT=0
"RTN","IBCEMRAA",22,0)
 D GETBIL I IBQUIT Q   ;ENT
"RTN","IBCEMRAA",23,0)
 ;
"RTN","IBCEMRAA",24,0)
ENT1 ; Prompt for a print device and print MRA Reports
"RTN","IBCEMRAA",25,0)
 D DEV^IBCEMRAX(IBIFN) I IBQUIT Q    ; device handling  ENT1
"RTN","IBCEMRAA",26,0)
 ;
"RTN","IBCEMRAA",27,0)
PROC ; This section must have IBIFN defined
"RTN","IBCEMRAA",28,0)
 ; This section is called as both a foreground and a background process,
"RTN","IBCEMRAA",29,0)
 ; so all write stmts need to consider printing in both cases.
"RTN","IBCEMRAA",30,0)
 N FRMTYP,IEN,IBZDATA,INPAT
"RTN","IBCEMRAA",31,0)
 S IBQUIT=$G(IBQUIT)
"RTN","IBCEMRAA",32,0)
 S FRMTYP=$$FT^IBCEF(IBIFN)    ;Form Type
"RTN","IBCEMRAA",33,0)
 S INPAT=$$INPAT^IBCEF(IBIFN)  ;Inpatient Flag
"RTN","IBCEMRAA",34,0)
 ;
"RTN","IBCEMRAA",35,0)
 ; Get Service Line Level Data from 837 Extract - Make the appropriate call
"RTN","IBCEMRAA",36,0)
 ; based on the Bill's Form Type 3=UB-04  ; 2=CMS-1500
"RTN","IBCEMRAA",37,0)
 D  ;
"RTN","IBCEMRAA",38,0)
 . I FRMTYP=2 D F^IBCEF("N-HCFA 1500 SERVICE LINE (EDI)","IBZDATA",,IBIFN) Q
"RTN","IBCEMRAA",39,0)
 . D F^IBCEF("N-UB-04 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
"RTN","IBCEMRAA",40,0)
 ;
"RTN","IBCEMRAA",41,0)
 ; For a given IBIFN, print all MRA's on file for that Bill
"RTN","IBCEMRAA",42,0)
 S IEN=0
"RTN","IBCEMRAA",43,0)
 F  S IEN=$O(^IBM(361.1,"B",IBIFN,IEN)) Q:'IEN  D  I IBQUIT Q
"RTN","IBCEMRAA",44,0)
 . I $P($G(^IBM(361.1,IEN,0)),U,4)'=1 Q  ;not an MRA
"RTN","IBCEMRAA",45,0)
 . D PRNTMRA  ; print an MRA
"RTN","IBCEMRAA",46,0)
 ;
"RTN","IBCEMRAA",47,0)
 ; Force a form feed at end of a printer report
"RTN","IBCEMRAA",48,0)
 I $E(IOST,1,2)'["C-" W @IOF
"RTN","IBCEMRAA",49,0)
 ; Pause on screen before exiting
"RTN","IBCEMRAA",50,0)
 I 'IBQUIT,$E(IOST,1,2)["C-" W ! S DIR("A")="Press RETURN to continue: ",DIR(0)="EA" D ^DIR K DIR
"RTN","IBCEMRAA",51,0)
 ;
"RTN","IBCEMRAA",52,0)
 ; Quit if called from a background process (ZTQUEUED defined)
"RTN","IBCEMRAA",53,0)
 I $D(ZTQUEUED) S ZTREQ="@" Q  ;PROC
"RTN","IBCEMRAA",54,0)
 D ^%ZISC     ; handle device closing before exiting
"RTN","IBCEMRAA",55,0)
 Q   ;PROC
"RTN","IBCEMRAA",56,0)
 ;
"RTN","IBCEMRAA",57,0)
PRNTMRA ; Print a single MRA
"RTN","IBCEMRAA",58,0)
 ; Input IEN - the ien# of EOB file (361.1); Required
"RTN","IBCEMRAA",59,0)
 S IBPGN=0
"RTN","IBCEMRAA",60,0)
 ; Print Part B - CMS-1500
"RTN","IBCEMRAA",61,0)
 I FRMTYP=2 D PRNT^IBCEMRAB Q  ;PRNTMRA
"RTN","IBCEMRAA",62,0)
 ;
"RTN","IBCEMRAA",63,0)
 ; Print Part A - Institutional next
"RTN","IBCEMRAA",64,0)
 ; Claim Level
"RTN","IBCEMRAA",65,0)
 N RSNCD,NCVRCHRG,IBILL,IBILLU,IBCOINS,IBCTADJ,IBEOB,RMKS,IBFD,IBTD,IBDED,CLMADJ
"RTN","IBCEMRAA",66,0)
 I IBPGN>1 D PAUSE^IBCEMRAX I IBQUIT Q  ;pause between EOB reports
"RTN","IBCEMRAA",67,0)
 D CLMDATA,CLMHDR I IBQUIT Q
"RTN","IBCEMRAA",68,0)
 D CLMPRNT
"RTN","IBCEMRAA",69,0)
 ;
"RTN","IBCEMRAA",70,0)
 ; Print Service Line Level Adjustments - check if exist
"RTN","IBCEMRAA",71,0)
 I $D(^IBM(361.1,IEN,15)) D  I IBQUIT Q
"RTN","IBCEMRAA",72,0)
 . I ($Y+4)>IOSL D PAUSE^IBCEMRAX Q:IBQUIT  W @IOF D CLMHDR
"RTN","IBCEMRAA",73,0)
 . D SRVHDR^IBCEMRAX,SRVDATA^IBCEMRAX
"RTN","IBCEMRAA",74,0)
 ;
"RTN","IBCEMRAA",75,0)
 ; Print Disclaimer
"RTN","IBCEMRAA",76,0)
 D DSCLMR^IBCEMRAX
"RTN","IBCEMRAA",77,0)
 Q  ;PRTMRA
"RTN","IBCEMRAA",78,0)
 ;
"RTN","IBCEMRAA",79,0)
GETBIL ; Prompt the user for a Bill#. Get INIFN and IBEOB.
"RTN","IBCEMRAA",80,0)
 ;
"RTN","IBCEMRAA",81,0)
 N DIC,Y W !
"RTN","IBCEMRAA",82,0)
 ; Access Explanation Of Benefits File #361.1
"RTN","IBCEMRAA",83,0)
 ; Screen: only allow access to EOB's of Type = 1 (Medicare MRA)
"RTN","IBCEMRAA",84,0)
 S DIC="^IBM(361.1,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,4)=1"
"RTN","IBCEMRAA",85,0)
 S DIC("W")="D EOBLST^IBCEMU1(Y)"   ; modify generic lister
"RTN","IBCEMRAA",86,0)
 D ^DIC
"RTN","IBCEMRAA",87,0)
 I Y<1!$D(DTOUT)!$D(DUOUT) S IBQUIT=1 Q  ; GETBIL
"RTN","IBCEMRAA",88,0)
 S IBIFN=+$P(Y,U,2)   ; get index to Bill file (#399)
"RTN","IBCEMRAA",89,0)
 Q  ;GETBIL
"RTN","IBCEMRAA",90,0)
 ;
"RTN","IBCEMRAA",91,0)
CLMDATA ; Get MRA Claim Level data of EOB file (#361.1)
"RTN","IBCEMRAA",92,0)
 N I,RCNT,GRPCD,GLVL,GLVLD,RLVL,RLVLD,RCDED,RCOINS,RCTADJ,RCNCVR,RCLMADJ,CLMLVL
"RTN","IBCEMRAA",93,0)
 F I=1:1:5 S @($P($T(TABLE+I),";",3))=$P($T(TABLE+I),";",4)
"RTN","IBCEMRAA",94,0)
 ;
"RTN","IBCEMRAA",95,0)
 ; Get Top Levels of EOB file (#361.1)
"RTN","IBCEMRAA",96,0)
 F I=0,1,3:1:6 S IBEOB(I)=$G(^IBM(361.1,IEN,I))
"RTN","IBCEMRAA",97,0)
 ;
"RTN","IBCEMRAA",98,0)
 ; Get Claim Level Remarks Code from appropriate levels of 361.1 based on
"RTN","IBCEMRAA",99,0)
 ; whether Bill is Outpatient or Inpatient.
"RTN","IBCEMRAA",100,0)
 D  ;
"RTN","IBCEMRAA",101,0)
 . I INPAT S RMKS=IBEOB(5) Q   ; Inpatient remarks code
"RTN","IBCEMRAA",102,0)
 . S RMKS=$P(IBEOB(3),U,3,7)   ; Outpatient remarks code
"RTN","IBCEMRAA",103,0)
 ;
"RTN","IBCEMRAA",104,0)
 ; Get Group Level Data
"RTN","IBCEMRAA",105,0)
 ; RLVLD=reason_code^amount^quantity^reason text
"RTN","IBCEMRAA",106,0)
 ; CLMLVL=Claim Level Flag indicating where the displayed data is coming from
"RTN","IBCEMRAA",107,0)
 ; 1=Claim Level; 0=Line Level
"RTN","IBCEMRAA",108,0)
 ;
"RTN","IBCEMRAA",109,0)
 S (GLVL,RLVL,RCNT,NCVRCHRG,IBDED,IBCOINS,IBCTADJ,CLMADJ,CLMLVL)=0
"RTN","IBCEMRAA",110,0)
 F  S GLVL=$O(^IBM(361.1,IEN,10,GLVL)) Q:'GLVL  S GLVLD=^(GLVL,0) D  ;
"RTN","IBCEMRAA",111,0)
 . S GRPCD=$P(GLVLD,U),RLVL=0
"RTN","IBCEMRAA",112,0)
 . F  S RLVL=$O(^IBM(361.1,IEN,10,GLVL,1,RLVL)) Q:'RLVL  S RLVLD=^(RLVL,0) D  ;
"RTN","IBCEMRAA",113,0)
 . . S RSNCD=$P(RLVLD,U)
"RTN","IBCEMRAA",114,0)
 . . I GRPCD="PR",RSNCD="AAA" Q   ;exception
"RTN","IBCEMRAA",115,0)
 . . I GRPCD="OA",RSNCD="AB3" Q   ;exception
"RTN","IBCEMRAA",116,0)
 . . I GRPCD="LQ" Q               ;exception
"RTN","IBCEMRAA",117,0)
 . . S RCNT=RCNT+1,RSNCD(RCNT)=RSNCD ;display
"RTN","IBCEMRAA",118,0)
 . . I RCLMADJ[(","_RSNCD_",") S CLMADJ=CLMADJ+$P(RLVLD,U,2),CLMLVL=1 ;Claim Adjustment
"RTN","IBCEMRAA",119,0)
 . . ; Get data from Claim Level: calculate Coinsurance, Contractual Adjustment,
"RTN","IBCEMRAA",120,0)
 . . ; Noncovered Charges and Deductible amounts
"RTN","IBCEMRAA",121,0)
 . . I GRPCD="PR",RCOINS[(","_RSNCD_",") S IBCOINS=$P(RLVLD,U,2),CLMLVL=1 Q
"RTN","IBCEMRAA",122,0)
 . . I GRPCD="PR",RCDED[(","_RSNCD_",") S IBDED=IBDED+$P(RLVLD,U,2),CLMLVL=1 Q
"RTN","IBCEMRAA",123,0)
 . . I GRPCD="CO" D  ;
"RTN","IBCEMRAA",124,0)
 . . . I RCTADJ[(","_RSNCD_",") S IBCTADJ=IBCTADJ+$P(RLVLD,U,2),CLMLVL=1
"RTN","IBCEMRAA",125,0)
 . . . I RCNCVR'[(","_RSNCD_",") S NCVRCHRG=NCVRCHRG+$P(RLVLD,U,2),CLMLVL=1
"RTN","IBCEMRAA",126,0)
 ;
"RTN","IBCEMRAA",127,0)
 ; If no data was found at Claim Level, get data from Line Level
"RTN","IBCEMRAA",128,0)
 I 'CLMLVL D LINELVL^IBCEMRAX
"RTN","IBCEMRAA",129,0)
 S IBILL=$G(^DGCR(399,$P(IBEOB(0),U),0)),IBILLU=$G(^DGCR(399,$P(IBEOB(0),U),"U"))
"RTN","IBCEMRAA",130,0)
 S IBFD=$$FMTE^XLFDT($P(IBILLU,U),5),IBTD=$$FMTE^XLFDT($P(IBILLU,U,2),5)
"RTN","IBCEMRAA",131,0)
 ;
"RTN","IBCEMRAA",132,0)
 Q  ;CLMDATA
"RTN","IBCEMRAA",133,0)
 ;
"RTN","IBCEMRAA",134,0)
CLMHDR ; Print Claim Level Header
"RTN","IBCEMRAA",135,0)
 S IBPGN=IBPGN+1
"RTN","IBCEMRAA",136,0)
 I IBPGN=1,$E(IOST,1,2)["C-" W @IOF  ; refresh terminal screen on 1st hdr
"RTN","IBCEMRAA",137,0)
 ;
"RTN","IBCEMRAA",138,0)
 ; Rows 1 to 3
"RTN","IBCEMRAA",139,0)
 W !,?108,"Medicare-equivalent",!?110,"Remittance Advice",!
"RTN","IBCEMRAA",140,0)
 N PRVDR
"RTN","IBCEMRAA",141,0)
 ;
"RTN","IBCEMRAA",142,0)
 ; gather the pay-to provider information - IB*2*400
"RTN","IBCEMRAA",143,0)
 S PRVDR=$$PRVDATA^IBJPS3($P(IBEOB(0),U,1))
"RTN","IBCEMRAA",144,0)
 ;
"RTN","IBCEMRAA",145,0)
 ; Row 4 to 15
"RTN","IBCEMRAA",146,0)
 W !!!,"DEPT OF VETERANS AFFAIRS"
"RTN","IBCEMRAA",147,0)
 W !,$P(PRVDR,U,5),?103,"PROVIDER #:",?117,$P($G(^IBE(350.9,1,1)),U,5) ;Tax ID
"RTN","IBCEMRAA",148,0)
 W !,$P(PRVDR,U,6),?103,"PAGE #:",?117,$J(IBPGN,3)
"RTN","IBCEMRAA",149,0)
 W !,$P(PRVDR,U,7),", ",$P(PRVDR,U,8)," ",$P(PRVDR,U,9),?103,"DATE: ",?117,$$FMTE^XLFDT($P(IBEOB(0),U,6),5)
"RTN","IBCEMRAA",150,0)
 W !!,"PATIENT NAME",?24,"PATIENT CNTRL NUMBER",?48,"RC",?52,"REM",?58,"DRG#",?72,"DRG OUT AMT"
"RTN","IBCEMRAA",151,0)
 W ?86,"COINSURANCE",?100,"PAT REFUND",?115,"CONTRACT ADJ"
"RTN","IBCEMRAA",152,0)
 W !,"HIC NUMBER",?48,"RC",?52,"REM",?58,"OUTCD CAPCD",?72,"DRG CAP AMT"
"RTN","IBCEMRAA",153,0)
 W ?86,"COVD CHGS",?100,"ESRD NET ADJ",?115,"PER DIEM RTE"
"RTN","IBCEMRAA",154,0)
 W !,"ICN NUMBER"
"RTN","IBCEMRAA",155,0)
 W !,"FROM DT    THRU DT",?24,"NACHG  HICHG  TOB",?48,"RC",?52,"REM",?58,"PROF COMP",?72,"MSP PAYMT"
"RTN","IBCEMRAA",156,0)
 W ?86,"NCOVD CHGS",?100,"INTEREST",?115,"PROC CD AMT"
"RTN","IBCEMRAA",157,0)
 W !,"CLM STATUS",?24,"COST  COVDY  NCOVDY",?48,"RC",?52,"REM",?58,"DRG AMT",?72,"DEDUCTIBLES"
"RTN","IBCEMRAA",158,0)
 W ?86,"DENIED CHGS",?100,"CLAIM ADJ",?115,"NET REIMB",!
"RTN","IBCEMRAA",159,0)
 Q  ;CLMHDR
"RTN","IBCEMRAA",160,0)
 ;
"RTN","IBCEMRAA",161,0)
CLMPRNT ; - Print Claim Level part of the Report
"RTN","IBCEMRAA",162,0)
 N PTNM,PTLEN,HIC
"RTN","IBCEMRAA",163,0)
 ; ROW 16
"RTN","IBCEMRAA",164,0)
 ; format and standardize patient name for display
"RTN","IBCEMRAA",165,0)
 S PTNM("FILE")=2,PTNM("IENS")=$P(IBILL,U,2),PTNM("FIELD")=.01,PTLEN=23
"RTN","IBCEMRAA",166,0)
 S PTNM=$$BLDNAME^XLFNAME(.PTNM,PTLEN)
"RTN","IBCEMRAA",167,0)
 I $P(IBEOB(6),U,1)'="" S PTNM=$E($P(IBEOB(6),U,1),1,PTLEN)
"RTN","IBCEMRAA",168,0)
 W !,PTNM
"RTN","IBCEMRAA",169,0)
 ; Account # (Bill #)
"RTN","IBCEMRAA",170,0)
 W ?24,$P($$SITE^VASITE,U,3),"-",$P(IBILL,U)
"RTN","IBCEMRAA",171,0)
 ; Reason Code,Remarks Code 1
"RTN","IBCEMRAA",172,0)
 W ?48,$G(RSNCD(1)),?52,$P(RMKS,U,1)
"RTN","IBCEMRAA",173,0)
 ; DRG Code Used
"RTN","IBCEMRAA",174,0)
 W ?58,$P(IBEOB(0),U,10)
"RTN","IBCEMRAA",175,0)
 ; Coinsurance, Contract Adjustment
"RTN","IBCEMRAA",176,0)
 W ?86,$J($G(IBCOINS),11,2),?115,$J($G(IBCTADJ),11,2)
"RTN","IBCEMRAA",177,0)
 ; ROW 17
"RTN","IBCEMRAA",178,0)
 ; HIC & ICN
"RTN","IBCEMRAA",179,0)
 S HIC=$S($P(IBEOB(6),U,2)'="":$P(IBEOB(6),U,2),$$WNRBILL^IBEFUNC(IBIFN,1):$P($G(^DGCR(399,$P(IBEOB(0),U),"I1")),U,2),1:$P($G(^DGCR(399,$P(IBEOB(0),U),"I2")),U,2))
"RTN","IBCEMRAA",180,0)
 W !,HIC
"RTN","IBCEMRAA",181,0)
 ; Reason Code, Remarks Code 2
"RTN","IBCEMRAA",182,0)
 W ?48,$G(RSNCD(2)),?52,$P(RMKS,U,2)
"RTN","IBCEMRAA",183,0)
 ; covered charges
"RTN","IBCEMRAA",184,0)
 W ?86,$J($P(IBEOB(1),U,3),11,2)
"RTN","IBCEMRAA",185,0)
 ; Outpatient Reimbursement Rate
"RTN","IBCEMRAA",186,0)
 I 'INPAT W ?115,$J($P(IBEOB(3),U,1),11,2)
"RTN","IBCEMRAA",187,0)
 ;ICN moved with HIPAA 5010
"RTN","IBCEMRAA",188,0)
 W !,$P(IBEOB(0),U,14)
"RTN","IBCEMRAA",189,0)
 ; ROW 18
"RTN","IBCEMRAA",190,0)
 W !,IBFD,?12,IBTD
"RTN","IBCEMRAA",191,0)
 ; Type of Bill (=Location of Care_Bill Clasification_Frequency)
"RTN","IBCEMRAA",192,0)
 W ?38,$P(IBILL,U,24)_$P($G(^DGCR(399.1,$P(IBILL,U,25),0)),U,2)_$P(IBILL,U,26)
"RTN","IBCEMRAA",193,0)
 ; Reason Code,Remarks Code 3
"RTN","IBCEMRAA",194,0)
 W ?48,$G(RSNCD(3)),?52,$P(RMKS,U,3)
"RTN","IBCEMRAA",195,0)
 ; non-covered amount (Pt Responsibility)
"RTN","IBCEMRAA",196,0)
 W ?86,$J(NCVRCHRG,11,2)
"RTN","IBCEMRAA",197,0)
 ; Interest Amount
"RTN","IBCEMRAA",198,0)
 I $P(IBEOB(1),U,7) W ?100,$J($P(IBEOB(1),U,7),11,2)
"RTN","IBCEMRAA",199,0)
 ; Procedure code amount
"RTN","IBCEMRAA",200,0)
 W ?115,$J($P(IBEOB(3),U,2),11,2)
"RTN","IBCEMRAA",201,0)
 ; ROW 19
"RTN","IBCEMRAA",202,0)
 ; claim status
"RTN","IBCEMRAA",203,0)
 W !?6,$E($P(IBEOB(0),U,21),1,2)
"RTN","IBCEMRAA",204,0)
 ; M-Care Inp Cost Report Day Ct
"RTN","IBCEMRAA",205,0)
 W ?24,$P(IBEOB(4),U,14)
"RTN","IBCEMRAA",206,0)
 ; M-Care Inp Cov. Days/Visit Ct
"RTN","IBCEMRAA",207,0)
 W ?30,$P(IBEOB(4),U,1)
"RTN","IBCEMRAA",208,0)
 ; Medicare Non-Covered Days
"RTN","IBCEMRAA",209,0)
 W ?38,$P(IBEOB(4),U,19)
"RTN","IBCEMRAA",210,0)
 ; Reason Code,Remarks Code 4
"RTN","IBCEMRAA",211,0)
 W ?48,$G(RSNCD(4)),?52,$P(RMKS,U,4)
"RTN","IBCEMRAA",212,0)
 ; M-Care Inp Claim Drg Amt
"RTN","IBCEMRAA",213,0)
 W ?58,$J($P(IBEOB(4),U,3),11,2)
"RTN","IBCEMRAA",214,0)
 ; if Group Code is PR, print the sum of Reason Codes 1 and 66
"RTN","IBCEMRAA",215,0)
 W ?72,$J($G(IBDED),11,2)
"RTN","IBCEMRAA",216,0)
 ; Claim Adjustments
"RTN","IBCEMRAA",217,0)
 W ?100,$J($G(CLMADJ),10,2)
"RTN","IBCEMRAA",218,0)
 ; net reimburse
"RTN","IBCEMRAA",219,0)
 W ?115,$J($P(IBEOB(1),U,1),11,2)
"RTN","IBCEMRAA",220,0)
 ; Row 20
"RTN","IBCEMRAA",221,0)
 ; Reason Code,Remarks Code 5
"RTN","IBCEMRAA",222,0)
 W !?48,$G(RSNCD(5)),?52,$P(RMKS,U,5)
"RTN","IBCEMRAA",223,0)
 ;
"RTN","IBCEMRAA",224,0)
 Q  ; CLMPRNT
"RTN","IBCEMRAA",225,0)
TABLE ;;variable;list of Reason Codes w/leading & trailing commas; description;
"RTN","IBCEMRAA",226,0)
 ;;RCDED;,1,66,;reason code to calc deductible amount;
"RTN","IBCEMRAA",227,0)
 ;;RCOINS;,2,;reason code to calc coinsurance amount;
"RTN","IBCEMRAA",228,0)
 ;;RCTADJ;,A2,;reason codes to calc contract adjustment amount;
"RTN","IBCEMRAA",229,0)
 ;;RCNCVR;,1,2,23,42,45,66,70,71,89,94,97,118,A1,A2,B3,B6,;reason codes excluded from calc of noncovered charges amount;
"RTN","IBCEMRAA",230,0)
 ;;RCLMADJ;,42,45,70,94,97,122,A1,;reason codes to calc claim adj
"RTN","IBCEMRAA",231,0)
 ;
"RTN","IBCEMRAB")
0^12^B49859211
"RTN","IBCEMRAB",1,0)
IBCEMRAB ;ALB/DSM - MEDICARE REMITTANCE ADVICE DETAIL-PART B ; 3/10/11 10:14am
"RTN","IBCEMRAB",2,0)
 ;;2.0;INTEGRATED BILLING;**155,323,349,400,431**;21-MAR-94;Build 106
"RTN","IBCEMRAB",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCEMRAB",4,0)
 ;
"RTN","IBCEMRAB",5,0)
 Q  ; this routine must be called at an entry point
"RTN","IBCEMRAB",6,0)
 ;
"RTN","IBCEMRAB",7,0)
 ;  This routine prints MRA Report for CMS-1500 (Part B) Form Type
"RTN","IBCEMRAB",8,0)
PRNT ;
"RTN","IBCEMRAB",9,0)
 ; Claim Level Adjustments
"RTN","IBCEMRAB",10,0)
 N DIC,Y,IBEOB,IBILL,IBILLU,IBTD,IBFD,TOT,PRFRMID
"RTN","IBCEMRAB",11,0)
 D GDATA,HDR
"RTN","IBCEMRAB",12,0)
 ;
"RTN","IBCEMRAB",13,0)
 ; Initialize Totals
"RTN","IBCEMRAB",14,0)
 S (TOT("ALWD"),TOT("SRVDED"),TOT("SRVCOIN"),TOT("SRVADJ"),TOT("PAID"))=0
"RTN","IBCEMRAB",15,0)
 ;
"RTN","IBCEMRAB",16,0)
 ; Service Line Level Adjustments
"RTN","IBCEMRAB",17,0)
 I $D(^IBM(361.1,IEN,15)) D SRVPRNT I IBQUIT Q
"RTN","IBCEMRAB",18,0)
 ;
"RTN","IBCEMRAB",19,0)
 ; Print Totals Line
"RTN","IBCEMRAB",20,0)
 D TOTAL
"RTN","IBCEMRAB",21,0)
 ;
"RTN","IBCEMRAB",22,0)
 ; Print Disclaimer
"RTN","IBCEMRAB",23,0)
 D DSCLMR^IBCEMRAX
"RTN","IBCEMRAB",24,0)
 ;
"RTN","IBCEMRAB",25,0)
 Q  ;PRNT
"RTN","IBCEMRAB",26,0)
 ;
"RTN","IBCEMRAB",27,0)
GDATA ; Get MRA data
"RTN","IBCEMRAB",28,0)
 ;
"RTN","IBCEMRAB",29,0)
 N I
"RTN","IBCEMRAB",30,0)
 F I=0,1,2,3,6 S IBEOB(I)=$G(^IBM(361.1,IEN,I))
"RTN","IBCEMRAB",31,0)
 S IBILL=$G(^DGCR(399,$P(IBEOB(0),U),0)),IBILLU=$G(^DGCR(399,$P(IBEOB(0),U),"U"))
"RTN","IBCEMRAB",32,0)
 S IBTD=$$FMTE^XLFDT($P(IBILLU,U),5),IBFD=$$FMTE^XLFDT($P(IBILLU,U,2),5)
"RTN","IBCEMRAB",33,0)
 Q  ;GDATA
"RTN","IBCEMRAB",34,0)
 ;
"RTN","IBCEMRAB",35,0)
HDR ; Print Header
"RTN","IBCEMRAB",36,0)
 I $E(IOST,1,2)["C-" W @IOF
"RTN","IBCEMRAB",37,0)
 S IBPGN=IBPGN+1
"RTN","IBCEMRAB",38,0)
 ;
"RTN","IBCEMRAB",39,0)
 ; Row 1,2,3
"RTN","IBCEMRAB",40,0)
 W !,?102,"Medicare-equivalent",!?104,"Remittance Advice",!
"RTN","IBCEMRAB",41,0)
 ; Row 7
"RTN","IBCEMRAB",42,0)
 W !!!!,"DEPT OF VETERANS AFFAIRS"
"RTN","IBCEMRAB",43,0)
 ;
"RTN","IBCEMRAB",44,0)
 N PRVDR,LINE,PTNM,PTLEN,RMKS,HIC
"RTN","IBCEMRAB",45,0)
 ;
"RTN","IBCEMRAB",46,0)
 ; gather the pay-to provider information - IB*2*400
"RTN","IBCEMRAB",47,0)
 S PRVDR=$$PRVDATA^IBJPS3($P(IBEOB(0),U,1))
"RTN","IBCEMRAB",48,0)
 ;
"RTN","IBCEMRAB",49,0)
 ; Row 8
"RTN","IBCEMRAB",50,0)
 W !,$P(PRVDR,U,5),?97,"PROVIDER #:",?111,"VA0"_$P($$SITE^VASITE,U,3)
"RTN","IBCEMRAB",51,0)
 ; Row 9
"RTN","IBCEMRAB",52,0)
 W !,$P(PRVDR,U,6),?97,"PAGE #:",?111,$J(IBPGN,3)
"RTN","IBCEMRAB",53,0)
 ; Row 10
"RTN","IBCEMRAB",54,0)
 W !,$P(PRVDR,U,7),", ",$P(PRVDR,U,8)," ",$P(PRVDR,U,9),?97,"DATE:",?111,$$FMTE^XLFDT($P(IBEOB(0),U,6),5)
"RTN","IBCEMRAB",55,0)
 ; Row 14
"RTN","IBCEMRAB",56,0)
 W !!!!,"PERF PROV",?12,"SERV DATE",?25,"POS",?29,"NOS",?34,"PROC",?40,"MODS",?53,"BILLED",?63,"ALLOWED",?75,"DEDUCT"
"RTN","IBCEMRAB",57,0)
 W ?87,"COINS",?93,"GRP-RC",?107,"AMT",?114,"PROV PD"
"RTN","IBCEMRAB",58,0)
 ; Row 15
"RTN","IBCEMRAB",59,0)
 S $P(LINE,"-",122)="" W !,LINE
"RTN","IBCEMRAB",60,0)
 ;
"RTN","IBCEMRAB",61,0)
 ; format and standardize patient name for display
"RTN","IBCEMRAB",62,0)
 S PTNM("FILE")=2,PTNM("IENS")=$P(IBILL,U,2),PTNM("FIELD")=.01,PTLEN=23
"RTN","IBCEMRAB",63,0)
 S PTNM=$$BLDNAME^XLFNAME(.PTNM,PTLEN)
"RTN","IBCEMRAB",64,0)
 I $P(IBEOB(6),U,1)'="" S PTNM=$E($P(IBEOB(6),U,1),1,PTLEN)
"RTN","IBCEMRAB",65,0)
 ;
"RTN","IBCEMRAB",66,0)
 S HIC=$S($P(IBEOB(6),U,2)'="":$P(IBEOB(6),U,2),$$WNRBILL^IBEFUNC(IBIFN,1):$P($G(^DGCR(399,$P(IBEOB(0),U),"I1")),U,2),1:$P($G(^DGCR(399,$P(IBEOB(0),U),"I2")),U,2))
"RTN","IBCEMRAB",67,0)
 ; Row 17
"RTN","IBCEMRAB",68,0)
 ; Patient Name, HIC, ACNT, ICN, ASG
"RTN","IBCEMRAB",69,0)
 W !!,"NAME",?7,PTNM,?31,"HIC",?35,HIC
"RTN","IBCEMRAB",70,0)
 W ?49,"ACNT",?54,$P($$SITE^VASITE,U,3),"-",$P(IBILL,U)
"RTN","IBCEMRAB",71,0)
 ; HIPAA 5010 Changes
"RTN","IBCEMRAB",72,0)
 N ICN
"RTN","IBCEMRAB",73,0)
 S ICN=$P(IBEOB(0),U,14)
"RTN","IBCEMRAB",74,0)
 W ?76,"ICN",?80,ICN W:$L(ICN)>17 !
"RTN","IBCEMRAB",75,0)
 W ?97,"ASG",?101,$S($P(IBILLU,U,6):"Y",1:"N")
"RTN","IBCEMRAB",76,0)
 ;
"RTN","IBCEMRAB",77,0)
 ; MOA: Medicare Outpatient Remarks Code
"RTN","IBCEMRAB",78,0)
 S RMKS=$P(IBEOB(3),U,3,7) I RMKS="" S RMKS="^^^^"
"RTN","IBCEMRAB",79,0)
 W ?104,"MOA   " I RMKS'?1."^" W $P(RMKS,U,1)," ",$P(RMKS,U,2)
"RTN","IBCEMRAB",80,0)
 I $P(RMKS,U,3,5)'?1."^" S RMKS=$TR(RMKS,U," ") W !,RMKS
"RTN","IBCEMRAB",81,0)
 ; Secondary Performing Provider ID
"RTN","IBCEMRAB",82,0)
 ; On CMS-1500 Form Type reports, If Medicare WNR is Primary or Secondary, then set Performing Provider ID
"RTN","IBCEMRAB",83,0)
 I $$WNRBILL^IBEFUNC(IBIFN,1)!$$WNRBILL^IBEFUNC(IBIFN,2) S PRFRMID="V"_$$MCRSPEC^IBCEU4(IBIFN,1)_$P($$SITE^VASITE,U,3)
"RTN","IBCEMRAB",84,0)
 Q  ;HDR
"RTN","IBCEMRAB",85,0)
 ;
"RTN","IBCEMRAB",86,0)
SRVPRNT ; Print Service Level Data of EOB file (#361.1 Level 15)
"RTN","IBCEMRAB",87,0)
 ;
"RTN","IBCEMRAB",88,0)
 N LNLVL,RLVL,RLVLD,LNLVLD,SRVFDT,SRVTDT,UNIT,PRCD,MOD,I
"RTN","IBCEMRAB",89,0)
 N ALWD,GLVL,GLVLD,GRPCD,OPRCD,PAID,RCNT,SRMKS,SRVCOIN
"RTN","IBCEMRAB",90,0)
 N SRVDED,SRVADJ,SRVCHRG,SRVDT,CLMLN,Z
"RTN","IBCEMRAB",91,0)
 ;
"RTN","IBCEMRAB",92,0)
 ; RLVLD=reason_code^amount^quantity^reason text
"RTN","IBCEMRAB",93,0)
 S LNLVL=0
"RTN","IBCEMRAB",94,0)
 F  S LNLVL=$O(^IBM(361.1,IEN,15,LNLVL)) Q:'LNLVL  S LNLVLD=^(LNLVL,0) D  I IBQUIT Q
"RTN","IBCEMRAB",95,0)
 . I ($Y+4)>IOSL D  I IBQUIT Q
"RTN","IBCEMRAB",96,0)
 . . D PAUSE^IBCEMRAX I IBQUIT Q
"RTN","IBCEMRAB",97,0)
 . . W @IOF D HDR
"RTN","IBCEMRAB",98,0)
 . ; From Service Date, To Service Date
"RTN","IBCEMRAB",99,0)
 . S SRVFDT=$P(LNLVLD,U,16),SRVTDT=$P(LNLVLD,U,17)
"RTN","IBCEMRAB",100,0)
 . S SRVFDT=$$FMTE^XLFDT(SRVFDT,5),SRVTDT=$$FMTE^XLFDT(SRVTDT,5)
"RTN","IBCEMRAB",101,0)
 . ; Get Units, Procedure Code, Original Procedure Code
"RTN","IBCEMRAB",102,0)
 . S UNIT=$P(LNLVLD,U,11),PRCD=$P(LNLVLD,U,4),OPRCD=$P(LNLVLD,U,15)
"RTN","IBCEMRAB",103,0)
 . S PAID=$P(LNLVLD,U,3),TOT("PAID")=TOT("PAID")+PAID    ; Provider Paid Amount
"RTN","IBCEMRAB",104,0)
 . S ALWD=$P(LNLVLD,U,13),TOT("ALWD")=TOT("ALWD")+ALWD   ; Allowed Amount
"RTN","IBCEMRAB",105,0)
 . ; Handle Multiple Paid Modifiers from the Service Line Level - string together
"RTN","IBCEMRAB",106,0)
 . K MOD M MOD=^IBM(361.1,IEN,15,LNLVL,2) S MOD="" F I=1:1:4 Q:'$D(MOD(I))  S MOD=MOD_MOD(I,0)
"RTN","IBCEMRAB",107,0)
 . ; Calculate Submitted Service Line Charge
"RTN","IBCEMRAB",108,0)
 . S CLMLN=$P(LNLVLD,U,12)   ; use to match EOB line # to VistA Bill line#
"RTN","IBCEMRAB",109,0)
 . S SRVCHRG=$P($G(IBZDATA(CLMLN)),U,8)*$P($G(IBZDATA(CLMLN)),U,9)
"RTN","IBCEMRAB",110,0)
 . ; Service Line Level Remarks Codes
"RTN","IBCEMRAB",111,0)
 . S Z=0 F  S Z=$O(^IBM(361.1,IEN,15,LNLVL,4,Z)) Q:'Z  I $G(^(Z,0))'="" S SRMKS(Z)=$P(^(0),U,2)
"RTN","IBCEMRAB",112,0)
 . ; Get Service Level Group Code/Reason Code Data
"RTN","IBCEMRAB",113,0)
 . S (SRVDED,GLVL,RCNT,SRVCOIN)=0 K RSNCD
"RTN","IBCEMRAB",114,0)
 . F  S GLVL=$O(^IBM(361.1,IEN,15,LNLVL,1,GLVL)) Q:'GLVL  S GLVLD=^(GLVL,0) D  ;
"RTN","IBCEMRAB",115,0)
 . . S GRPCD=$P(GLVLD,U),RLVL=0
"RTN","IBCEMRAB",116,0)
 . . F  S RLVL=$O(^IBM(361.1,IEN,15,LNLVL,1,GLVL,1,RLVL)) Q:'RLVL  S RLVLD=^(RLVL,0),RSNCD=$P(RLVLD,U) D  ;
"RTN","IBCEMRAB",117,0)
 . . . I GRPCD="PR",RSNCD="AAA" Q  ;exception
"RTN","IBCEMRAB",118,0)
 . . . I GRPCD="OA",RSNCD="AB3" Q  ;exception
"RTN","IBCEMRAB",119,0)
 . . . I GRPCD="LQ" Q              ;exception
"RTN","IBCEMRAB",120,0)
 . . . I GRPCD="PR",RSNCD=1 S SRVDED=SRVDED+$P(RLVLD,U,2),TOT("SRVDED")=TOT("SRVDED")+SRVDED Q  ;deductible
"RTN","IBCEMRAB",121,0)
 . . . I GRPCD="PR",RSNCD=2 S SRVCOIN=$P(RLVLD,U,2),TOT("SRVCOIN")=TOT("SRVCOIN")+SRVCOIN Q  ;coinsurance
"RTN","IBCEMRAB",122,0)
 . . . S SRVADJ=$P(RLVLD,U,2),TOT("SRVADJ")=TOT("SRVADJ")+SRVADJ  ;adjustment
"RTN","IBCEMRAB",123,0)
 . . . S RCNT=RCNT+1,RSNCD(RCNT)=GRPCD_"-"_RSNCD_U_SRVADJ
"RTN","IBCEMRAB",124,0)
 . ; Performing Provider ID
"RTN","IBCEMRAB",125,0)
 . W !,$G(PRFRMID)
"RTN","IBCEMRAB",126,0)
 . ; From Date in MMDD (w/leading zero) format
"RTN","IBCEMRAB",127,0)
 . I SRVFDT'="" S SRVDT=$E("00",1,2-$L(+SRVFDT))_+SRVFDT_$E("00",1,2-$L($P(SRVFDT,"/",2)))_$P(SRVFDT,"/",2) W ?12,SRVDT
"RTN","IBCEMRAB",128,0)
 . ; To Date in MMDDYY (w/leading zero) format
"RTN","IBCEMRAB",129,0)
 . I SRVTDT'="" W ?17,$E("00",1,2-$L(+SRVTDT)),+SRVTDT,$E("00",1,2-$L($P(SRVTDT,"/",2))),$P(SRVTDT,"/",2),$E($P(SRVTDT,"/",3),3,4)
"RTN","IBCEMRAB",130,0)
 . ; If To Date is Null, Print From Date with year (if not Null)
"RTN","IBCEMRAB",131,0)
 . I SRVTDT="",SRVFDT'="" W ?17,SRVDT,$E($P(SRVFDT,"/",3),3,4)
"RTN","IBCEMRAB",132,0)
 . ; Place of Service - from 837 Extract from CMS-1500 Service Line Level
"RTN","IBCEMRAB",133,0)
 . W ?25,$P($G(IBZDATA(CLMLN)),U,3)
"RTN","IBCEMRAB",134,0)
 . ; Print Units, Procedure Code Paid, Modifiers, Submitted Line Charge, Allowed Amt, Deductable, Coinsurance
"RTN","IBCEMRAB",135,0)
 . W ?28,UNIT,?34,PRCD,?40,MOD,?49,$J(SRVCHRG,10,2),?60,$J(ALWD,10,2),?71,$J(SRVDED,10,2),?82,$J(SRVCOIN,10,2)
"RTN","IBCEMRAB",136,0)
 . ; Print 1st Line of Group Code-Reason Code, Adjustment Amount, Paid Amount
"RTN","IBCEMRAB",137,0)
 . W ?93,$P($G(RSNCD(1)),U),?100,$J($P($G(RSNCD(1)),U,2),10,2),?111,$J(PAID,10,2)
"RTN","IBCEMRAB",138,0)
 . ; print PRCD Submitted, Remarks if any
"RTN","IBCEMRAB",139,0)
 . I OPRCD'=""!$O(SRMKS(0)) W ! D  ;
"RTN","IBCEMRAB",140,0)
 . . I OPRCD'="" W ?33,"(",OPRCD,")"
"RTN","IBCEMRAB",141,0)
 . . I $O(SRMKS(0)) W ?44,"REM: " S Z=0 F  S Z=$O(SRMKS(Z)) Q:'Z  W SRMKS(Z),$S($O(SRMKS(Z)):",",1:"")
"RTN","IBCEMRAB",142,0)
 . ; Print the rest of Group Code-Reason Code, Reason Code Amount
"RTN","IBCEMRAB",143,0)
 . F I=2:1:RCNT W !?93,$P(RSNCD(I),U),?100,$J($P(RSNCD(I),U,2),10,2)
"RTN","IBCEMRAB",144,0)
 Q  ;SRVPRNT
"RTN","IBCEMRAB",145,0)
 ;
"RTN","IBCEMRAB",146,0)
TOTAL ; Print Totals
"RTN","IBCEMRAB",147,0)
 W !!,"PT RESP ",$J($P($G(IBEOB(1)),U,2),10,2)  ;Patient Responsibility
"RTN","IBCEMRAB",148,0)
 ; Billed Amount, Allowed Amount, Deductable Amount
"RTN","IBCEMRAB",149,0)
 W ?35,"CLAIM TOTAL",?49,$J($P($G(IBEOB(2)),U,4),10,2),?60,$J(TOT("ALWD"),10,2),?71,$J(TOT("SRVDED"),10,2)
"RTN","IBCEMRAB",150,0)
 ; Coinsurance Amount, Adjustment Amount, Paid Amount
"RTN","IBCEMRAB",151,0)
 W ?82,$J(TOT("SRVCOIN"),10,2),?100,$J(TOT("SRVADJ"),10,2),?111,$J(TOT("PAID"),10,2)
"RTN","IBCEMRAB",152,0)
 Q  ;TOTAL
"RTN","IBCEMRAB",153,0)
 ;
"RTN","IBCEOB")
0^2^B81821331
"RTN","IBCEOB",1,0)
IBCEOB ;ALB/TMP/PJH - 835 EDI EOB MESSAGE PROCESSING ; 8/19/10 6:33pm
"RTN","IBCEOB",2,0)
 ;;2.0;INTEGRATED BILLING;**137,135,265,155,377,407,431**;21-MAR-94;Build 106
"RTN","IBCEOB",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCEOB",4,0)
 ;
"RTN","IBCEOB",5,0)
 Q
"RTN","IBCEOB",6,0)
 ;
"RTN","IBCEOB",7,0)
UPDEOB(IBTDA) ; Update EXPLANATION OF BENEFITS file (#361.1) from return msg
"RTN","IBCEOB",8,0)
 ; IBTDA = ien of return message
"RTN","IBCEOB",9,0)
 ; Function returns ien of EOB file entry or "" if errors found
"RTN","IBCEOB",10,0)
 ;          the data.  Any errors found are
"RTN","IBCEOB",11,0)
 ;          stored in array ^TMP("IBCERR-EOB",$J,n) in text format
"RTN","IBCEOB",12,0)
 ;          n = seq # and are stored with the EOB in a wp field
"RTN","IBCEOB",13,0)
 ;
"RTN","IBCEOB",14,0)
 N IB0,IB100,IBBTCH,IBE,IBMNUM,IBT,DLAYGO,DIC,DD,DO,X,Y,Z,Z0,Z1,IBEOB,IBBAD,IBOK,IB,IBA1,IBIFN,IBFILE
"RTN","IBCEOB",15,0)
 K ^TMP($J),^TMP("IBCERR-EOB",$J)
"RTN","IBCEOB",16,0)
 ;
"RTN","IBCEOB",17,0)
 S (IBBAD,IBEOB)=""
"RTN","IBCEOB",18,0)
 S IB0=$G(^IBA(364.2,IBTDA,0))
"RTN","IBCEOB",19,0)
 S IBMNUM=+$P(IB0,U)
"RTN","IBCEOB",20,0)
 S X=+$G(^IBA(364,+$P(IB0,U,5),0))
"RTN","IBCEOB",21,0)
 ;
"RTN","IBCEOB",22,0)
 I IBMNUM=""!(X="") G UPDQ
"RTN","IBCEOB",23,0)
 ;
"RTN","IBCEOB",24,0)
 ; Duplicate EOB Check
"RTN","IBCEOB",25,0)
 S IBFILE="^IBA(364.2,"_IBTDA_",2)"
"RTN","IBCEOB",26,0)
 I $$DUP(IBFILE,X) D DELMSG^IBCESRV2(IBTDA) G UPDQ
"RTN","IBCEOB",27,0)
 ;
"RTN","IBCEOB",28,0)
 I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock msg file 364.2
"RTN","IBCEOB",29,0)
 S IBEOB=+$$ADD3611(IBMNUM,$P(IB0,U,5),$P(IB0,U,4),X,0,IBFILE)
"RTN","IBCEOB",30,0)
 L -^IBA(364.2,IBTDA,0)
"RTN","IBCEOB",31,0)
 ;
"RTN","IBCEOB",32,0)
 I IBEOB<0 S IBEOB="" G UPDQ
"RTN","IBCEOB",33,0)
 D UPD3611(IBEOB,IBTDA,0)
"RTN","IBCEOB",34,0)
 ;
"RTN","IBCEOB",35,0)
UPDQ I IBEOB,$O(^TMP("IBCERR-EOB",$J,0)) D ERRUPD(IBEOB,"IBCERR-EOB")
"RTN","IBCEOB",36,0)
 K ^TMP($J),^TMP("IBCERR-EOB",$J)
"RTN","IBCEOB",37,0)
 D CLEAN^DILF
"RTN","IBCEOB",38,0)
 Q +IBEOB
"RTN","IBCEOB",39,0)
 ;
"RTN","IBCEOB",40,0)
 ;
"RTN","IBCEOB",41,0)
 ; NOTE: **** For all variables IB0,IBEGBL,IBEOB below:
"RTN","IBCEOB",42,0)
 ; IB0 = raw data received for this record type on the 835 flat file
"RTN","IBCEOB",43,0)
 ; IBEGBL = subscript to use in error global
"RTN","IBCEOB",44,0)
 ; IBEOB = ien in file 361.1 for this EOB
"RTN","IBCEOB",45,0)
 ;
"RTN","IBCEOB",46,0)
835(IB0,IBEGBL,IBEOB) ; Store header
"RTN","IBCEOB",47,0)
 ;
"RTN","IBCEOB",48,0)
 Q $$HDR^IBCEOB1(IB0,IBEGBL,IBEOB,.HIPAA)
"RTN","IBCEOB",49,0)
 ;
"RTN","IBCEOB",50,0)
5(IB0,IBEGBL,IBEOB) ; Record '05'
"RTN","IBCEOB",51,0)
 ;
"RTN","IBCEOB",52,0)
 N IBOK,DA,DR,DIE,X,Y
"RTN","IBCEOB",53,0)
 K IBZDATA
"RTN","IBCEOB",54,0)
 S DR=";",IBOK=1
"RTN","IBCEOB",55,0)
 S DIE="^IBM(361.1,",DA=IBEOB
"RTN","IBCEOB",56,0)
 ;
"RTN","IBCEOB",57,0)
 I $P(IB0,U,9) S DR=DR_"1.1///"_$$DATE^IBCEU($P(IB0,U,9))_";"         ; statement start date
"RTN","IBCEOB",58,0)
 I $P(IB0,U,10) S DR=DR_"1.11///"_$$DATE^IBCEU($P(IB0,U,10))_";"      ; statement end date
"RTN","IBCEOB",59,0)
 I $P(IB0,U,11) S DR=DR_"1.12///"_$$DATE^IBCEU($P(IB0,U,11))_";"      ; claim received date
"RTN","IBCEOB",60,0)
 S DR=$P(DR,";",2,$L(DR,";")-1)
"RTN","IBCEOB",61,0)
 I DR'="" D ^DIE S IBOK=$D(Y)=0
"RTN","IBCEOB",62,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 5 data"
"RTN","IBCEOB",63,0)
 Q IBOK
"RTN","IBCEOB",64,0)
 ;
"RTN","IBCEOB",65,0)
6(IB0,IBEGBL,IBEOB) ; Record '06' - corrected patient name and/or ID#
"RTN","IBCEOB",66,0)
 ; This data is not going to be filed into file 361.1 so the value of this function will always be a 1 so as to
"RTN","IBCEOB",67,0)
 ; not interrupt the filing process of the EOB/MRA data into file 361.1.
"RTN","IBCEOB",68,0)
 ;
"RTN","IBCEOB",69,0)
 ; perform overall integrity checks on the incoming 06 record.  If anything is out of place, don't update anything
"RTN","IBCEOB",70,0)
 ; and report the problem and get out.
"RTN","IBCEOB",71,0)
 NEW CLM,SITE,IBM,IBIFN,IBIFN1,DFN,SEQ,DIE,DA,DR
"RTN","IBCEOB",72,0)
 S DIE=361.1,DA=IBEOB,DR="61.01////^S X=IB0" D ^DIE    ; archive the raw 06 record data
"RTN","IBCEOB",73,0)
 S CLM=$P(IB0,U,2),SITE=+CLM,CLM=$P(CLM,"-",2) I CLM="" D MSG(IBEOB,"The claim# in piece 2 is invalid.") G Q6
"RTN","IBCEOB",74,0)
 S IBM=$G(^IBM(361.1,IBEOB,0))
"RTN","IBCEOB",75,0)
 I $P(IBM,U,4)'=1 D MSG(IBEOB,"This is a non-Medicare EOB.") G Q6
"RTN","IBCEOB",76,0)
 S IBIFN=+$P(IBM,U,1)                    ; claim# from MRA
"RTN","IBCEOB",77,0)
 S IBIFN1=+$O(^DGCR(399,"B",CLM,""))     ; claim# from 06 record
"RTN","IBCEOB",78,0)
 I IBIFN'=IBIFN1 D MSG(IBEOB,"Claim mismatch error."_IBIFN_","_IBIFN1_","_CLM_".") G Q6
"RTN","IBCEOB",79,0)
 I $P($$SITE^VASITE,U,3)'=SITE D MSG(IBEOB,"Invalid station# mismatch."_$P($$SITE^VASITE,U,3)_","_SITE_".") G Q6
"RTN","IBCEOB",80,0)
 S SEQ=$$COBN^IBCEF(IBIFN)               ; current payer sequence# on claim
"RTN","IBCEOB",81,0)
 I '$$WNRBILL^IBEFUNC(IBIFN,SEQ) D MSG(IBEOB,"The current payer on this claim is not MEDICARE (WNR).") G Q6
"RTN","IBCEOB",82,0)
 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2)   ; patient ien
"RTN","IBCEOB",83,0)
 I 'DFN D MSG(IBEOB,"The patient DFN cannot be determined.") G Q6
"RTN","IBCEOB",84,0)
 ;
"RTN","IBCEOB",85,0)
 D UPD^IBCEOB01(IB0,IBEOB,IBIFN,DFN,SEQ)     ; update patient insurance policy data
"RTN","IBCEOB",86,0)
 ;
"RTN","IBCEOB",87,0)
Q6 ; exit point for $$6 function
"RTN","IBCEOB",88,0)
 Q 1
"RTN","IBCEOB",89,0)
 ;
"RTN","IBCEOB",90,0)
10(IB0,IBEGBL,IBEOB) ; Record '10'
"RTN","IBCEOB",91,0)
 ;
"RTN","IBCEOB",92,0)
 N DA,DR,DIE,X,Y,VAL,IBOK
"RTN","IBCEOB",93,0)
 S DIE="^IBM(361.1,",DA=IBEOB
"RTN","IBCEOB",94,0)
 S DR=".13////"_$S($P(IB0,U,3)="Y":1,$P(IB0,U,4)="Y":2,$P(IB0,U,5)="Y":3,$P(IB0,U,6)="Y":4,1:5)_";.21////"_$P(IB0,U,7)
"RTN","IBCEOB",95,0)
 S DR=DR_";2.04////"_$$DOLLAR($P(IB0,U,10))_";1.01////"_$$DOLLAR($P(IB0,U,11))_$S($P(IB0,U,12)'="":";.14///"_$P(IB0,U,12),1:"")
"RTN","IBCEOB",96,0)
 S DR=DR_$S($P(IB0,U,13)'="":";.1///"_$P(IB0,U,13),1:"")_";.11///"_($P(IB0,U,14)/10000)_";.12///"_($P(IB0,U,15)/100)
"RTN","IBCEOB",97,0)
 I $P(IB0,U,8)'="" S DR=DR_";.08////"_$P(IB0,U,8)_$S($P(IB0,U,9)'="":";.09///"_$P(IB0,U,9),1:"")
"RTN","IBCEOB",98,0)
 I HIPAA,$P(IB0,U,16) S DR=DR_";1.13///"_$$DATE^IBCEU($P(IB0,U,16))_";"      ; coverage exp. date
"RTN","IBCEOB",99,0)
 ;
"RTN","IBCEOB",100,0)
 D ^DIE
"RTN","IBCEOB",101,0)
 S IBOK=($D(Y)=0)
"RTN","IBCEOB",102,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 10 data" G Q10
"RTN","IBCEOB",103,0)
 ;
"RTN","IBCEOB",104,0)
 ; File ICN in Bill
"RTN","IBCEOB",105,0)
 D ICN^IBCEOB00(IBEOB,$P(IB0,U,12),$P($G(^IBM(361.1,IBEOB,0)),U,15),.IBOK)
"RTN","IBCEOB",106,0)
 ;
"RTN","IBCEOB",107,0)
Q10 Q IBOK
"RTN","IBCEOB",108,0)
 ;
"RTN","IBCEOB",109,0)
12(IB0,IBEGL,IBEOB) ; Record '12'
"RTN","IBCEOB",110,0)
 ;
"RTN","IBCEOB",111,0)
 N DA,DR,DIE,X,Y,VAL,IBOK
"RTN","IBCEOB",112,0)
 I HIPAA'=5010 S IBOK=1 G Q12
"RTN","IBCEOB",113,0)
 S DIE="^IBM(361.1,",DA=IBEOB,DR=";"
"RTN","IBCEOB",114,0)
 I $P(IB0,U,3)'="" S DR=DR_"1.14////"_$P(IB0,U,3)_";"
"RTN","IBCEOB",115,0)
 I $P(IB0,U,4)'="" S DR=DR_"1.15////"_$P(IB0,U,4)_";"
"RTN","IBCEOB",116,0)
 I $P(IB0,U,5)'="" S DR=DR_"1.16////"_$P(IB0,U,5)_";"
"RTN","IBCEOB",117,0)
 S DR=$P(DR,";",2,$L(DR,";")-1)
"RTN","IBCEOB",118,0)
 ;
"RTN","IBCEOB",119,0)
 D ^DIE
"RTN","IBCEOB",120,0)
 S IBOK=($D(Y)=0)
"RTN","IBCEOB",121,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 12 data"
"RTN","IBCEOB",122,0)
 ;
"RTN","IBCEOB",123,0)
Q12 Q IBOK
"RTN","IBCEOB",124,0)
 ;
"RTN","IBCEOB",125,0)
13(IB0,IBEGL,IBEOB) ; Record '13'
"RTN","IBCEOB",126,0)
 ;
"RTN","IBCEOB",127,0)
 N DA,DR,DIE,X,Y,VAL,IBOK,NAME
"RTN","IBCEOB",128,0)
 I HIPAA'=5010 S IBOK=1 G Q13
"RTN","IBCEOB",129,0)
 S DIE="^IBM(361.1,",DA=IBEOB
"RTN","IBCEOB",130,0)
 S NAME=$P(IB0,U,3) I NAME="" S IBOK=1 G Q13
"RTN","IBCEOB",131,0)
 I $P(IB0,U,4)'="" S NAME=NAME_","_$P(IB0,U,4)
"RTN","IBCEOB",132,0)
 I $P(IB0,U,5)'="" S NAME=NAME_","_$P(IB0,U,5)
"RTN","IBCEOB",133,0)
 S DR="1.17////"_NAME ; Other Subscriber Name
"RTN","IBCEOB",134,0)
 ;
"RTN","IBCEOB",135,0)
 D ^DIE
"RTN","IBCEOB",136,0)
 S IBOK=($D(Y)=0)
"RTN","IBCEOB",137,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 13 data"
"RTN","IBCEOB",138,0)
 ;
"RTN","IBCEOB",139,0)
Q13 Q IBOK
"RTN","IBCEOB",140,0)
 ;
"RTN","IBCEOB",141,0)
15(IB0,IBEGBL,IBEOB) ; Record '15'
"RTN","IBCEOB",142,0)
 ; Moved due to space constraints
"RTN","IBCEOB",143,0)
Q15 Q $$15^IBCEOB00(IB0,IBEGBL,IBEOB)
"RTN","IBCEOB",144,0)
 ;
"RTN","IBCEOB",145,0)
17(IB0,IBEGBL,IBEOB) ; Record '17'
"RTN","IBCEOB",146,0)
 N A,DATA,IBOK
"RTN","IBCEOB",147,0)
 ;Old Format
"RTN","IBCEOB",148,0)
 S DATA=IB0
"RTN","IBCEOB",149,0)
 ;New Format - store incoming data in first available field
"RTN","IBCEOB",150,0)
 I HIPAA>0 D
"RTN","IBCEOB",151,0)
 .N CNT
"RTN","IBCEOB",152,0)
 .S CNT=4,DATA=$P(DATA,U,1,3) ;Claim Contact Name
"RTN","IBCEOB",153,0)
 .I $P(IB0,U,4)'="" S $P(DATA,U,CNT)=$P(IB0,U,4),$P(DATA,U,CNT+1)="TE",CNT=CNT+2 ;Tel
"RTN","IBCEOB",154,0)
 .I $P(IB0,U,5)'="" S $P(DATA,U,CNT)=$P(IB0,U,5),$P(DATA,U,CNT+1)="FX",CNT=CNT+2 ;Fax
"RTN","IBCEOB",155,0)
 .I $P(IB0,U,6)'="" S $P(DATA,U,CNT)=$P(IB0,U,6),$P(DATA,U,CNT+1)="EM" ;email
"RTN","IBCEOB",156,0)
 ;
"RTN","IBCEOB",157,0)
 S A="3;25.01;0;1;0^4;25.02;0;1;0^5;25.03;0;1;0^6;25.04;0;1;0^7;25.05;0;1;0^8;25.06;0;1;0^9;25.07;0;1;0"
"RTN","IBCEOB",158,0)
 S IBOK=$$STORE^IBCEOB1(A,DATA,IBEOB)
"RTN","IBCEOB",159,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 17 data"
"RTN","IBCEOB",160,0)
Q17 Q IBOK
"RTN","IBCEOB",161,0)
 ;
"RTN","IBCEOB",162,0)
20(IB0,IBEGBL,IBEOB) ; Record '20'
"RTN","IBCEOB",163,0)
 ; Moved due to space constraints
"RTN","IBCEOB",164,0)
Q20 Q $$20^IBCEOB00(IB0,IBEGBL,IBEOB)
"RTN","IBCEOB",165,0)
 ;
"RTN","IBCEOB",166,0)
30(IB0,IBEGBL,IBEOB) ; Record '30'
"RTN","IBCEOB",167,0)
 ;
"RTN","IBCEOB",168,0)
 N IBOK
"RTN","IBCEOB",169,0)
 D 30^IBCEOB0(IB0,IBEOB,.IBOK)
"RTN","IBCEOB",170,0)
Q30 Q $G(IBOK)
"RTN","IBCEOB",171,0)
 ;
"RTN","IBCEOB",172,0)
35(IB0,IBEGBL,IBEOB) ; Record '35'
"RTN","IBCEOB",173,0)
 ; Moved due to space constraints
"RTN","IBCEOB",174,0)
Q35 Q $$35^IBCEOB00(IB0,IBEGBL,IBEOB)
"RTN","IBCEOB",175,0)
 ;
"RTN","IBCEOB",176,0)
37(IB0,IBEGBL,IBEOB) ; Record '37'
"RTN","IBCEOB",177,0)
 ; Moved due to space constraints
"RTN","IBCEOB",178,0)
Q37 Q $$37^IBCEOB00(IB0,IBEGBL,IBEOB)
"RTN","IBCEOB",179,0)
 ;
"RTN","IBCEOB",180,0)
40(IB0,IBEGBL,IBEOB) ; Record '40'
"RTN","IBCEOB",181,0)
 ;
"RTN","IBCEOB",182,0)
 N IBOK
"RTN","IBCEOB",183,0)
 D 40^IBCEOB0(IB0,IBEOB,.IBOK)
"RTN","IBCEOB",184,0)
Q40 Q $G(IBOK)
"RTN","IBCEOB",185,0)
 ;
"RTN","IBCEOB",186,0)
41(IB0,IBEGBL,IBEOB) ; Record '41'
"RTN","IBCEOB",187,0)
 ;
"RTN","IBCEOB",188,0)
 N IBOK
"RTN","IBCEOB",189,0)
 D 41^IBCEOB0(IB0,IBEOB,.IBOK)
"RTN","IBCEOB",190,0)
Q41 Q $G(IBOK)
"RTN","IBCEOB",191,0)
 ;
"RTN","IBCEOB",192,0)
42(IB0,IBEGBL,IBEOB) ; Record '42'
"RTN","IBCEOB",193,0)
 ;
"RTN","IBCEOB",194,0)
 N IBOK
"RTN","IBCEOB",195,0)
 D 42^IBCEOB0(IB0,IBEOB,.IBOK)
"RTN","IBCEOB",196,0)
Q42 Q $G(IBOK)
"RTN","IBCEOB",197,0)
 ;
"RTN","IBCEOB",198,0)
45(IB0,IBEGBL,IBEOB) ; Record '45'
"RTN","IBCEOB",199,0)
 ;
"RTN","IBCEOB",200,0)
 N IBOK
"RTN","IBCEOB",201,0)
 D 45^IBCEOB0(IB0,IBEOB,.IBOK)
"RTN","IBCEOB",202,0)
 Q $G(IBOK)
"RTN","IBCEOB",203,0)
 ;
"RTN","IBCEOB",204,0)
 ;
"RTN","IBCEOB",205,0)
46(IB0,IBEGBL,IBEOB) ; Record '46'
"RTN","IBCEOB",206,0)
 ;
"RTN","IBCEOB",207,0)
 N IBOK
"RTN","IBCEOB",208,0)
 I HIPAA'=5010 S IBOK=1 G Q46
"RTN","IBCEOB",209,0)
 D 46^IBCEOB0(IB0,IBEOB,.IBOK)
"RTN","IBCEOB",210,0)
Q46 Q $G(IBOK)
"RTN","IBCEOB",211,0)
 ;
"RTN","IBCEOB",212,0)
MSG(IBEOB,MSG) ; procedure to file message into field 6.03
"RTN","IBCEOB",213,0)
 ; Results of processing of the "06" record type
"RTN","IBCEOB",214,0)
 N DIE,DA,DR,Z
"RTN","IBCEOB",215,0)
 S DIE=361.1,DA=+$G(IBEOB)
"RTN","IBCEOB",216,0)
 I $G(MSG)="" G MSGX
"RTN","IBCEOB",217,0)
 S Z=$P($G(^IBM(361.1,DA,6)),U,3)    ; already existing message
"RTN","IBCEOB",218,0)
 I Z'="" S MSG=Z_"  "_MSG            ; append new message to existing message
"RTN","IBCEOB",219,0)
 S MSG=$E(MSG,1,190)
"RTN","IBCEOB",220,0)
 S DR="6.03///^S X=MSG"
"RTN","IBCEOB",221,0)
 D ^DIE
"RTN","IBCEOB",222,0)
MSGX ;
"RTN","IBCEOB",223,0)
 Q
"RTN","IBCEOB",224,0)
 ;
"RTN","IBCEOB",225,0)
DOLLAR(X) ; Convert value in X to dollar format XXX.XX
"RTN","IBCEOB",226,0)
 Q $S(+X:$J(X/100,$L(+X),2),1:0)
"RTN","IBCEOB",227,0)
 ;
"RTN","IBCEOB",228,0)
ADD3611(IBMNUM,IBTBILL,IBBATCH,X,IBAR,IBFILE) ; Add stub record to file 361.1
"RTN","IBCEOB",229,0)
 ; X = the ien of the referenced bill in file 399
"RTN","IBCEOB",230,0)
 ; IBTBILL = ien of transmitted bill (optional)
"RTN","IBCEOB",231,0)
 ; IBBATCH = ien of batch # the transmitted bill was in (optional)
"RTN","IBCEOB",232,0)
 ; IBMNUM = the message # from which this record originally came
"RTN","IBCEOB",233,0)
 ; IBAR = 1 only if called from AR
"RTN","IBCEOB",234,0)
 ; IBFILE = array reference of raw EOB data
"RTN","IBCEOB",235,0)
 ;
"RTN","IBCEOB",236,0)
 N DIC,DA,DR,DO,DD,DLAYGO,Y,REVSTAT,BS,MMI
"RTN","IBCEOB",237,0)
 F  L +^IBM(361.1,0):10 Q:$T
"RTN","IBCEOB",238,0)
 ;
"RTN","IBCEOB",239,0)
 ; default proper review status
"RTN","IBCEOB",240,0)
 S BS=$P($G(^DGCR(399,X,0)),U,13)   ; bill status
"RTN","IBCEOB",241,0)
 S REVSTAT=$S(BS=7:9,BS=3:3,BS=4:3,1:0)
"RTN","IBCEOB",242,0)
 S MMI=$$NET^XMRENT(IBMNUM)         ; MailMan header info
"RTN","IBCEOB",243,0)
 S DIC(0)="L",DIC="^IBM(361.1,",DLAYGO=361.1
"RTN","IBCEOB",244,0)
 S DIC("DR")=".16////"_REVSTAT_";.17////0"_";100.02////"_IBMNUM_$S('$G(IBAR):";.19////"_+IBTBILL_";100.01////"_IBBATCH,1:"")
"RTN","IBCEOB",245,0)
 S DIC("DR")=DIC("DR")_";100.05////"_$$CHKSUM^IBCEMU1(IBFILE)_";62.01////^S X=MMI"
"RTN","IBCEOB",246,0)
 D FILE^DICN
"RTN","IBCEOB",247,0)
 L -^IBM(361.1,0)
"RTN","IBCEOB",248,0)
 Q +Y
"RTN","IBCEOB",249,0)
 ;
"RTN","IBCEOB",250,0)
UPD3611(IBEOB,IBTDA,IBAR) ; From flat file 835 format, add EOB record
"RTN","IBCEOB",251,0)
 ; IBEOB = the ien of the entry in file 361.1 being updated
"RTN","IBCEOB",252,0)
 ; IBTDA = the ien in the source file
"RTN","IBCEOB",253,0)
 ; IBAR = 1 if being called from AR
"RTN","IBCEOB",254,0)
 N HIPAA,IBA1,IBFILE,IBEGBL,Z,IBREC,Q
"RTN","IBCEOB",255,0)
 S IBFILE=$S('$G(IBAR):"^IBA(364.2,"_IBTDA_",2)",1:"^TMP("_$J_",""RCDP-EOB"","_IBTDA_")")
"RTN","IBCEOB",256,0)
 S IBEGBL=$S('$G(IBAR):"IBCERR-EOB",1:"RCDPERR-EOB")
"RTN","IBCEOB",257,0)
 S HIPAA=0
"RTN","IBCEOB",258,0)
 I $G(IBAR),'$$HDR^IBCEOB1($G(^TMP($J,"RCDPEOB","HDR")),IBEGBL,IBEOB,.HIPAA) Q
"RTN","IBCEOB",259,0)
 S IBA1=0
"RTN","IBCEOB",260,0)
 F  S IBA1=$O(@IBFILE@(IBA1)) Q:'IBA1  S IB0=$S('$G(IBAR):$P($G(^(IBA1,0)),"##RAW DATA: ",2),1:$G(@IBFILE@(IBA1,0))) I IB0'="" D
"RTN","IBCEOB",261,0)
 . S IBREC=+IB0
"RTN","IBCEOB",262,0)
 . I IBREC'=37 K ^TMP($J,37)
"RTN","IBCEOB",263,0)
 . I IBREC S IB="S IBOK=$$"_IBREC_"(IB0,IBEGBL,IBEOB)",Q=IBREC_"^IBCEOB" I $T(@Q)'="" X IB S:'IBOK ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=$S('$G(IBAR):"  ##RAW DATA: ",1:"")_IB0
"RTN","IBCEOB",264,0)
 ;
"RTN","IBCEOB",265,0)
 Q
"RTN","IBCEOB",266,0)
 ;
"RTN","IBCEOB",267,0)
ERRUPD(IBEOB,IBEGBL) ; Update error text in entry, if needed
"RTN","IBCEOB",268,0)
 D WP^DIE(361.1,IBEOB_",",20,"","^TMP(IBEGBL,$J)","")
"RTN","IBCEOB",269,0)
 Q
"RTN","IBCEOB",270,0)
 ;
"RTN","IBCEOB",271,0)
 ;
"RTN","IBCEOB",272,0)
DUP(IBARRAY,IBIFN) ; Duplicate Check
"RTN","IBCEOB",273,0)
 ; This function determines if the EOB data already exists in file
"RTN","IBCEOB",274,0)
 ; 361.1 by comparing the checksums of the raw 835 data.
"RTN","IBCEOB",275,0)
 ;
"RTN","IBCEOB",276,0)
 ; IBARRAY = Literal array reference where the raw 835 data exists.
"RTN","IBCEOB",277,0)
 ;           The data exists at @IBARRAY@(n,0), where n is the seq#.
"RTN","IBCEOB",278,0)
 ;           For example, IBARRAY = "^IBA(364.2,IBIEN,2)"
"RTN","IBCEOB",279,0)
 ;
"RTN","IBCEOB",280,0)
 ; IBIFN = the bill # (ptr to 399).  The checksums of the EOB's on 
"RTN","IBCEOB",281,0)
 ;         file for this bill will be compared to the checksum of the
"RTN","IBCEOB",282,0)
 ;         835 raw data in the IBARRAY reference.
"RTN","IBCEOB",283,0)
 ;
"RTN","IBCEOB",284,0)
 ; This function returns 0 if the entry is not found (no duplicate),
"RTN","IBCEOB",285,0)
 ; Otherwise, the IEN of the entry in file 361.1 is returned if this
"RTN","IBCEOB",286,0)
 ; is a duplicate EOB.
"RTN","IBCEOB",287,0)
 ;
"RTN","IBCEOB",288,0)
 NEW DUP,IBEOB,CHKSUM1,CHKSUM2
"RTN","IBCEOB",289,0)
 S DUP=0,IBIFN=+$G(IBIFN)
"RTN","IBCEOB",290,0)
 I $G(IBARRAY)=""!'IBIFN G DUPX
"RTN","IBCEOB",291,0)
 I '$D(^IBM(361.1,"B",IBIFN)) G DUPX     ; no EOB's on file yet
"RTN","IBCEOB",292,0)
 S CHKSUM1=$$CHKSUM^IBCEMU1(IBARRAY)     ; checksum of current EOB
"RTN","IBCEOB",293,0)
 I 'CHKSUM1 G DUPX                       ; must be able to be calculated
"RTN","IBCEOB",294,0)
 S IBEOB=0
"RTN","IBCEOB",295,0)
 F  S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB  D  Q:DUP
"RTN","IBCEOB",296,0)
 . S CHKSUM2=+$P($G(^IBM(361.1,IBEOB,100)),U,5)   ; checksum of old EOB
"RTN","IBCEOB",297,0)
 . I 'CHKSUM2 Q
"RTN","IBCEOB",298,0)
 . I CHKSUM1=CHKSUM2 S DUP=IBEOB Q                    ; comparison
"RTN","IBCEOB",299,0)
 . Q
"RTN","IBCEOB",300,0)
DUPX ;
"RTN","IBCEOB",301,0)
 Q DUP
"RTN","IBCEOB",302,0)
 ;
"RTN","IBCEOB0")
0^3^B83008311
"RTN","IBCEOB0",1,0)
IBCEOB0 ;ALB/TMP/PJH - 835 EDI EOB MSG PROCESSING ; 8/24/10 7:23pm
"RTN","IBCEOB0",2,0)
 ;;2.0;INTEGRATED BILLING;**135,280,155,431**;21-MAR-94;Build 106
"RTN","IBCEOB0",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCEOB0",4,0)
 Q
"RTN","IBCEOB0",5,0)
 ;
"RTN","IBCEOB0",6,0)
LINE() ;Extract Provider Line Reference from 42 record
"RTN","IBCEOB0",7,0)
 N SUB,NODE,VAL
"RTN","IBCEOB0",8,0)
 S VAL="",SUB=IBA1 ; from loop in UPD3611^IBCEOB
"RTN","IBCEOB0",9,0)
 F  S SUB=$O(@IBFILE@(SUB)) Q:SUB=""  D  Q:+NODE>42
"RTN","IBCEOB0",10,0)
 .S NODE=$G(@IBFILE@(SUB,0))
"RTN","IBCEOB0",11,0)
 .S:NODE["RAW DATA" NODE=$P(NODE," ",3,99)
"RTN","IBCEOB0",12,0)
 .Q:+NODE'=42  S VAL=$P(NODE,U,5)
"RTN","IBCEOB0",13,0)
 Q VAL
"RTN","IBCEOB0",14,0)
 ;
"RTN","IBCEOB0",15,0)
30(IB0,IBEOB,IBOK) ; Process record type 30 for EOB
"RTN","IBCEOB0",16,0)
 ; IB0 = the record being processed
"RTN","IBCEOB0",17,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB0",18,0)
 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
"RTN","IBCEOB0",19,0)
 ;
"RTN","IBCEOB0",20,0)
 N A
"RTN","IBCEOB0",21,0)
 S A="3;4.01;0;1;1^5;4.02;0;1;1^6;4.03;1;0;0^7;4.05;1;0;0^8;4.06;1;0;0^9;4.07;1;0;0^10;4.08;1;0;0^11;4.09;1;0;0^12;4.1;1;0;0^13;4.11;1;0;0^14;4.19;0;1;1"
"RTN","IBCEOB0",22,0)
 ;
"RTN","IBCEOB0",23,0)
 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
"RTN","IBCEOB0",24,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
"RTN","IBCEOB0",25,0)
Q30 Q
"RTN","IBCEOB0",26,0)
 ;
"RTN","IBCEOB0",27,0)
40(IB0,IBEOB,IBOK) ; Process record type 40 for EOB
"RTN","IBCEOB0",28,0)
 ; IB0 = the record being processed
"RTN","IBCEOB0",29,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB0",30,0)
 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
"RTN","IBCEOB0",31,0)
 ;
"RTN","IBCEOB0",32,0)
 ; IBZDATA is also assumed to exist or if not, it is created in FINDLN
"RTN","IBCEOB0",33,0)
 ;
"RTN","IBCEOB0",34,0)
 N A,LEVEL,IBSEQ,IBDA,IBPC,IBLREF,IBIFN,Q,X,Y,DA,DD,DO,DIC,DLAYGO,PLREF
"RTN","IBCEOB0",35,0)
 K ^TMP($J,40) ; the entry # for corresponding 41, 42, and 45 records
"RTN","IBCEOB0",36,0)
 ;
"RTN","IBCEOB0",37,0)
 S IBIFN=+$G(^IBM(361.1,IBEOB,0))
"RTN","IBCEOB0",38,0)
 L +^IBM(361.1,IBEOB,15):0 I $T S IBSEQ=+$O(^IBM(361.1,IBEOB,15," "),-1)+1
"RTN","IBCEOB0",39,0)
 I '$G(IBSEQ) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Record lock failure - could not acquire next service line number" G Q40
"RTN","IBCEOB0",40,0)
 ;
"RTN","IBCEOB0",41,0)
 ; Update the 40 record data a little bit (pieces 3/4/16)
"RTN","IBCEOB0",42,0)
 I $P(IB0,U,21)="NU" S $P(IB0,U,4)=$P(IB0,U,3),$P(IB0,U,3)=""
"RTN","IBCEOB0",43,0)
 S $P(IB0,U,16)=$S(+$P(IB0,U,16):$P(IB0,U,16)/100,1:+$P(IB0,U,18)/100)
"RTN","IBCEOB0",44,0)
 I $P(IB0,U,4)?1.N S $P(IB0,U,4)=+$P(IB0,U,4)
"RTN","IBCEOB0",45,0)
 ;
"RTN","IBCEOB0",46,0)
 ; Find the line item from original bill for this adjustment
"RTN","IBCEOB0",47,0)
 S PLREF=$S('HIPAA:$P(IB0,U,22),1:$$LINE()) ; old format from 40 record, new format from 42
"RTN","IBCEOB0",48,0)
 S IBLREF=+$$FINDLN^IBCEOB1(IB0,IBEOB,.IBZDATA,+PLREF)
"RTN","IBCEOB0",49,0)
 I 'IBLREF D  G Q40
"RTN","IBCEOB0",50,0)
 . N Z,Z0,CT
"RTN","IBCEOB0",51,0)
 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line detail could not be matched to a billed item"
"RTN","IBCEOB0",52,0)
 . D DET40^IBCEOB00(IB0,.Z0)
"RTN","IBCEOB0",53,0)
 . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F  S Z=$O(Z0(Z)) Q:'Z  S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
"RTN","IBCEOB0",54,0)
 ;
"RTN","IBCEOB0",55,0)
 S DIC="^IBM(361.1,"_IBEOB_",15,",DIC(0)="L",DLAYGO=361.115,DA(1)=IBEOB
"RTN","IBCEOB0",56,0)
 S X=IBSEQ
"RTN","IBCEOB0",57,0)
 S DIC("DR")=".12////"_+IBLREF_$S($P(IBLREF,U,2)="":"",1:";.15////"_$P(IBLREF,U,2))_";.16////"_$$DATE^IBCEU($P(IB0,U,19))_$S($P(IB0,U,20):";.17////"_$$DATE^IBCEU($P(IB0,U,20)),1:"")
"RTN","IBCEOB0",58,0)
 D FILE^DICN K DIC,DO,DD,DLAYGO ;Add a new LINE LEVEL ADJUSTMENT ('SVC')
"RTN","IBCEOB0",59,0)
 I Y<0 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add a LINE LEVEL ADJUSTMENT ("_IBSEQ_")" G Q40
"RTN","IBCEOB0",60,0)
 ;
"RTN","IBCEOB0",61,0)
 L -^IBM(361.1,IBEOB,15)
"RTN","IBCEOB0",62,0)
 ;
"RTN","IBCEOB0",63,0)
 S LEVEL=15.1,LEVEL(0)=+Y,LEVEL(1)=IBEOB,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"
"RTN","IBCEOB0",64,0)
 S A="3;.04;0;0;0^4;.1;0;0;0^9;.09;0;0;0^17;.03;1;0;0^18;.11;0;1;D2^21;.18;0;0;0"
"RTN","IBCEOB0",65,0)
 I '$P(IB0,U,18),$P(IB0,U,16) S $P(A,U,5)="16;.11;0;1;1"
"RTN","IBCEOB0",66,0)
 I $$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL) S ^TMP($J,40)=LEVEL(0),IBOK=1
"RTN","IBCEOB0",67,0)
 I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for line level adjustment "_IBSEQ G Q40
"RTN","IBCEOB0",68,0)
 ;
"RTN","IBCEOB0",69,0)
 ; Store modifiers in multiple
"RTN","IBCEOB0",70,0)
 S DIC="^IBM(361.1,"_IBEOB_",15,"_LEVEL(0)_",2,",DIC(0)="L",DLAYGO=361.1152,DA(2)=IBEOB,DA(1)=LEVEL(0)
"RTN","IBCEOB0",71,0)
 F Q=5:1:8 S X=$P(IB0,U,Q) I X'="" D FILE^DICN K DO,DD I Y<0 S IBOK=0 Q
"RTN","IBCEOB0",72,0)
 K DLAYGO,DIC,DR,DA
"RTN","IBCEOB0",73,0)
 I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file modifier data for line level adjustment "_IBSEQ G Q40
"RTN","IBCEOB0",74,0)
Q40 Q
"RTN","IBCEOB0",75,0)
 ;
"RTN","IBCEOB0",76,0)
41(IB0,IBEOB,IBOK) ; Process record type 41 for EOB
"RTN","IBCEOB0",77,0)
 ; IB0 = the record being processed
"RTN","IBCEOB0",78,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB0",79,0)
 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
"RTN","IBCEOB0",80,0)
 ;
"RTN","IBCEOB0",81,0)
 N DA,DR,DIE,X,Y,Z,Z0,CT
"RTN","IBCEOB0",82,0)
 I '$G(^TMP($J,40)) D  G Q41
"RTN","IBCEOB0",83,0)
 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment has no corresponding service line"
"RTN","IBCEOB0",84,0)
 . D DET4X^IBCEOB00(41,IB0,.Z0)
"RTN","IBCEOB0",85,0)
 . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F  S Z=$O(Z0(Z)) Q:'Z  S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
"RTN","IBCEOB0",86,0)
 ;
"RTN","IBCEOB0",87,0)
 S DR="",IBOK=1
"RTN","IBCEOB0",88,0)
 S DA=+^TMP($J,40),DA(1)=IBEOB
"RTN","IBCEOB0",89,0)
 S DIE="^IBM(361.1,"_DA(1)_",15,"
"RTN","IBCEOB0",90,0)
 I +$P(IB0,U,3) S DR=".13///"_$$DOLLAR^IBCEOB($P(IB0,U,3))
"RTN","IBCEOB0",91,0)
 I +$P(IB0,U,4) S DR=DR_$S(DR="":"",1:";")_".14///"_$$DOLLAR^IBCEOB($P(IB0,U,4))
"RTN","IBCEOB0",92,0)
 I DR'="" D ^DIE S IBOK=($D(Y)=0)
"RTN","IBCEOB0",93,0)
 I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for service line adjustment-2"
"RTN","IBCEOB0",94,0)
 ;
"RTN","IBCEOB0",95,0)
 ; For Medicare MRA's only:
"RTN","IBCEOB0",96,0)
 ; If the Allowed Amount field is present, then we need to file an
"RTN","IBCEOB0",97,0)
 ; adjustment:  Group code PR, Reason code AAA, Amount, Quantity, and
"RTN","IBCEOB0",98,0)
 ; Reason Text.  This is data normally found on the 45 record, so we're
"RTN","IBCEOB0",99,0)
 ; going to create our own "45" record and file it.
"RTN","IBCEOB0",100,0)
 ;
"RTN","IBCEOB0",101,0)
 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D
"RTN","IBCEOB0",102,0)
 . N IB45,IBSAV40
"RTN","IBCEOB0",103,0)
 . S IB45=45_U_$P(IB0,U,2)_U_"PR"_U_"AAA"_U_$P(IB0,U,3)_U_"0000000001"
"RTN","IBCEOB0",104,0)
 . S IB45=IB45_U_"Allowed Amount"
"RTN","IBCEOB0",105,0)
 . S IBSAV40=$G(^TMP($J,40))
"RTN","IBCEOB0",106,0)
 . D 45(IB45,IBEOB,.IBOK)
"RTN","IBCEOB0",107,0)
 . S ^TMP($J,40)=IBSAV40
"RTN","IBCEOB0",108,0)
 . I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the PR-AAA adjustment for the Allowed Amount at line "_+^TMP($J,40)
"RTN","IBCEOB0",109,0)
 . Q
"RTN","IBCEOB0",110,0)
 ;
"RTN","IBCEOB0",111,0)
Q41 Q
"RTN","IBCEOB0",112,0)
 ;
"RTN","IBCEOB0",113,0)
42(IB0,IBEOB,IBOK) ; Process record type 42 for EOB 
"RTN","IBCEOB0",114,0)
 ; IB0 = the record being processed
"RTN","IBCEOB0",115,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB0",116,0)
 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
"RTN","IBCEOB0",117,0)
 ;
"RTN","IBCEOB0",118,0)
 N DO,DD,DLAYGO,DIC,DA,X,Y,Z,Z0,CT
"RTN","IBCEOB0",119,0)
 S IBOK=0
"RTN","IBCEOB0",120,0)
 I '$G(^TMP($J,40)) D  G Q42
"RTN","IBCEOB0",121,0)
 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment has no corresponding service line"
"RTN","IBCEOB0",122,0)
 . D DET4X^IBCEOB00(42,IB0,.Z0)
"RTN","IBCEOB0",123,0)
 . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F  S Z=$O(Z0(Z)) Q:'Z  S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
"RTN","IBCEOB0",124,0)
 ;
"RTN","IBCEOB0",125,0)
 K DO,DD,DLAYGO
"RTN","IBCEOB0",126,0)
 S IBOK=1
"RTN","IBCEOB0",127,0)
 S DA(1)=+^TMP($J,40),DA(2)=IBEOB
"RTN","IBCEOB0",128,0)
 S X=+$O(^IBM(361.1,DA(2),15,DA(1),4," "),-1)+1,DIC="^IBM(361.1,"_DA(2)_",15,"_DA(1)_",4,",DIC(0)="L",DLAYGO=361.1154
"RTN","IBCEOB0",129,0)
 S DIC("DR")=$S($P(IB0,U,3)'="":".02////"_$P(IB0,U,3),1:"")
"RTN","IBCEOB0",130,0)
 I $P(IB0,U,4)'="" S:$L(DIC("DR")) DIC("DR")=DIC("DR")_";" S DIC("DR")=DIC("DR")_".03////"_$TR($P(IB0,U,4),";"," ")
"RTN","IBCEOB0",131,0)
 D FILE^DICN K DO,DD,DLAYGO
"RTN","IBCEOB0",132,0)
 I Y'>0 S IBOK=0
"RTN","IBCEOB0",133,0)
 I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for service line adjustment-3"
"RTN","IBCEOB0",134,0)
 ;
"RTN","IBCEOB0",135,0)
 ; For Medicare MRA's only:
"RTN","IBCEOB0",136,0)
 ; Process and store the line level remark code as an LQ kludge line
"RTN","IBCEOB0",137,0)
 ; level adjustment.
"RTN","IBCEOB0",138,0)
 ;
"RTN","IBCEOB0",139,0)
 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$P(IB0,U,3)'="" D
"RTN","IBCEOB0",140,0)
 . N IB45,IBSAV40
"RTN","IBCEOB0",141,0)
 . S IB45=45_U_$P(IB0,U,2)_U_"LQ"_U_$P(IB0,U,3)_U_0_U_0_U_$P(IB0,U,4)
"RTN","IBCEOB0",142,0)
 . S IBSAV40=$G(^TMP($J,40))
"RTN","IBCEOB0",143,0)
 . D 45(IB45,IBEOB,.IBOK)
"RTN","IBCEOB0",144,0)
 . S ^TMP($J,40)=IBSAV40
"RTN","IBCEOB0",145,0)
 . I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the LQ-remark code adjustment at line "_+^TMP($J,40)
"RTN","IBCEOB0",146,0)
 . Q
"RTN","IBCEOB0",147,0)
Q42 Q
"RTN","IBCEOB0",148,0)
 ;
"RTN","IBCEOB0",149,0)
45(IB0,IBEOB,IBOK) ; Process record type 45 for EOB 
"RTN","IBCEOB0",150,0)
 ; IB0 = the record being processed
"RTN","IBCEOB0",151,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB0",152,0)
 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
"RTN","IBCEOB0",153,0)
 ;
"RTN","IBCEOB0",154,0)
 N IBDA,LEVEL,A,Z0,CT,Z
"RTN","IBCEOB0",155,0)
 I '$G(^TMP($J,40)) D  G Q45
"RTN","IBCEOB0",156,0)
 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment has no corresponding service line"
"RTN","IBCEOB0",157,0)
 . D DET4X^IBCEOB00(45,IB0,.Z0)
"RTN","IBCEOB0",158,0)
 . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F  S Z=$O(Z0(Z)) Q:'Z  S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
"RTN","IBCEOB0",159,0)
 ;
"RTN","IBCEOB0",160,0)
 I $P(IB0,U,3)'="" S $P(^TMP($J,40),U,2)=$P(IB0,U,3)
"RTN","IBCEOB0",161,0)
 I $P(IB0,U,3)="" S $P(IB0,U,3)=$P(^TMP($J,40),U,2)
"RTN","IBCEOB0",162,0)
 I $P(IB0,U,3)="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment is missing its group code" G Q45
"RTN","IBCEOB0",163,0)
 ;
"RTN","IBCEOB0",164,0)
 S IBDA(2)=+^TMP($J,40)
"RTN","IBCEOB0",165,0)
 S IBDA(1)=+$O(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",$P(IB0,U,3),0))
"RTN","IBCEOB0",166,0)
 ;
"RTN","IBCEOB0",167,0)
 I 'IBDA(1) D  ;Needs a new entry at group level
"RTN","IBCEOB0",168,0)
 . N X,Y,DA,DD,DO,DIC,DLAYGO
"RTN","IBCEOB0",169,0)
 . S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,",DIC(0)="L",DLAYGO=361.1151,DA(2)=IBEOB,DA(1)=IBDA(2)
"RTN","IBCEOB0",170,0)
 . S DIC("P")=$$GETSPEC^IBEFUNC(361.115,1)
"RTN","IBCEOB0",171,0)
 . S X=$P(IB0,U,3)
"RTN","IBCEOB0",172,0)
 . D FILE^DICN K DIC,DO,DD,DLAYGO
"RTN","IBCEOB0",173,0)
 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
"RTN","IBCEOB0",174,0)
 . S IBDA(1)=+Y
"RTN","IBCEOB0",175,0)
 ;
"RTN","IBCEOB0",176,0)
 ;Add a new entry at the reason code level
"RTN","IBCEOB0",177,0)
 I $G(IBDA(1)) D
"RTN","IBCEOB0",178,0)
 . S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.11511,DA(1)=IBDA(1),DA(2)=IBDA(2),DA(3)=IBEOB
"RTN","IBCEOB0",179,0)
 . S DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1)
"RTN","IBCEOB0",180,0)
 . S X=$P(IB0,U,4)
"RTN","IBCEOB0",181,0)
 . D FILE^DICN K DIC,DO,DD,DLAYGO
"RTN","IBCEOB0",182,0)
 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add reason code ("_$P(IB0,U,4)_") for adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
"RTN","IBCEOB0",183,0)
 . S IBDA=+Y
"RTN","IBCEOB0",184,0)
 ;
"RTN","IBCEOB0",185,0)
 I $G(IBDA) D
"RTN","IBCEOB0",186,0)
 . S LEVEL=15,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,"
"RTN","IBCEOB0",187,0)
 . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBDA(2),LEVEL(3)=IBEOB
"RTN","IBCEOB0",188,0)
 . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0"
"RTN","IBCEOB0",189,0)
 . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
"RTN","IBCEOB0",190,0)
 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for reason code ("_$P(IB0,U,4)_"), adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
"RTN","IBCEOB0",191,0)
 ;
"RTN","IBCEOB0",192,0)
Q45 Q
"RTN","IBCEOB0",193,0)
 ;
"RTN","IBCEOB0",194,0)
46(IB0,IBEOB,IBOK) ; Process record type 46 for EOB 
"RTN","IBCEOB0",195,0)
 ; IB0 = the record being processed
"RTN","IBCEOB0",196,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB0",197,0)
 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
"RTN","IBCEOB0",198,0)
 ;
"RTN","IBCEOB0",199,0)
 S IBOK=0
"RTN","IBCEOB0",200,0)
 N AGC,IBDA,LEVEL,A,Z0,CT,Z
"RTN","IBCEOB0",201,0)
 I '$G(^TMP($J,40)) D  G Q46
"RTN","IBCEOB0",202,0)
 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment has no corresponding service line"
"RTN","IBCEOB0",203,0)
 . D DET4X^IBCEOB00(46,IB0,.Z0)
"RTN","IBCEOB0",204,0)
 . ;S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F  S Z=$O(Z0(Z)) Q:'Z  S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
"RTN","IBCEOB0",205,0)
 ;
"RTN","IBCEOB0",206,0)
 S AGC=$P(^TMP($J,40),U,2)
"RTN","IBCEOB0",207,0)
 I AGC="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment is missing its group code" G Q46
"RTN","IBCEOB0",208,0)
 ;
"RTN","IBCEOB0",209,0)
 S IBDA(2)=+^TMP($J,40)
"RTN","IBCEOB0",210,0)
 S IBDA(1)=+$O(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",AGC,0))
"RTN","IBCEOB0",211,0)
 ;
"RTN","IBCEOB0",212,0)
 ;
"RTN","IBCEOB0",213,0)
 ;Add a new entry at the Payer Policy level
"RTN","IBCEOB0",214,0)
 I $G(IBDA(1)) D
"RTN","IBCEOB0",215,0)
 . S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",2,",DIC(0)="L",DLAYGO=361.11511,DA(1)=IBDA(1),DA(2)=IBDA(2),DA(3)=IBEOB
"RTN","IBCEOB0",216,0)
 . S DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1)
"RTN","IBCEOB0",217,0)
 . S X=$P(IB0,U,3)
"RTN","IBCEOB0",218,0)
 . D FILE^DICN K DIC,DO,DD,DLAYGO
"RTN","IBCEOB0",219,0)
 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add payer policy ("_$P(IB0,U,4)_") for adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
"RTN","IBCEOB0",220,0)
 . S IBDA=+Y,IBOK=1
"RTN","IBCEOB0",221,0)
 ;
"RTN","IBCEOB0",222,0)
Q46 Q
"RTN","IBCEOB0",223,0)
 ;
"RTN","IBCEOB00")
0^4^B76540225
"RTN","IBCEOB00",1,0)
IBCEOB00 ;ALB/ESG/PJH - 835 EDI EOB MSG PROCESSING CONT ;30-JUN-2003
"RTN","IBCEOB00",2,0)
 ;;2.0;INTEGRATED BILLING;**155,349,377,431**;21-MAR-94;Build 106
"RTN","IBCEOB00",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCEOB00",4,0)
 Q
"RTN","IBCEOB00",5,0)
 ;
"RTN","IBCEOB00",6,0)
RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check -
"RTN","IBCEOB00",7,0)
 ; Total up outbound line items by revenue code and compare with
"RTN","IBCEOB00",8,0)
 ; incoming EOB 40 record to see if it has been rolled up
"RTN","IBCEOB00",9,0)
 ;
"RTN","IBCEOB00",10,0)
 ; IBZDATA - UB output formatter array, passed by reference
"RTN","IBCEOB00",11,0)
 ; IB0     - 40 record data
"RTN","IBCEOB00",12,0)
 ; IBLN    - output parameter, passed by reference
"RTN","IBCEOB00",13,0)
 ;
"RTN","IBCEOB00",14,0)
 NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH
"RTN","IBCEOB00",15,0)
 I $P(IB0,U,4)="" G RCRUX
"RTN","IBCEOB00",16,0)
 S IBLN="",Z=0
"RTN","IBCEOB00",17,0)
 F  S Z=$O(IBZDATA(Z)) Q:'Z  S LN=IBZDATA(Z) D
"RTN","IBCEOB00",18,0)
 . S REV=$P(LN,U,1),UN=$P(LN,U,4),CH=$P(LN,U,5),UCH=+$P(LN,U,3)
"RTN","IBCEOB00",19,0)
 . I REV="" Q
"RTN","IBCEOB00",20,0)
 . ;
"RTN","IBCEOB00",21,0)
 . S RUD=$G(RUD(REV))                 ; roll up data array for rev code
"RTN","IBCEOB00",22,0)
 . S $P(RUD,U,1)=$P(RUD,U,1)+CH       ; total charges
"RTN","IBCEOB00",23,0)
 . S $P(RUD,U,2)=$P(RUD,U,2)+UN       ; total units
"RTN","IBCEOB00",24,0)
 . S $P(RUD,U,3)=$P(RUD,U,3)+1        ; total line items
"RTN","IBCEOB00",25,0)
 . S RUD(REV)=RUD
"RTN","IBCEOB00",26,0)
 . S RUD(REV,Z)=""
"RTN","IBCEOB00",27,0)
 . ;
"RTN","IBCEOB00",28,0)
 . S RUD2=$G(RUD2(REV,UCH))           ; roll up data array for rev code
"RTN","IBCEOB00",29,0)
 . S $P(RUD2,U,1)=$P(RUD2,U,1)+CH     ; total charges
"RTN","IBCEOB00",30,0)
 . S $P(RUD2,U,2)=$P(RUD2,U,2)+UN     ; total units
"RTN","IBCEOB00",31,0)
 . S $P(RUD2,U,3)=$P(RUD2,U,3)+1      ; total line items
"RTN","IBCEOB00",32,0)
 . S RUD2(REV,UCH)=RUD2
"RTN","IBCEOB00",33,0)
 . S RUD2(REV,UCH,Z)=""
"RTN","IBCEOB00",34,0)
 . ;
"RTN","IBCEOB00",35,0)
 . Q
"RTN","IBCEOB00",36,0)
 ;
"RTN","IBCEOB00",37,0)
 I '$D(RUD),'$D(RUD2) G RCRUX
"RTN","IBCEOB00",38,0)
 ;
"RTN","IBCEOB00",39,0)
 ; delete the revenue code roll-up, if only 1 line item.
"RTN","IBCEOB00",40,0)
 S REV=""     ; this is not a roll up situation
"RTN","IBCEOB00",41,0)
 F  S REV=$O(RUD(REV)) Q:REV=""  I $P(RUD(REV),U,3)=1 KILL RUD(REV)
"RTN","IBCEOB00",42,0)
 ;
"RTN","IBCEOB00",43,0)
 S (REV,UCH)=""
"RTN","IBCEOB00",44,0)
 F  S REV=$O(RUD2(REV)) Q:REV=""  F  S UCH=$O(RUD2(REV,UCH)) Q:UCH=""  I $P(RUD2(REV,UCH),U,3)=1 KILL RUD2(REV,UCH)
"RTN","IBCEOB00",45,0)
 ;
"RTN","IBCEOB00",46,0)
 I '$D(RUD),'$D(RUD2) G RCRUX
"RTN","IBCEOB00",47,0)
 ;
"RTN","IBCEOB00",48,0)
 S RUD=$G(RUD($P(IB0,U,4)))      ; compare with 40 record data
"RTN","IBCEOB00",49,0)
 I RUD="" G RCRU2                ; make sure it exists
"RTN","IBCEOB00",50,0)
 I $P(RUD,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRU2    ; charges
"RTN","IBCEOB00",51,0)
 I $P(RUD,U,2)'=$P(IB0,U,16) G RCRU2                      ; units
"RTN","IBCEOB00",52,0)
 S IBLN=$O(RUD($P(IB0,U,4),""))  ; use the first line# found
"RTN","IBCEOB00",53,0)
 G RCRUX
"RTN","IBCEOB00",54,0)
 ;
"RTN","IBCEOB00",55,0)
RCRU2 ; check roll-up data by rev code and unit charge
"RTN","IBCEOB00",56,0)
 S MRAUCH=0
"RTN","IBCEOB00",57,0)
 I $P(IB0,U,16) S MRAUCH=+$$DOLLAR^IBCEOB($P(IB0,U,15))/$P(IB0,U,16)
"RTN","IBCEOB00",58,0)
 S RUD2=$G(RUD2($P(IB0,U,4),MRAUCH))     ; compare with 40 record data
"RTN","IBCEOB00",59,0)
 I RUD2="" G RCRUX                       ; make sure it exists
"RTN","IBCEOB00",60,0)
 I $P(RUD2,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRUX   ; charges
"RTN","IBCEOB00",61,0)
 I $P(RUD2,U,2)'=$P(IB0,U,16) G RCRUX                     ; units
"RTN","IBCEOB00",62,0)
 S IBLN=$O(RUD2($P(IB0,U,4),MRAUCH,""))  ; use the first line# found
"RTN","IBCEOB00",63,0)
 ;
"RTN","IBCEOB00",64,0)
RCRUX ;
"RTN","IBCEOB00",65,0)
 Q
"RTN","IBCEOB00",66,0)
 ;
"RTN","IBCEOB00",67,0)
ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill
"RTN","IBCEOB00",68,0)
 ;
"RTN","IBCEOB00",69,0)
 ; Input parameters
"RTN","IBCEOB00",70,0)
 ;   IBEOB - ien to file 361.1
"RTN","IBCEOB00",71,0)
 ;   ICN   - the ICN# from the 835 transmission
"RTN","IBCEOB00",72,0)
 ;   COBN  - the insurance sequence#
"RTN","IBCEOB00",73,0)
 ;
"RTN","IBCEOB00",74,0)
 ; Output parameter
"RTN","IBCEOB00",75,0)
 ;   IBOK  - returns as 0 if we get a filing error here
"RTN","IBCEOB00",76,0)
 ;
"RTN","IBCEOB00",77,0)
 ; The field in file 399 depends on the current payer sequence
"RTN","IBCEOB00",78,0)
 ;     399,453 - primary ICN
"RTN","IBCEOB00",79,0)
 ;     399,454 - secondary ICN
"RTN","IBCEOB00",80,0)
 ;     399,455 - tertiary ICN
"RTN","IBCEOB00",81,0)
 ;
"RTN","IBCEOB00",82,0)
 NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
"RTN","IBCEOB00",83,0)
 S IBEOB=+$G(IBEOB),COBN=+$G(COBN)
"RTN","IBCEOB00",84,0)
 I 'IBEOB!'COBN G ICNX
"RTN","IBCEOB00",85,0)
 S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1)
"RTN","IBCEOB00",86,0)
 I '$D(^DGCR(399,IBIFN)) G ICNX
"RTN","IBCEOB00",87,0)
 I $G(ICN)="" G ICNX
"RTN","IBCEOB00",88,0)
 I '$F(".1.2.3.","."_COBN_".") G ICNX
"RTN","IBCEOB00",89,0)
 ;
"RTN","IBCEOB00",90,0)
 S FIELD=452+COBN
"RTN","IBCEOB00",91,0)
 S DIE=399,DA=IBIFN,DR=FIELD_"////"_ICN D ^DIE
"RTN","IBCEOB00",92,0)
 S IBOK=($D(Y)=0)
"RTN","IBCEOB00",93,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Error in filing the ICN into the Bill/Claims file"
"RTN","IBCEOB00",94,0)
ICNX ;
"RTN","IBCEOB00",95,0)
 Q
"RTN","IBCEOB00",96,0)
 ;
"RTN","IBCEOB00",97,0)
15(IB0,IBEGBL,IBEOB) ; Record '15'
"RTN","IBCEOB00",98,0)
 ;
"RTN","IBCEOB00",99,0)
 N A,IBOK
"RTN","IBCEOB00",100,0)
 ;
"RTN","IBCEOB00",101,0)
 S A="3;1.03;1;0;0^4;1.04;1;0;0^5;1.05;1;0;0^6;1.07;1;0;0^7;1.08;1;0;0^8;1.09;1;0;0^9;1.02;1;0;0^10;2.05;1;0;0"
"RTN","IBCEOB00",102,0)
 ;
"RTN","IBCEOB00",103,0)
 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
"RTN","IBCEOB00",104,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 15 data" G Q15
"RTN","IBCEOB00",105,0)
 ;
"RTN","IBCEOB00",106,0)
 ; For Medicare MRA's only:
"RTN","IBCEOB00",107,0)
 ; If the Covered Amount is present (15 record, piece 3), then file
"RTN","IBCEOB00",108,0)
 ; a claim level adjustment with Group code=OA, Reason code=AB3.
"RTN","IBCEOB00",109,0)
 ;
"RTN","IBCEOB00",110,0)
 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D
"RTN","IBCEOB00",111,0)
 . N IB20
"RTN","IBCEOB00",112,0)
 . S IB20=20_U_$P(IB0,U,2)_U_"OA"_U_"AB3"_U_$P(IB0,U,3)_U_"0000000000"
"RTN","IBCEOB00",113,0)
 . S IB20=IB20_U_"Covered Amount"
"RTN","IBCEOB00",114,0)
 . S IBOK=$$20(IB20,IBEGBL,IBEOB)
"RTN","IBCEOB00",115,0)
 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the OA-AB3 claim level adjustment for the Covered Amount"
"RTN","IBCEOB00",116,0)
 . K ^TMP($J,20)
"RTN","IBCEOB00",117,0)
 . Q
"RTN","IBCEOB00",118,0)
 ;
"RTN","IBCEOB00",119,0)
Q15 Q IBOK
"RTN","IBCEOB00",120,0)
 ;
"RTN","IBCEOB00",121,0)
20(IB0,IBEGBL,IBEOB) ; Record '20'
"RTN","IBCEOB00",122,0)
 ;
"RTN","IBCEOB00",123,0)
 N A,LEVEL,IBGRP,IBDA,IBOK
"RTN","IBCEOB00",124,0)
 ;
"RTN","IBCEOB00",125,0)
 S IBGRP=$P(IB0,U,3)
"RTN","IBCEOB00",126,0)
 I IBGRP'="" S ^TMP($J,20)=IBGRP
"RTN","IBCEOB00",127,0)
 I IBGRP="" S IBGRP=$G(^TMP($J,20))
"RTN","IBCEOB00",128,0)
 I IBGRP="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Missing claim level adjustment group code" G Q20
"RTN","IBCEOB00",129,0)
 ;
"RTN","IBCEOB00",130,0)
 S IBDA(1)=$O(^IBM(361.1,IBEOB,10,"B",IBGRP,0))
"RTN","IBCEOB00",131,0)
 ;
"RTN","IBCEOB00",132,0)
 I 'IBDA(1) D  ;Needs a new entry at group level
"RTN","IBCEOB00",133,0)
 . N X,Y,DA,DD,DO,DIC,DLAYGO
"RTN","IBCEOB00",134,0)
 . S DIC="^IBM(361.1,"_IBEOB_",10,",DIC(0)="L",DLAYGO=361.11,DA(1)=IBEOB
"RTN","IBCEOB00",135,0)
 . S DIC("P")=$$GETSPEC^IBEFUNC(361.1,10)
"RTN","IBCEOB00",136,0)
 . S X=IBGRP
"RTN","IBCEOB00",137,0)
 . D FILE^DICN K DIC,DO,DD,DLAYGO
"RTN","IBCEOB00",138,0)
 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment group code could not be added" Q
"RTN","IBCEOB00",139,0)
 . S IBDA(1)=+Y
"RTN","IBCEOB00",140,0)
 ;
"RTN","IBCEOB00",141,0)
 I $G(IBDA(1)) D  ;Add a new entry at the reason code level
"RTN","IBCEOB00",142,0)
 . S DIC="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.111,DA(2)=IBEOB,DA(1)=IBDA(1)
"RTN","IBCEOB00",143,0)
 . S DIC("P")=$$GETSPEC^IBEFUNC(361.11,1)
"RTN","IBCEOB00",144,0)
 . S X=$P(IB0,U,4)
"RTN","IBCEOB00",145,0)
 . D FILE^DICN K DIC,DO,DD,DLAYGO
"RTN","IBCEOB00",146,0)
 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment reason code could not be added" Q
"RTN","IBCEOB00",147,0)
 . S IBDA=+Y
"RTN","IBCEOB00",148,0)
 ;
"RTN","IBCEOB00",149,0)
 I $G(IBDA) D
"RTN","IBCEOB00",150,0)
 . S LEVEL=10,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,"
"RTN","IBCEOB00",151,0)
 . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBEOB
"RTN","IBCEOB00",152,0)
 . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0"
"RTN","IBCEOB00",153,0)
 . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
"RTN","IBCEOB00",154,0)
 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad adjustment reason code ("_$P(IB0,U,4)_") data" Q
"RTN","IBCEOB00",155,0)
Q20 Q $G(IBOK)
"RTN","IBCEOB00",156,0)
 ;
"RTN","IBCEOB00",157,0)
35(IB0,IBEGBL,IBEOB) ; Record '35'
"RTN","IBCEOB00",158,0)
 ;
"RTN","IBCEOB00",159,0)
 N A,IBOK
"RTN","IBCEOB00",160,0)
 ;
"RTN","IBCEOB00",161,0)
 S A="3;4.12;1;0;0^4;4.13;1;0;0^5;4.14;0;1;1^6;4.15;1;0;0^7;4.16;1;0;0^8;4.17;1;0;0^9;4.18;1;0;0^10;4.04;1;0;0^11;3.01;0;1;1^12;3.02;1;0;0^13;3.08;1;0;0^14;3.09;1;0;0"
"RTN","IBCEOB00",162,0)
 ;
"RTN","IBCEOB00",163,0)
 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
"RTN","IBCEOB00",164,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
"RTN","IBCEOB00",165,0)
Q35 Q $G(IBOK)
"RTN","IBCEOB00",166,0)
 ;
"RTN","IBCEOB00",167,0)
37(IB0,IBEGBL,IBEOB) ; Record '37'
"RTN","IBCEOB00",168,0)
 ;
"RTN","IBCEOB00",169,0)
 N IBOK,IBCT
"RTN","IBCEOB00",170,0)
 S IBCT=$G(^TMP($J,37))+1
"RTN","IBCEOB00",171,0)
 I IBCT>5 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Too many Medicare Claim Level Adjudication Remarks" G Q37    ; Max 5 allowed
"RTN","IBCEOB00",172,0)
 S A="4;"_$S($P(IB0,U,3)="O":"3.0"_(IBCT+2),1:"5.0"_IBCT)_";0;0;0^5;5.0"_IBCT_"1;0;0;0"
"RTN","IBCEOB00",173,0)
 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
"RTN","IBCEOB00",174,0)
 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data"
"RTN","IBCEOB00",175,0)
 ;
"RTN","IBCEOB00",176,0)
 ; 4/22/03 - esg - If claim level remark code MA15 is reported, then
"RTN","IBCEOB00",177,0)
 ;         this is a split EOB and we need to change the REVIEW STATUS
"RTN","IBCEOB00",178,0)
 ;         of this EOB to be ACCEPTED-INTERIM EOB.
"RTN","IBCEOB00",179,0)
 ;
"RTN","IBCEOB00",180,0)
 I $P(IB0,U,4)["MA15" D
"RTN","IBCEOB00",181,0)
 . N DA,DIE,DR,DIC
"RTN","IBCEOB00",182,0)
 . S DA=IBEOB,DIE=361.1,DR=".16////2" D ^DIE S IBOK=($D(Y)=0)
"RTN","IBCEOB00",183,0)
 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Split EOB, but review status was not updated correctly"
"RTN","IBCEOB00",184,0)
 . Q
"RTN","IBCEOB00",185,0)
 ;
"RTN","IBCEOB00",186,0)
Q37 S ^TMP($J,37)=$G(^TMP($J,37))+1 ; Saves the # of entries for 37 records
"RTN","IBCEOB00",187,0)
 Q $G(IBOK)
"RTN","IBCEOB00",188,0)
 ;
"RTN","IBCEOB00",189,0)
 ;
"RTN","IBCEOB00",190,0)
DET40(IB0,ARRAY) ; Format important details of record 40 for error
"RTN","IBCEOB00",191,0)
 ; IB0 = data on 40 record (some pieces pre-formatted)
"RTN","IBCEOB00",192,0)
 ;  ARRAY(n)=formatted line is returned if passed by ref
"RTN","IBCEOB00",193,0)
 N Q
"RTN","IBCEOB00",194,0)
 S ARRAY(1)="Payer reported the following was billed to them:"
"RTN","IBCEOB00",195,0)
 S ARRAY(2)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,10)'="":$P(IB0,U,10),1:"Same as adjudicated")_"  Chg: "_$J($P(IB0,U,15)/100,"",2)_"  Units: "_$S($P(IB0,U,16):$P(IB0,U,16),1:1)
"RTN","IBCEOB00",196,0)
 S ARRAY(3)="  Svc Date(s): "_$S($P(IB0,U,19)'="":$$FDT($P(IB0,U,19)),1:"??")_$S($P(IB0,U,20)'="":"-"_$$FDT($P(IB0,U,20)),1:"")
"RTN","IBCEOB00",197,0)
 I $P(IB0,U,11)'="" S ARRAY(3)=ARRAY(3)_"  Mods: " F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(3)=ARRAY(3)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"")
"RTN","IBCEOB00",198,0)
 S ARRAY(4)="Payer reported adjudication on:"
"RTN","IBCEOB00",199,0)
 S ARRAY(5)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,3)'="":$P(IB0,U,3),1:$P(IB0,U,4))
"RTN","IBCEOB00",200,0)
 S ARRAY(5)=ARRAY(5)_"  Type: "_$P(IB0,U,21)_$S($P(IB0,U,21)'="NU":"  Rev Cd: "_$P(IB0,U,4),1:"")_"  Units: "_$S($P(IB0,U,18):$P(IB0,U,18)/100,1:1)_"  Amt: "_$J($P(IB0,U,17)/100,"",2)
"RTN","IBCEOB00",201,0)
 I $P(IB0,U,5)'="" S ARRAY(5)=ARRAY(5)_"  Mods: " F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(5)=ARRAY(5)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"")
"RTN","IBCEOB00",202,0)
 Q
"RTN","IBCEOB00",203,0)
 ;
"RTN","IBCEOB00",204,0)
DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-46 for error
"RTN","IBCEOB00",205,0)
 ; RECID = 41,42,45,46
"RTN","IBCEOB00",206,0)
 ; IB0 = data on RECID record
"RTN","IBCEOB00",207,0)
 ;  ARRAY(n)=formatted line is returned if passed by ref
"RTN","IBCEOB00",208,0)
 N CT,Q
"RTN","IBCEOB00",209,0)
 I RECID=41 D  Q
"RTN","IBCEOB00",210,0)
 . S ARRAY(1)="Allowed Amt: "_$J($P(IB0,U,3)/100,"",2)_"  Per Diem Amt: "_$J($P(IB0,U,4)/100,"",2)
"RTN","IBCEOB00",211,0)
 ;
"RTN","IBCEOB00",212,0)
 I RECID=42 D  Q
"RTN","IBCEOB00",213,0)
 . S ARRAY(1)="Line Item Remark Code: "_$P(IB0,U,3)
"RTN","IBCEOB00",214,0)
 . I $P(IB0,U,4)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,4),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,4),Q+1,Q+80)
"RTN","IBCEOB00",215,0)
 ;
"RTN","IBCEOB00",216,0)
 I RECID=45 D
"RTN","IBCEOB00",217,0)
 . S ARRAY(1)="Adj Group Cd: "_$P(IB0,U,3)_"  Reason Cd: "_$P(IB0,U,4)_"  Amt: "_$J($P(IB0,U,5)/100,"",2)_"  Quantity: "_+$P(IB0,U,6)
"RTN","IBCEOB00",218,0)
 . I $P(IB0,U,7)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,7),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,7),Q+1,Q+80)
"RTN","IBCEOB00",219,0)
 ;
"RTN","IBCEOB00",220,0)
 I RECID=46 D
"RTN","IBCEOB00",221,0)
 . S ARRAY(1)="Payer Policy Reference: "_$P(IB0,U,3)
"RTN","IBCEOB00",222,0)
 Q
"RTN","IBCEOB00",223,0)
 ; 
"RTN","IBCEOB00",224,0)
FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY
"RTN","IBCEOB00",225,0)
 S:X'="" X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
"RTN","IBCEOB00",226,0)
 Q X
"RTN","IBCEOB00",227,0)
 ;
"RTN","IBCEOB1")
0^11^B69809131
"RTN","IBCEOB1",1,0)
IBCEOB1 ;ALB/TMP/PJH - 835 EDI EOB MSG PROCESSING ; 7/13/10 5:32pm
"RTN","IBCEOB1",2,0)
 ;;2.0;INTEGRATED BILLING;**137,135,155,296,356,349,431**;21-MAR-94;Build 106
"RTN","IBCEOB1",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBCEOB1",4,0)
 Q
"RTN","IBCEOB1",5,0)
 ;
"RTN","IBCEOB1",6,0)
STORE(A,IB0,IBEOB,LEVEL) ;
"RTN","IBCEOB1",7,0)
 ; A = the string of data to extract and try to store
"RTN","IBCEOB1",8,0)
 ;       each ^ piece is a field to store
"RTN","IBCEOB1",9,0)
 ;         within each ^ piece, there are 5 ';' pieces:
"RTN","IBCEOB1",10,0)
 ;            1 = piece to extract from the data string;
"RTN","IBCEOB1",11,0)
 ;            2 = field to update;
"RTN","IBCEOB1",12,0)
 ;            3 = flag for dollar amt (1=YES);
"RTN","IBCEOB1",13,0)
 ;            4 = flag for 4-slash stuff without transform (1=YES);
"RTN","IBCEOB1",14,0)
 ;            5 = flag for numeric/non-dollar amt (1=Yes, 0=No,
"RTN","IBCEOB1",15,0)
 ;                 Dn = the field is numeric with 'n' decimal places
"RTN","IBCEOB1",16,0)
 ; IB0 = the record being processed
"RTN","IBCEOB1",17,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB1",18,0)
 ; LEVEL = the array that contains the DIE and DA values if stuffing at a
"RTN","IBCEOB1",19,0)
 ;         level other than the top level
"RTN","IBCEOB1",20,0)
 ;
"RTN","IBCEOB1",21,0)
 N B,IBPC,IBFLD,DA,DR,DIE,X,Y
"RTN","IBCEOB1",22,0)
 S DR=";"
"RTN","IBCEOB1",23,0)
 ;
"RTN","IBCEOB1",24,0)
 I '$G(LEVEL) S DIE="^IBM(361.1,",DA=IBEOB
"RTN","IBCEOB1",25,0)
 ;
"RTN","IBCEOB1",26,0)
 I $G(LEVEL) D
"RTN","IBCEOB1",27,0)
 . N Q
"RTN","IBCEOB1",28,0)
 . S DIE=$G(LEVEL("DIE"))
"RTN","IBCEOB1",29,0)
 . S Q=0 F  S Q=$O(LEVEL(Q)) Q:'Q  S DA(Q)=LEVEL(Q)
"RTN","IBCEOB1",30,0)
 . S DA=LEVEL(0)
"RTN","IBCEOB1",31,0)
 ;
"RTN","IBCEOB1",32,0)
 I $G(DA) F B=1:1:$L(A,U) D
"RTN","IBCEOB1",33,0)
 . S IBPC=$P(A,U,B),IBFLD=$P(IBPC,";",2)
"RTN","IBCEOB1",34,0)
 . I $P(IB0,U,+IBPC)'="",IBFLD D
"RTN","IBCEOB1",35,0)
 .. N VAL
"RTN","IBCEOB1",36,0)
 .. ; For dollar amts, add full cents; For numerics, strip leading
"RTN","IBCEOB1",37,0)
 .. ;   0's; For non-numeric/non-dollar amts, make any ; in data into |
"RTN","IBCEOB1",38,0)
 .. S VAL=$S($P(IBPC,";",3):$$DOLLAR^IBCEOB($P(IB0,U,+IBPC)),$P(IBPC,";",5):+$P(IB0,U,+IBPC),$P($P(IBPC,";",5),"D",2):$P(IB0,U,+IBPC)/(10**$P($P(IBPC,";",5),"D",2)),1:$TR($P(IB0,U,+IBPC),";","|"))
"RTN","IBCEOB1",39,0)
 .. I $P(IBPC,";",3),VAL S VAL=$P(VAL,".")_"."_$E($P(VAL,".",2)_"00",1,2)
"RTN","IBCEOB1",40,0)
 .. S DR=DR_IBFLD_"///"_$S($P(IBPC,";",4):"/",1:"")_VAL_";"
"RTN","IBCEOB1",41,0)
 ;
"RTN","IBCEOB1",42,0)
 S DR=$P(DR,";",2,$L(DR,";")-1)
"RTN","IBCEOB1",43,0)
 I DR'="" D ^DIE
"RTN","IBCEOB1",44,0)
 Q ($D(Y)=0) ;Successfully stored all the data it was sent if $D(Y)=0
"RTN","IBCEOB1",45,0)
 ;
"RTN","IBCEOB1",46,0)
HDR(IB0,IBEGBL,IBEOB,HIPAA) ; Store header data for EOB
"RTN","IBCEOB1",47,0)
 ; IB0 = the record being processed from the msg
"RTN","IBCEOB1",48,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB1",49,0)
 ;
"RTN","IBCEOB1",50,0)
 N IBDT,IBDTP,DA,DR,DIE,X,Y
"RTN","IBCEOB1",51,0)
 K IBXSAVE("XTRA"),IBZSAVE
"RTN","IBCEOB1",52,0)
 ;
"RTN","IBCEOB1",53,0)
 S HIPAA=+$P(IB0,U,16) ;HIPAA Version code
"RTN","IBCEOB1",54,0)
 S IBDT=$P(IB0,U,3),IBDT=$E(IBDT,1,4)-1700_$E(IBDT,5,8)_"."_$P(IB0,U,4)
"RTN","IBCEOB1",55,0)
 S IBDTP=$P(IB0,U,9)
"RTN","IBCEOB1",56,0)
 I IBDTP S IBDTP=$E(IBDTP,1,4)-1700_$E(IBDTP,5,8)
"RTN","IBCEOB1",57,0)
 S DR=$S($P(IB0,U,7)'="":".03////"_$P(IB0,U,7)_";",1:"")_".05////"_IBDT_";.04////"_($P(IB0,U,5)="Y")_";.15///"_$$COBN^IBCEF(+$G(^IBM(361.1,IBEOB,0)))_";.07///"_$P(IB0,U,8)_$S(IBDTP:";.06////"_IBDTP,1:"")
"RTN","IBCEOB1",58,0)
 S DIE="^IBM(361.1,",DA=IBEOB
"RTN","IBCEOB1",59,0)
 D ^DIE
"RTN","IBCEOB1",60,0)
 I $D(Y)'=0 D
"RTN","IBCEOB1",61,0)
 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad header data"
"RTN","IBCEOB1",62,0)
 Q ($D(Y)=0)
"RTN","IBCEOB1",63,0)
 ;
"RTN","IBCEOB1",64,0)
FINDLN(IB0,IBEOB,IBZDATA,PLREF) ; Find corresponding billed line for the adj
"RTN","IBCEOB1",65,0)
 ; IB0 = the record being processed
"RTN","IBCEOB1",66,0)
 ;       NOTE: pieces 3,4,16 are already reformatted
"RTN","IBCEOB1",67,0)
 ; IBEOB = the ien of the EOB entry in file 361.1
"RTN","IBCEOB1",68,0)
 ; IBZDATA = the array from the output formatter containing line
"RTN","IBCEOB1",69,0)
 ;           items for the bill.  This is passed in so this data only has
"RTN","IBCEOB1",70,0)
 ;           to be extracted once for each bill (the first time in, it
"RTN","IBCEOB1",71,0)
 ;           will be undefined)
"RTN","IBCEOB1",72,0)
 ; PLREF = Provider Line Reference
"RTN","IBCEOB1",73,0)
 ; OUTPUT = Line # in the original bill that this adjustment relates to
"RTN","IBCEOB1",74,0)
 ;          ^ paid procedure code if different from original procedure OR
"RTN","IBCEOB1",75,0)
 ;            paid rev code if different from original and no proc code
"RTN","IBCEOB1",76,0)
 ;
"RTN","IBCEOB1",77,0)
 N IBLN,IBLN1,IBBNDL,OCHG,OCHG2,OPROC,OREVCD,IBIFN,IBXARRAY,IBXARRY
"RTN","IBCEOB1",78,0)
 N IBXERR,UNITS,UNITS2,UNITS3,IBMOD,Z,Z0,CPT,EOBCHG,IBZVLA,IBAMIN
"RTN","IBCEOB1",79,0)
 ;
"RTN","IBCEOB1",80,0)
 S (IBLN,IBLN1)="",IBIFN=+$G(^IBM(361.1,IBEOB,0))
"RTN","IBCEOB1",81,0)
 S EOBCHG=+$$DOLLAR^IBCEOB($P(IB0,U,15))   ; charges on EOB 40 record
"RTN","IBCEOB1",82,0)
 ;
"RTN","IBCEOB1",83,0)
 ; if original procedure exists and is different than the 835 procedure,
"RTN","IBCEOB1",84,0)
 ; the procedure or revenue code originally billed will be in piece 10
"RTN","IBCEOB1",85,0)
 ; of the '40' record of the 835 flat file.  Otherwise, pc 10 is null.
"RTN","IBCEOB1",86,0)
 S IBBNDL=$S($P(IB0,U,10)'="":1,1:0)
"RTN","IBCEOB1",87,0)
 ;
"RTN","IBCEOB1",88,0)
 ; If this is a split MRA, build array of Vista line#'s from other split MRA's
"RTN","IBCEOB1",89,0)
 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$$SPLIT^IBCEMU1(IBEOB) D
"RTN","IBCEOB1",90,0)
 . N IEN S IEN=0
"RTN","IBCEOB1",91,0)
 . F  S IEN=$O(^IBM(361.1,"B",IBIFN,IEN)) Q:'IEN  I IEN'=IBEOB D
"RTN","IBCEOB1",92,0)
 .. I $P($G(^IBM(361.1,IEN,0)),U,4)'=1 Q    ; not an MRA
"RTN","IBCEOB1",93,0)
 .. I '$$SPLIT^IBCEMU1(IEN) Q               ; not a split EOB
"RTN","IBCEOB1",94,0)
 .. M IBZVLA=^IBM(361.1,IEN,15,"AC")
"RTN","IBCEOB1",95,0)
 .. Q
"RTN","IBCEOB1",96,0)
 . Q
"RTN","IBCEOB1",97,0)
 ;
"RTN","IBCEOB1",98,0)
 I $P($G(^DGCR(399,IBIFN,0)),U,19)=3 D  G FINDLNX     ; UB-04 format
"RTN","IBCEOB1",99,0)
 . I '$D(IBZDATA) D F^IBCEF("N-UB-04 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
"RTN","IBCEOB1",100,0)
 . I +PLREF,$D(IBZDATA(+PLREF)) S IBLN=+PLREF_U_$P(IB0,U,10) Q
"RTN","IBCEOB1",101,0)
 . ;
"RTN","IBCEOB1",102,0)
 . S Z=0 F  S Z=$O(IBZDATA(Z)) Q:'Z  D  Q:IBLN
"RTN","IBCEOB1",103,0)
 .. ; Quit if processing an MRA and this VistA line# has already been filed
"RTN","IBCEOB1",104,0)
 .. I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$D(^IBM(361.1,IBEOB,15,"AC",Z)) Q
"RTN","IBCEOB1",105,0)
 .. ; Quit if split MRA and this VistA line# has already been filed
"RTN","IBCEOB1",106,0)
 .. I $D(IBZVLA(Z)) Q
"RTN","IBCEOB1",107,0)
 .. I $G(IBZDATA(Z))="" Q
"RTN","IBCEOB1",108,0)
 .. S OCHG=$P(IBZDATA(Z),U,3)*$P(IBZDATA(Z),U,4) ; Total charge from bill
"RTN","IBCEOB1",109,0)
 .. S OCHG2=+$P(IBZDATA(Z),U,5)
"RTN","IBCEOB1",110,0)
 .. I OCHG'=EOBCHG,OCHG2=EOBCHG S OCHG=OCHG2     ; update OCHG
"RTN","IBCEOB1",111,0)
 .. ;
"RTN","IBCEOB1",112,0)
 .. S CPT=$P(IBZDATA(Z),U,2)                        ; proc from bill
"RTN","IBCEOB1",113,0)
 .. I CPT'?.N,CPT'="" S CPT=$O(^ICPT("B",CPT,""))   ; non-numeric proc
"RTN","IBCEOB1",114,0)
 .. S OPROC=$$PRCD^IBCEF1(+CPT_";ICPT(")            ; ext proc code
"RTN","IBCEOB1",115,0)
 .. S OREVCD=+$P($G(^DGCR(399.2,+IBZDATA(Z),0)),U)  ; Rev cd from bill
"RTN","IBCEOB1",116,0)
 .. ;
"RTN","IBCEOB1",117,0)
 .. ; if not bundled/unbundled
"RTN","IBCEOB1",118,0)
 .. I 'IBBNDL D  Q
"RTN","IBCEOB1",119,0)
 ... I OPROC="",OREVCD,OREVCD'=$P(IB0,U,4) Q      ; revenue code
"RTN","IBCEOB1",120,0)
 ... I OPROC'="",OPROC'=$P(IB0,U,3) Q             ; procedure code
"RTN","IBCEOB1",121,0)
 ... I +$P(IBZDATA(Z),U,4)'=$P(IB0,U,16) Q        ; original units
"RTN","IBCEOB1",122,0)
 ... I +OCHG'=EOBCHG Q                            ; original charges
"RTN","IBCEOB1",123,0)
 ... I '$$MODMATCH($P(IBZDATA(Z),U,9),$P(IB0,U,5,8)),'$$MODMATCH($P($P(IBZDATA(Z),U,9),",",1),$P(IB0,U,5)) Q                    ; modifiers
"RTN","IBCEOB1",124,0)
 ... S IBLN=Z
"RTN","IBCEOB1",125,0)
 ... Q
"RTN","IBCEOB1",126,0)
 .. ;
"RTN","IBCEOB1",127,0)
 .. ; if bundled/unbundled
"RTN","IBCEOB1",128,0)
 .. I IBBNDL D  Q
"RTN","IBCEOB1",129,0)
 ... I OPROC="",OREVCD,OREVCD'=+$P(IB0,U,10) Q    ; revenue code
"RTN","IBCEOB1",130,0)
 ... I OPROC'="",OPROC'=$P(IB0,U,10) Q            ; procedure code
"RTN","IBCEOB1",131,0)
 ... I +$P(IBZDATA(Z),U,4)'=$P(IB0,U,16) Q        ; original units
"RTN","IBCEOB1",132,0)
 ... I +OCHG'=EOBCHG Q                            ; original charges
"RTN","IBCEOB1",133,0)
 ... I '$$MODMATCH($P(IBZDATA(Z),U,9),$P(IB0,U,11,14)),'$$MODMATCH($P($P(IBZDATA(Z),U,9),",",1),$P(IB0,U,11)) Q                 ; modifiers
"RTN","IBCEOB1",134,0)
 ... S IBLN=Z_U_$S(OPROC'="":OPROC,1:OREVCD)
"RTN","IBCEOB1",135,0)
 ... Q
"RTN","IBCEOB1",136,0)
 .. Q
"RTN","IBCEOB1",137,0)
 . ; When dealing with Inpatient UB-04's, check for revenue code roll-ups
"RTN","IBCEOB1",138,0)
 . I 'IBLN,$$INPAT^IBCEF(IBIFN,1) D RCRU^IBCEOB00(.IBZDATA,IB0,.IBLN)
"RTN","IBCEOB1",139,0)
 . ; If only 1 rev code and charges are the same, assume a match
"RTN","IBCEOB1",140,0)
 . I 'IBLN,'$P($G(^IBM(361.1,IBEOB,0)),U,4),$O(IBZDATA(""),-1)=$O(IBZDATA("")),+OCHG=EOBCHG S IBLN=+$O(IBZDATA(""))_U_OREVCD
"RTN","IBCEOB1",141,0)
 ;
"RTN","IBCEOB1",142,0)
 ; At this point, we can assume the claim is CMS-1500 format
"RTN","IBCEOB1",143,0)
 I '$D(IBZDATA) D F^IBCEF("N-HCFA 1500 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
"RTN","IBCEOB1",144,0)
 I PLREF,$D(IBZDATA(PLREF)) S IBLN=PLREF_U_$P(IB0,U,10) G FINDLNX
"RTN","IBCEOB1",145,0)
 S Z=0 F  S Z=$O(IBZDATA(Z)) Q:'Z  D  Q:IBLN
"RTN","IBCEOB1",146,0)
 . ; Quit if processing an MRA and this VistA line# has already been filed
"RTN","IBCEOB1",147,0)
 . I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$D(^IBM(361.1,IBEOB,15,"AC",Z)) Q
"RTN","IBCEOB1",148,0)
 . ; Quit if split MRA and this VistA line# has already been filed
"RTN","IBCEOB1",149,0)
 . I $D(IBZVLA(Z)) Q
"RTN","IBCEOB1",150,0)
 . S OCHG=$P(IBZDATA(Z),U,8)*$P(IBZDATA(Z),U,9) ; charge from bill
"RTN","IBCEOB1",151,0)
 . S IBAMIN=""
"RTN","IBCEOB1",152,0)
 . I $P(IBZDATA(Z),U,12)'="" S IBAMIN=$P(IBZDATA(Z),U,12)  ;anesthesia minutes
"RTN","IBCEOB1",153,0)
 . S UNITS=$S('IBAMIN:$P(IBZDATA(Z),U,9),1:IBAMIN/15)
"RTN","IBCEOB1",154,0)
 . ; original units from bill or anesthesia minutes calculation
"RTN","IBCEOB1",155,0)
 . I $P(UNITS,".",2) S UNITS=$FN(UNITS,"",1)    ; round to a single decimal place for fractional units
"RTN","IBCEOB1",156,0)
 . I $P($P(IB0,U,16),".",2) S $P(IB0,U,16)=$FN($P(IB0,U,16),"",1)
"RTN","IBCEOB1",157,0)
 . S UNITS2=$P(IBZDATA(Z),U,9)     ; just the units
"RTN","IBCEOB1",158,0)
 . ; UNITS3 is the number of anesthesia minutes divided by 10, or nil.
"RTN","IBCEOB1",159,0)
 . ; Solution to get around the Trailblazers bug for MRAs
"RTN","IBCEOB1",160,0)
 . S UNITS3=""
"RTN","IBCEOB1",161,0)
 . I IBAMIN'=0 S UNITS3=IBAMIN/10
"RTN","IBCEOB1",162,0)
 . ;
"RTN","IBCEOB1",163,0)
 . S CPT=$P(IBZDATA(Z),U,5)        ; proc from bill
"RTN","IBCEOB1",164,0)
 . I CPT'?.N,CPT'="" S CPT=$O(^ICPT("B",CPT,""))   ; non-numeric proc
"RTN","IBCEOB1",165,0)
 . S OPROC=$$PRCD^IBCEF1(+CPT_";ICPT(")            ; ext proc code
"RTN","IBCEOB1",166,0)
 . Q:OPROC'=$S('IBBNDL:$P(IB0,U,3),1:$P(IB0,U,10))
"RTN","IBCEOB1",167,0)
 . ;
"RTN","IBCEOB1",168,0)
 . S MODOK=0
"RTN","IBCEOB1",169,0)
 . I $$DOLLAR^IBCEFG1(OCHG)=+$P(IB0,U,15),UNITS=$P(IB0,U,16)!(UNITS2=$P(IB0,U,16))!(UNITS3=$P(IB0,U,16))!(IBAMIN=$P(IB0,U,16)),$S($P(IB0,U,19):$P(IB0,U,19)=$P(IBZDATA(Z),U),1:1) D
"RTN","IBCEOB1",170,0)
 .. ;Original procedure/chg/units/date match to get here
"RTN","IBCEOB1",171,0)
 .. ;Check matching original modifiers
"RTN","IBCEOB1",172,0)
 .. S MODOK=$$MODMATCH($$MODLST^IBEFUNC2($P(IBZDATA(Z),U,10)),$S('IBBNDL:$P(IB0,U,5,8),1:$P(IB0,U,11,14)))
"RTN","IBCEOB1",173,0)
 .. I 'MODOK,'IBLN1 S IBLN1=Z_$S(IBBNDL:U_OPROC,1:"")
"RTN","IBCEOB1",174,0)
 .. Q:'MODOK
"RTN","IBCEOB1",175,0)
 .. S IBLN=Z_$S(IBBNDL:U_OPROC,1:"")
"RTN","IBCEOB1",176,0)
 I 'IBLN,IBLN1 S IBLN=IBLN1
"RTN","IBCEOB1",177,0)
 ;
"RTN","IBCEOB1",178,0)
FINDLNX ;
"RTN","IBCEOB1",179,0)
 Q IBLN
"RTN","IBCEOB1",180,0)
 ;
"RTN","IBCEOB1",181,0)
MODMATCH(IB,MODLST) ; Match modifiers
"RTN","IBCEOB1",182,0)
 ; IB = the list of modifiers iens from the bill, comma delimited
"RTN","IBCEOB1",183,0)
 ; MODLST = the 4 '^' pieces of the reported modifiers
"RTN","IBCEOB1",184,0)
 ;
"RTN","IBCEOB1",185,0)
 N MODOK,Q,Z0,IBMOD,MMOD
"RTN","IBCEOB1",186,0)
 S MODOK=1
"RTN","IBCEOB1",187,0)
 I $TR(IB,",")'="" F Q=1:1:$L(IB,",") S Z0=$P(IB,",",Q) I Z0'="" S IBMOD(Z0)=$G(IBMOD(Z0))+1
"RTN","IBCEOB1",188,0)
 I $TR(MODLST,U)="",$O(IBMOD(""))="" G MODQ ; No modifiers used
"RTN","IBCEOB1",189,0)
 ;
"RTN","IBCEOB1",190,0)
 ; No match if no VistA modifiers, but there are MRA modifiers
"RTN","IBCEOB1",191,0)
 I $TR(MODLST,U)'="",$O(IBMOD(""))="" S MODOK=0 G MODQ
"RTN","IBCEOB1",192,0)
 ;
"RTN","IBCEOB1",193,0)
 ; Evaluate each MRA modifier
"RTN","IBCEOB1",194,0)
 F Z0=1:1:4 D
"RTN","IBCEOB1",195,0)
 . S MMOD=$P(MODLST,U,Z0) Q:MMOD=""     ; individual MRA modifier
"RTN","IBCEOB1",196,0)
 . I '$D(IBMOD(MMOD)) Q                 ; not in array so just quit
"RTN","IBCEOB1",197,0)
 . S IBMOD(MMOD)=IBMOD(MMOD)-1          ; decrement array counter
"RTN","IBCEOB1",198,0)
 . I 'IBMOD(MMOD) KILL IBMOD(MMOD)      ; if 0, then kill array entry
"RTN","IBCEOB1",199,0)
 . Q
"RTN","IBCEOB1",200,0)
 ;
"RTN","IBCEOB1",201,0)
 I $O(IBMOD(""))'="" S MODOK=0 ; All submitted mods not matched
"RTN","IBCEOB1",202,0)
MODQ Q MODOK
"RTN","IBCEOB1",203,0)
 ;
"RTN","IBJTTC")
0^10^B51819511
"RTN","IBJTTC",1,0)
IBJTTC ;ALB/ARH/PJH - TPI AR COMMENT HISTORY ; 4/25/11 5:22pm
"RTN","IBJTTC",2,0)
 ;;2.0;INTEGRATED BILLING;**39,377,431**;21-MAR-94;Build 106
"RTN","IBJTTC",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBJTTC",4,0)
 ;
"RTN","IBJTTC",5,0)
 ; AR Profile of Comments:  This screen prints the following Comments:
"RTN","IBJTTC",6,0)
 ;    Bill Comments (430,98)  - entered during auditing
"RTN","IBJTTC",7,0)
 ;    For each COMMENT Transaction:
"RTN","IBJTTC",8,0)
 ;           Brief Comment (433,5.02)
"RTN","IBJTTC",9,0)
 ;           Transaction Comment (433,86)
"RTN","IBJTTC",10,0)
 ;           Comment (433,41)
"RTN","IBJTTC",11,0)
 ;
"RTN","IBJTTC",12,0)
EN ; -- main entry point for IBJT AR COMMENT HISTORY
"RTN","IBJTTC",13,0)
 D EN^VALM("IBJT AR COMMENT HISTORY")
"RTN","IBJTTC",14,0)
 Q
"RTN","IBJTTC",15,0)
 ;
"RTN","IBJTTC",16,0)
HDR ; -- header code
"RTN","IBJTTC",17,0)
 D HDR^IBJTU1(+IBIFN,+DFN,13)
"RTN","IBJTTC",18,0)
 Q
"RTN","IBJTTC",19,0)
 ;
"RTN","IBJTTC",20,0)
INIT ; -- init variables and list array
"RTN","IBJTTC",21,0)
 K ^TMP("IBJTTC",$J)
"RTN","IBJTTC",22,0)
 I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ
"RTN","IBJTTC",23,0)
 D BLD
"RTN","IBJTTC",24,0)
INITQ Q
"RTN","IBJTTC",25,0)
 ;
"RTN","IBJTTC",26,0)
HELP ; -- help code
"RTN","IBJTTC",27,0)
 S X="?" D DISP^XQORM1 W !!
"RTN","IBJTTC",28,0)
 Q
"RTN","IBJTTC",29,0)
 ;
"RTN","IBJTTC",30,0)
EXIT ; -- exit code
"RTN","IBJTTC",31,0)
 K ^TMP("IBJTTC",$J)
"RTN","IBJTTC",32,0)
 D CLEAR^VALM1
"RTN","IBJTTC",33,0)
 Q
"RTN","IBJTTC",34,0)
 ;
"RTN","IBJTTC",35,0)
BLD ;
"RTN","IBJTTC",36,0)
 N CMLN,CMSTR,X,IBCNT,IBZ,IB0,IBI,IBX,IBD,IBDATE,IBDUZ,IBRCT5,IBLN,IBSTR,IBK,IBJ,DIWL,DIWR,DIWF,COM
"RTN","IBJTTC",37,0)
 ; HIPAA 5010
"RTN","IBJTTC",38,0)
 N IB3611,FOUND
"RTN","IBJTTC",39,0)
 ;
"RTN","IBJTTC",40,0)
 S VALMCNT=0,IBLN=0
"RTN","IBJTTC",41,0)
 ;
"RTN","IBJTTC",42,0)
 ; Bill Comments (430,98)
"RTN","IBJTTC",43,0)
 K COM,^UTILITY($J,"W") D BCOM^RCJIBFN2(IBIFN) I $D(COM)>10 D
"RTN","IBJTTC",44,0)
 . S IBSTR="",IBD="AR BILL COMMENTS:" S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
"RTN","IBJTTC",45,0)
 . ;
"RTN","IBJTTC",46,0)
 . S IBJ="" F  S IBJ=$O(COM(IBJ)) Q:'IBJ  S X=$G(COM(IBJ)) I X'="" S DIWL=1,DIWR=54,DIWF=""  D ^DIWP
"RTN","IBJTTC",47,0)
 . ;
"RTN","IBJTTC",48,0)
 . I $D(^UTILITY($J,"W")) S (IBK,IBCNT)=0 F  S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK  D
"RTN","IBJTTC",49,0)
 .. S IBD=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",50,0)
 . K ^UTILITY($J,"W")
"RTN","IBJTTC",51,0)
 ; AR profile of comment transactions  (433: 5.02, 41, 86)
"RTN","IBJTTC",52,0)
 K ^TMP("RCJIB",$J),^UTILITY($J,"W") D TRN^RCJIBFN2(IBIFN)
"RTN","IBJTTC",53,0)
 ;HIPAA 5010 - check if contact data has been added as a comment 
"RTN","IBJTTC",54,0)
 I '$$CONTACT D
"RTN","IBJTTC",55,0)
 .;Check for payer contact data in all entries associated with the bill # (IBIFN)
"RTN","IBJTTC",56,0)
 .S (FOUND,IB3611)=0 F  S IB3611=$O(^IBM(361.1,"B",IBIFN,IB3611)) Q:'IB3611  Q:FOUND  S FOUND=$$EN^RCDPAYER(IB3611)
"RTN","IBJTTC",57,0)
 .Q:'FOUND  ; payer contact data does not exist in any of the EOB entries related to claim
"RTN","IBJTTC",58,0)
 .;Add canned text as a brief comment in file #433 which will serve as a notice that contact data came from 835 ERA
"RTN","IBJTTC",59,0)
 .D ADD^RCDPAYER(IBIFN) ;IA 5549
"RTN","IBJTTC",60,0)
 .;Rebuild AR profile of comment transactions
"RTN","IBJTTC",61,0)
 .K ^TMP("RCJIB",$J),^UTILITY($J,"W") D TRN^RCJIBFN2(IBIFN)
"RTN","IBJTTC",62,0)
 ;
"RTN","IBJTTC",63,0)
 I $D(^TMP("RCJIB",$J)) S IBI="" F  S IBI=$O(^TMP("RCJIB",$J,IBI)) Q:'IBI  D
"RTN","IBJTTC",64,0)
 . S IBX=$G(^TMP("RCJIB",$J,IBI)) I $$STNO^RCJIBFN2(+$P(IBX,U,3))'["COMMENT" Q
"RTN","IBJTTC",65,0)
 . S IBRCT5=$$N5^RCJIBFN1(IBI)
"RTN","IBJTTC",66,0)
 . S IBSTR="",IBLN=$$SET(IBSTR,IBLN)
"RTN","IBJTTC",67,0)
 . S IBD=$P(IBX,U,1) S IBSTR=$$SETLN(IBD,IBSTR,2,8)
"RTN","IBJTTC",68,0)
 . S IBD=$$DATE(+$P(IBX,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,14,8)
"RTN","IBJTTC",69,0)
 . S IBD=$P(IBRCT5,U,1) S IBSTR=$$SETLN(IBD,IBSTR,25,30)
"RTN","IBJTTC",70,0)
 . S IBD="FOLLOW-UP DT: "_$$DATE(+$P(IBRCT5,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,57,22)
"RTN","IBJTTC",71,0)
 . S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",72,0)
 .;HIPAA 5010 - check if this comment is contact data
"RTN","IBJTTC",73,0)
 .I $P(IBRCT5,U)["ERA Payer Contact Information" D
"RTN","IBJTTC",74,0)
 ..N CONTACT,PHONE,FAX,EMAIL,WEB,NAME,EXT,PAYER,HAVPAYER
"RTN","IBJTTC",75,0)
 ..;Display contact data IA 5549
"RTN","IBJTTC",76,0)
 ..; primary, secondary, and tertiary contact data need to be displayed.  Display of contact data
"RTN","IBJTTC",77,0)
 ..; should only occur for each unique payer at BILL (B) x-ref of IBM(361.1,"B",IBIFN). 
"RTN","IBJTTC",78,0)
 ..; evaluation starts with the most recent entry.
"RTN","IBJTTC",79,0)
 ..; Contact data belonging to more than one payer can be distinguished by payer name
"RTN","IBJTTC",80,0)
 ..S (HAVPAYER,IB3611)=""
"RTN","IBJTTC",81,0)
 ..F  S IB3611=$O(^IBM(361.1,"B",IBIFN,IB3611),-1) Q:'IB3611  S CONTACT=$$EN^RCDPAYER(IB3611) D
"RTN","IBJTTC",82,0)
 ...Q:'CONTACT
"RTN","IBJTTC",83,0)
 ...S PAYER=$P($G(^IBM(361.1,IB3611,0)),U,2),PAYER=$$EXTERNAL^DILFD(361.1,.02,,PAYER) ;IA 4051
"RTN","IBJTTC",84,0)
 ...Q:PAYER=HAVPAYER  ; payer contact data has already been displayed
"RTN","IBJTTC",85,0)
 ...S HAVPAYER=PAYER
"RTN","IBJTTC",86,0)
 ...S FAX=$P(CONTACT,U,5),EMAIL=$P(CONTACT,U,6),WEB=$P(CONTACT,U,3)
"RTN","IBJTTC",87,0)
 ...S PHONE=$P(CONTACT,U,4),EXT=$P(CONTACT,U,7),NAME=$P(CONTACT,U,2)
"RTN","IBJTTC",88,0)
 ...S IBD="Payer Name: "_PAYER
"RTN","IBJTTC",89,0)
 ...S IBSTR=$$SETLN(IBD,IBSTR,25,78)
"RTN","IBJTTC",90,0)
 ...S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",91,0)
 ...I NAME]"" D
"RTN","IBJTTC",92,0)
 ....S IBD="Contact Name: "_NAME
"RTN","IBJTTC",93,0)
 ....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
"RTN","IBJTTC",94,0)
 ....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",95,0)
 ...I PHONE]"" D
"RTN","IBJTTC",96,0)
 ....S IBD="Phone Number: "_PHONE S:EXT]"" IBD=IBD_" Ext: "_EXT
"RTN","IBJTTC",97,0)
 ....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
"RTN","IBJTTC",98,0)
 ....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",99,0)
 ...I FAX]"" D
"RTN","IBJTTC",100,0)
 ....S IBD="Facsimile Number: "_FAX
"RTN","IBJTTC",101,0)
 ....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
"RTN","IBJTTC",102,0)
 ....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",103,0)
 ...I EMAIL]"" D
"RTN","IBJTTC",104,0)
 ....S IBD="Email Address: "_EMAIL
"RTN","IBJTTC",105,0)
 ....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
"RTN","IBJTTC",106,0)
 ....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",107,0)
 ...I WEB]"" D
"RTN","IBJTTC",108,0)
 ....S IBD="Website Address:"_$E(WEB,1,40)
"RTN","IBJTTC",109,0)
 ....S IBSTR=$$SETLN(IBD,IBSTR,25,78)
"RTN","IBJTTC",110,0)
 ....S IBLN=$$SET(IBSTR,IBLN),IBSTR="" Q:$L(WEB)<41
"RTN","IBJTTC",111,0)
 ....S IBSTR=$$SETLN($E(WEB,41,96),IBSTR,25,78)
"RTN","IBJTTC",112,0)
 ....S IBLN=$$SET(IBSTR,IBLN),IBSTR="" Q:$L(WEB)<97
"RTN","IBJTTC",113,0)
 ....S IBSTR=$$SETLN($E(WEB,97,115),IBSTR,25,78)
"RTN","IBJTTC",114,0)
 ....S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",115,0)
 ...S IBLN=$$SET(IBSTR,IBLN)
"RTN","IBJTTC",116,0)
 . ;
"RTN","IBJTTC",117,0)
 . ;   -- transaction comments (86)
"RTN","IBJTTC",118,0)
 . S X=$P($G(^TMP("RCJIB",$J,IBI)),U,6) I X'="" S DIWL=1,DIWR=54,DIWF=""  D ^DIWP
"RTN","IBJTTC",119,0)
 . ;
"RTN","IBJTTC",120,0)
 . ;   -- comments  (86 & 41)
"RTN","IBJTTC",121,0)
 . K COM D N7^RCJIBFN1(IBI) I $D(COM)>2 D
"RTN","IBJTTC",122,0)
 .. S IBJ="" F  S IBJ=$O(COM(IBJ)) Q:'IBJ  S X=$G(COM(IBJ)) I X'="" S DIWL=1,DIWR=54,DIWF=""  D ^DIWP
"RTN","IBJTTC",123,0)
 . ;
"RTN","IBJTTC",124,0)
 . I $D(^UTILITY($J,"W")) S (IBK,IBCNT)=0 F  S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK  D
"RTN","IBJTTC",125,0)
 .. S IBD=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(IBD,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",126,0)
 . K ^UTILITY($J,"W")
"RTN","IBJTTC",127,0)
 K ^TMP("RCJIB",$J),^UTILITY($J,"W")
"RTN","IBJTTC",128,0)
 ; MRA comments
"RTN","IBJTTC",129,0)
 ; check if we have any comments to display
"RTN","IBJTTC",130,0)
 I $D(^DGCR(399,IBIFN,"TXC","B")) D
"RTN","IBJTTC",131,0)
 .S IBLN=$$SET("",IBLN)
"RTN","IBJTTC",132,0)
 .S IBSTR="",IBSTR=$$SETLN("MRA REQUEST CLAIM COMMENTS",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
"RTN","IBJTTC",133,0)
 .S IBSTR="",IBSTR=$$SETLN("--------------------------",IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN)
"RTN","IBJTTC",134,0)
 .; loop through all available comments
"RTN","IBJTTC",135,0)
 .S IBDATE="" F  S IBDATE=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE),-1) Q:IBDATE=""  D
"RTN","IBJTTC",136,0)
 ..S IBZ=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC",IBZ,0),IBDUZ=$P(IB0,U,2)
"RTN","IBJTTC",137,0)
 ..S IBLN=$$SET("",IBLN)
"RTN","IBJTTC",138,0)
 ..S IBSTR=""
"RTN","IBJTTC",139,0)
 ..S IBSTR=$$SETLN($$FMTE^XLFDT(IBDATE,"2Z"),IBSTR,14,8)
"RTN","IBJTTC",140,0)
 ..S IBSTR=$$SETLN($J("Entered by "_$$GET1^DIQ(200,IBDUZ,.01),54),IBSTR,25,54)
"RTN","IBJTTC",141,0)
 ..S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",142,0)
 ..; loop through comment lines
"RTN","IBJTTC",143,0)
 ..S CMLN=0 F  S CMLN=$O(^DGCR(399,IBIFN,"TXC",IBZ,1,CMLN)) Q:CMLN=""  D
"RTN","IBJTTC",144,0)
 ...S X=^DGCR(399,IBIFN,"TXC",IBZ,1,CMLN,0) I X'="" S DIWL=1,DIWR=54,DIWF=""  D ^DIWP
"RTN","IBJTTC",145,0)
 ...Q
"RTN","IBJTTC",146,0)
 ..I $D(^UTILITY($J,"W")) S IBK=0 F  S IBK=$O(^UTILITY($J,"W",1,IBK)) Q:'IBK  D
"RTN","IBJTTC",147,0)
 ...S CMSTR=$G(^UTILITY($J,"W",1,IBK,0)) S IBSTR=$$SETLN(CMSTR,IBSTR,25,54),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
"RTN","IBJTTC",148,0)
 ...Q
"RTN","IBJTTC",149,0)
 ..K ^UTILITY($J,"W")
"RTN","IBJTTC",150,0)
 ..Q
"RTN","IBJTTC",151,0)
 .D CLEAN^DILF
"RTN","IBJTTC",152,0)
 .Q
"RTN","IBJTTC",153,0)
 ;
"RTN","IBJTTC",154,0)
 I IBLN=0 S IBLN=$$SET("",IBLN),IBLN=$$SET("No Comment Transactions Exist For This Account.",IBLN)
"RTN","IBJTTC",155,0)
 S VALMCNT=IBLN
"RTN","IBJTTC",156,0)
 Q
"RTN","IBJTTC",157,0)
 ;
"RTN","IBJTTC",158,0)
CONTACT() ;HIPAA 5010 check for contact data in comments
"RTN","IBJTTC",159,0)
 N FOUND,IBI
"RTN","IBJTTC",160,0)
 S FOUND=0,IBI=""
"RTN","IBJTTC",161,0)
 F  S IBI=$O(^TMP("RCJIB",$J,IBI)) Q:'IBI  D  Q:FOUND
"RTN","IBJTTC",162,0)
 .S IBX=$G(^TMP("RCJIB",$J,IBI)) Q:$$STNO^RCJIBFN2(+$P(IBX,U,3))'["COMMENT"
"RTN","IBJTTC",163,0)
 .S:$P($$N5^RCJIBFN1(IBI),U)["ERA Payer Contact Information" FOUND=1
"RTN","IBJTTC",164,0)
 Q FOUND
"RTN","IBJTTC",165,0)
 ;
"RTN","IBJTTC",166,0)
DATE(X) ; date in external format
"RTN","IBJTTC",167,0)
 N Y S Y="" I +X S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
"RTN","IBJTTC",168,0)
 Q Y
"RTN","IBJTTC",169,0)
 ;
"RTN","IBJTTC",170,0)
SETLN(STR,IBX,COL,WD) ;
"RTN","IBJTTC",171,0)
 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
"RTN","IBJTTC",172,0)
 Q IBX
"RTN","IBJTTC",173,0)
 ;
"RTN","IBJTTC",174,0)
SET(STR,LN) ; set up TMP array with screen data
"RTN","IBJTTC",175,0)
 S LN=LN+1 D SET^VALM10(LN,STR)
"RTN","IBJTTC",176,0)
SETQ Q LN
"RTN","IBP431")
0^1^B8517081
"RTN","IBP431",1,0)
IBP431 ;ALB/PJH - POST INSTALL FOR IB*2.0*431 ; 4/25/11 5:24pm
"RTN","IBP431",2,0)
 ;;2.0;INTEGRATED BILLING;**431**;21-MAR-94;Build 106
"RTN","IBP431",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IBP431",4,0)
 ;
"RTN","IBP431",5,0)
 Q
"RTN","IBP431",6,0)
 ;
"RTN","IBP431",7,0)
POST ;Called from IB*2*431 patch install 
"RTN","IBP431",8,0)
 ;
"RTN","IBP431",9,0)
 ;Move EOB file #361.1 fields to new location
"RTN","IBP431",10,0)
 ;
"RTN","IBP431",11,0)
 N OK,PROG
"RTN","IBP431",12,0)
 S PROG="IBP431"
"RTN","IBP431",13,0)
 K ^TMP(PROG,$J)
"RTN","IBP431",14,0)
 D BMES^XPDUTL("Converting EXPLANATION OF BENEFIT FILE")
"RTN","IBP431",15,0)
 S OK=$$MOVE(PROG)
"RTN","IBP431",16,0)
 I OK D BMES^XPDUTL("Conversion COMPLETED")
"RTN","IBP431",17,0)
 I 'OK D BMES^XPDUTL("Conversion ABORTED")
"RTN","IBP431",18,0)
 K ^TMP(PROG,$J)
"RTN","IBP431",19,0)
 Q
"RTN","IBP431",20,0)
 ;
"RTN","IBP431",21,0)
MAIL ;Send mail message
"RTN","IBP431",22,0)
 N XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
"RTN","IBP431",23,0)
 S XMDUZ=DUZ
"RTN","IBP431",24,0)
 S XMTEXT="^TMP(""IBP431"","_$J_")"
"RTN","IBP431",25,0)
 S XMSUB="IB*2.0*431 Post Install - Completed"
"RTN","IBP431",26,0)
 S XMY(DUZ)=""
"RTN","IBP431",27,0)
 S XMINSTR("FROM")="VistA routine IBP431"
"RTN","IBP431",28,0)
 D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
"RTN","IBP431",29,0)
 Q
"RTN","IBP431",30,0)
 ;
"RTN","IBP431",31,0)
MOVE(PROG) ;Move existing field to new global node
"RTN","IBP431",32,0)
 ;
"RTN","IBP431",33,0)
 ;Moves field CROSSED OVER NAME (361.1, #.08)
"RTN","IBP431",34,0)
 ;from ^IBM(361.1,D0,0) piece 8
"RTN","IBP431",35,0)
 ;to ^IBM(361.1,D0,51) piece 2
"RTN","IBP431",36,0)
 ;
"RTN","IBP431",37,0)
 N C,I,M,N,VALUE,X,X1,X2,%
"RTN","IBP431",38,0)
 S C=0,M=0
"RTN","IBP431",39,0)
 ;Lock ^XTMP
"RTN","IBP431",40,0)
 L +^XTMP(PROG):5 E  Q 0
"RTN","IBP431",41,0)
 ;Update mail message
"RTN","IBP431",42,0)
 D NOW^%DTC S M=M+1,^TMP(PROG,$J,M)="Started "_$$FMTE^XLFDT(%)
"RTN","IBP431",43,0)
 ;XTMP purge Date is today+90
"RTN","IBP431",44,0)
 S X1=DT,X2=90 D C^%DTC
"RTN","IBP431",45,0)
 ;Set up ^XTMP header
"RTN","IBP431",46,0)
 S ^XTMP(PROG,0)=X_"^"_DT_"^IB*2.0*431 Post Install"
"RTN","IBP431",47,0)
 ;Scan file moving non-null fields only into ^XTMP and new location
"RTN","IBP431",48,0)
 ;and clear field in original location
"RTN","IBP431",49,0)
 S N=0 F I=1:1 S N=$O(^IBM(361.1,N)) Q:'N  S VALUE=$P($G(^IBM(361.1,N,0)),U,8) I VALUE]"" S C=C+1,^XTMP(PROG,C)=VALUE_U_N,$P(^IBM(361.1,N,51),U,2)=VALUE,$P(^IBM(361.1,N,0),U,8)=""
"RTN","IBP431",50,0)
 ;Completion time
"RTN","IBP431",51,0)
 D NOW^%DTC
"RTN","IBP431",52,0)
 S $P(^XTMP(PROG,0),U,4)=X
"RTN","IBP431",53,0)
 S M=M+1,^TMP(PROG,$J,M)="Completed "_$$FMTE^XLFDT(%)
"RTN","IBP431",54,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of records in EOB file - "_(I-1)
"RTN","IBP431",55,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of fields moved - "_+C
"RTN","IBP431",56,0)
 ;Send mail message to patch installer
"RTN","IBP431",57,0)
 D MAIL
"RTN","IBP431",58,0)
 ;Release ^XTMP
"RTN","IBP431",59,0)
 L -^XTMP(PROG)
"RTN","IBP431",60,0)
 Q 1
"RTN","IBP431",61,0)
 ;
"RTN","IBP431",62,0)
RESET ;Restore original fields
"RTN","IBP431",63,0)
 Q
"RTN","IBP431",64,0)
 N DIR,N,C,VALUE,Y
"RTN","IBP431",65,0)
 S DIR("A")="Move data to original location"
"RTN","IBP431",66,0)
 S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:Y'=1
"RTN","IBP431",67,0)
 S C=0
"RTN","IBP431",68,0)
 F  S C=$O(^XTMP("IBP431",C)) Q:'C  D
"RTN","IBP431",69,0)
 .;Get values saved in ^XTMP
"RTN","IBP431",70,0)
 .S VALUE=$P(^XTMP("IBP431",C),U),N=$P(^XTMP("IBP431",C),U,2)
"RTN","IBP431",71,0)
 .;Ignore if not present
"RTN","IBP431",72,0)
 .Q:(VALUE="")!('N)
"RTN","IBP431",73,0)
 .;Do not update if node is not defined
"RTN","IBP431",74,0)
 .Q:$G(^IBM(361.1,N,0))=""
"RTN","IBP431",75,0)
 .;Or if data already exists in field
"RTN","IBP431",76,0)
 .Q:$P($G(^IBM(361.1,N,0)),U,8)]""
"RTN","IBP431",77,0)
 .;Otherwise reset original value
"RTN","IBP431",78,0)
 .S $P(^IBM(361.1,N,0),U,8)=VALUE
"RTN","IBP431",79,0)
 .;And clear from 51 node
"RTN","IBP431",80,0)
 .K ^IBM(361.1,N,51)
"RTN","IBP431",81,0)
 Q
"UP",361.1,361.11512,-3)
361.1^15
"UP",361.1,361.11512,-2)
361.115^1
"UP",361.1,361.11512,-1)
361.1151^2
"UP",361.1,361.11512,0)
361.11512
"VER")
8.0^22.0
"^DD",361.1,361.1,.07,0)
TRACE NUMBER^F^^0;7^K:$L(X)>50!($L(X)<1) X
"^DD",361.1,361.1,.07,1,0)
^.1^^0
"^DD",361.1,361.1,.07,3)
Answer must be 1-50 characters in length.
"^DD",361.1,361.1,.07,21,0)
^.001^1^1^3100619^^^
"^DD",361.1,361.1,.07,21,1,0)
This is the TRACE NUMBER from the 835 transaction for this EOB
"^DD",361.1,361.1,.07,23,0)
^.001^1^1^3100619^^^^
"^DD",361.1,361.1,.07,23,1,0)
This is the data from the 835 data field (TRN-02)
"^DD",361.1,361.1,.07,"DT")
3101004
"^DD",361.1,361.1,.08,0)
CROSSED OVER NAME^F^^51;2^K:$L(X)>60!($L(X)<1) X
"^DD",361.1,361.1,.08,3)
Answer must be 1-60 characters in length.
"^DD",361.1,361.1,.08,21,0)
^.001^2^2^3100619^^^
"^DD",361.1,361.1,.08,21,1,0)
This is the name of the insurance company to which this claim was sent 
"^DD",361.1,361.1,.08,21,2,0)
for COB purposes automatically.
"^DD",361.1,361.1,.08,23,0)
^.001^1^1^3100619^^
"^DD",361.1,361.1,.08,23,1,0)
This is the data from the 835 data field (NM-103/Qualifier='DC')
"^DD",361.1,361.1,.08,"DT")
3100619
"^DD",361.1,361.1,.14,0)
ICN^F^^0;14^K:$L(X)>50!($L(X)<1) X
"^DD",361.1,361.1,.14,3)
Answer must be 1-50 characters in length.
"^DD",361.1,361.1,.14,21,0)
^.001^1^1^3100619^^^^
"^DD",361.1,361.1,.14,21,1,0)
This is the ICN as reported on the EOB from the payer.
"^DD",361.1,361.1,.14,23,0)
^.001^1^1^3100619^^^
"^DD",361.1,361.1,.14,23,1,0)
This data is found on the 835 in the CLP-07 data element.
"^DD",361.1,361.1,.14,"DT")
3100619
"^DD",361.1,361.1,1.12,0)
CLAIM RECEIVED DATE^D^^50;1^S %DT="EX" D ^%DT S X=Y K:Y<1 X
"^DD",361.1,361.1,1.12,3)
Enter the date the payer received the claim.
"^DD",361.1,361.1,1.12,21,0)
^.001^1^1^3100618^^^
"^DD",361.1,361.1,1.12,21,1,0)
This is the date the payer received the claim.
"^DD",361.1,361.1,1.12,23,0)
^^1^1^3100618^
"^DD",361.1,361.1,1.12,23,1,0)
From 835 record: 2100 DTM02 where DTM01 = "050"
"^DD",361.1,361.1,1.12,"DT")
3100618
"^DD",361.1,361.1,1.13,0)
COVERAGE EXPIRATION DATE^D^^50;2^S %DT="EX" D ^%DT S X=Y K:Y<1 X
"^DD",361.1,361.1,1.13,3)
Enter the date the insurance coverage expires.
"^DD",361.1,361.1,1.13,21,0)
^^1^1^3100621^
"^DD",361.1,361.1,1.13,21,1,0)
This is the date the insurance coverage expires.
"^DD",361.1,361.1,1.13,23,0)
^^1^1^3100621^
"^DD",361.1,361.1,1.13,23,1,0)
From 835 record: 2100 DTM02 where DTM01= "036"
"^DD",361.1,361.1,1.13,"DT")
3100621
"^DD",361.1,361.1,1.14,0)
CORRECTED PRIORITY PAYER NAME^F^^50;3^K:$L(X)>60!($L(X)<1) X
"^DD",361.1,361.1,1.14,3)
Enter the corrected name (1-60 characters) of the priority payer.
"^DD",361.1,361.1,1.14,21,0)
^.001^1^1^3100618^^
"^DD",361.1,361.1,1.14,21,1,0)
This is the corrected name of the priority payer for this claim.
"^DD",361.1,361.1,1.14,23,0)
^^1^1^3100618^
"^DD",361.1,361.1,1.14,23,1,0)
From 835 record: 2100NM103 where NM101 = "PR"
"^DD",361.1,361.1,1.14,"DT")
3100621
"^DD",361.1,361.1,1.15,0)
CORRECTED PRIORITY PAYER TYPE^S^AD:BLUE CROSS/BLUE SHIELD ASSOC;FI:FEDERAL TAXPAYER;NI:NAIC;PP:PHARMACY PROCESSOR NUMBER;XV:CENTERS FOR MEDICARE/MEDICAID;^50;4^Q
"^DD",361.1,361.1,1.15,3)
Enter code for type of corrected priority payer.
"^DD",361.1,361.1,1.15,21,0)
^^1^1^3100618^
"^DD",361.1,361.1,1.15,21,1,0)
This is the type of the corrected priority payer.
"^DD",361.1,361.1,1.15,23,0)
^.001^1^1^3100618^^
"^DD",361.1,361.1,1.15,23,1,0)
From 835 record: 2100 NM108 where NM101 = "PR"
"^DD",361.1,361.1,1.15,"DT")
3100614
"^DD",361.1,361.1,1.16,0)
CORRECTED PRIORITY PAYER ID^F^^50;5^K:$L(X)>80!($L(X)<1) X
"^DD",361.1,361.1,1.16,3)
Enter the ID (1-80 characters) of the corrected priority payer.
"^DD",361.1,361.1,1.16,21,0)
^^1^1^3100621^
"^DD",361.1,361.1,1.16,21,1,0)
This is the ID of the corrected priority payer.
"^DD",361.1,361.1,1.16,23,0)
^^1^1^3100621^
"^DD",361.1,361.1,1.16,23,1,0)
From 835 record: 2100 NM109 where NM101= "PR"
"^DD",361.1,361.1,1.16,"DT")
3100621
"^DD",361.1,361.1,1.17,0)
OTHER SUBSCRIBER NAME^F^^51;1^K:$L(X)>122!($L(X)<1) X
"^DD",361.1,361.1,1.17,3)
Enter the name (1-122 characters) of the other subscriber for this claim.
"^DD",361.1,361.1,1.17,21,0)
^.001^1^1^3100621^^^
"^DD",361.1,361.1,1.17,21,1,0)
This is the name of the other subscriber for this claim.
"^DD",361.1,361.1,1.17,23,0)
^.001^1^1^3100621^^
"^DD",361.1,361.1,1.17,23,1,0)
From 835 record: 2100 NM104 where NM101 = "GB" or NM101 = "GN"
"^DD",361.1,361.1,1.17,"DT")
3100614
"^DD",361.1,361.1,25.02,0)
CONTACT NUMBER 1^F^^25;2^K:$L(X)>60!($L(X)<1) X
"^DD",361.1,361.1,25.02,3)
Answer must be 1-60 characters in length.
"^DD",361.1,361.1,25.02,21,0)
^.001^1^1^3100802^^
"^DD",361.1,361.1,25.02,21,1,0)
This is a phone #/telephone extension or email address for the contact.
"^DD",361.1,361.1,25.02,"DT")
3100802
"^DD",361.1,361.1,25.04,0)
CONTACT NUMBER 2^F^^25;4^K:$L(X)>60!($L(X)<1) X
"^DD",361.1,361.1,25.04,3)
Answer must be 1-60 characters in length.
"^DD",361.1,361.1,25.04,21,0)
^.001^1^1^3100802^^
"^DD",361.1,361.1,25.04,21,1,0)
This is a phone #/telephone extension or email address for the contact.
"^DD",361.1,361.1,25.04,"DT")
3100802
"^DD",361.1,361.1,25.06,0)
CONTACT NUMBER 3^F^^25;6^K:$L(X)>60!($L(X)<1) X
"^DD",361.1,361.1,25.06,3)
Answer must be 1-60 characters in length.
"^DD",361.1,361.1,25.06,21,0)
^.001^1^1^3100802^^^^
"^DD",361.1,361.1,25.06,21,1,0)
This is a phone #/telephone extension or email address for the contact.
"^DD",361.1,361.1,25.06,"DT")
3100802
"^DD",361.1,361.1151,2,0)
PAYER POLICY REFERENCE^361.11512A^^2;0
"^DD",361.1,361.1151,2,21,0)
^^2^2^3100826^
"^DD",361.1,361.1151,2,21,1,0)
These are the payer policy references listed on the payer web site. Up to 
"^DD",361.1,361.1151,2,21,2,0)
5 payer policy references are allowed on the 835 record.
"^DD",361.1,361.11512,0)
PAYER POLICY REFERENCE SUB-FIELD^^.01^1
"^DD",361.1,361.11512,0,"DT")
3100826
"^DD",361.1,361.11512,0,"IX","B",361.11512,.01)

"^DD",361.1,361.11512,0,"NM","PAYER POLICY REFERENCE")

"^DD",361.1,361.11512,0,"UP")
361.1151
"^DD",361.1,361.11512,.01,0)
PAYER POLICY REFERENCE^F^^0;1^K:$L(X)>50!($L(X)<1) X
"^DD",361.1,361.11512,.01,1,0)
^.1
"^DD",361.1,361.11512,.01,1,1,0)
361.11512^B
"^DD",361.1,361.11512,.01,1,1,1)
S ^IBM(361.1,DA(3),15,DA(2),1,DA(1),2,"B",$E(X,1,30),DA)=""
"^DD",361.1,361.11512,.01,1,1,2)
K ^IBM(361.1,DA(3),15,DA(2),1,DA(1),2,"B",$E(X,1,30),DA)
"^DD",361.1,361.11512,.01,3)
Enter the payer policy reference (1-50characters) used on the payer web site.
"^DD",361.1,361.11512,.01,21,0)
^^1^1^3100826^
"^DD",361.1,361.11512,.01,21,1,0)
This is the payer policy reference used on the payer web site.
"^DD",361.1,361.11512,.01,23,0)
^^1^1^3100826^
"^DD",361.1,361.11512,.01,23,1,0)
From 835 record: 2110 REF02 where REF01 = "OK"
"^DD",361.1,361.11512,.01,"DT")
3100826
**INSTALL NAME**
PRCA*4.5*269
"BLD",8056,0)
PRCA*4.5*269^ACCOUNTS RECEIVABLE^0^3110701^y
"BLD",8056,1,0)
^^1^1^3100609^
"BLD",8056,1,1,0)
FMS 5010 CHANGES
"BLD",8056,4,0)
^9.64PA^344^3
"BLD",8056,4,344,0)
344
"BLD",8056,4,344,2,0)
^9.641^344.01^1
"BLD",8056,4,344,2,344.01,0)
TRANSACTION  (sub-file)
"BLD",8056,4,344,2,344.01,1,0)
^9.6411^.07^1
"BLD",8056,4,344,2,344.01,1,.07,0)
CHECK #
"BLD",8056,4,344,222)
y^y^p^^^^n^^n
"BLD",8056,4,344,224)

"BLD",8056,4,344.31,0)
344.31
"BLD",8056,4,344.31,2,0)
^9.641^344.31^1
"BLD",8056,4,344.31,2,344.31,0)
EDI THIRD PARTY EFT DETAIL  (File-top level)
"BLD",8056,4,344.31,2,344.31,1,0)
^9.6411^.16^4
"BLD",8056,4,344.31,2,344.31,1,.02,0)
PAYER NAME
"BLD",8056,4,344.31,2,344.31,1,.04,0)
TRACE #
"BLD",8056,4,344.31,2,344.31,1,.15,0)
ACH TRACE#
"BLD",8056,4,344.31,2,344.31,1,.16,0)
MANUAL TR DOCUMENT
"BLD",8056,4,344.31,222)
y^y^p^^^^n^^n
"BLD",8056,4,344.31,224)

"BLD",8056,4,344.4,0)
344.4
"BLD",8056,4,344.4,2,0)
^9.641^344.42^3
"BLD",8056,4,344.4,2,344.4,0)
ELECTRONIC REMITTANCE ADVICE  (File-top level)
"BLD",8056,4,344.4,2,344.4,1,0)
^9.6411^3.06^6
"BLD",8056,4,344.4,2,344.4,1,.02,0)
TRACE NUMBER
"BLD",8056,4,344.4,2,344.4,1,.13,0)
CHECK #
"BLD",8056,4,344.4,2,344.4,1,3.02,0)
CONTACT NUMBER 1
"BLD",8056,4,344.4,2,344.4,1,3.04,0)
CONTACT NUMBER 2
"BLD",8056,4,344.4,2,344.4,1,3.06,0)
CONTACT NUMBER 3
"BLD",8056,4,344.4,2,344.4,1,5.01,0)
PAYER WEB SITE ADDRESS
"BLD",8056,4,344.4,2,344.41,0)
ERA DETAIL  (sub-file)
"BLD",8056,4,344.4,2,344.41,1,0)
^9.6411^.21^2
"BLD",8056,4,344.4,2,344.41,1,.21,0)
RENDERING/SERVICING PROV NAME
"BLD",8056,4,344.4,2,344.41,1,.23,0)
REN PROV COMMENT
"BLD",8056,4,344.4,2,344.42,0)
ERA LEVEL ADJUSTMENTS  (sub-file)
"BLD",8056,4,344.4,2,344.42,1,0)
^9.6411^.04^2
"BLD",8056,4,344.4,2,344.42,1,.01,0)
REFERENCE NUMBER
"BLD",8056,4,344.4,2,344.42,1,.04,0)
ADJUSTMENT TEXT
"BLD",8056,4,344.4,222)
y^y^p^^^^n^^n
"BLD",8056,4,344.4,224)

"BLD",8056,4,"APDD",344,344.01)

"BLD",8056,4,"APDD",344,344.01,.07)

"BLD",8056,4,"APDD",344.31,344.31)

"BLD",8056,4,"APDD",344.31,344.31,.02)

"BLD",8056,4,"APDD",344.31,344.31,.04)

"BLD",8056,4,"APDD",344.31,344.31,.15)

"BLD",8056,4,"APDD",344.31,344.31,.16)

"BLD",8056,4,"APDD",344.4,344.4)

"BLD",8056,4,"APDD",344.4,344.4,.02)

"BLD",8056,4,"APDD",344.4,344.4,.13)

"BLD",8056,4,"APDD",344.4,344.4,3.02)

"BLD",8056,4,"APDD",344.4,344.4,3.04)

"BLD",8056,4,"APDD",344.4,344.4,3.06)

"BLD",8056,4,"APDD",344.4,344.4,5.01)

"BLD",8056,4,"APDD",344.4,344.41)

"BLD",8056,4,"APDD",344.4,344.41,.21)

"BLD",8056,4,"APDD",344.4,344.41,.23)

"BLD",8056,4,"APDD",344.4,344.42)

"BLD",8056,4,"APDD",344.4,344.42,.01)

"BLD",8056,4,"APDD",344.4,344.42,.04)

"BLD",8056,4,"B",344,344)

"BLD",8056,4,"B",344.31,344.31)

"BLD",8056,4,"B",344.4,344.4)

"BLD",8056,6.3)
113
"BLD",8056,"ABPKG")
n
"BLD",8056,"INI")

"BLD",8056,"INIT")
POST^PRCAP269
"BLD",8056,"KRN",0)
^9.67PA^779.2^20
"BLD",8056,"KRN",.4,0)
.4
"BLD",8056,"KRN",.4,"NM",0)
^9.68A^^
"BLD",8056,"KRN",.401,0)
.401
"BLD",8056,"KRN",.402,0)
.402
"BLD",8056,"KRN",.403,0)
.403
"BLD",8056,"KRN",.5,0)
.5
"BLD",8056,"KRN",.84,0)
.84
"BLD",8056,"KRN",3.6,0)
3.6
"BLD",8056,"KRN",3.8,0)
3.8
"BLD",8056,"KRN",9.2,0)
9.2
"BLD",8056,"KRN",9.8,0)
9.8
"BLD",8056,"KRN",9.8,"NM",0)
^9.68A^39^34
"BLD",8056,"KRN",9.8,"NM",1,0)
RCDPEWL^^0^B44600003
"BLD",8056,"KRN",9.8,"NM",2,0)
RCDPEWL2^^0^B84334841
"BLD",8056,"KRN",9.8,"NM",3,0)
RCDPUT^^0^B25168927
"BLD",8056,"KRN",9.8,"NM",4,0)
RCDPEWL7^^0^B84756815
"BLD",8056,"KRN",9.8,"NM",5,0)
RCDPEREC^^0^B39701184
"BLD",8056,"KRN",9.8,"NM",7,0)
PRCAP269^^0^B36195744
"BLD",8056,"KRN",9.8,"NM",8,0)
RCDPESR3^^0^B60020580
"BLD",8056,"KRN",9.8,"NM",9,0)
RCDPEWL5^^0^B56283493
"BLD",8056,"KRN",9.8,"NM",10,0)
RCDPEWL4^^0^B48717166
"BLD",8056,"KRN",9.8,"NM",11,0)
RCDPEAC^^0^B66599458
"BLD",8056,"KRN",9.8,"NM",12,0)
RCDPEDA1^^0^B14062058
"BLD",8056,"KRN",9.8,"NM",13,0)
RCDPEAR2^^0^B32087204
"BLD",8056,"KRN",9.8,"NM",14,0)
RCDPEAR1^^0^B37135763
"BLD",8056,"KRN",9.8,"NM",15,0)
RCDPE8NZ^^0^B24021950
"BLD",8056,"KRN",9.8,"NM",16,0)
RCDPESR4^^0^B76222786
"BLD",8056,"KRN",9.8,"NM",18,0)
RCDPAYER^^0^B13162829
"BLD",8056,"KRN",9.8,"NM",19,0)
RCDPEWL8^^0^B74316733
"BLD",8056,"KRN",9.8,"NM",20,0)
RCDPESR0^^0^B57243958
"BLD",8056,"KRN",9.8,"NM",21,0)
RCDPESR2^^0^B84144020
"BLD",8056,"KRN",9.8,"NM",22,0)
RCDPESR6^^0^B43157350
"BLD",8056,"KRN",9.8,"NM",24,0)
RCDPEDS^^0^B36371277
"BLD",8056,"KRN",9.8,"NM",26,0)
RCDPES10^^0^B85948119
"BLD",8056,"KRN",9.8,"NM",27,0)
RCDPEWL0^^0^B83670852
"BLD",8056,"KRN",9.8,"NM",28,0)
RCDPEX^^0^B76642906
"BLD",8056,"KRN",9.8,"NM",29,0)
RCDPEX2^^0^B15963944
"BLD",8056,"KRN",9.8,"NM",30,0)
RCDPESR9^^0^B71424370
"BLD",8056,"KRN",9.8,"NM",31,0)
RCDPETR^^0^B58479252
"BLD",8056,"KRN",9.8,"NM",32,0)
RCDPESR5^^0^B27780882
"BLD",8056,"KRN",9.8,"NM",33,0)
RCDPEX3^^0^B75257587
"BLD",8056,"KRN",9.8,"NM",35,0)
RCDPLPL1^^0^B25554080
"BLD",8056,"KRN",9.8,"NM",36,0)
RCDPRPL4^^0^B28923437
"BLD",8056,"KRN",9.8,"NM",37,0)
RCDPRSEA^^0^B21546260
"BLD",8056,"KRN",9.8,"NM",38,0)
RCDPEM^^0^B54192380
"BLD",8056,"KRN",9.8,"NM",39,0)
RCDPEM1^^0^B50720523
"BLD",8056,"KRN",9.8,"NM","B","PRCAP269",7)

"BLD",8056,"KRN",9.8,"NM","B","RCDPAYER",18)

"BLD",8056,"KRN",9.8,"NM","B","RCDPE8NZ",15)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEAC",11)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEAR1",14)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEAR2",13)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEDA1",12)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEDS",24)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEM",38)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEM1",39)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEREC",5)

"BLD",8056,"KRN",9.8,"NM","B","RCDPES10",26)

"BLD",8056,"KRN",9.8,"NM","B","RCDPESR0",20)

"BLD",8056,"KRN",9.8,"NM","B","RCDPESR2",21)

"BLD",8056,"KRN",9.8,"NM","B","RCDPESR3",8)

"BLD",8056,"KRN",9.8,"NM","B","RCDPESR4",16)

"BLD",8056,"KRN",9.8,"NM","B","RCDPESR5",32)

"BLD",8056,"KRN",9.8,"NM","B","RCDPESR6",22)

"BLD",8056,"KRN",9.8,"NM","B","RCDPESR9",30)

"BLD",8056,"KRN",9.8,"NM","B","RCDPETR",31)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEWL",1)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEWL0",27)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEWL2",2)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEWL4",10)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEWL5",9)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEWL7",4)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEWL8",19)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEX",28)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEX2",29)

"BLD",8056,"KRN",9.8,"NM","B","RCDPEX3",33)

"BLD",8056,"KRN",9.8,"NM","B","RCDPLPL1",35)

"BLD",8056,"KRN",9.8,"NM","B","RCDPRPL4",36)

"BLD",8056,"KRN",9.8,"NM","B","RCDPRSEA",37)

"BLD",8056,"KRN",9.8,"NM","B","RCDPUT",3)

"BLD",8056,"KRN",19,0)
19
"BLD",8056,"KRN",19,"NM",0)
^9.68A^^
"BLD",8056,"KRN",19.1,0)
19.1
"BLD",8056,"KRN",101,0)
101
"BLD",8056,"KRN",101,"NM",0)
^9.68A^13^13
"BLD",8056,"KRN",101,"NM",1,0)
RCDPE EOB WORKLIST ADMIN COST ADJ^^0^
"BLD",8056,"KRN",101,"NM",2,0)
RCDPE EOB WORKLIST RESEARCH MENU^^0
"BLD",8056,"KRN",101,"NM",3,0)
RCDPE EOB WORKLIST REL HOLD^^4^
"BLD",8056,"KRN",101,"NM",4,0)
RCDPE EOB WORKLIST TPJI^^4^
"BLD",8056,"KRN",101,"NM",5,0)
RCDPE EOB WORKLIST ON HOLD RPT^^4^
"BLD",8056,"KRN",101,"NM",6,0)
RCDPE EOB WORKLIST CL MATCH RPT^^4^
"BLD",8056,"KRN",101,"NM",7,0)
RCDPE EOB WL RESEARCH EXIT^^4^
"BLD",8056,"KRN",101,"NM",8,0)
RCDPE EOB WL REVIEW^^4^
"BLD",8056,"KRN",101,"NM",9,0)
RCDPE VIEW/PRINT WORKLIST EOB^^4^
"BLD",8056,"KRN",101,"NM",10,0)
RCDPE EOB WORKLIST BILL COMMENT^^4^
"BLD",8056,"KRN",101,"NM",11,0)
RCDPE EOB WORKLIST REESTABLISH^^4^
"BLD",8056,"KRN",101,"NM",12,0)
RCDPE EOB WORKLIST ADJUST^^4^
"BLD",8056,"KRN",101,"NM",13,0)
RCDPE EOB WORKLIST FULL ACCT PROF^^4^
"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WL RESEARCH EXIT",7)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WL REVIEW",8)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST ADJUST",12)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST ADMIN COST ADJ",1)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST BILL COMMENT",10)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST CL MATCH RPT",6)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST FULL ACCT PROF",13)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST ON HOLD RPT",5)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST REESTABLISH",11)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST REL HOLD",3)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST RESEARCH MENU",2)

"BLD",8056,"KRN",101,"NM","B","RCDPE EOB WORKLIST TPJI",4)

"BLD",8056,"KRN",101,"NM","B","RCDPE VIEW/PRINT WORKLIST EOB",9)

"BLD",8056,"KRN",409.61,0)
409.61
"BLD",8056,"KRN",409.61,"NM",0)
^9.68A^2^2
"BLD",8056,"KRN",409.61,"NM",1,0)
RCDPE WORKLIST ERA LIST^^0
"BLD",8056,"KRN",409.61,"NM",2,0)
RCDPEX EOB_SUM EXCEPTION LIST^^0
"BLD",8056,"KRN",409.61,"NM","B","RCDPE WORKLIST ERA LIST",1)

"BLD",8056,"KRN",409.61,"NM","B","RCDPEX EOB_SUM EXCEPTION LIST",2)

"BLD",8056,"KRN",771,0)
771
"BLD",8056,"KRN",779.2,0)
779.2
"BLD",8056,"KRN",870,0)
870
"BLD",8056,"KRN",8989.51,0)
8989.51
"BLD",8056,"KRN",8989.52,0)
8989.52
"BLD",8056,"KRN",8994,0)
8994
"BLD",8056,"KRN","B",.4,.4)

"BLD",8056,"KRN","B",.401,.401)

"BLD",8056,"KRN","B",.402,.402)

"BLD",8056,"KRN","B",.403,.403)

"BLD",8056,"KRN","B",.5,.5)

"BLD",8056,"KRN","B",.84,.84)

"BLD",8056,"KRN","B",3.6,3.6)

"BLD",8056,"KRN","B",3.8,3.8)

"BLD",8056,"KRN","B",9.2,9.2)

"BLD",8056,"KRN","B",9.8,9.8)

"BLD",8056,"KRN","B",19,19)

"BLD",8056,"KRN","B",19.1,19.1)

"BLD",8056,"KRN","B",101,101)

"BLD",8056,"KRN","B",409.61,409.61)

"BLD",8056,"KRN","B",771,771)

"BLD",8056,"KRN","B",779.2,779.2)

"BLD",8056,"KRN","B",870,870)

"BLD",8056,"KRN","B",8989.51,8989.51)

"BLD",8056,"KRN","B",8989.52,8989.52)

"BLD",8056,"KRN","B",8994,8994)

"BLD",8056,"QUES",0)
^9.62^^
"BLD",8056,"REQB",0)
^9.611^9^8
"BLD",8056,"REQB",1,0)
PRCA*4.5*244^2
"BLD",8056,"REQB",2,0)
PRCA*4.5*222^2
"BLD",8056,"REQB",3,0)
PRCA*4.5*169^2
"BLD",8056,"REQB",5,0)
PRCA*4.5*255^2
"BLD",8056,"REQB",6,0)
PRCA*4.5*252^2
"BLD",8056,"REQB",7,0)
XU*8.0*539^2
"BLD",8056,"REQB",8,0)
PRCA*4.5*258^2
"BLD",8056,"REQB",9,0)
PRCA*4.5*264^2
"BLD",8056,"REQB","B","PRCA*4.5*169",3)

"BLD",8056,"REQB","B","PRCA*4.5*222",2)

"BLD",8056,"REQB","B","PRCA*4.5*244",1)

"BLD",8056,"REQB","B","PRCA*4.5*252",6)

"BLD",8056,"REQB","B","PRCA*4.5*255",5)

"BLD",8056,"REQB","B","PRCA*4.5*258",8)

"BLD",8056,"REQB","B","PRCA*4.5*264",9)

"BLD",8056,"REQB","B","XU*8.0*539",7)

"FIA",344)
AR BATCH PAYMENT
"FIA",344,0)
^RCY(344,
"FIA",344,0,0)
344I
"FIA",344,0,1)
y^y^p^^^^n^^n
"FIA",344,0,10)

"FIA",344,0,11)

"FIA",344,0,"RLRO")

"FIA",344,0,"VR")
4.5^PRCA
"FIA",344,344)
1
"FIA",344,344.01)
1
"FIA",344,344.01,.07)

"FIA",344.31)
EDI THIRD PARTY EFT DETAIL
"FIA",344.31,0)
^RCY(344.31,
"FIA",344.31,0,0)
344.31PI
"FIA",344.31,0,1)
y^y^p^^^^n^^n
"FIA",344.31,0,10)

"FIA",344.31,0,11)

"FIA",344.31,0,"RLRO")

"FIA",344.31,0,"VR")
4.5^PRCA
"FIA",344.31,344.31)
1
"FIA",344.31,344.31,.02)

"FIA",344.31,344.31,.04)

"FIA",344.31,344.31,.15)

"FIA",344.31,344.31,.16)

"FIA",344.4)
ELECTRONIC REMITTANCE ADVICE
"FIA",344.4,0)
^RCY(344.4,
"FIA",344.4,0,0)
344.4I
"FIA",344.4,0,1)
y^y^p^^^^n^^n
"FIA",344.4,0,10)

"FIA",344.4,0,11)

"FIA",344.4,0,"RLRO")

"FIA",344.4,0,"VR")
4.5^PRCA
"FIA",344.4,344.4)
1
"FIA",344.4,344.4,.02)

"FIA",344.4,344.4,.13)

"FIA",344.4,344.4,2)

"FIA",344.4,344.4,3.02)

"FIA",344.4,344.4,3.04)

"FIA",344.4,344.4,3.06)

"FIA",344.4,344.4,5.01)

"FIA",344.4,344.41)
1
"FIA",344.4,344.41,.21)

"FIA",344.4,344.41,.23)

"FIA",344.4,344.42)
1
"FIA",344.4,344.42,.01)

"FIA",344.4,344.42,.04)

"INIT")
POST^PRCAP269
"IX",344.31,344.31,"C",0)
344.31^C^REGULAR INDEX^R^^F^IR^I^344.31^^^^^LS
"IX",344.31,344.31,"C",1)
S ^RCY(344.31,"C",$E(X,1,50),DA)=""
"IX",344.31,344.31,"C",2)
K ^RCY(344.31,"C",$E(X,1,50),DA)
"IX",344.31,344.31,"C",2.5)
K ^RCY(344.31,"C")
"IX",344.31,344.31,"C",11.1,0)
^.114IA^1^1
"IX",344.31,344.31,"C",11.1,1,0)
1^F^344.31^.02^50^1^F
"IX",344.31,344.31,"D",0)
344.31^D^REGULAR INDEX^R^^F^IR^I^344.31^^^^^LS
"IX",344.31,344.31,"D",1)
S ^RCY(344.31,"D",$E(X,1,50),DA)=""
"IX",344.31,344.31,"D",2)
K ^RCY(344.31,"D",$E(X,1,50),DA)
"IX",344.31,344.31,"D",2.5)
K ^RCY(344.31,"D")
"IX",344.31,344.31,"D",11.1,0)
^.114IA^1^1
"IX",344.31,344.31,"D",11.1,1,0)
1^F^344.31^.04^50^1^F
"IX",344.31,344.31,"D",11.1,1,3)

"IX",344.4,344.4,"ATRID",0)
344.4^ATRID^Xref by bank trace # and ins co id #^MU^^R^IR^I^344.4^^^^^S
"IX",344.4,344.4,"ATRID",1)
S ^RCY(344.4,"ATRID",$E(X(1),1,50),$E(X(2),1,30),DA)=""
"IX",344.4,344.4,"ATRID",2)
K ^RCY(344.4,"ATRID",$E(X(1),1,50),$E(X(2),1,30),DA)
"IX",344.4,344.4,"ATRID",2.5)
K ^RCY(344.4,"ATRID")
"IX",344.4,344.4,"ATRID",11.1,0)
^.114IA^2^2
"IX",344.4,344.4,"ATRID",11.1,1,0)
1^F^344.4^.02^30^1^F
"IX",344.4,344.4,"ATRID",11.1,2,0)
2^F^344.4^.03^30^2^F
"IX",344.4,344.4,"D",0)
344.4^D^REGULAR INDEX^R^^F^IR^I^344.4^^^^^LS
"IX",344.4,344.4,"D",1)
S ^RCY(344.4,"D",$E(X,1,50),DA)=""
"IX",344.4,344.4,"D",2)
K ^RCY(344.4,"D",$E(X,1,50),DA)
"IX",344.4,344.4,"D",2.5)
K ^RCY(344.4,"D")
"IX",344.4,344.4,"D",11.1,0)
^.114IA^1^1
"IX",344.4,344.4,"D",11.1,1,0)
1^F^344.4^.02^50^1^F
"IX",344.4,344.42,"B",0)
344.42^B^REGULAR INDEX^R^^F^IR^I^344.42^^^^^LS
"IX",344.4,344.42,"B",1)
S ^RCY(344.4,DA(1),2,"B",$E(X,1,50),DA)=""
"IX",344.4,344.42,"B",2)
K ^RCY(344.4,DA(1),2,"B",$E(X,1,50),DA)
"IX",344.4,344.42,"B",2.5)
K ^RCY(344.4,DA(1),2,"B")
"IX",344.4,344.42,"B",11.1,0)
^.114IA^1^1
"IX",344.4,344.42,"B",11.1,1,0)
1^F^344.42^.01^50^1^F
"IX",344.4,344.42,"B",11.1,1,3)

"KRN",101,3348,-1)
0^2
"KRN",101,3348,0)
RCDPE EOB WORKLIST RESEARCH MENU^Research Menu^^M^^^^^^^^ACCOUNTS RECEIVABLE
"KRN",101,3348,1,0)
^^2^2^3030220^
"KRN",101,3348,1,1,0)
This is the main menu that contains the actions that can be performed to 
"KRN",101,3348,1,2,0)
research a payment/denial for a claim when reviewing an EOB.
"KRN",101,3348,4)
26^4
"KRN",101,3348,10,0)
^101.01PA^15^15
"KRN",101,3348,10,1,0)
3352^^5^
"KRN",101,3348,10,1,"^")
RCDPE EOB WORKLIST REL HOLD
"KRN",101,3348,10,2,0)
3351^^20^
"KRN",101,3348,10,2,"^")
RCDPE EOB WORKLIST TPJI
"KRN",101,3348,10,5,0)
3412^^50^
"KRN",101,3348,10,5,"^")
RCDPE EOB WORKLIST ON HOLD RPT
"KRN",101,3348,10,6,0)
3413^^60^
"KRN",101,3348,10,6,"^")
RCDPE EOB WORKLIST CL MATCH RPT
"KRN",101,3348,10,7,0)
3424^^100^
"KRN",101,3348,10,7,"^")
RCDPE EOB WL RESEARCH EXIT
"KRN",101,3348,10,8,0)
3475^^80^
"KRN",101,3348,10,8,"^")
RCDPE EOB WL REVIEW
"KRN",101,3348,10,9,0)
3349^^70^
"KRN",101,3348,10,9,"^")
RCDPE VIEW/PRINT WORKLIST EOB
"KRN",101,3348,10,11,0)
3447^^65^
"KRN",101,3348,10,11,"^")
RCDPE EOB WORKLIST BILL COMMENT
"KRN",101,3348,10,12,0)
3446^^67^
"KRN",101,3348,10,12,"^")
RCDPE EOB WORKLIST REESTABLISH
"KRN",101,3348,10,13,0)
3445^^8^
"KRN",101,3348,10,13,"^")
RCDPE EOB WORKLIST ADJUST
"KRN",101,3348,10,14,0)
3411^^9^
"KRN",101,3348,10,14,"^")
RCDPE EOB WORKLIST FULL ACCT PROF
"KRN",101,3348,10,15,0)
4345^^10^^^
"KRN",101,3348,10,15,"^")
RCDPE EOB WORKLIST ADMIN COST ADJ
"KRN",101,3348,15)
I $G(RCFASTXT) S VALMBCK="Q"
"KRN",101,3348,26)
D SHOW^VALM
"KRN",101,3348,28)
Select Action: 
"KRN",101,3348,99)
62216,66862
"KRN",101,3349,-1)
4^9
"KRN",101,3349,0)
RCDPE VIEW/PRINT WORKLIST EOB
"KRN",101,3351,-1)
4^4
"KRN",101,3351,0)
RCDPE EOB WORKLIST TPJI
"KRN",101,3352,-1)
4^3
"KRN",101,3352,0)
RCDPE EOB WORKLIST REL HOLD
"KRN",101,3411,-1)
4^13
"KRN",101,3411,0)
RCDPE EOB WORKLIST FULL ACCT PROF
"KRN",101,3412,-1)
4^5
"KRN",101,3412,0)
RCDPE EOB WORKLIST ON HOLD RPT
"KRN",101,3413,-1)
4^6
"KRN",101,3413,0)
RCDPE EOB WORKLIST CL MATCH RPT
"KRN",101,3424,-1)
4^7
"KRN",101,3424,0)
RCDPE EOB WL RESEARCH EXIT
"KRN",101,3445,-1)
4^12
"KRN",101,3445,0)
RCDPE EOB WORKLIST ADJUST
"KRN",101,3446,-1)
4^11
"KRN",101,3446,0)
RCDPE EOB WORKLIST REESTABLISH
"KRN",101,3447,-1)
4^10
"KRN",101,3447,0)
RCDPE EOB WORKLIST BILL COMMENT
"KRN",101,3475,-1)
4^8
"KRN",101,3475,0)
RCDPE EOB WL REVIEW
"KRN",101,4345,-1)
0^1
"KRN",101,4345,0)
RCDPE EOB WORKLIST ADMIN COST ADJ^Admin Cost Adj^^A^^^^^^^^ACCOUNTS RECEIVABLE
"KRN",101,4345,1,0)
^^1^1^3100707^
"KRN",101,4345,1,1,0)
Used to adjust the administrative costs, IRS cost, DMV cost, etc
"KRN",101,4345,15)
S VALMBCK="R" K PRCASUP
"KRN",101,4345,20)
S PRCASUP=1 D FULL^VALM1 D ^PRCAEXM K DTOUT
"KRN",101,4345,99)
62216,66862
"KRN",409.61,720,-1)
0^2
"KRN",409.61,720,0)
RCDPEX EOB_SUM EXCEPTION LIST^1^^80^5^19^1^1^EDI LBox EEOB Data Exception^RCDPEX EOB_SUM EXCEPTION MENU^LOCKBOX EEOB DATA EXCEPTIONS^1^^1
"KRN",409.61,720,1)
^VALM HIDDEN ACTIONS
"KRN",409.61,720,"ARRAY")
 ^TMP("RCDPEX_SUM-EOB",$J)
"KRN",409.61,720,"COL",0)
^409.621^1^1
"KRN",409.61,720,"COL",1,0)
INS_CO^9^46^Insurance Co Name/ID
"KRN",409.61,720,"COL","B","INS_CO",1)

"KRN",409.61,720,"FNL")
D FNL^RCDPEX2
"KRN",409.61,720,"HDR")
D HDR^RCDPEX2
"KRN",409.61,720,"INIT")
D INIT^RCDPEX2
"KRN",409.61,774,-1)
0^1
"KRN",409.61,774,0)
RCDPE WORKLIST ERA LIST^1^^80^7^20^1^1^#^RCDPE WORKLIST ERA LIST MENU^ERA List - Worklist^1^^1
"KRN",409.61,774,1)
^VALM HIDDEN ACTIONS
"KRN",409.61,774,"ARRAY")
 ^TMP("RCDPE-ERA_WL",$J)
"KRN",409.61,774,"COL",0)
^409.621^7^4
"KRN",409.61,774,"COL",3,0)
DATE_PAID^45^11^ERA PAID DT
"KRN",409.61,774,"COL",4,0)
TOT_PAID^58^12^TOT AMT PAID
"KRN",409.61,774,"COL",6,0)
DATE_RECEIVED^73^8^DT REC'D
"KRN",409.61,774,"COL",7,0)
PAYER_LN^13^32^PAYER NAME/MATCH STATUS
"KRN",409.61,774,"COL","B","DATE_PAID",3)

"KRN",409.61,774,"COL","B","DATE_RECEIVED",6)

"KRN",409.61,774,"COL","B","PAYER_LN",7)

"KRN",409.61,774,"COL","B","TOT_PAID",4)

"KRN",409.61,774,"FNL")
D FNL^RCDPEWL7
"KRN",409.61,774,"HDR")
D HDR^RCDPEWL7
"KRN",409.61,774,"INIT")
D INIT^RCDPEWL7
"MBREQ")
1
"ORD",15,101)
101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA
"ORD",15,101,0)
PROTOCOL
"ORD",17,409.61)
409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1
"ORD",17,409.61,0)
LIST TEMPLATE
"PKG",142,-1)
1^1
"PKG",142,0)
ACCOUNTS RECEIVABLE^PRCA^BILL COLLECTIONS
"PKG",142,20,0)
^9.402P^1^1
"PKG",142,20,1,0)
2^^PRCAMRG
"PKG",142,20,1,1)

"PKG",142,20,"B",2,1)

"PKG",142,22,0)
^9.49I^1^1
"PKG",142,22,1,0)
4.5^^2950320
"PKG",142,22,1,"PAH",1,0)
269^3110701^123457061
"PKG",142,22,1,"PAH",1,1,0)
^^1^1^3110701
"PKG",142,22,1,"PAH",1,1,1,0)
FMS 5010 CHANGES
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
34
"RTN","PRCAP269")
0^7^B36195744
"RTN","PRCAP269",1,0)
PRCAP269 ;ALB/PJH - PRCA*4.5*269 POST INSTALL ; 3/9/11 12:50pm
"RTN","PRCAP269",2,0)
 ;;4.5;Accounts Receivable;**269**;Mar 20, 1995;Build 113
"RTN","PRCAP269",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","PRCAP269",4,0)
 Q
"RTN","PRCAP269",5,0)
 ;
"RTN","PRCAP269",6,0)
POST ;Called from PRCA*4.5*269 patch install
"RTN","PRCAP269",7,0)
 ;
"RTN","PRCAP269",8,0)
 ;Move ERA file #344.4 and EFT file #344.31 fields to new locations
"RTN","PRCAP269",9,0)
 ;
"RTN","PRCAP269",10,0)
 N M,OK,PROG,X,X1,X2
"RTN","PRCAP269",11,0)
 S PROG="PRCAP269"
"RTN","PRCAP269",12,0)
 ;Clear workfile
"RTN","PRCAP269",13,0)
 K ^TMP(PROG,$J)
"RTN","PRCAP269",14,0)
 ;
"RTN","PRCAP269",15,0)
 ;Lock ^XTMP
"RTN","PRCAP269",16,0)
 L +^XTMP(PROG):5 E  D BMES^XPDUTL("Conversion ABORTED") Q
"RTN","PRCAP269",17,0)
 ;XTMP purge Date is today+90
"RTN","PRCAP269",18,0)
 S X1=DT,X2=90 D C^%DTC
"RTN","PRCAP269",19,0)
 ;Set up ^XTMP header
"RTN","PRCAP269",20,0)
 S ^XTMP(PROG,0)=X_"^"_DT_"^PRCA*4.5*269 Post Install"
"RTN","PRCAP269",21,0)
 ;
"RTN","PRCAP269",22,0)
 D BMES^XPDUTL("Deleting Obsolete Cross References")
"RTN","PRCAP269",23,0)
 D DELIX^DDMOD(344.31,.02,1) ;PAYER NAME - "C"
"RTN","PRCAP269",24,0)
 D DELIX^DDMOD(344.31,.04,1) ;TRACE # - "D"
"RTN","PRCAP269",25,0)
 D DELIX^DDMOD(344.4,.02,1) ;TRACE # - "D"
"RTN","PRCAP269",26,0)
 D DELIX^DDMOD(344.42,.01,1) ;REFERENCE NUMBER - "B"
"RTN","PRCAP269",27,0)
 ;
"RTN","PRCAP269",28,0)
 D BMES^XPDUTL("Converting EDI THIRD PARTY EFT DETAIL FILE")
"RTN","PRCAP269",29,0)
 D MOVEEFT
"RTN","PRCAP269",30,0)
 ;
"RTN","PRCAP269",31,0)
 D BMES^XPDUTL("Converting ELECTRONIC REMITTANCE ADVICE file")
"RTN","PRCAP269",32,0)
 D MOVEERA,MOVEERA1,MOVEERA2
"RTN","PRCAP269",33,0)
 ;
"RTN","PRCAP269",34,0)
 ;Send mail message to patch installer
"RTN","PRCAP269",35,0)
 D MAIL
"RTN","PRCAP269",36,0)
 ;
"RTN","PRCAP269",37,0)
 ;Send mail message to CBO release coordinators
"RTN","PRCAP269",38,0)
 D MAILCBO
"RTN","PRCAP269",39,0)
 ;
"RTN","PRCAP269",40,0)
 ;Clear workfile
"RTN","PRCAP269",41,0)
 K ^TMP(PROG,$J)
"RTN","PRCAP269",42,0)
 ;
"RTN","PRCAP269",43,0)
 D BMES^XPDUTL("Conversion COMPLETED")
"RTN","PRCAP269",44,0)
 ;Release ^XTMP
"RTN","PRCAP269",45,0)
 L -^XTMP(PROG)
"RTN","PRCAP269",46,0)
 Q
"RTN","PRCAP269",47,0)
 ;
"RTN","PRCAP269",48,0)
MAIL ;Installer mail message
"RTN","PRCAP269",49,0)
 N XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
"RTN","PRCAP269",50,0)
 S XMDUZ=DUZ
"RTN","PRCAP269",51,0)
 S XMTEXT="^TMP(""PRCAP269"","_$J_")"
"RTN","PRCAP269",52,0)
 S XMSUB="PRCA*4.5*269 Post Install - Completed"
"RTN","PRCAP269",53,0)
 S XMY(DUZ)=""
"RTN","PRCAP269",54,0)
 S XMINSTR("FROM")="VistA routine PRCAP269"
"RTN","PRCAP269",55,0)
 D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
"RTN","PRCAP269",56,0)
 Q
"RTN","PRCAP269",57,0)
 ;
"RTN","PRCAP269",58,0)
MAILCBO ;CBO notification mail message
"RTN","PRCAP269",59,0)
 N %,INSTNAME,M,MSG,SITE,STATION,X,XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
"RTN","PRCAP269",60,0)
 S M=0
"RTN","PRCAP269",61,0)
 D NOW^%DTC
"RTN","PRCAP269",62,0)
 ;IA - 10112 supported reference
"RTN","PRCAP269",63,0)
 S SITE=$$SITE^VASITE,STATION=$P(SITE,U,3),INSTNAME=$P(SITE,U,2)
"RTN","PRCAP269",64,0)
 S M=M+1,MSG(M)="Institution Name: "_INSTNAME
"RTN","PRCAP269",65,0)
 S M=M+1,MSG(M)="Station Number  : "_STATION
"RTN","PRCAP269",66,0)
 S M=M+1,MSG(M)=""
"RTN","PRCAP269",67,0)
 S M=M+1,MSG(M)="Completed Install "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",68,0)
 S XMDUZ=DUZ
"RTN","PRCAP269",69,0)
 S XMTEXT="MSG"
"RTN","PRCAP269",70,0)
 S XMSUB="ePayments - Station "_STATION
"RTN","PRCAP269",71,0)
 S XMY(DUZ)=""
"RTN","PRCAP269",72,0)
 S:$$PROD^XUPROD(1) XMY("VHACBOEPAY5010@VA.GOV")=""
"RTN","PRCAP269",73,0)
 S XMINSTR("FROM")="VistA routine PRCAP269"
"RTN","PRCAP269",74,0)
 D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
"RTN","PRCAP269",75,0)
 ;
"RTN","PRCAP269",76,0)
 I $D(^TMP("XMERR",$J)) D
"RTN","PRCAP269",77,0)
 .D MES^XPDUTL("MailMan reported a problem trying to send the installation notification message.")
"RTN","PRCAP269",78,0)
 .D MES^XPDUTL("  ")
"RTN","PRCAP269",79,0)
 .N GLO,GLB
"RTN","PRCAP269",80,0)
 .S GLB="^TMP(""XMERR"","_$J,GLO=GLB_")"
"RTN","PRCAP269",81,0)
 .F  S GLO=$Q(@GLO) Q:GLO'[GLB  D MES^XPDUTL("   "_GLO_" = "_$G(@GLO))
"RTN","PRCAP269",82,0)
 .D MES^XPDUTL("  ")
"RTN","PRCAP269",83,0)
 Q
"RTN","PRCAP269",84,0)
 ;
"RTN","PRCAP269",85,0)
MOVEEFT ;Move existing EFT (File #344.31) field to new global node
"RTN","PRCAP269",86,0)
 ;
"RTN","PRCAP269",87,0)
 ;Moves field ACH TRACE # (.15)
"RTN","PRCAP269",88,0)
 ;from ^RCY(344.31,D0,0) piece 15
"RTN","PRCAP269",89,0)
 ;to ^RCY(344.31,D0,1) piece 1
"RTN","PRCAP269",90,0)
 ;
"RTN","PRCAP269",91,0)
 ;Moves field MANUAL TR DOCUMENT (.16)
"RTN","PRCAP269",92,0)
 ;from ^RCY(344.31,D0,0) piece 16
"RTN","PRCAP269",93,0)
 ;to ^RCY(344.31,D0,1) piece 2
"RTN","PRCAP269",94,0)
 ;
"RTN","PRCAP269",95,0)
 N %,C,I,N,VALUE,X
"RTN","PRCAP269",96,0)
 S C=0,M=0
"RTN","PRCAP269",97,0)
 ;Update mail message
"RTN","PRCAP269",98,0)
 D NOW^%DTC
"RTN","PRCAP269",99,0)
 S M=M+1,^TMP(PROG,$J,M)="Started EFT file at "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",100,0)
 ;Scan file moving non-null fields only into ^XTMP and new location
"RTN","PRCAP269",101,0)
 ;and clear field in original location
"RTN","PRCAP269",102,0)
 S N=0 F I=1:1 S N=$O(^RCY(344.31,N)) Q:'N  S VALUE=$P($G(^RCY(344.31,N,0)),U,15,16) I $P(VALUE,U)'="",$P(VALUE,U,2)'="" S C=C+1,^XTMP(PROG,"EFT",C)=VALUE_U_N,^RCY(344.31,N,1)=VALUE,$P(^RCY(344.31,N,0),U,15)="",$P(^RCY(344.31,N,0),U,16)=""
"RTN","PRCAP269",103,0)
 ;Completion time
"RTN","PRCAP269",104,0)
 D NOW^%DTC
"RTN","PRCAP269",105,0)
 S M=M+1,^TMP(PROG,$J,M)="Completed EFT file at "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",106,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of records in EFT file - "_(I-1)
"RTN","PRCAP269",107,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of fields moved        - "_+C
"RTN","PRCAP269",108,0)
 Q
"RTN","PRCAP269",109,0)
 ;
"RTN","PRCAP269",110,0)
 ;
"RTN","PRCAP269",111,0)
MOVEERA ;Move existing ERA (File #344.4) field to new global node
"RTN","PRCAP269",112,0)
 ;
"RTN","PRCAP269",113,0)
 ;Moves field CHECK# (.13)
"RTN","PRCAP269",114,0)
 ;from ^RCY(344.4,D0,0) piece 13
"RTN","PRCAP269",115,0)
 ;to ^RCY(344.4,D0,5) piece 2
"RTN","PRCAP269",116,0)
 ;
"RTN","PRCAP269",117,0)
 ;
"RTN","PRCAP269",118,0)
 N %,C,I,N,VALUE,X
"RTN","PRCAP269",119,0)
 S C=0
"RTN","PRCAP269",120,0)
 ;Update mail message
"RTN","PRCAP269",121,0)
 D NOW^%DTC
"RTN","PRCAP269",122,0)
 S M=M+1,^TMP(PROG,$J,M)="Started ERA file at "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",123,0)
 ;Scan file moving non-null fields only into ^XTMP and new location
"RTN","PRCAP269",124,0)
 ;and clear field in original location
"RTN","PRCAP269",125,0)
 S N=0 F I=1:1 S N=$O(^RCY(344.4,N)) Q:'N  S VALUE=$P($G(^RCY(344.4,N,0)),U,13) I VALUE]"" S C=C+1,^XTMP(PROG,"ERA",C)=VALUE_U_N,$P(^RCY(344.4,N,5),U,2)=VALUE,$P(^RCY(344.4,N,0),U,13)=""
"RTN","PRCAP269",126,0)
 ;Completion time
"RTN","PRCAP269",127,0)
 D NOW^%DTC
"RTN","PRCAP269",128,0)
 S M=M+1,^TMP(PROG,$J,M)="Completed ERA file at "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",129,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of records in ERA file - "_(I-1)
"RTN","PRCAP269",130,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of fields moved        - "_+C
"RTN","PRCAP269",131,0)
 Q
"RTN","PRCAP269",132,0)
 ;
"RTN","PRCAP269",133,0)
MOVEERA1 ;Move existing ERA (File #344.41) field to new global node
"RTN","PRCAP269",134,0)
 ;
"RTN","PRCAP269",135,0)
 ;Moves field REN PROV COMMENT (#.23)
"RTN","PRCAP269",136,0)
 ;from ^RCY(344.4,D0,1,D1,3) piece 5
"RTN","PRCAP269",137,0)
 ;to ^RCY(344.4,D0,1,D1,4) piece 1
"RTN","PRCAP269",138,0)
 ;
"RTN","PRCAP269",139,0)
 ;
"RTN","PRCAP269",140,0)
 N %,C,I,N,N1,VALUE,X
"RTN","PRCAP269",141,0)
 S C=0
"RTN","PRCAP269",142,0)
 ;Update mail message
"RTN","PRCAP269",143,0)
 D NOW^%DTC
"RTN","PRCAP269",144,0)
 S M=M+1,^TMP(PROG,$J,M)="Started ERA,1 file at "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",145,0)
 ;Scan file moving non-null fields only into ^XTMP and new location
"RTN","PRCAP269",146,0)
 ;and clear field in original location
"RTN","PRCAP269",147,0)
 S N=0,I=0
"RTN","PRCAP269",148,0)
 F  S N=$O(^RCY(344.4,N)) Q:'N  S N1=0 D
"RTN","PRCAP269",149,0)
 .F  S N1=$O(^RCY(344.4,N,1,N1)) Q:'N1  D
"RTN","PRCAP269",150,0)
 ..S I=I+1,VALUE=$P($G(^RCY(344.4,N,1,N1,3)),U,5) I VALUE]"" S C=C+1,^XTMP(PROG,"ERA1",C)=VALUE_U_N_U_N1,^RCY(344.4,N,1,N1,4)=VALUE,$P(^RCY(344.4,N,1,N1,3),U,5)=""
"RTN","PRCAP269",151,0)
 ;Completion time
"RTN","PRCAP269",152,0)
 D NOW^%DTC
"RTN","PRCAP269",153,0)
 S M=M+1,^TMP(PROG,$J,M)="Completed ERA,1 file at "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",154,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of records in ERA,1 file - "_+I
"RTN","PRCAP269",155,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of fields moved          - "_+C
"RTN","PRCAP269",156,0)
 Q
"RTN","PRCAP269",157,0)
 ;
"RTN","PRCAP269",158,0)
MOVEERA2 ;Move existing ERA (File #344.42) field to new global node
"RTN","PRCAP269",159,0)
 ;
"RTN","PRCAP269",160,0)
 ;Moves field ADJUSTMENT TEXT (#.04)
"RTN","PRCAP269",161,0)
 ;from ^RCY(344.4,D0,2,D1,0) piece 4
"RTN","PRCAP269",162,0)
 ;to ^RCY(344.4,D0,2,D1,1) piece 1
"RTN","PRCAP269",163,0)
 ;
"RTN","PRCAP269",164,0)
 ;
"RTN","PRCAP269",165,0)
 N %,C,I,N,N1,VALUE,X
"RTN","PRCAP269",166,0)
 S C=0
"RTN","PRCAP269",167,0)
 ;Update mail message
"RTN","PRCAP269",168,0)
 D NOW^%DTC
"RTN","PRCAP269",169,0)
 S M=M+1,^TMP(PROG,$J,M)="Started ERA,2 file at "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",170,0)
 ;Scan file moving non-null fields only into ^XTMP and new location
"RTN","PRCAP269",171,0)
 ;and clear field in original location
"RTN","PRCAP269",172,0)
 S N=0,I=0
"RTN","PRCAP269",173,0)
 F  S N=$O(^RCY(344.4,N)) Q:'N  S N1=0 D
"RTN","PRCAP269",174,0)
 .F  S N1=$O(^RCY(344.4,N,2,N1)) Q:'N1  D
"RTN","PRCAP269",175,0)
 ..S I=I+1,VALUE=$P($G(^RCY(344.4,N,2,N1,0)),U,4) I VALUE]"" S C=C+1,^XTMP(PROG,"ERA2",C)=VALUE_U_N_U_N1,^RCY(344.4,N,2,N1,1)=VALUE,$P(^RCY(344.4,N,2,N1,0),U,4)=""
"RTN","PRCAP269",176,0)
 ;Completion time
"RTN","PRCAP269",177,0)
 D NOW^%DTC
"RTN","PRCAP269",178,0)
 ;Also update XTMP as complete
"RTN","PRCAP269",179,0)
 S $P(^XTMP(PROG,0),U,4)=X
"RTN","PRCAP269",180,0)
 S M=M+1,^TMP(PROG,$J,M)="Completed ERA,2 file at "_$$FMTE^XLFDT(%)
"RTN","PRCAP269",181,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of records in ERA,2 file - "_+I
"RTN","PRCAP269",182,0)
 S M=M+1,^TMP(PROG,$J,M)="Count of fields moved          - "_+C
"RTN","PRCAP269",183,0)
 Q
"RTN","RCDPAYER")
0^18^B13162829
"RTN","RCDPAYER",1,0)
RCDPAYER ;ALB/PJH - TPJI Utility ; 3/29/11 12:43pm
"RTN","RCDPAYER",2,0)
 ;;4.5;Accounts Receivable;**269**;Mar 20, 1995;Build 113
"RTN","RCDPAYER",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPAYER",4,0)
 ;
"RTN","RCDPAYER",5,0)
 ;Integration Agreement 5549
"RTN","RCDPAYER",6,0)
 ;
"RTN","RCDPAYER",7,0)
 Q
"RTN","RCDPAYER",8,0)
 ;
"RTN","RCDPAYER",9,0)
EN(IB3611) ;Called from IBJTTC
"RTN","RCDPAYER",10,0)
 ; IB3611 = ien of EXPLANATION OF BENEFITS file (361.1)
"RTN","RCDPAYER",11,0)
 ; gathers payer contact data from file 361.1 and 344.4
"RTN","RCDPAYER",12,0)
 ; returns the data to IBJTTC for display on COMMENT HISTORY screen of TPJI
"RTN","RCDPAYER",13,0)
 N AR3444,CONTACTS,ERA3,FOUND,I,IBTEXT,IB25,STR,WEB,NAME
"RTN","RCDPAYER",14,0)
 ;
"RTN","RCDPAYER",15,0)
 S CONTACTS="",STR="",FOUND=0,WEB="",NAME=""
"RTN","RCDPAYER",16,0)
 ;
"RTN","RCDPAYER",17,0)
 ;Retrieve contacts from EOB file
"RTN","RCDPAYER",18,0)
 S IB25=$P($G(^IBM(361.1,IB3611,25)),U,1,7) ;IA 4051
"RTN","RCDPAYER",19,0)
 S:$TR(IB25,U,"")]"" FOUND=1,STR=IB25
"RTN","RCDPAYER",20,0)
 ;
"RTN","RCDPAYER",21,0)
 ;Get ERA reference
"RTN","RCDPAYER",22,0)
 S AR3444=$O(^RCY(344.4,"ADET",IB3611,""))
"RTN","RCDPAYER",23,0)
 ;
"RTN","RCDPAYER",24,0)
 ;If no contact in EOB retrieve contacts from ERA file
"RTN","RCDPAYER",25,0)
 I AR3444,'FOUND D
"RTN","RCDPAYER",26,0)
 .S ERA3=$P($G(^RCY(344.4,AR3444,3)),U,1,7)
"RTN","RCDPAYER",27,0)
 .S:$TR(ERA3,U,"")]"" FOUND=1,STR=ERA3
"RTN","RCDPAYER",28,0)
 ;
"RTN","RCDPAYER",29,0)
 ;Retrieve Payer Web Address from ERA file
"RTN","RCDPAYER",30,0)
 I AR3444 S WEB=$P($G(^RCY(344.4,AR3444,5)),U) S:WEB]"" FOUND=1
"RTN","RCDPAYER",31,0)
 ;
"RTN","RCDPAYER",32,0)
 ;Get Payer Contact Name
"RTN","RCDPAYER",33,0)
 S NAME=$P(STR,U) S:NAME]"" FOUND=1
"RTN","RCDPAYER",34,0)
 ;
"RTN","RCDPAYER",35,0)
 ;Format contacts
"RTN","RCDPAYER",36,0)
 I STR]"" D
"RTN","RCDPAYER",37,0)
 .N I,CTYP,CPOS
"RTN","RCDPAYER",38,0)
 .F I=2,4,6 D:$P(STR,U,I)]""
"RTN","RCDPAYER",39,0)
 ..;Validate contact type
"RTN","RCDPAYER",40,0)
 ..S CTYP=$P(STR,U,I+1)
"RTN","RCDPAYER",41,0)
 ..S CPOS=$S(CTYP="TE":1,CTYP="FX":2,CTYP="EM":3,CTYP="EX":4,1:0)
"RTN","RCDPAYER",42,0)
 ..Q:'CPOS
"RTN","RCDPAYER",43,0)
 ..;Save only first occurance of each type of contact
"RTN","RCDPAYER",44,0)
 ..S:$P(CONTACTS,U,CPOS)="" $P(CONTACTS,U,CPOS)=$P(STR,U,I)
"RTN","RCDPAYER",45,0)
 ;
"RTN","RCDPAYER",46,0)
 ;Allow for misfiled legacy contact data
"RTN","RCDPAYER",47,0)
 I FOUND,NAME="",WEB="",CONTACTS="" S FOUND=0
"RTN","RCDPAYER",48,0)
 ;Return found_web_phone_fax_email
"RTN","RCDPAYER",49,0)
 Q FOUND_U_NAME_U_WEB_U_CONTACTS
"RTN","RCDPAYER",50,0)
 ;
"RTN","RCDPAYER",51,0)
ADD(PRCABN) ;Update AR Transaction file #433 with comment type transaction
"RTN","RCDPAYER",52,0)
 ;PRCABN = Bill/Claim IEN for file #399
"RTN","RCDPAYER",53,0)
 ; called only if 'ERA Contact Information' type comment is not found
"RTN","RCDPAYER",54,0)
 ; serves as a notice to the user that the contact data came from the 835 ERA
"RTN","RCDPAYER",55,0)
 ;called from IBJTTC
"RTN","RCDPAYER",56,0)
 ;Note; PJH 8/11/2010 - see ADJUST^RCJIBFN3 (called by ARCA^IBJTA1)
"RTN","RCDPAYER",57,0)
 ;
"RTN","RCDPAYER",58,0)
 N AUTHDT,MRADT,STATUS,IBIFN
"RTN","RCDPAYER",59,0)
 S IBIFN=PRCABN
"RTN","RCDPAYER",60,0)
 S STATUS=$P($G(^DGCR(399,IBIFN,0)),U,13)
"RTN","RCDPAYER",61,0)
 S AUTHDT=$P($G(^DGCR(399,IBIFN,"S")),U,10)
"RTN","RCDPAYER",62,0)
 S MRADT=$P($G(^DGCR(399,IBIFN,"S")),U,7)
"RTN","RCDPAYER",63,0)
 ;
"RTN","RCDPAYER",64,0)
 ;If claim status is "NOT REVIEWED" or claim status is "CANCELLED"
"RTN","RCDPAYER",65,0)
 ;with neither MRA request date nor Authorization date present
"RTN","RCDPAYER",66,0)
 ;comment may not be added
"RTN","RCDPAYER",67,0)
 I STATUS=1!(STATUS=7&(MRADT="")&(AUTHDT="")) Q
"RTN","RCDPAYER",68,0)
 ;
"RTN","RCDPAYER",69,0)
 ;If claim status is "REQUEST MRA" or claim status is "CANCELLED"
"RTN","RCDPAYER",70,0)
 ;with MRA request date present, but no Authorization date comment
"RTN","RCDPAYER",71,0)
 ;cannot be added
"RTN","RCDPAYER",72,0)
 I STATUS=2!(STATUS=7&(MRADT'="")&(AUTHDT="")) Q
"RTN","RCDPAYER",73,0)
 ;
"RTN","RCDPAYER",74,0)
 ;Ignore bill cancelled in IB
"RTN","RCDPAYER",75,0)
 I '$D(^PRCA(430,PRCABN,2,0)) Q
"RTN","RCDPAYER",76,0)
 ;
"RTN","RCDPAYER",77,0)
 ;Ignore Archived bill
"RTN","RCDPAYER",78,0)
 I $P($G(^PRCA(430,PRCABN,0)),"^",8)=49 Q
"RTN","RCDPAYER",79,0)
 ;
"RTN","RCDPAYER",80,0)
 ;Build AR Transaction
"RTN","RCDPAYER",81,0)
 ;
"RTN","RCDPAYER",82,0)
 N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY
"RTN","RCDPAYER",83,0)
 ;
"RTN","RCDPAYER",84,0)
 ;Create stub record in 433
"RTN","RCDPAYER",85,0)
 D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
"RTN","RCDPAYER",86,0)
 ;
"RTN","RCDPAYER",87,0)
 S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
"RTN","RCDPAYER",88,0)
 Q:PRCAA1'>0  S PRCAA2=$P(^(0),U,3)
"RTN","RCDPAYER",89,0)
 ;
"RTN","RCDPAYER",90,0)
 ;Direct update of [PRCA COMMENT] edit template fields 
"RTN","RCDPAYER",91,0)
 ;(excluding Date of Contact, Extended Comments and Follow-up Date)
"RTN","RCDPAYER",92,0)
 S DIE="^PRCA(433,",DA=PRCAEN
"RTN","RCDPAYER",93,0)
 S DR=".03////"_PRCABN ;Bill Number
"RTN","RCDPAYER",94,0)
 S DR=DR_";3////0" ;Calm Code Done
"RTN","RCDPAYER",95,0)
 S DR=DR_";12////"_$O(^PRCA(430.3,"AC",17,0)) ;Transaction Type
"RTN","RCDPAYER",96,0)
 S DR=DR_";15////0" ;Transaction Amount
"RTN","RCDPAYER",97,0)
 S DR=DR_";42////.5" ;Processed by POSTMASTER
"RTN","RCDPAYER",98,0)
 S DR=DR_";11////"_DT ;Transaction date
"RTN","RCDPAYER",99,0)
 S DR=DR_";4////2" ;Transaction status (complete)
"RTN","RCDPAYER",100,0)
 S DR=DR_";5.02////ERA Payer Contact Information" D ^DIE
"RTN","RCDPAYER",101,0)
 ;
"RTN","RCDPAYER",102,0)
 ;Leave validation checks in place
"RTN","RCDPAYER",103,0)
 I $P($G(^PRCA(433,PRCAEN,5)),"^",2)=""!'$P(^PRCA(433,PRCAEN,1),"^") S PRCACOMM="TRANSACTION INCOMPLETE" D DELETE^PRCAWO1 K PRCACOMM Q
"RTN","RCDPAYER",104,0)
 ;
"RTN","RCDPAYER",105,0)
 I '$D(PRCAD("DELETE")) S RCASK=1 D TRANUP^PRCAUTL,UPPRIN^PRCADJ
"RTN","RCDPAYER",106,0)
 ;
"RTN","RCDPAYER",107,0)
 I $P($G(^RCD(340,+$P(^PRCA(430,PRCABN,0),"^",9),0)),"^")[";DPT(" D
"RTN","RCDPAYER",108,0)
 .;Ensure comment does not appear on patient statement
"RTN","RCDPAYER",109,0)
 .S $P(^PRCA(433,PRCAEN,0),"^",10)=1
"RTN","RCDPAYER",110,0)
 Q
"RTN","RCDPE8NZ")
0^15^B24021950
"RTN","RCDPE8NZ",1,0)
RCDPE8NZ ;ALB/TMK/PJH-report of unlinked payments in 5287/8NZZ ; 8/2/10 9:17pm
"RTN","RCDPE8NZ",2,0)
 ;;4.5;Accounts Receivable;**173,212,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPE8NZ",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPE8NZ",4,0)
 ;
"RTN","RCDPE8NZ",5,0)
EN N RCDPPADT,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP,ZTSK,DIR,X,Y
"RTN","RCDPE8NZ",6,0)
 S DIR("A")="Start with Deposit Date: FIRST// ",DIR(0)="DOA^:"_DT_":AEP" W ! D ^DIR K DIR
"RTN","RCDPE8NZ",7,0)
 I $D(DUOUT)!$D(DTOUT) Q
"RTN","RCDPE8NZ",8,0)
 S RCDPPADT=+Y
"RTN","RCDPE8NZ",9,0)
 ; Ask device
"RTN","RCDPE8NZ",10,0)
 S %ZIS="QM" D ^%ZIS G:POP PRQ
"RTN","RCDPE8NZ",11,0)
 I $D(IO("Q")) D  G PRQ
"RTN","RCDPE8NZ",12,0)
 . S ZTRTN="PR^RCDPE8NZ",ZTDESC="AR - List of unlinked EFT deposit payments"
"RTN","RCDPE8NZ",13,0)
 . S ZTSAVE("RCDPPADT")=""
"RTN","RCDPE8NZ",14,0)
 . D ^%ZTLOAD
"RTN","RCDPE8NZ",15,0)
 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPE8NZ",16,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPE8NZ",17,0)
 U IO
"RTN","RCDPE8NZ",18,0)
 ;
"RTN","RCDPE8NZ",19,0)
PR ; Entrypoint for queued job
"RTN","RCDPE8NZ",20,0)
 ;
"RTN","RCDPE8NZ",21,0)
 N RCCT,RCOK,RCPG,RCEFT,RCEFT1,RCDATA,RCDATA0,RCDA,RCREC,RCSTAT,RCDT,RCTOT,RCEFTD,RCSTOP,RCRDT,X,Y,Z
"RTN","RCDPE8NZ",22,0)
 ;
"RTN","RCDPE8NZ",23,0)
 ;  get list of unlinked EFT deposit data
"RTN","RCDPE8NZ",24,0)
 K ^TMP("RCDPE8NZZ_EFT",$J) ; subscripts: dep date,EFT ien,EFT det ien
"RTN","RCDPE8NZ",25,0)
 ;  Data is FMS doc indicator^FMS doc #^FMS Doc Status
"RTN","RCDPE8NZ",26,0)
 ;    FMS doc indicator = -1:no receipt  -2:no FMS doc  1:FMS doc exists
"RTN","RCDPE8NZ",27,0)
 ;
"RTN","RCDPE8NZ",28,0)
 S (RCCT,RCSTOP)=0
"RTN","RCDPE8NZ",29,0)
 S RCEFT1="" F  S RCEFT1=$O(^RCY(344.3,"ARDEP",RCEFT1)) Q:RCEFT1=""!RCSTOP  S RCDA=0 F  S RCDA=$O(^RCY(344.3,"ARDEP",RCEFT1,RCDA)) Q:'RCDA  D  Q:RCSTOP
"RTN","RCDPE8NZ",30,0)
 . S RCDATA=$G(^RCY(344.3,RCDA,0)),RCDT=$P(RCDATA,U,7),RCTOT=0
"RTN","RCDPE8NZ",31,0)
 . Q:RCDT<RCDPPADT  ; Before date selected
"RTN","RCDPE8NZ",32,0)
 . Q:'$P(RCDATA,"^",8)  ; no payment amt
"RTN","RCDPE8NZ",33,0)
 . S RCEFT=0 F  S RCEFT=$O(^RCY(344.31,"B",RCDA,RCEFT)) Q:'RCEFT!RCSTOP  S RCDATA0=$G(^RCY(344.31,RCEFT,0)) D  Q:RCSTOP  S:RCTOT ^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCDA)=RCTOT
"RTN","RCDPE8NZ",34,0)
 .. S RCCT=RCCT+1
"RTN","RCDPE8NZ",35,0)
 .. I '(RCCT#100),$D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ Q
"RTN","RCDPE8NZ",36,0)
 .. S RCREC=+$P($G(^RCY(344.4,+$P(RCDATA0,U,10),0)),U,8)
"RTN","RCDPE8NZ",37,0)
 .. S RCOK=1
"RTN","RCDPE8NZ",38,0)
 .. I 'RCREC D  Q
"RTN","RCDPE8NZ",39,0)
 ... I $P(RCDATA0,U,16)'="" Q
"RTN","RCDPE8NZ",40,0)
 ... S ^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCDA,RCEFT)=-1,RCTOT=RCTOT+$P(RCDATA0,U,7) S RCOK=0  ; No receipt
"RTN","RCDPE8NZ",41,0)
 .. S RCSTAT=$$FMSSTAT^RCDPUREC(RCREC)
"RTN","RCDPE8NZ",42,0)
 .. Q:$P(RCSTAT,U,2)["ACCEPTED"!($P(RCSTAT,U,2)["FINAL")!($P(RCSTAT,U,2)["ON LINE ENTRY")
"RTN","RCDPE8NZ",43,0)
 .. S RCTOT=RCTOT+$P(RCDATA0,U,7)
"RTN","RCDPE8NZ",44,0)
 .. I RCSTAT=-1 S ^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCDA,RCEFT)="-2^^"_$P(RCSTAT,U) Q  ; No FMS doc
"RTN","RCDPE8NZ",45,0)
 .. S ^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCDA,RCEFT)="1^"_$P(RCSTAT,U,1,2)
"RTN","RCDPE8NZ",46,0)
 ;
"RTN","RCDPE8NZ",47,0)
 S (RCPG,RCDT)=0,RCRDT=$$FMTE^XLFDT($$NOW^XLFDT(),2)
"RTN","RCDPE8NZ",48,0)
 F  S RCDT=$O(^TMP("RCDPE8NZZ_EFT",$J,RCDT)) Q:'RCDT  D  Q:RCSTOP
"RTN","RCDPE8NZ",49,0)
 . I 'RCPG!(($Y+5)>IOSL) D  Q:RCSTOP
"RTN","RCDPE8NZ",50,0)
 .. D HDR(RCRDT,.RCPG,.RCSTOP)
"RTN","RCDPE8NZ",51,0)
 . E  W !
"RTN","RCDPE8NZ",52,0)
 . W ! S Z="DEPOSIT DATE: "_$$FMTE^XLFDT(RCDT,1) W ?(80-$L(Z)\2),Z,!
"RTN","RCDPE8NZ",53,0)
 . ;
"RTN","RCDPE8NZ",54,0)
 . S RCEFT1=0 F  S RCEFT1=$O(^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCEFT1)) Q:'RCEFT1  D
"RTN","RCDPE8NZ",55,0)
 .. S RCCT=RCCT+1
"RTN","RCDPE8NZ",56,0)
 .. I '(RCCT#100),$D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 W:$G(RCPG) !!,"TASK STOPPED BY USER!!" K ZTREQ Q
"RTN","RCDPE8NZ",57,0)
 .. S RCDATA0=$G(^RCY(344.3,RCEFT1,0))
"RTN","RCDPE8NZ",58,0)
 .. I ($Y+5)>IOSL D HDR(RCRDT,.RCPG,.RCSTOP) Q:RCSTOP
"RTN","RCDPE8NZ",59,0)
 .. W !,$J("",4),$E($P(RCDATA0,U,6)_$S('$$HACEFT^RCDPEU(RCEFT1):"",1:"-HAC")_$J("",10),1,10)_"  "_$E($$FMTE^XLFDT($P(RCDATA0,U,7),2)_$J("",16),1,16)_"  "_$E($J(+$P(RCDATA0,U,8),"",2)_$J("",20),1,20)
"RTN","RCDPE8NZ",60,0)
 .. W "  "_$J(+$G(^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCEFT1)),"",2)
"RTN","RCDPE8NZ",61,0)
 .. ;
"RTN","RCDPE8NZ",62,0)
 .. S RCEFT=0 F  S RCEFT=$O(^TMP("RCDPE8NZZ_EFT",$J,RCDT,RCEFT1,RCEFT)) Q:'RCEFT  S RCDATA=$G(^(RCEFT)),RCEFTD=$G(^RCY(344.31,RCEFT,0)) D
"RTN","RCDPE8NZ",63,0)
 ... I ($Y+5)>IOSL D HDR(RCRDT,.RCPG,.RCSTOP) Q:RCSTOP
"RTN","RCDPE8NZ",64,0)
 ... W !,$J("",5)_$P(RCEFTD,U,2)_"/"_$P(RCEFTD,U,3),!,$J("",6)_$E($P(RCEFTD,U,4)_$J("",50),1,50)_" "
"RTN","RCDPE8NZ",65,0)
 ... W $E($J(+$P(RCEFTD,U,7),"",2)_$J("",12),1,12)_" "_$S($P(RCEFTD,U,9)'="":$P($G(^RCY(344,+$P(RCEFTD,U,9),0)),U),1:"NO RECEIPT")
"RTN","RCDPE8NZ",66,0)
 ... S Z=$P(RCEFTD,U,8)
"RTN","RCDPE8NZ",67,0)
 ... W !,$J("",8)_$E($S('Z:"UNMATCHED",Z=2:"PAPER EOB",1:"MATCHED TO ERA #: "_$P(RCEFTD,U,10)_$S(Z=-1:" (TOTALS MISMATCH)",1:""))_$J("",40),1,40)_"  "
"RTN","RCDPE8NZ",68,0)
 ... W $S($P(RCDATA,U)<0:"NO FMS DOCUMENT",1:$P(RCDATA,U,2)_" - "_$P(RCDATA,U,3)),!
"RTN","RCDPE8NZ",69,0)
 ;
"RTN","RCDPE8NZ",70,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPE8NZ",71,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPE8NZ",72,0)
 G:RCSTOP PRQ
"RTN","RCDPE8NZ",73,0)
 I $E(IOST,1,2)="C-" D ASK(.RCSTOP)
"RTN","RCDPE8NZ",74,0)
 ;
"RTN","RCDPE8NZ",75,0)
PRQ K ^TMP("RCDPE8NZZ_EFT",$J)
"RTN","RCDPE8NZ",76,0)
 Q
"RTN","RCDPE8NZ",77,0)
 ;
"RTN","RCDPE8NZ",78,0)
HDR(RCRDT,RCPG,RCSTOP) ; Print header data
"RTN","RCDPE8NZ",79,0)
 I 'RCSTOP,RCPG D ASK(.RCSTOP) Q:RCSTOP
"RTN","RCDPE8NZ",80,0)
 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
"RTN","RCDPE8NZ",81,0)
 S RCPG=RCPG+1
"RTN","RCDPE8NZ",82,0)
 W !,$S(RCDPPADT'>0:"ALL ",1:"")_"UNAPPLIED EFT PAYMENT DEPOSITS"_$S(RCDPPADT>0:" AFTER "_$$FMTE^XLFDT(RCDPPADT,2),1:""),?50,RCRDT,?70,"PAGE: ",RCPG
"RTN","RCDPE8NZ",83,0)
 W !!,"    DEPOSIT #   DEPOSIT DATE      TOT AMT OF DEPOSIT    TOT AMT UNPOSTED"
"RTN","RCDPE8NZ",84,0)
 W !,"     PAYER/ID",!,$J("",6)_"TRACE #"_$J("",44)_"PAYMENT AMT  RECEIPT #",!,$J("",8)_$E("ERA MATCHED"_$J("",40),1,40)_"  FMS DOC #/STATUS"
"RTN","RCDPE8NZ",85,0)
 W !,$TR($J("",IOM)," ","=")
"RTN","RCDPE8NZ",86,0)
 Q
"RTN","RCDPE8NZ",87,0)
 ;
"RTN","RCDPE8NZ",88,0)
ASK(RCSTOP) ;
"RTN","RCDPE8NZ",89,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPE8NZ",90,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPE8NZ",91,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPE8NZ",92,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPE8NZ",93,0)
 Q
"RTN","RCDPE8NZ",94,0)
 ;
"RTN","RCDPEAC")
0^11^B66599458
"RTN","RCDPEAC",1,0)
RCDPEAC ;ALB/TMK/PJH - ACTIVE BILLS WITH EEOB ON FILE ; 8/2/10 4:31pm
"RTN","RCDPEAC",2,0)
 ;;4.5;Accounts Receivable;**208,269**;Mar 20, 1995;Build 113
"RTN","RCDPEAC",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPEAC",4,0)
 ;
"RTN","RCDPEAC",5,0)
EN ; Entrypoint for producing the report
"RTN","RCDPEAC",6,0)
 N RCSORT,RCINS,ZTRTN,ZTDESC,ZTSAVE,ZTSK,%ZIS,POP
"RTN","RCDPEAC",7,0)
 Q:'$$SELECT(.RCINS,.RCSORT)
"RTN","RCDPEAC",8,0)
 W !
"RTN","RCDPEAC",9,0)
 S %ZIS="QM" D ^%ZIS Q:POP
"RTN","RCDPEAC",10,0)
 I $D(IO("Q")) D  Q
"RTN","RCDPEAC",11,0)
 . S ZTRTN="ENQ^RCDPEAC",ZTDESC="AR - ACTIVE BILLS WITH EEOB REPORT",ZTSAVE("RCINS")="",ZTSAVE("RCSORT")="",ZTSAVE("RCINS(")=""
"RTN","RCDPEAC",12,0)
 . D ^%ZTLOAD
"RTN","RCDPEAC",13,0)
 . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPEAC",14,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEAC",15,0)
 U IO
"RTN","RCDPEAC",16,0)
 ;
"RTN","RCDPEAC",17,0)
ENQ ; Queued entrypoint for the report
"RTN","RCDPEAC",18,0)
 ; RCSORT and array RCINS must exist
"RTN","RCDPEAC",19,0)
 ; RCINS = "A" for all ins co, "R" for range, "S" for selected individual
"RTN","RCDPEAC",20,0)
 ;         for RCINS="R"  ("FR")=from payer name and ("TR")=to payer name
"RTN","RCDPEAC",21,0)
 ;         for RCINS="S"  ("S",INS CO IEN IN FILE 36)=""
"RTN","RCDPEAC",22,0)
 ; RCSORT = "PN" for sort by patient name followed by ;- if reverse order
"RTN","RCDPEAC",23,0)
 ;          "L4" for sort by patient SSN followed by ;- if reverse order
"RTN","RCDPEAC",24,0)
 ;
"RTN","RCDPEAC",25,0)
 N Z,Z0,RCACT,RCBILL,RCEOB,RCTOT,RCSTOP,RCNEW,RCZ,RCZ0
"RTN","RCDPEAC",26,0)
 K ^TMP($J,"RCSORT")
"RTN","RCDPEAC",27,0)
 S RCACT=+$O(^PRCA(430.3,"AC",102,0)) ; Get active status ien
"RTN","RCDPEAC",28,0)
 G:'RCACT ENOUT
"RTN","RCDPEAC",29,0)
 ;
"RTN","RCDPEAC",30,0)
 S RCBILL=0
"RTN","RCDPEAC",31,0)
 F  S RCBILL=$O(^PRCA(430,"AC",RCACT,RCBILL)) Q:RCBILL=""  I +$G(^PRCA(430,RCBILL,7))>0,$$INCLUDE(.RCINS,RCBILL),$$EEOB(RCBILL,.RCEOB) D
"RTN","RCDPEAC",32,0)
 . S (RCTOT,RCEOB)=0 F  S RCEOB=$O(RCEOB(RCEOB)) Q:'RCEOB  S RCTOT=RCTOT+$G(^IBM(361.1,RCEOB,1)),^TMP($J,"RCSORT",$$INSNM(RCBILL),$$SL1(RCSORT,RCBILL),RCBILL,+RCEOB(RCEOB),RCEOB)=""
"RTN","RCDPEAC",33,0)
 . I $O(RCEOB(0)) S ^TMP($J,"RCSORT",$$INSNM(RCBILL),$$SL1(RCSORT,RCBILL),RCBILL)=RCTOT
"RTN","RCDPEAC",34,0)
 ;
"RTN","RCDPEAC",35,0)
 S RCZ="",(RCPG,RCSTOP,RCNEW)=0
"RTN","RCDPEAC",36,0)
 F  S RCZ=$O(^TMP($J,"RCSORT",RCZ)) Q:RCZ=""!RCSTOP  S RCZ0="" S:$G(RCINS)="R"!($G(RCINS)="S") RCNEW=1 D
"RTN","RCDPEAC",37,0)
 . I RCSORT'["-" D
"RTN","RCDPEAC",38,0)
 .. S RCZ0="" F  S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0)) Q:RCZ0=""!RCSTOP  D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,.RCPG,RCNEW) S RCNEW=0
"RTN","RCDPEAC",39,0)
 . I RCSORT["-" D
"RTN","RCDPEAC",40,0)
 .. S RCZ0="" F  S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0),-1) Q:RCZ0=""!RCSTOP  D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,.RCPG,.RCNEW) S RCNEW=0
"RTN","RCDPEAC",41,0)
 ;
"RTN","RCDPEAC",42,0)
 I 'RCSTOP,RCPG D ASK(.RCSTOP)
"RTN","RCDPEAC",43,0)
 ;
"RTN","RCDPEAC",44,0)
ENOUT I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPEAC",45,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPEAC",46,0)
 K ^TMP($J,"RCSORT")
"RTN","RCDPEAC",47,0)
 Q
"RTN","RCDPEAC",48,0)
 ;
"RTN","RCDPEAC",49,0)
OUTPUT(RCZ,RCZ0,RCSORT,RCSTOP,RCINS,RCPG,RCNEW) ; Output the data
"RTN","RCDPEAC",50,0)
 ; RCZ, RCZ0 are the first 2 sort levels for the array
"RTN","RCDPEAC",51,0)
 ; RCINS = insurance co info array
"RTN","RCDPEAC",52,0)
 ; RCSTOP passed by ref - returned if user chooses to stop
"RTN","RCDPEAC",53,0)
 ; RCNEW = 1 if the header should be forced to print
"RTN","RCDPEAC",54,0)
 N RCZ1,RCBILL,RC399,RCPT,RC430,RC0,RCEOB,X,Y
"RTN","RCDPEAC",55,0)
 S RCBILL=0 F  S RCBILL=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL)) Q:'RCBILL!RCSTOP  S RCZ1="" F  S RCZ1=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1)) Q:RCZ1=""!RCSTOP  D
"RTN","RCDPEAC",56,0)
 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q
"RTN","RCDPEAC",57,0)
 . S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) S RCNEW=0
"RTN","RCDPEAC",58,0)
 . Q:RCSTOP
"RTN","RCDPEAC",59,0)
 . S RC399=$G(^DGCR(399,RCBILL,0)),RCPT=+$P(RC399,U,2),RC430=$G(^PRCA(430,RCBILL,0))
"RTN","RCDPEAC",60,0)
 . S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) Q:RCSTOP
"RTN","RCDPEAC",61,0)
 . S X=$$GET1^DIQ(430,RCBILL_",",11)
"RTN","RCDPEAC",62,0)
 . W !,$E($P(RC399,U)_$J("",8),1,8)_"  "_$E($P($G(^DPT(RCPT,0)),U)_$J("",25),1,25)_"  "_$E($P($G(^DPT(RCPT,0)),U,9)_$J("",10),1,10)_"  ",$E($$INSNM(RCBILL)_$J("",30),1,30)
"RTN","RCDPEAC",63,0)
 . W !,$J("",8)_$E($J(+$P(RC430,U,3),"",2)_$J("",13),1,13)_"  "_$E($J(+$G(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL)),"",2)_$J("",13),1,13)_"  "_$E($J(+X,"",2)_$J("",12),1,12)
"RTN","RCDPEAC",64,0)
 . I $P($G(^PRCA(430,RCBILL,6)),U,4) W "  "_$$FMTE^XLFDT($P(^PRCA(430,RCBILL,6),U,4),2)
"RTN","RCDPEAC",65,0)
 . S RCEOB=0 F  S RCEOB=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB)) Q:'RCEOB!RCSTOP  D
"RTN","RCDPEAC",66,0)
 .. S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW)
"RTN","RCDPEAC",67,0)
 .. Q:RCSTOP
"RTN","RCDPEAC",68,0)
 .. S RC0=$G(^IBM(361.1,RCEOB,0))
"RTN","RCDPEAC",69,0)
 .. S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) Q:RCSTOP
"RTN","RCDPEAC",70,0)
 .. W !,?10,$P(RC0,U,7),!,$J("",39)_$E($$FMTE^XLFDT($P(RC0,U,5),"2D")_$J("",8),1,8)_" "_$E($$FMTE^XLFDT($P(RC0,U,6),"2D")_$J("",8),1,8)_" "_$E($S(RCZ1:$$FMTE^XLFDT(RCZ1,"2D"),1:"")_$J("",8),1,8)
"RTN","RCDPEAC",71,0)
 .. W " "_$J(+$G(^IBM(361.1,RCEOB,1)),"",2)
"RTN","RCDPEAC",72,0)
 ;
"RTN","RCDPEAC",73,0)
 Q
"RTN","RCDPEAC",74,0)
 ;
"RTN","RCDPEAC",75,0)
INCLUDE(RCINS,RCZ) ; Function returns 1 if record should be included based
"RTN","RCDPEAC",76,0)
 ; on ins co
"RTN","RCDPEAC",77,0)
 ; RCINS = array containing insurance co information
"RTN","RCDPEAC",78,0)
 ; RCZ = ien of the entry in file 430
"RTN","RCDPEAC",79,0)
 N OK,RCI,RCINM
"RTN","RCDPEAC",80,0)
 S OK=0
"RTN","RCDPEAC",81,0)
 S RCI=+$$INS(RCZ)
"RTN","RCDPEAC",82,0)
 ;
"RTN","RCDPEAC",83,0)
 I 'RCI G INCQ ; Not a third party bill
"RTN","RCDPEAC",84,0)
 ;
"RTN","RCDPEAC",85,0)
 I RCINS="A" S OK=1
"RTN","RCDPEAC",86,0)
 ;
"RTN","RCDPEAC",87,0)
 I RCINS="S"!(RCINS="R") D
"RTN","RCDPEAC",88,0)
 . I RCINS="S" S:$D(RCINS("S",RCI)) OK=1 Q
"RTN","RCDPEAC",89,0)
 . S RCINM=$$INSNM(RCZ) ; INS CO NAME
"RTN","RCDPEAC",90,0)
 . I $S(RCINM=RCINS("FR")!(RCINM]RCINS("FR")):RCINM']RCINS("TO"),1:0) S OK=1
"RTN","RCDPEAC",91,0)
 ;
"RTN","RCDPEAC",92,0)
INCQ Q OK
"RTN","RCDPEAC",93,0)
 ;
"RTN","RCDPEAC",94,0)
INSNM(RCZ) ; Returns the name of the insurance co for bill ien RCZ file 430
"RTN","RCDPEAC",95,0)
 N NM
"RTN","RCDPEAC",96,0)
 S NM=$P($G(^DIC(36,+$$INS(RCZ),0)),U)
"RTN","RCDPEAC",97,0)
 Q NM
"RTN","RCDPEAC",98,0)
 ;
"RTN","RCDPEAC",99,0)
INS(RCZ) ; Returns ien of insurance co for bill ien RCZ from file 430
"RTN","RCDPEAC",100,0)
 N RC
"RTN","RCDPEAC",101,0)
 S RC=$P($G(^PRCA(430,RCZ,0)),U,9) ;DEBTOR
"RTN","RCDPEAC",102,0)
 Q $S($P($G(^RCD(340,+RC,0)),U)'["DIC(36":"",1:+^(0))
"RTN","RCDPEAC",103,0)
 ;
"RTN","RCDPEAC",104,0)
NEWPG(RCPG,RCINS,RCNEW) ; Check for new page needed, output header
"RTN","RCDPEAC",105,0)
 ; RCINS = ins co selection criteria
"RTN","RCDPEAC",106,0)
 ; RCNEW = 1 to force new page
"RTN","RCDPEAC",107,0)
 ; Function returns 1 if user chooses to stop output
"RTN","RCDPEAC",108,0)
 I RCNEW!'RCPG!(($Y+5)>IOSL) D
"RTN","RCDPEAC",109,0)
 . D:RCPG ASK(.RCSTOP) I RCSTOP Q
"RTN","RCDPEAC",110,0)
 . D HDR(.RCPG,.RCINS)
"RTN","RCDPEAC",111,0)
 Q RCSTOP
"RTN","RCDPEAC",112,0)
 ;
"RTN","RCDPEAC",113,0)
EEOB(RCZ,RCEOB) ; Find all non-MRA  EEOBs for bill ien RCZ
"RTN","RCDPEAC",114,0)
 ; Function returns 1 if any valid EEOBs found, 0 if none
"RTN","RCDPEAC",115,0)
 ; RCEOB(eob ien)=date posted returned for valid EEOBs found -
"RTN","RCDPEAC",116,0)
 ;                pass by reference
"RTN","RCDPEAC",117,0)
 N OK,Z
"RTN","RCDPEAC",118,0)
 K RCEOB
"RTN","RCDPEAC",119,0)
 ;
"RTN","RCDPEAC",120,0)
 S OK=0
"RTN","RCDPEAC",121,0)
 S Z=0 F  S Z=$O(^IBM(361.1,"B",RCZ,Z)) Q:'Z  I $P($G(^IBM(361.1,Z,0)),U,4)'=1 D
"RTN","RCDPEAC",122,0)
 . N Z0,Z1,Z00
"RTN","RCDPEAC",123,0)
 . S Z0=+$O(^RCY(344.4,"ADET",Z,0)) ; ERA entry received in
"RTN","RCDPEAC",124,0)
 . S Z1=+$P($G(^RCY(344.4,Z0,0)),U,8) ; Receipt
"RTN","RCDPEAC",125,0)
 . S Z00=$P($G(^RCY(344.4,Z0,0)),U,14)
"RTN","RCDPEAC",126,0)
 . I Z1,$S(Z00=1!(Z00=2):1,1:0) S RCEOB(Z)=+$P($G(^RCY(344,Z1,0)),U,8),OK=1
"RTN","RCDPEAC",127,0)
 ;
"RTN","RCDPEAC",128,0)
 Q OK
"RTN","RCDPEAC",129,0)
 ;
"RTN","RCDPEAC",130,0)
SL1(RCSORT,RCZ) ; Function returns 1st sort level data from ien RCZ in file 430
"RTN","RCDPEAC",131,0)
 ; RCSORT = "PN" for patient name sort = "L4" for SSN last 4 sort
"RTN","RCDPEAC",132,0)
 N DAT
"RTN","RCDPEAC",133,0)
 I RCSORT="PN" S DAT=$P($G(^DPT(+$P($G(^PRCA(430,RCZ,0)),U,7),0)),U)
"RTN","RCDPEAC",134,0)
 I RCSORT="L4" S DAT=$P($G(^DPT(+$P($G(^PRCA(430,RCZ,0)),U,7),0)),U,9),DAT=$E(DAT,$L(DAT)-3,$L(DAT))
"RTN","RCDPEAC",135,0)
 Q $S($G(DAT)'="":DAT,1:" ")
"RTN","RCDPEAC",136,0)
 ;
"RTN","RCDPEAC",137,0)
SELECT(RCINS,RCSORT) ; Select insurance co and sort criteria
"RTN","RCDPEAC",138,0)
 ; Function returns values selected for RCSORT and RCINS - passed by ref
"RTN","RCDPEAC",139,0)
 N RCQUIT,DONE,DIR,X,Y
"RTN","RCDPEAC",140,0)
 S (RCQUIT,DONE)=0
"RTN","RCDPEAC",141,0)
 S DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE",DIR("A")="RUN REPORT FOR (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: ",DIR("B")="ALL" W ! D ^DIR K DIR
"RTN","RCDPEAC",142,0)
 I $D(DTOUT)!$D(DUOUT) G SELQ
"RTN","RCDPEAC",143,0)
 ;
"RTN","RCDPEAC",144,0)
 S RCINS=Y
"RTN","RCDPEAC",145,0)
 I RCINS="S" D  G:RCQUIT SELQ
"RTN","RCDPEAC",146,0)
 . W !
"RTN","RCDPEAC",147,0)
 . F  D LIST(.DIR,.RCINS) S DIR("A")="SELECT "_$S($O(RCINS("S",0)):"ANOTHER ",1:"")_"INSURANCE COMPANY"_$S($O(RCINS("S",0)):" (PRESS RETURN WHEN DONE)",1:"")_": ",DIR(0)="PAO^DIC(36,:AEMQ" D ^DIR K DIR D  Q:Y'>0
"RTN","RCDPEAC",148,0)
 .. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEAC",149,0)
 .. I Y>0 S RCINS("S",+Y)=""
"RTN","RCDPEAC",150,0)
 . I '$O(RCINS("S",0)) S RCQUIT=1 W !!,"NO INSURANCE COMPANIES SELECTED - NO REPORT GENERATED" S DIR(0)="E" D ^DIR K DIR
"RTN","RCDPEAC",151,0)
 ;
"RTN","RCDPEAC",152,0)
 I RCINS="R" D  I RCQUIT W !!,"NO INSURANCE COMPANY NAME RANGE SELECTED - NO REPORT GENERATED" S DIR(0)="E" D ^DIR K DIR G SELQ
"RTN","RCDPEAC",153,0)
 . W !
"RTN","RCDPEAC",154,0)
 . S DIR("?")="ENTER 1-30 UPPERCASE CHARACTERS OF THE FIRST NAME TO INCLUDE"
"RTN","RCDPEAC",155,0)
 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="START WITH INSURANCE COMPANY NAME: " D ^DIR K DIR
"RTN","RCDPEAC",156,0)
 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEAC",157,0)
 . S RCINS("FR")=Y
"RTN","RCDPEAC",158,0)
 . S DIR("?")="ENTER 1-30 UPPERCASE CHARACTERS OF THE LAST NAME TO INCLUDE"
"RTN","RCDPEAC",159,0)
 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="GO TO INSURANCE COMPANY NAME: ",DIR("B")=$E(RCINS("FR"),1,27)_"ZZZ"
"RTN","RCDPEAC",160,0)
 . F  W ! D ^DIR Q:$S($D(DTOUT)!$D(DUOUT):1,1:RCINS("FR")']Y)  W !,"'GO TO' NAME MUST COME AFTER 'START WITH' NAME"
"RTN","RCDPEAC",161,0)
 . K DIR
"RTN","RCDPEAC",162,0)
 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEAC",163,0)
 . S RCINS("TO")=Y
"RTN","RCDPEAC",164,0)
 S DIR(0)="SA^P:PATIENT NAME;L:LAST 4 OF PATIENT SSN",DIR("A")="WITHIN INS CO, SORT BY (P)ATIENT NAME OR (L)AST 4 OF SSN?: ",DIR("B")="PATIENT NAME" W ! D ^DIR K DIR
"RTN","RCDPEAC",165,0)
 I $D(DTOUT)!$D(DUOUT) G SELQ
"RTN","RCDPEAC",166,0)
 S RCSORT=$S(Y="P":"PN",1:"L4")
"RTN","RCDPEAC",167,0)
 S DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST",DIR("A")="SORT "_$S(RCSORT="PN":"PATIENT NAME",1:"LAST 4")_" (F)IRST TO LAST OR (L)AST TO FIRST?: ",DIR("B")="FIRST TO LAST" D ^DIR K DIR
"RTN","RCDPEAC",168,0)
 I $D(DTOUT)!$D(DUOUT) G SELQ
"RTN","RCDPEAC",169,0)
 I Y="L" S RCSORT=RCSORT_";-"
"RTN","RCDPEAC",170,0)
 S DONE=1
"RTN","RCDPEAC",171,0)
 ;
"RTN","RCDPEAC",172,0)
SELQ Q DONE
"RTN","RCDPEAC",173,0)
 ;
"RTN","RCDPEAC",174,0)
LIST(DIR,RCINS) ; Sets up help array for ins co selected in DIR("?")
"RTN","RCDPEAC",175,0)
 N CT,Z
"RTN","RCDPEAC",176,0)
 S CT=1
"RTN","RCDPEAC",177,0)
 I '$O(RCINS("S",0)) S DIR("?")="NO INSURANCE COMPANIES SELECTED" Q
"RTN","RCDPEAC",178,0)
 S DIR("?",1)="INSURANCE COMPANIES ALREADY SELECTED:"
"RTN","RCDPEAC",179,0)
 S Z=0 F  S Z=$O(RCINS("S",Z)) Q:'Z  S CT=CT+1,DIR("?",CT)="   "_$P($G(^DIC(36,Z,0)),U)
"RTN","RCDPEAC",180,0)
 S DIR("?")=" "
"RTN","RCDPEAC",181,0)
 Q
"RTN","RCDPEAC",182,0)
 ;
"RTN","RCDPEAC",183,0)
HDR(RCPG,RCINS) ;Print report hdr
"RTN","RCDPEAC",184,0)
 ; RCPG = last page #
"RTN","RCDPEAC",185,0)
 N Z,Z0,X
"RTN","RCDPEAC",186,0)
 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
"RTN","RCDPEAC",187,0)
 S RCPG=$G(RCPG)+1
"RTN","RCDPEAC",188,0)
 W !,?5,"EDI LOCKBOX ACTIVE BILLS W/EEOB REPORT",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG
"RTN","RCDPEAC",189,0)
 W !!,"INSURANCE SELECTED: "_$S(RCINS="A":"ALL",RCINS="R":"RANGE FROM "_RCINS("FR")_"-"_RCINS("TO"),1:"")
"RTN","RCDPEAC",190,0)
 S Z0=""
"RTN","RCDPEAC",191,0)
 I RCINS="S" S Z=0,Z0="" F  S Z=$O(RCINS("S",Z)) Q:'Z  S X=$P($G(^DIC(36,Z,0)),U) D
"RTN","RCDPEAC",192,0)
 . I $L(Z0)+$L(X)>79 W Z0 S Z0="" W !
"RTN","RCDPEAC",193,0)
 . S Z0=Z0_$S(Z0'="":",",1:"")_X
"RTN","RCDPEAC",194,0)
 I Z0'="" W Z0
"RTN","RCDPEAC",195,0)
 W !!,"BILL #    PATIENT NAME              SSN         INS CO NAME"
"RTN","RCDPEAC",196,0)
 W !,"        AMOUNT BILLED  AMOUNT PAID    BALANCE       DT REFERRED REG COUNSEL"
"RTN","RCDPEAC",197,0)
 W !,?10,"TRACE #",!,$J("",39)_"DT REC'D DT PAID  DT POST  AMOUNT PAID"
"RTN","RCDPEAC",198,0)
 W !,$TR($J("",IOM)," ","=")
"RTN","RCDPEAC",199,0)
 Q
"RTN","RCDPEAC",200,0)
 ;
"RTN","RCDPEAC",201,0)
ASK(RCSTOP) ;
"RTN","RCDPEAC",202,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEAC",203,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEAC",204,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEAC",205,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEAC",206,0)
 Q
"RTN","RCDPEAC",207,0)
 ;
"RTN","RCDPEAR1")
0^14^B37135763
"RTN","RCDPEAR1",1,0)
RCDPEAR1 ;ALB/TMK/PJH - ELECTRONIC ERA AGING REPORT - FILE 344.4 ; 8/2/10 7:26pm
"RTN","RCDPEAR1",2,0)
 ;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
"RTN","RCDPEAR1",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEAR1",4,0)
 Q
"RTN","RCDPEAR1",5,0)
 ;
"RTN","RCDPEAR1",6,0)
EN1 ; Entry from option - run on the fly
"RTN","RCDPEAR1",7,0)
 N RCDETAIL,RCMIN,DIR,X,Y,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
"RTN","RCDPEAR1",8,0)
 S DIR(0)="NA^0:1000",DIR("A")="Enter the minimum # of days elapsed before including on report (0-1000): " S:$P($G(^RC(342,1,7)),U,3) DIR("B")=$P(^(7),U,3)
"RTN","RCDPEAR1",9,0)
 W ! D ^DIR K DIR
"RTN","RCDPEAR1",10,0)
 I $D(DUOUT)!$D(DTOUT) G EN1Q
"RTN","RCDPEAR1",11,0)
 S RCMIN=+Y
"RTN","RCDPEAR1",12,0)
 S DIR(0)="SA^S:SUMMARY;D:DETAIL",DIR("A")="DO YOU WANT (S)UMMARY OR (D)ETAIL?: ",DIR("B")="SUMMARY" D ^DIR K DIR
"RTN","RCDPEAR1",13,0)
 I $D(DUOUT)!$D(DTOUT) G EN1Q
"RTN","RCDPEAR1",14,0)
 S RCDETAIL=(Y="D")
"RTN","RCDPEAR1",15,0)
 ; Ask device
"RTN","RCDPEAR1",16,0)
 S %ZIS="QM" D ^%ZIS G:POP EN1Q
"RTN","RCDPEAR1",17,0)
 I $D(IO("Q")) D  G EN1Q
"RTN","RCDPEAR1",18,0)
 . S ZTRTN="RPTOUT^RCDPEAR1("_RCMIN_","_RCDETAIL_")",ZTDESC="AR - EDI LOCKBOX ERA AGING REPORT"
"RTN","RCDPEAR1",19,0)
 . D ^%ZTLOAD
"RTN","RCDPEAR1",20,0)
 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPEAR1",21,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEAR1",22,0)
 U IO
"RTN","RCDPEAR1",23,0)
 D RPTOUT(RCMIN,RCDETAIL)
"RTN","RCDPEAR1",24,0)
EN1Q Q
"RTN","RCDPEAR1",25,0)
 ;
"RTN","RCDPEAR1",26,0)
RPTOUT(RCMIN,RCDETAIL,RCPRT) ; Entrypoint for queued job, nightly job
"RTN","RCDPEAR1",27,0)
 ; RCMIN = the minimum # of days before an entry is included on report
"RTN","RCDPEAR1",28,0)
 ; RCDETAIL = 1 if detail is needed, otherwise only summary is reported
"RTN","RCDPEAR1",29,0)
 ; RCPRT = name of the subscript for ^TMP to use to return all lines
"RTN","RCDPEAR1",30,0)
 ;        (for bulletin).  If undefined or null, output is printed
"RTN","RCDPEAR1",31,0)
 ; Return global if RCPRT not null: ^TMP($J,RCPRT,line#)=line text
"RTN","RCDPEAR1",32,0)
 N RCCT,RCPG,RCSTOP,RCNT,RCDATA,RCOUT,RCEDT,RC0,RC7,RCZ,RCZ0,RCZ1,RC00,RCTOT,Z,Z0
"RTN","RCDPEAR1",33,0)
 S RCPRT=$G(RCPRT)
"RTN","RCDPEAR1",34,0)
 S (RCCT,RCSTOP,RCPG,RCNT,RCTOT)=0
"RTN","RCDPEAR1",35,0)
 S RCEDT=$$FMADD^XLFDT(DT,-RCMIN)
"RTN","RCDPEAR1",36,0)
 K ^TMP($J,"RCERA_AGED"),^TMP($J,"RCERA_ADJ")
"RTN","RCDPEAR1",37,0)
 I RCPRT'="" K ^TMP($J,RCPRT)
"RTN","RCDPEAR1",38,0)
 S RCZ0=0 F  S RCZ0=$O(^RCY(344.4,"AMATCH",0,RCZ0)) Q:'RCZ0  D
"RTN","RCDPEAR1",39,0)
 . S RC7=$P($G(^RCY(344.4,RCZ0,0)),U,7)\1
"RTN","RCDPEAR1",40,0)
 . I RC7>RCEDT Q
"RTN","RCDPEAR1",41,0)
 . ; Minimum days have elapsed - include on report
"RTN","RCDPEAR1",42,0)
 . S ^TMP($J,"RCERA_AGED",$$FMDIFF^XLFDT(RC7,DT),RCZ0)=0,RCNT=RCNT+1
"RTN","RCDPEAR1",43,0)
 S RCZ="" F  S RCZ=$O(^TMP($J,"RCERA_AGED",RCZ)) Q:RCZ=""  S RCZ0=0 F  S RCZ0=$O(^TMP($J,"RCERA_AGED",RCZ,RCZ0)) Q:'RCZ0  D  G:RCSTOP PRTQ
"RTN","RCDPEAR1",44,0)
 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W:RCPRT="" !!,"***TASK STOPPED BY USER***" Q
"RTN","RCDPEAR1",45,0)
 . I RCDETAIL,RCPG D SETLINE(" ",.RCCT,.RCPRT) ; On detail list, skip line
"RTN","RCDPEAR1",46,0)
 . I 'RCPG!(($Y+5)>IOSL) D HDR(.RCCT,.RCPG,.RCSTOP,RCPRT,RCDETAIL,RCMIN) Q:RCSTOP
"RTN","RCDPEAR1",47,0)
 . S RC0=$G(^RCY(344.4,RCZ0,0)),RCTOT=RCTOT+$P(RC0,U,5)
"RTN","RCDPEAR1",48,0)
 . S Z=$$SETSTR^VALM1($J(-RCZ,4),"",1,4)
"RTN","RCDPEAR1",49,0)
 . S Z=$$SETSTR^VALM1("  "_$P(RC0,U,2),Z,5,50)
"RTN","RCDPEAR1",50,0)
 . D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",51,0)
 . S Z=$$SETSTR^VALM1($P(RC0,U,6)_"/"_$P(RC0,U,3),"",11,69)
"RTN","RCDPEAR1",52,0)
 . S Z=$$SETSTR^VALM1("  "_$$FMTE^XLFDT($P(RC0,U,4),2),Z,70,10)
"RTN","RCDPEAR1",53,0)
 . D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",54,0)
 . S Z=$$SETSTR^VALM1($J("",16)_$S($P(RC0,U,7):$$FMTE^XLFDT($P(RC0,U,7)\1,2),1:""),"",1,25)
"RTN","RCDPEAR1",55,0)
 . S Z=$$SETSTR^VALM1("  "_$J($P(RC0,U,5),15,2),Z,26,17)
"RTN","RCDPEAR1",56,0)
 . S Z=$$SETSTR^VALM1("  "_+$P(RC0,U,11),Z,43,11)
"RTN","RCDPEAR1",57,0)
 . S Z=$$SETSTR^VALM1("  "_$P(RC0,U),Z_$S('$$HACERA^RCDPEU(RCZ0):"",1:" (HAC ERA)"),54,26)
"RTN","RCDPEAR1",58,0)
 . D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",59,0)
 . ;
"RTN","RCDPEAR1",60,0)
 . I "23"[$$ADJ^RCDPEU(RCZ0) D SETLINE($J("",9)_"** CLAIM LEVEL ADJUSTMENTS EXIST FOR THIS ERA ***",.RCCT,RCPRT)
"RTN","RCDPEAR1",61,0)
 . I $O(^RCY(344.4,RCZ0,2,0)) D  ; ERA level adjustments exist
"RTN","RCDPEAR1",62,0)
 .. N Q
"RTN","RCDPEAR1",63,0)
 .. D DISPADJ^RCDPESR8(RCZ0,"^TMP("_$J_",""RCERA_ADJ"")")
"RTN","RCDPEAR1",64,0)
 .. I $O(^TMP($J,"RCERA_ADJ",0)) D SETLINE($J("",9)_"** GENERAL ADJUSTMENT DATA EXISTS FOR ERA **",.RCCT,RCPRT)
"RTN","RCDPEAR1",65,0)
 .. S Q=0 F  S Q=$O(^TMP($J,"RCERA_ADJ",Q)) Q:'Q  D SETLINE($J("",9)_$G(^TMP($J,"RCERA_ADJ",Q)),.RCCT,RCPRT)
"RTN","RCDPEAR1",66,0)
 . ;
"RTN","RCDPEAR1",67,0)
 . I RCDETAIL D  ; Detail wanted
"RTN","RCDPEAR1",68,0)
 .. S RCZ1=0 F  S RCZ1=$O(^RCY(344.4,RCZ0,1,RCZ1)) Q:'RCZ1  S RC00=$G(^(RCZ1,0)) D  Q:RCSTOP
"RTN","RCDPEAR1",69,0)
 ... N D
"RTN","RCDPEAR1",70,0)
 ... K RCDATA,RCOUT
"RTN","RCDPEAR1",71,0)
 ... ;I $O(^RCY(344.4,RCZ0,1,RCZ1),-1) D SETLINE(" ",.RCCT,RCPRT)
"RTN","RCDPEAR1",72,0)
 ... I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,RCPRT,RCDETAIL,RCMIN) Q:RCSTOP
"RTN","RCDPEAR1",73,0)
 ... S D=$J("",7)_" EEOB Seq #: "_$P(RC00,U)_$S($D(^RCY(344.4,RCZ0,1,"ATB",1,RCZ1)):" (REVERSAL)",1:"")_"  EEOB "
"RTN","RCDPEAR1",74,0)
 ... S D=D_$S('$P(RC00,U,2):"not on file",1:"on file for "_$P($G(^DGCR(399,+$G(^IBM(361.1,+$P(RC00,U,2),0)),0)),U))_"  "_$J(+$P(RC00,U,3),"",2)
"RTN","RCDPEAR1",75,0)
 ... D SETLINE(D,.RCCT,RCPRT)
"RTN","RCDPEAR1",76,0)
 ... Q:$P(RC00,U,2)
"RTN","RCDPEAR1",77,0)
 ... D DISP^RCDPESR0("^RCY(344.4,"_RCZ0_",1,"_RCZ1_",1)","RCDATA",1,"RCOUT",68,1)
"RTN","RCDPEAR1",78,0)
 ... I '$O(RCOUT(0)) D SETLINE($J("",9)_" NO DETAIL FOUND",.RCCT,RCPRT) Q
"RTN","RCDPEAR1",79,0)
 ... S Z=0 F  S Z=$O(RCOUT(Z)) Q:'Z  D  Q:RCSTOP
"RTN","RCDPEAR1",80,0)
 .... I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,RCPRT,RCDETAIL,RCMIN) Q:RCSTOP
"RTN","RCDPEAR1",81,0)
 .... D SETLINE($J("",9)_"*"_RCOUT(Z),.RCCT,RCPRT)
"RTN","RCDPEAR1",82,0)
 ;
"RTN","RCDPEAR1",83,0)
 F Z0=1:1:2 D SETLINE(" ",.RCCT,RCPRT)
"RTN","RCDPEAR1",84,0)
 I ($Y+7)>IOSL!'RCPG D HDR(.RCCT,.RCPG,.RCSTOP,RCPRT,RCDETAIL,RCMIN)
"RTN","RCDPEAR1",85,0)
 S Z=$$SETSTR^VALM1("TOTALS:","",1,79)
"RTN","RCDPEAR1",86,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",87,0)
 S Z=$$SETSTR^VALM1(" NUMBER AGED ELECTRONIC ERA MESSAGES FOUND: "_RCNT,"",1,79)
"RTN","RCDPEAR1",88,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",89,0)
 S Z=$$SETSTR^VALM1(" AMOUNT AGED ELECTRONIC ERA MESSAGES FOUND: "_$J(RCTOT,0,2),"",1,79)
"RTN","RCDPEAR1",90,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",91,0)
 ;
"RTN","RCDPEAR1",92,0)
PRTQ I '$D(ZTQUEUED),'RCSTOP,RCPG,RCPRT="" D ASK()
"RTN","RCDPEAR1",93,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPEAR1",94,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPEAR1",95,0)
 K ^TMP($J,"RCERA_AGED")
"RTN","RCDPEAR1",96,0)
 Q
"RTN","RCDPEAR1",97,0)
 ;
"RTN","RCDPEAR1",98,0)
HDR(RCCT,RCPG,RCSTOP,RCPRT,RCDETAIL,RCMIN) ;Prints report heading
"RTN","RCDPEAR1",99,0)
 ; Function returns RCPG = current page # and RCCT = running line count
"RTN","RCDPEAR1",100,0)
 ;   and RCSTOP = 1 if user aborted print 
"RTN","RCDPEAR1",101,0)
 ; Parameters must be passed by reference
"RTN","RCDPEAR1",102,0)
 ; RCDETAIL = 1 if detail is needed, otherwise only summary is reported
"RTN","RCDPEAR1",103,0)
 ; RCPRT = name of the subscript for ^TMP to use to return all lines
"RTN","RCDPEAR1",104,0)
 ;        (for bulletin).  If undefined or null, output is printed
"RTN","RCDPEAR1",105,0)
 ; RCMIN = minimum # days being used to age
"RTN","RCDPEAR1",106,0)
 N Z,Z0
"RTN","RCDPEAR1",107,0)
 Q:$G(RCSTOP)
"RTN","RCDPEAR1",108,0)
 I RCPG!($E(IOST,1,2)="C-") D  Q:$G(RCSTOP)
"RTN","RCDPEAR1",109,0)
 . I RCPG&($E(IOST,1,2)="C-")&(RCPRT="") D ASK(.RCSTOP) Q:RCSTOP
"RTN","RCDPEAR1",110,0)
 . I RCPRT="" W @IOF,*13 Q  ; Write form feed for report
"RTN","RCDPEAR1",111,0)
 . ; Add 2 blank lines for bulletin
"RTN","RCDPEAR1",112,0)
 . F Z=1:1:2 D SETLINE(" ",.RCCT,RCPRT)
"RTN","RCDPEAR1",113,0)
 S RCPG=RCPG+1
"RTN","RCDPEAR1",114,0)
 S Z0="EDI LOCKBOX ERA AGING "_$S(RCDETAIL:"DETAIL",1:"SUMMARY")_" REPORT"
"RTN","RCDPEAR1",115,0)
 S Z=$$SETSTR^VALM1($J("",80-$L(Z0)\2)_Z0,"",1,79)
"RTN","RCDPEAR1",116,0)
 S Z=$$SETSTR^VALM1("Page: "_RCPG,Z,70,10)
"RTN","RCDPEAR1",117,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",118,0)
 S Z0="MINIMUM DAYS FOR AGING: "_RCMIN,Z0=$J("",80-$L(Z0)\2)_Z0
"RTN","RCDPEAR1",119,0)
 S Z=$$SETSTR^VALM1(Z0,"",1,79)
"RTN","RCDPEAR1",120,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",121,0)
 S Z0="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z0=$J("",80-$L(Z0)\2)_Z0
"RTN","RCDPEAR1",122,0)
 S Z=$$SETSTR^VALM1(Z0,"",1,79)
"RTN","RCDPEAR1",123,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",124,0)
 D SETLINE(" ",.RCCT,RCPRT)
"RTN","RCDPEAR1",125,0)
 D SETLINE("AGED",.RCCT,RCPRT)
"RTN","RCDPEAR1",126,0)
 S Z=$$SETSTR^VALM1("DAYS"_$J("",2)_"TRACE #","",1,79)
"RTN","RCDPEAR1",127,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",128,0)
 S Z=$$SETSTR^VALM1($J("",10)_"PAYMENT FROM/ID"_$J("",46)_"ERA DATE","",1,79)
"RTN","RCDPEAR1",129,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",130,0)
 S Z=$$SETSTR^VALM1($J("",16)_"FILE DATE"_$J("",6)_"AMOUNT PAID"_$J("",2)_"EEOB CNT "_$J("",2)_"ERA #",Z,1,79)
"RTN","RCDPEAR1",131,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR1",132,0)
 D SETLINE($TR($J("",IOM-1)," ","="),.RCCT,RCPRT)
"RTN","RCDPEAR1",133,0)
 Q
"RTN","RCDPEAR1",134,0)
 ;
"RTN","RCDPEAR1",135,0)
SETLINE(Z,RCCT,RCPRT) ; Sets line into print global or writes line
"RTN","RCDPEAR1",136,0)
 ; Z = txt to output
"RTN","RCDPEAR1",137,0)
 ; RCCT = line counter
"RTN","RCDPEAR1",138,0)
 ; RCPRT = flag if 1, indicates output to global, no writes 
"RTN","RCDPEAR1",139,0)
 S RCCT=RCCT+1
"RTN","RCDPEAR1",140,0)
 I RCPRT="" W !,Z Q
"RTN","RCDPEAR1",141,0)
 S ^TMP($J,RCPRT,RCCT)=Z
"RTN","RCDPEAR1",142,0)
 Q
"RTN","RCDPEAR1",143,0)
 ;
"RTN","RCDPEAR1",144,0)
ASK(RCSTOP) ; Ask to continue
"RTN","RCDPEAR1",145,0)
 ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
"RTN","RCDPEAR1",146,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEAR1",147,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEAR1",148,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEAR1",149,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEAR1",150,0)
 Q
"RTN","RCDPEAR1",151,0)
 ;
"RTN","RCDPEAR2")
0^13^B32087204
"RTN","RCDPEAR2",1,0)
RCDPEAR2 ;ALB/TMK/PJH - ELECTRONIC EFT AGING REPORT - FILE 344.3 ; 8/2/10 7:14pm
"RTN","RCDPEAR2",2,0)
 ;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
"RTN","RCDPEAR2",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEAR2",4,0)
 Q
"RTN","RCDPEAR2",5,0)
 ;
"RTN","RCDPEAR2",6,0)
EN1 ; Entry from option - run on the fly
"RTN","RCDPEAR2",7,0)
 N RCDETAIL,RCMIN,DIR,X,Y,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
"RTN","RCDPEAR2",8,0)
 S DIR(0)="NA^0:1000",DIR("A")="Enter the minimum # of days elapsed before including on report (0-1000): " S:$P($G(^RC(342,1,7)),U,2) DIR("B")=$P(^(7),U,2)
"RTN","RCDPEAR2",9,0)
 S DIR("?",1)="This is the # minimum # of days this EFT has been in an UNMATCHED status",DIR("?",2)="before being included on this report.  EFT's with a 0 dollar balance are",DIR("?")="always excluded from this report."
"RTN","RCDPEAR2",10,0)
 W ! D ^DIR K DIR
"RTN","RCDPEAR2",11,0)
 I $D(DUOUT)!$D(DTOUT) G EN1Q
"RTN","RCDPEAR2",12,0)
 S RCMIN=+Y
"RTN","RCDPEAR2",13,0)
 S DIR(0)="SA^S:SUMMARY;D:DETAIL",DIR("A")="DO YOU WANT (S)UMMARY OR (D)ETAIL?: ",DIR("B")="SUMMARY" D ^DIR K DIR
"RTN","RCDPEAR2",14,0)
 I $D(DUOUT)!$D(DTOUT) G EN1Q
"RTN","RCDPEAR2",15,0)
 S RCDETAIL=(Y="D")
"RTN","RCDPEAR2",16,0)
 ; Ask device
"RTN","RCDPEAR2",17,0)
 S %ZIS="QM" D ^%ZIS G:POP EN1Q
"RTN","RCDPEAR2",18,0)
 I $D(IO("Q")) D  G EN1Q
"RTN","RCDPEAR2",19,0)
 . S ZTRTN="RPTOUT^RCDPEAR2("_RCMIN_","_RCDETAIL_")",ZTDESC="AR - EDI LOCKBOX EFT AGING REPORT"
"RTN","RCDPEAR2",20,0)
 . D ^%ZTLOAD
"RTN","RCDPEAR2",21,0)
 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPEAR2",22,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEAR2",23,0)
 U IO
"RTN","RCDPEAR2",24,0)
 D RPTOUT(RCMIN,RCDETAIL)
"RTN","RCDPEAR2",25,0)
EN1Q Q
"RTN","RCDPEAR2",26,0)
 ;
"RTN","RCDPEAR2",27,0)
RPTOUT(RCMIN,RCDETAIL,RCPRT) ; Entrypoint for queued job, nightly job
"RTN","RCDPEAR2",28,0)
 ; RCMIN = the minimum # of days before an entry is included on report
"RTN","RCDPEAR2",29,0)
 ; RCDETAIL = 1 if detail is needed, otherwise only summary is reported
"RTN","RCDPEAR2",30,0)
 ; RCPRT = name of the subscript for ^TMP to use to return all lines
"RTN","RCDPEAR2",31,0)
 ;        (for bulletin).  If undefined or null, output is printed
"RTN","RCDPEAR2",32,0)
 ; Return global if RCPRT not null: ^TMP($J,RCPRT,line#)=line text
"RTN","RCDPEAR2",33,0)
 N RCCT,RCPG,RCSTOP,RCNT,RCTOT,RCOUT,RCEDT,RC0,RC1,RC13,RCZ,RCZ0,RC00,Z,Z0
"RTN","RCDPEAR2",34,0)
 S RCPRT=$G(RCPRT)
"RTN","RCDPEAR2",35,0)
 S (RCCT,RCSTOP,RCPG,RCNT,RCTOT)=0
"RTN","RCDPEAR2",36,0)
 S RCEDT=$$FMADD^XLFDT(DT,-RCMIN)
"RTN","RCDPEAR2",37,0)
 K ^TMP($J,"RCEFT_AGED")
"RTN","RCDPEAR2",38,0)
 I RCPRT'="" K ^TMP($J,RCPRT)
"RTN","RCDPEAR2",39,0)
 S RCZ0=0 F  S RCZ0=$O(^RCY(344.31,"AMATCH",0,RCZ0)) Q:'RCZ0  D
"RTN","RCDPEAR2",40,0)
 . Q:$P($G(^RCY(344.31,RCZ0,0)),U,7)=0
"RTN","RCDPEAR2",41,0)
 . S RC13=$P($G(^RCY(344.31,RCZ0,0)),U,13)
"RTN","RCDPEAR2",42,0)
 . I RC13>RCEDT Q
"RTN","RCDPEAR2",43,0)
 . ; Minimum days have elapsed - include on report
"RTN","RCDPEAR2",44,0)
 . S ^TMP($J,"RCEFT_AGED",$$FMDIFF^XLFDT(RC13,DT),RCZ0)=0,RCNT=RCNT+1
"RTN","RCDPEAR2",45,0)
 ;
"RTN","RCDPEAR2",46,0)
 S RCZ="" F  S RCZ=$O(^TMP($J,"RCEFT_AGED",RCZ)) Q:RCZ=""  S RCZ0=0 F  S RCZ0=$O(^TMP($J,"RCEFT_AGED",RCZ,RCZ0)) Q:'RCZ0  D  G:RCSTOP PRTQ
"RTN","RCDPEAR2",47,0)
 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W:RCPRT="" !!,"***TASK STOPPED BY USER***" Q
"RTN","RCDPEAR2",48,0)
 . I RCDETAIL,RCPG D SETLINE(" ",.RCCT,.RCPRT) ; On detail list, skip line
"RTN","RCDPEAR2",49,0)
 . I 'RCPG!(($Y+5)>IOSL) D HDR(.RCCT,.RCPG,RCMIN,.RCSTOP,RCPRT,RCDETAIL) Q:RCSTOP
"RTN","RCDPEAR2",50,0)
 . S RC0=$G(^RCY(344.31,RCZ0,0)),RC00=$G(^RCY(344.3,+RC0,0))
"RTN","RCDPEAR2",51,0)
 . S RCTOT=RCTOT+$P(RC0,U,7)
"RTN","RCDPEAR2",52,0)
 . S Z=$$SETSTR^VALM1($J(-RCZ,4),"",1,4)
"RTN","RCDPEAR2",53,0)
 . S Z=$$SETSTR^VALM1("  "_$P(RC0,U,4),Z,5,75)
"RTN","RCDPEAR2",54,0)
 . D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",55,0)
 . S Z=$$SETSTR^VALM1($P(RC0,U,2)_"/"_$P(RC0,U,3),"",11,69)
"RTN","RCDPEAR2",56,0)
 . S Z=$$SETSTR^VALM1("  "_$$FMTE^XLFDT($P(RC0,U,12),2),Z,70,10)
"RTN","RCDPEAR2",57,0)
 . D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",58,0)
 . S Z=$$SETSTR^VALM1($J("",6)_$S($P(RC0,U,13):$$FMTE^XLFDT($P(RC0,U,13),2),1:""),"",1,17)
"RTN","RCDPEAR2",59,0)
 . S Z=$$SETSTR^VALM1("  "_$J($P(RC0,U,7),15,2),Z,18,17)
"RTN","RCDPEAR2",60,0)
 . S Z=$$SETSTR^VALM1("  "_$P(RC00,U,6),Z,35,8)
"RTN","RCDPEAR2",61,0)
 . S Z=$$SETSTR^VALM1("  "_$S($P(RC00,U,12):"",1:"NOT ")_"POSTED TO 8NZZ"_$S($P(RC00,U,12):" ON "_$$FMTE^XLFDT($P(RC00,U,11),2),1:""),Z,44,36)
"RTN","RCDPEAR2",62,0)
 . D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",63,0)
 . ;
"RTN","RCDPEAR2",64,0)
 . I RCDETAIL D  ; Detail wanted
"RTN","RCDPEAR2",65,0)
 .. K RCOUT
"RTN","RCDPEAR2",66,0)
 .. D GETS^DIQ(344.31,RCZ0_",",2,"E","RCOUT")
"RTN","RCDPEAR2",67,0)
 .. Q:'$O(RCOUT(344.31,RCZ0_",",2,0))
"RTN","RCDPEAR2",68,0)
 .. D SETLINE($J("",8)_"--EXCEPTION NOTES--",.RCCT,RCPRT)
"RTN","RCDPEAR2",69,0)
 .. S Z=0 F  S Z=$O(RCOUT(344.31,RCZ0_",",2,Z)) Q:'Z  D  Q:RCSTOP
"RTN","RCDPEAR2",70,0)
 ... I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,RCMIN,.RCSTOP,RCPRT,RCDETAIL) Q:RCSTOP
"RTN","RCDPEAR2",71,0)
 ... D SETLINE($J("",8)_" "_RCOUT(344.31,RCZ0_",",2,Z),.RCCT,RCPRT)
"RTN","RCDPEAR2",72,0)
 ;
"RTN","RCDPEAR2",73,0)
 F Z0=1:1:2 D SETLINE(" ",.RCCT,RCPRT)
"RTN","RCDPEAR2",74,0)
 I ($Y+7)>IOSL!'RCPG D HDR(.RCCT,.RCPG,RCMIN,.RCSTOP,RCPRT,RCDETAIL)
"RTN","RCDPEAR2",75,0)
 S Z=$$SETSTR^VALM1("TOTALS:","",1,79)
"RTN","RCDPEAR2",76,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",77,0)
 S Z=$$SETSTR^VALM1(" NUMBER AGED ELECTRONIC EFT MESSAGES FOUND: "_RCNT,"",1,79)
"RTN","RCDPEAR2",78,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",79,0)
 S Z=$$SETSTR^VALM1(" AMOUNT AGED ELECTRONIC EFT MESSAGES FOUND: "_$J(+RCTOT,0,2),"",1,79)
"RTN","RCDPEAR2",80,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",81,0)
 ;
"RTN","RCDPEAR2",82,0)
PRTQ I '$D(ZTQUEUED),'RCSTOP,RCPG,RCPRT="" D ASK()
"RTN","RCDPEAR2",83,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPEAR2",84,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPEAR2",85,0)
 K ^TMP($J,"RCEFT_AGED")
"RTN","RCDPEAR2",86,0)
 Q
"RTN","RCDPEAR2",87,0)
 ;
"RTN","RCDPEAR2",88,0)
HDR(RCCT,RCPG,RCMIN,RCSTOP,RCPRT,RCDETAIL) ;Prints report heading
"RTN","RCDPEAR2",89,0)
 ; Function returns RCPG = current page # and RCCT = running line count
"RTN","RCDPEAR2",90,0)
 ;   and RCSTOP = 1 if user aborted print 
"RTN","RCDPEAR2",91,0)
 ; Above parameters must be passed by reference
"RTN","RCDPEAR2",92,0)
 ; RCMIN = the minimum # of days before an entry is included on report
"RTN","RCDPEAR2",93,0)
 ; RCDETAIL = 1 if detail is needed, otherwise only summary is reported
"RTN","RCDPEAR2",94,0)
 ; RCPRT = name of the subscript for ^TMP to use to return all lines
"RTN","RCDPEAR2",95,0)
 ;        (for bulletin).  If undefined or null, output is printed
"RTN","RCDPEAR2",96,0)
 N Z,Z0
"RTN","RCDPEAR2",97,0)
 I RCPG!($E(IOST,1,2)="C-") D
"RTN","RCDPEAR2",98,0)
 . I RCPG&($E(IOST,1,2)="C-")&(RCPRT="") D ASK(.RCSTOP) Q:RCSTOP
"RTN","RCDPEAR2",99,0)
 . I RCPRT="" W @IOF,*13 Q  ; Write form feed for report
"RTN","RCDPEAR2",100,0)
 . ; Add 2 blank lines for bulletin
"RTN","RCDPEAR2",101,0)
 . F Z=1:1:2 D SETLINE(" ",.RCCT,RCPRT)
"RTN","RCDPEAR2",102,0)
 Q:$G(RCSTOP)
"RTN","RCDPEAR2",103,0)
 S RCPG=RCPG+1
"RTN","RCDPEAR2",104,0)
 S Z0="EDI LOCKBOX EFT UNMATCHED AGING "_$S(RCDETAIL:"DETAIL",1:"SUMMARY")_" REPORT"
"RTN","RCDPEAR2",105,0)
 S Z=$$SETSTR^VALM1($J("",80-$L(Z0)\2)_Z0,"",1,79)
"RTN","RCDPEAR2",106,0)
 S Z=$$SETSTR^VALM1("Page: "_RCPG,Z,70,10)
"RTN","RCDPEAR2",107,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",108,0)
 S Z0="MINIMUM DAYS NOT MATCHED FOR AGING: "_RCMIN,Z0=$J("",80-$L(Z0)\2)_Z0
"RTN","RCDPEAR2",109,0)
 S Z=$$SETSTR^VALM1(Z0,"",1,79)
"RTN","RCDPEAR2",110,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",111,0)
 S Z0="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z0=$J("",80-$L(Z0)\2)_Z0
"RTN","RCDPEAR2",112,0)
 S Z=$$SETSTR^VALM1(Z0,"",1,79)
"RTN","RCDPEAR2",113,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",114,0)
 D SETLINE(" ",.RCCT,RCPRT)
"RTN","RCDPEAR2",115,0)
 D SETLINE("AGED",.RCCT,RCPRT)
"RTN","RCDPEAR2",116,0)
 S Z=$$SETSTR^VALM1("DAYS"_$J("",2)_"TRACE #","",1,79)
"RTN","RCDPEAR2",117,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",118,0)
 S Z=$$SETSTR^VALM1($J("",10)_"DEPOSIT FROM/ID"_$J("",46)_"DEP DATE","",1,79)
"RTN","RCDPEAR2",119,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",120,0)
 S Z=$$SETSTR^VALM1($J("",6)_"FILE DATE"_$J("",5)_"DEPOSIT AMOUNT"_$J("",2)_"DEP #  "_$J("",2)_"DEPOSIT POST STATUS",Z,1,79)
"RTN","RCDPEAR2",121,0)
 D SETLINE(Z,.RCCT,RCPRT)
"RTN","RCDPEAR2",122,0)
 D SETLINE($TR($J("",IOM-1)," ","="),.RCCT,RCPRT)
"RTN","RCDPEAR2",123,0)
 Q
"RTN","RCDPEAR2",124,0)
 ;
"RTN","RCDPEAR2",125,0)
SETLINE(Z,RCCT,RCPRT) ; Sets line into print global or writes line
"RTN","RCDPEAR2",126,0)
 ; Z = txt to output
"RTN","RCDPEAR2",127,0)
 ; RCCT = line counter
"RTN","RCDPEAR2",128,0)
 ; RCPRT = flag if 1, indicates output to global, no writes 
"RTN","RCDPEAR2",129,0)
 S RCCT=RCCT+1
"RTN","RCDPEAR2",130,0)
 I RCPRT="" W !,Z Q
"RTN","RCDPEAR2",131,0)
 S ^TMP($J,RCPRT,RCCT)=Z
"RTN","RCDPEAR2",132,0)
 Q
"RTN","RCDPEAR2",133,0)
 ;
"RTN","RCDPEAR2",134,0)
ASK(RCSTOP) ; Ask to continue
"RTN","RCDPEAR2",135,0)
 ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
"RTN","RCDPEAR2",136,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEAR2",137,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEAR2",138,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEAR2",139,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEAR2",140,0)
 Q
"RTN","RCDPEAR2",141,0)
 ;
"RTN","RCDPEDA1")
0^12^B14062058
"RTN","RCDPEDA1",1,0)
RCDPEDA1 ;ALB/TMK/PJH - ACTIVITY REPORT HEADER ; 8/2/10 6:23pm
"RTN","RCDPEDA1",2,0)
 ;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
"RTN","RCDPEDA1",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEDA1",4,0)
 Q
"RTN","RCDPEDA1",5,0)
 ;
"RTN","RCDPEDA1",6,0)
HDR(RCCT,RCPG,RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) ;Prints report heading
"RTN","RCDPEDA1",7,0)
 ; Function returns RCPG = current page # and RCCT = running line count
"RTN","RCDPEDA1",8,0)
 ;   and RCSTOP = 1 if user aborted print
"RTN","RCDPEDA1",9,0)
 ; Parameters RCCT,RCPG,RCSTOP must be passed by reference
"RTN","RCDPEDA1",10,0)
 ; RCDT1,RCDT2 = from,to date
"RTN","RCDPEDA1",11,0)
 ; RCDET = flag = 1 if detail is desired
"RTN","RCDPEDA1",12,0)
 N Z,Z0,X,Y
"RTN","RCDPEDA1",13,0)
 Q:RCNITE&(RCPG)
"RTN","RCDPEDA1",14,0)
 I RCPG!($E(IOST,1,2)="C-") D
"RTN","RCDPEDA1",15,0)
 . Q:$G(RCNITE)
"RTN","RCDPEDA1",16,0)
 . I RCPG&($E(IOST,1,2)="C-") D ASK(.RCSTOP) Q:RCSTOP
"RTN","RCDPEDA1",17,0)
 . W @IOF,*13 ; Write form feed
"RTN","RCDPEDA1",18,0)
 Q:RCSTOP
"RTN","RCDPEDA1",19,0)
 S RCPG=RCPG+1
"RTN","RCDPEDA1",20,0)
 S Z0="EDI LOCKBOX DAILY ACTIVITY "_$S($G(RCDET):"DETAIL",1:"SUMMARY")_" REPORT"
"RTN","RCDPEDA1",21,0)
 S Z=$$SETSTR^VALM1($J("",80-$L(Z0)\2)_Z0,"",1,79)
"RTN","RCDPEDA1",22,0)
 S Z=$$SETSTR^VALM1("Page: "_RCPG,Z,70,10)
"RTN","RCDPEDA1",23,0)
 D SETLINE^RCDPEDAR(RCNITE,Z,.RCCT)
"RTN","RCDPEDA1",24,0)
 S Z0="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z0=$J("",80-$L(Z0)\2)_Z0
"RTN","RCDPEDA1",25,0)
 S Z=$$SETSTR^VALM1(Z0,"",1,79)
"RTN","RCDPEDA1",26,0)
 D SETLINE^RCDPEDAR(RCNITE,Z,.RCCT)
"RTN","RCDPEDA1",27,0)
 D SETLINE^RCDPEDAR(RCNITE," ",.RCCT)
"RTN","RCDPEDA1",28,0)
 D SETLINE^RCDPEDAR(RCNITE,"DATE RANGE SELECTED: "_$$FMTE^XLFDT(RCDT1,2)_"-"_$$FMTE^XLFDT(RCDT2,2),.RCCT)
"RTN","RCDPEDA1",29,0)
 D SETLINE^RCDPEDAR(RCNITE," ",.RCCT)
"RTN","RCDPEDA1",30,0)
 I $G(RCDET) D
"RTN","RCDPEDA1",31,0)
 . S Z=$$SETSTR^VALM1("DEP #   DEPOSIT DT  "_$J("",22)_"DEP AMOUNT          FMS DEPOSIT STAT","",1,80)
"RTN","RCDPEDA1",32,0)
 . D SETLINE^RCDPEDAR(RCNITE,Z,.RCCT)
"RTN","RCDPEDA1",33,0)
 . D SETLINE^RCDPEDAR(RCNITE," ",.RCCT)
"RTN","RCDPEDA1",34,0)
 . S Z=$$SETSTR^VALM1($J("",3)_"EFT #"_$J("",23)_"DATE PD   PAYMENT AMOUNT     ERA MATCH STATUS","",1,80)
"RTN","RCDPEDA1",35,0)
 . D SETLINE^RCDPEDAR(RCNITE,Z,.RCCT)
"RTN","RCDPEDA1",36,0)
 . S Z=$$SETSTR^VALM1($J("",10)_"EFT PAYER TRACE #","",1,30)
"RTN","RCDPEDA1",37,0)
 . D SETLINE^RCDPEDAR(RCNITE,Z,.RCCT)
"RTN","RCDPEDA1",38,0)
 . S Z=$$SETSTR^VALM1($J("",14)_"PAYMENT FROM","",1,30)
"RTN","RCDPEDA1",39,0)
 . D SETLINE^RCDPEDAR(RCNITE,Z,.RCCT)
"RTN","RCDPEDA1",40,0)
 . S Z=$$SETSTR^VALM1($J("",45)_"DEP RECEIPT #","",1,60)
"RTN","RCDPEDA1",41,0)
 . S Z=$$SETSTR^VALM1("DEP RECEIPT STATUS",Z,61,19)
"RTN","RCDPEDA1",42,0)
 . D SETLINE^RCDPEDAR(RCNITE,Z,.RCCT)
"RTN","RCDPEDA1",43,0)
 D SETLINE^RCDPEDAR(RCNITE,$TR($J("",IOM-1)," ","="),.RCCT)
"RTN","RCDPEDA1",44,0)
 Q
"RTN","RCDPEDA1",45,0)
 ;
"RTN","RCDPEDA1",46,0)
ASK(RCSTOP) ; Ask to continue
"RTN","RCDPEDA1",47,0)
 ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
"RTN","RCDPEDA1",48,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEDA1",49,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEDA1",50,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEDA1",51,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEDA1",52,0)
 Q
"RTN","RCDPEDA1",53,0)
 ;
"RTN","RCDPEDA1",54,0)
EFTDET(Z2,Z3,RCCT,RCPG,RCSTOP,RCDT1,RCDT2,RCDET,RCFMS1,RCNITE) ; Display EFT Detail
"RTN","RCDPEDA1",55,0)
 N X
"RTN","RCDPEDA1",56,0)
 S X=$$SETSTR^VALM1(Z2,"",4,6)
"RTN","RCDPEDA1",57,0)
 S X=$$SETSTR^VALM1($$FMTE^XLFDT($P(Z3,U,12)\1,2),X,32,8)
"RTN","RCDPEDA1",58,0)
 S X=$$SETSTR^VALM1($J($P(Z3,U,7),"",2),X,42,18)
"RTN","RCDPEDA1",59,0)
 S X=$$SETSTR^VALM1($$EXTERNAL^DILFD(344.31,.08,"",+$P(Z3,U,8))_$S($P(Z3,U,8)=1:"/ERA #"_$P(Z3,U,10),1:""),X,61,20)
"RTN","RCDPEDA1",60,0)
 I '$G(RCNITE),($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
"RTN","RCDPEDA1",61,0)
 D SETLINE^RCDPEDAR(RCNITE,X,.RCCT)
"RTN","RCDPEDA1",62,0)
 S X=$$SETSTR^VALM1($P(Z3,U,4),"",11,61)
"RTN","RCDPEDA1",63,0)
 D SETLINE^RCDPEDAR(RCNITE,X,.RCCT)
"RTN","RCDPEDA1",64,0)
 S X=$$SETSTR^VALM1($P(Z3,U,2)_"/"_$P(Z3,U,3),"",15,65)
"RTN","RCDPEDA1",65,0)
 D SETLINE^RCDPEDAR(RCNITE,X,.RCCT)
"RTN","RCDPEDA1",66,0)
 S X=""
"RTN","RCDPEDA1",67,0)
 I $P(Z3,U,9) S X=$$SETSTR^VALM1($P($G(^RCY(344,+$P(Z3,U,9),0)),U),X,46,10)
"RTN","RCDPEDA1",68,0)
 S X=$$SETSTR^VALM1($G(RCFMS1(Z2)),X,61,19)
"RTN","RCDPEDA1",69,0)
 I '$G(RCNITE),($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
"RTN","RCDPEDA1",70,0)
 D SETLINE^RCDPEDAR(RCNITE,X,.RCCT)
"RTN","RCDPEDA1",71,0)
 I $O(^RCY(344.31,Z2,2,0)) D  Q:RCSTOP
"RTN","RCDPEDA1",72,0)
 . N V
"RTN","RCDPEDA1",73,0)
 . I '$G(RCNITE),($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
"RTN","RCDPEDA1",74,0)
 . D SETLINE^RCDPEDAR(RCNITE,$J("",10)_"ERROR MESSAGES FOR EFT DETAIL:",.RCCT)
"RTN","RCDPEDA1",75,0)
 . S V=0 F  S V=$O(^RCY(344.31,Z2,2,V)) Q:'V  D  Q:RCSTOP
"RTN","RCDPEDA1",76,0)
 .. I '$G(RCNITE),($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
"RTN","RCDPEDA1",77,0)
 .. D SETLINE^RCDPEDAR(RCNITE,$J("",12)_$G(^RCY(344.31,Z2,2,V,0)),.RCCT)
"RTN","RCDPEDA1",78,0)
 Q
"RTN","RCDPEDA1",79,0)
 ;
"RTN","RCDPEDS")
0^24^B36371277
"RTN","RCDPEDS",1,0)
RCDPEDS ;ALB/TMK/DWA - Display EEOB detail from receipt ;07/30/10
"RTN","RCDPEDS",2,0)
 ;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
"RTN","RCDPEDS",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEDS",4,0)
 ; IA for call to GETEOB^IBCECSA6 = 4044
"RTN","RCDPEDS",5,0)
 ;
"RTN","RCDPEDS",6,0)
DISP(RCTDA) ; Display EEOB detail/raw data from file 344.4
"RTN","RCDPEDS",7,0)
 ; RCTDA = ien of entry in file 344.4 to display
"RTN","RCDPEDS",8,0)
 ; Returns global ^TMP("$J,"RCDISP")
"RTN","RCDPEDS",9,0)
 ;
"RTN","RCDPEDS",10,0)
 N RCZ,RCZ0,RCCT
"RTN","RCDPEDS",11,0)
 K ^TMP($J,"RCDISP")
"RTN","RCDPEDS",12,0)
 S RCCT=0
"RTN","RCDPEDS",13,0)
 ; 
"RTN","RCDPEDS",14,0)
 D SUM(RCTDA,.RCCT)
"RTN","RCDPEDS",15,0)
 ;
"RTN","RCDPEDS",16,0)
 S RCZ=0 F  S RCZ=$O(^RCY(344.4,RCTDA,1,RCZ)) Q:'RCZ  S RCZ0=$G(^(RCZ,0)) I RCZ0'="" D SEQ(RCTDA,.RCCT,RCZ,RCZ0)
"RTN","RCDPEDS",17,0)
 ;
"RTN","RCDPEDS",18,0)
 Q
"RTN","RCDPEDS",19,0)
 ;
"RTN","RCDPEDS",20,0)
SEQ(RCTDA,RCCT,RC34441,RC0) ;
"RTN","RCDPEDS",21,0)
 ; RCTDA = ien of record in file 344.4
"RTN","RCDPEDS",22,0)
 ; RCCT = line counter, updated if passed by ref
"RTN","RCDPEDS",23,0)
 ; RC34441 = ien of seq # in file 344.41
"RTN","RCDPEDS",24,0)
 ; RC0 = the data on the 0-node of the sequence entry in file 344.41
"RTN","RCDPEDS",25,0)
 ;
"RTN","RCDPEDS",26,0)
 N RCIEN,RCZ,RCDPDATA
"RTN","RCDPEDS",27,0)
 I $P(RC0,U,2) D  ; Get detail from EOB file
"RTN","RCDPEDS",28,0)
 . K ^TMP("PRCA_EOB",$J)
"RTN","RCDPEDS",29,0)
 . S RCIEN=+$P(RC0,U,2)
"RTN","RCDPEDS",30,0)
 . D GETEOB^IBCECSA6(RCIEN,1) ; IA 4044
"RTN","RCDPEDS",31,0)
 . I $O(^IBM(361.1,RCIEN,"ERR",0)) D  ; Add error msgs
"RTN","RCDPEDS",32,0)
 .. D GETERR(RCIEN,+$O(^TMP("PRCA_EOB",$J,RCIEN," "),-1))
"RTN","RCDPEDS",33,0)
 . D SEQHDR(RCTDA,RC34441,.RCCT)
"RTN","RCDPEDS",34,0)
 . S RCZ=0
"RTN","RCDPEDS",35,0)
 . F  S RCZ=$O(^TMP("PRCA_EOB",$J,RCIEN,RCZ)) Q:'RCZ  S RCCT=RCCT+1 S ^TMP($J,"RCDISP",RCCT)=$G(^TMP("PRCA_EOB",$J,RCIEN,RCZ))
"RTN","RCDPEDS",36,0)
 ;
"RTN","RCDPEDS",37,0)
 I '$P(RC0,U,2),$O(^RCY(344.4,RCTDA,1,RC34441,1,0)) D  ; Get detail from raw data in file 344.411
"RTN","RCDPEDS",38,0)
 . K ^TMP($J,"RCOUT"),^TMP($J,"RCRAW")
"RTN","RCDPEDS",39,0)
 . D SEQHDR(RCTDA,RC34441,.RCCT)
"RTN","RCDPEDS",40,0)
 . D DISP^RCDPESR0("^RCY(344.4,"_RCTDA_",1,"_RC34441_",1)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75,1)
"RTN","RCDPEDS",41,0)
 . K ^TMP($J,"RCRAW")
"RTN","RCDPEDS",42,0)
 . S RCZ=0
"RTN","RCDPEDS",43,0)
 . F  S RCZ=$O(^TMP($J,"RCOUT",RCZ)) Q:'RCZ  S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$G(^TMP($J,"RCOUT",RCZ))
"RTN","RCDPEDS",44,0)
 K ^TMP($J,"RCOUT"),^TMP("PRCA_EOB",$J)
"RTN","RCDPEDS",45,0)
 Q
"RTN","RCDPEDS",46,0)
 ;
"RTN","RCDPEDS",47,0)
SEQHDR(RCTDA,RC34441,RCCT) ; Extract header data from sequence record
"RTN","RCDPEDS",48,0)
 ; RCTDA = ien of record in file 344.4
"RTN","RCDPEDS",49,0)
 ; RC34441 = ien of seq # in file 344.41
"RTN","RCDPEDS",50,0)
 ; RCCT = line counter, updated if passed by ref
"RTN","RCDPEDS",51,0)
 ; Returns line # incremented and ^TMP($J,"RCDISP" array
"RTN","RCDPEDS",52,0)
 ;
"RTN","RCDPEDS",53,0)
 N RCDPDATA,RCINV
"RTN","RCDPEDS",54,0)
 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=" "
"RTN","RCDPEDS",55,0)
 D DIQ34441(RCTDA,RC34441,".01:.15")
"RTN","RCDPEDS",56,0)
 S RCCT=RCCT+1
"RTN","RCDPEDS",57,0)
 S RCINV=($G(RCDPDATA(344.41,RC34441,.02,"E"))="")
"RTN","RCDPEDS",58,0)
 S ^TMP($J,"RCDISP",RCCT)=$E("Sequence #: "_$G(RCDPDATA(344.41,RC34441,.01,"E"))_$S(RCINV:" (Not Stored in IB)",1:"")_$J("",32),1,32)
"RTN","RCDPEDS",59,0)
 S ^TMP($J,"RCDISP",RCCT)=^TMP($J,"RCDISP",RCCT)_"Bill Number: "_$S('RCINV:RCDPDATA(344.41,RC34441,.02,"E"),1:$G(RCDPDATA(344.41,RC34441,.05,"E"))_" (Not in AR)")
"RTN","RCDPEDS",60,0)
 I $G(RCDPDATA(344.41,RC34441,.14,"E"))="YES" S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="  *** REVERSAL ***"
"RTN","RCDPEDS",61,0)
 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("Amount "_$S($G(RCDPDATA(344.41,RC34441,.14,"E"))="YES":"Reversed",1:"Paid")_": "_$G(RCDPDATA(344.41,RC34441,.03,"E"))_$J("",32),1,32)_"Ins Co: "_$E($G(RCDPDATA(344.41,RC34441,.04,"E")),1,30)
"RTN","RCDPEDS",62,0)
 I $G(RCDPDATA(344.41,RC34441,.07,"E"))'="" S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="Error: "_RCDPDATA(344.41,RC34441,.07,"E")_$S($G(RCDPDATA(344.41,RC34441,.08,"E"))'="":" - "_$G(RCDPDATA(344.41,RC34441,.08,"E")),1:"")
"RTN","RCDPEDS",63,0)
 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="Worklist Status: "_$G(RCDPDATA(344.41,RC34441,.06,"E"))
"RTN","RCDPEDS",64,0)
 Q
"RTN","RCDPEDS",65,0)
 ;
"RTN","RCDPEDS",66,0)
GETERR(RCIEN,Z) ; Extract error messages from entry RCIEN in file 361.1
"RTN","RCDPEDS",67,0)
 ; Z = the last line # in the ^TMP("PRCA_EOB",$J,RCIEN,n array
"RTN","RCDPEDS",68,0)
 ; Function returns error lines from file #361.1 in the
"RTN","RCDPEDS",69,0)
 ;   ^TMP("PRCA_EOB",$J,RCIEN,n array in subscripts at the end of the
"RTN","RCDPEDS",70,0)
 ;    array
"RTN","RCDPEDS",71,0)
 N Z0,DATA,RCRAW,RCFORM,RCLINE,X,RCV5
"RTN","RCDPEDS",72,0)
 S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)="EEOB FILING ERRORS:"
"RTN","RCDPEDS",73,0)
 S Z0=0 F  S Z0=$O(^IBM(361.1,RCIEN,"ERR",Z0)) Q:'Z0  S X=$G(^(Z0,0)) D
"RTN","RCDPEDS",74,0)
 . I +X,+X=835,+$P(X,U,16)>0 S RCV5=1
"RTN","RCDPEDS",75,0)
 . I +X S RCLINE=+X_$S($G(RCV5)=1:"^RCDPES10",1:"^RCDPESR9") I $T(@RCLINE)'="" D  Q
"RTN","RCDPEDS",76,0)
 .. S RCRAW(1,0)=X
"RTN","RCDPEDS",77,0)
 .. D DISP^RCDPESR0("RCRAW","RCFORM",1,"RCDATA",80,0)
"RTN","RCDPEDS",78,0)
 .. S X=0 F  S X=$O(RCFORM(X)) Q:'X  S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)="  "_RCFORM(X)
"RTN","RCDPEDS",79,0)
 . S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)="  "_$G(^IBM(361.1,RCIEN,"ERR",Z0,0))
"RTN","RCDPEDS",80,0)
 Q
"RTN","RCDPEDS",81,0)
 ;
"RTN","RCDPEDS",82,0)
SUM(RCTDA,RCCT) ; Extract pertinent top-level data
"RTN","RCDPEDS",83,0)
 ; RCTDA = ien of record in file 344.4
"RTN","RCDPEDS",84,0)
 ; RCCT = line counter, updated if passed by ref
"RTN","RCDPEDS",85,0)
 ;
"RTN","RCDPEDS",86,0)
 N Z,Z0,CT,CT1,RCDPDATA,RCADJ,RCREV
"RTN","RCDPEDS",87,0)
 D DIQ3444(RCTDA,".02:.11")
"RTN","RCDPEDS",88,0)
 S (Z,CT,RCADJ)=0 F  S Z=$O(^RCY(344.4,RCTDA,2,Z)) Q:'Z  S CT=CT+1,RCADJ=RCADJ+$J($P($G(^(Z,0)),U,3),0,2)
"RTN","RCDPEDS",89,0)
 S (Z,CT1,RCREV)=0 S Z=0 F  S Z0=$O(^RCY(344.4,RCTDA,1,"ATB",1,Z)) Q:'Z  S Z0=$G(^RCY(344.4,RCTDA,1,Z,0)),CT1=CT1+1,RCREV(Z)=$$BILLREF^RCDPESR0(RCTDA,Z)_U_$J($P(Z0,U,3),0,2),RCREV=RCREV+$P(RCREV(Z),U,2)
"RTN","RCDPEDS",90,0)
 S RCCT=RCCT+1,Z="There is data for "_+$G(RCDPDATA(344.4,RCTDA,.11,"E"))_" EEOBs"_$S(CT:", "_CT_" ERA adjustments",1:"")_$S(CT1:", "_CT1_" EEOB reversals",1:"")
"RTN","RCDPEDS",91,0)
 S ^TMP($J,"RCDISP",RCCT)=$J("",(80-$L(Z))\2)_Z
"RTN","RCDPEDS",92,0)
 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT PAID: "_+$G(RCDPDATA(344.4,RCTDA,.05,"E"))
"RTN","RCDPEDS",93,0)
 I RCADJ D
"RTN","RCDPEDS",94,0)
 . S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT ERA ADJUSTED: "_RCADJ
"RTN","RCDPEDS",95,0)
 . D DISPADJ^RCDPESR8(RCTDA,"RCADJ")
"RTN","RCDPEDS",96,0)
 . S Z=0 F  S Z=$O(RCADJ(Z)) Q:'Z  S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="  "_RCADJ(Z)
"RTN","RCDPEDS",97,0)
 I RCREV D
"RTN","RCDPEDS",98,0)
 . S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT REVERSED: "_RCREV
"RTN","RCDPEDS",99,0)
 . S Z=0 F  S Z=$O(RCREV(Z)) Q:'Z  S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("  BILL REFERENCE: "_$P(RCREV(Z),U)_$J("",30),1,30)_"  REVERSAL AMT: "_$P(RCREV,U,2)
"RTN","RCDPEDS",100,0)
 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("TRACE #: "_$G(RCDPDATA(344.4,RCTDA,.02,"E"))_$J("",35),1,35)_"RECEIPT #: "_$G(RCDPDATA(344.4,RCTDA,.08,"E"))
"RTN","RCDPEDS",101,0)
 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("INS CO ID: "_$G(RCDPDATA(344.4,RCTDA,.03,"E"))_$J("",35),1,35)_"NAME: "_$E($G(RCDPDATA(344.4,RCTDA,.06,"E")),1,29)
"RTN","RCDPEDS",102,0)
 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("ERA DATE: "_$G(RCDPDATA(344.4,RCTDA,.04,"E"))_$J("",35),1,35)_"DATE ERA RECEIVED: "_$G(RCDPDATA(344.4,RCTDA,.07,"E"))
"RTN","RCDPEDS",103,0)
 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="EFT MATCH STATUS: "_$G(RCDPDATA(344.4,RCTDA,.09,"E"))
"RTN","RCDPEDS",104,0)
 Q
"RTN","RCDPEDS",105,0)
 ;
"RTN","RCDPEDS",106,0)
DIQ34441(RCTDA,RC0,DR,ARR) ; DIQ call to retrieve data for DR fields in
"RTN","RCDPEDS",107,0)
 ; file 344.41
"RTN","RCDPEDS",108,0)
 N %I,D0,D1,DA,DIC,DIQ,DIQ2,YY
"RTN","RCDPEDS",109,0)
 I $G(ARR)="" S ARR="RCDPDATA"
"RTN","RCDPEDS",110,0)
 K @ARR@(344.41,RC0)
"RTN","RCDPEDS",111,0)
 S DA=RC0,DA(1)=RCTDA,DIQ(0)="E",DIC="^RCY(344.4,"_DA(1)_",1,",DIQ=ARR D EN^DIQ1
"RTN","RCDPEDS",112,0)
 Q
"RTN","RCDPEDS",113,0)
 ;
"RTN","RCDPEDS",114,0)
DIQ3444(DA,DR,ARR) ; DIQ call to retrieve data for DR fields in file 344.41
"RTN","RCDPEDS",115,0)
 N %I,D0,DIC,DIQ,DIQ2,YY
"RTN","RCDPEDS",116,0)
 I $G(ARR)="" S ARR="RCDPDATA"
"RTN","RCDPEDS",117,0)
 K @ARR@(344.4,DA)
"RTN","RCDPEDS",118,0)
 S DIQ(0)="E",DIC="^RCY(344.4,",DIQ=ARR D EN^DIQ1
"RTN","RCDPEDS",119,0)
 Q
"RTN","RCDPEDS",120,0)
 ;
"RTN","RCDPEM")
0^38^B54192380
"RTN","RCDPEM",1,0)
RCDPEM ;ALB/TMK/PJH - POST EFT, ERA MATCHING TO EFT ; 5/31/11 6:15pm
"RTN","RCDPEM",2,0)
 ;;4.5;Accounts Receivable;**173,255,269**;Mar 20, 1995;Build 113
"RTN","RCDPEM",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEM",4,0)
 ; IA 4050 covers call to SPL1^IBCEOBAR
"RTN","RCDPEM",5,0)
 Q
"RTN","RCDPEM",6,0)
 ; Note - keep processing in line with RCDPXPAP 
"RTN","RCDPEM",7,0)
EN ; Post EFT deposits, auto-match EFT's and ERA's 
"RTN","RCDPEM",8,0)
 ;
"RTN","RCDPEM",9,0)
 K ^TMP($J,"RCDPETOT")
"RTN","RCDPEM",10,0)
 ; ^TMP($J,"RCDPETOT",344.3 or 344.31,file ien)=
"RTN","RCDPEM",11,0)
 ;  (1) match (0/1/-1)   (2) total $   (3) posted (0/1)  (4) error ref
"RTN","RCDPEM",12,0)
 ;  (5) EFT deposit ien 344.1 if added for EFT
"RTN","RCDPEM",13,0)
 ;
"RTN","RCDPEM",14,0)
 N RCZ,RCSUM,RCDEP,RECTDA,RC0,RCER,RCDUZ,Z,Z0,Z1,DA,X,Y,DIE,DR
"RTN","RCDPEM",15,0)
 M RCDUZ=DUZ
"RTN","RCDPEM",16,0)
 N DUZ S DUZ=+$O(^VA(200,"B","EDILOCKBOX,AUTOMATIC",0)),DUZ(0)="" S:'DUZ DUZ=.5
"RTN","RCDPEM",17,0)
 K ^TMP($J,"RCXM"),^TMP($J,"RCTOT")
"RTN","RCDPEM",18,0)
 S ZTREQ="@"
"RTN","RCDPEM",19,0)
 L +^RCY(344.3,"ALOCK"):5 I '$T D  G ENQ ; Lock record
"RTN","RCDPEM",20,0)
 . ; Send bulletin that job could not be run
"RTN","RCDPEM",21,0)
 . S ^TMP($J,"RCXM",1)="The nightly job to post EFT deposits and match EFTs to ERAs could not be run",^TMP($J,"RCXM",2)="Another match process was already running (lock on ^RCY(344.3,""ALOCK"") )"
"RTN","RCDPEM",22,0)
 . D SENDBULL^RCDPEM1
"RTN","RCDPEM",23,0)
 ;
"RTN","RCDPEM",24,0)
 ; Post deposits for any unposted EFTs in file 344.3
"RTN","RCDPEM",25,0)
 ; 'Unposted' EFTs have a 0 in AMOUNT POSTED field
"RTN","RCDPEM",26,0)
 S ^TMP($J,"RCTOT","EFT_DEP")=0
"RTN","RCDPEM",27,0)
 S RCZ=0 F  S RCZ=$O(^RCY(344.3,"APOST",0,RCZ)) Q:'RCZ  S RC0=$G(^RCY(344.3,RCZ,0))  I RC0'="",$P(RC0,U,8),($E($P(RC0,U,6),1,3)="469")!($E($P(RC0,U,6),1,3)="569") D
"RTN","RCDPEM",28,0)
 . S ^TMP($J,"RCTOT","EFT_DEP")=^TMP($J,"RCTOT","EFT_DEP")+1
"RTN","RCDPEM",29,0)
 . ; Verify check sums
"RTN","RCDPEM",30,0)
 . S RCSUM=$$CHKSUM^RCDPESR3(RCZ)
"RTN","RCDPEM",31,0)
 . I RCSUM'=$P(RC0,U,9) D  Q
"RTN","RCDPEM",32,0)
 .. ; Bulletin that check sums do not match
"RTN","RCDPEM",33,0)
 .. ; Update record error list and checksum error field
"RTN","RCDPEM",34,0)
 .. S RCER(1)=$$SETERR^RCDPEM0(2)
"RTN","RCDPEM",35,0)
 .. S RCER(2)="  Checksum is invalid and the EFT deposit record is corrupted.",RCER(3)="  Stored Checksum = "_$P(RC0,U,9)_" Calculated Checksum: "_RCSUM,RCER(4)="  This EFT deposit cannot be sent to FMS.  You must ask for it to be"
"RTN","RCDPEM",36,0)
 .. S RCER(5)="   retransmitted to your site."
"RTN","RCDPEM",37,0)
 .. D BULL^RCDPEM1(344.3,RC0,.RCER)
"RTN","RCDPEM",38,0)
 .. S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,4)=+$G(^TMP($J,"RCXM",0))
"RTN","RCDPEM",39,0)
 .. D STORERR^RCDPEM0(RCZ,.RCER)
"RTN","RCDPEM",40,0)
 .. S DIE="^RCY(344.3,",DA=RCZ,DR=".1////1" D ^DIE
"RTN","RCDPEM",41,0)
 .. S ^TMP($J,"RCTOT","CSUM")=$G(^TMP($J,"RCTOT","CSUM"))+1
"RTN","RCDPEM",42,0)
 . ;
"RTN","RCDPEM",43,0)
 . S RCDEP=+$P(RC0,U,3),RECTDA=+$O(^RCY(344,"AD",RCDEP,0))
"RTN","RCDPEM",44,0)
 . I RCDEP D LOCKDEP(RCDEP,1)
"RTN","RCDPEM",45,0)
 . I 'RCDEP!'RECTDA D  ;  Add deposit and/or receipt to files 344.1, 344
"RTN","RCDPEM",46,0)
 .. I 'RCDEP D  ; Add dep record RCDEP, update field .03 with the pointer
"RTN","RCDPEM",47,0)
 ... S RCDEP=+$$ADDDEP^RCDPEM0($P(RC0,U,6),$P(RC0,U,7),RCZ)
"RTN","RCDPEM",48,0)
 ... S ^TMP($J,"RCTOT","DEPOSIT")=$G(^TMP($J,"RCTOT","DEPOSIT"))+1
"RTN","RCDPEM",49,0)
 .. ;
"RTN","RCDPEM",50,0)
 .. I 'RECTDA,RCDEP D  ; Add receipt record, post to rev source cd 8NZZ
"RTN","RCDPEM",51,0)
 ... S RECTDA=+$$ADDREC^RCDPEM0(RCDEP,RCZ)
"RTN","RCDPEM",52,0)
 .. ;
"RTN","RCDPEM",53,0)
 . I RCDEP D LOCKDEP(RCDEP,0)
"RTN","RCDPEM",54,0)
 . ;
"RTN","RCDPEM",55,0)
 . I 'RCDEP!'RECTDA D  Q  ; Could not add entry to file 344.1 or 344 
"RTN","RCDPEM",56,0)
 .. ; Send a bulletin, update error text
"RTN","RCDPEM",57,0)
 .. S RCER(1)=$$SETERR^RCDPEM0(2),RCER(2)="  "_$S('RCDEP:"Neither a deposit nor a receipt were able",1:"A receipt was not able")_" to be added - no match attempted"
"RTN","RCDPEM",58,0)
 .. I RCDEP,'RECTDA S RCER(3)="  Deposit Ticket # created: "_$P($G(^RCY(344.1,+$P(RC0,U,3),0)),U)
"RTN","RCDPEM",59,0)
 .. S RCER($O(RCER(""),-1)+1)="This EFT deposit can't be sent to FMS.  You must ask Austin to retransmit"
"RTN","RCDPEM",60,0)
 .. D BULL^RCDPEM1(344.3,RC0,.RCER)
"RTN","RCDPEM",61,0)
 .. S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,4)=+$G(^TMP($J,"RCXM",0))
"RTN","RCDPEM",62,0)
 .. D STORERR^RCDPEM0(RCZ,.RCER)
"RTN","RCDPEM",63,0)
 .. S ^TMP($J,"RCTOT","ERR")=$G(^TMP($J,"RCTOT","ERR"))+1
"RTN","RCDPEM",64,0)
 . ;
"RTN","RCDPEM",65,0)
 . S DIE="^RCY(344.31," S Z=0 F  S Z=$O(^RCY(344.31,"B",RCZ,Z)) Q:'Z  S DA=Z,DR=".11////1" D ^DIE
"RTN","RCDPEM",66,0)
 ;
"RTN","RCDPEM",67,0)
 D MATCH(0,1)
"RTN","RCDPEM",68,0)
 L -^RCY(344.3,"ALOCK")
"RTN","RCDPEM",69,0)
ENQ K ^TMP($J,"RCDPETOT")
"RTN","RCDPEM",70,0)
 Q
"RTN","RCDPEM",71,0)
 ;
"RTN","RCDPEM",72,0)
MATCH(RCMAN,RCPROC) ; Try to matched unmatched EFTs
"RTN","RCDPEM",73,0)
 ; RCMAN = 1 if job run manually, outside of nightly processing
"RTN","RCDPEM",74,0)
 ; RCPROC = 1 if called from EFT-EOB automatch, 0 if from manual match
"RTN","RCDPEM",75,0)
 ;
"RTN","RCDPEM",76,0)
 N RC0,RCER,RCZ,RCHAC
"RTN","RCDPEM",77,0)
 I '$O(^RCY(344.31,"AMATCH",0,0)) D  G MATCHQ
"RTN","RCDPEM",78,0)
 . ; Send bulletin - no unmatched EFTs found
"RTN","RCDPEM",79,0)
 . N RCT
"RTN","RCDPEM",80,0)
 . S RCT=+$O(^TMP($J,"RCXM"," "),-1)+1
"RTN","RCDPEM",81,0)
 . S ^TMP($J,"RCXM",RCT)=$S('$G(RCMAN):"The nightly job",1:"The manual option")_" to match EFTs has found no EFTs are currently unmatched on your system"
"RTN","RCDPEM",82,0)
 . I $G(RCMAN) S ^TMP($J,"RCXM",RCT+1)="The action was initiated by "_$P($G(^VA(200,DUZ,0)),U)
"RTN","RCDPEM",83,0)
 . D SENDBULL^RCDPEM1
"RTN","RCDPEM",84,0)
 ;
"RTN","RCDPEM",85,0)
 S RCZ=0 F  S RCZ=$O(^RCY(344.31,"AMATCH",0,RCZ)) Q:'RCZ  D
"RTN","RCDPEM",86,0)
 . K RCER
"RTN","RCDPEM",87,0)
 . S RC0=$G(^RCY(344.31,RCZ,0)),RCHAC=($E($P($G(^RCY(344.3,+RC0,0)),U,6),1,3)="HAC")
"RTN","RCDPEM",88,0)
 . Q:RC0=""  ; Bad xref
"RTN","RCDPEM",89,0)
 . Q:$S('RCHAC:'$P(RC0,U,11),1:0)  ; EFT deposit must have been recorded
"RTN","RCDPEM",90,0)
 . S ^TMP($J,"RCTOT","EFT")=$G(^TMP($J,"RCTOT","EFT"))+1
"RTN","RCDPEM",91,0)
 . I RCHAC S ^TMP($J,"RCTOT","EFT_HAC")=$G(^TMP($J,"RCTOT","EFT_HAC"))+1
"RTN","RCDPEM",92,0)
 . S ^TMP($J,"RCDPETOT",344.31,RCZ)=""
"RTN","RCDPEM",93,0)
 . ;
"RTN","RCDPEM",94,0)
 . D MATCH^RCDPEM0(RCZ,RCPROC)
"RTN","RCDPEM",95,0)
 ;
"RTN","RCDPEM",96,0)
 I '$O(^TMP($J,"RCXM",0)) K RCER S RCER(1)="",RCER(2)="NO EXCEPTIONS WHILE MATCHING EFTs-ERAs OR IN RECORDING THE DEPOSITS TO FMS" D BULL^RCDPEM1("","",.RCER) K RCER
"RTN","RCDPEM",97,0)
 D EN2^RCDPEM1,BULL^RCDPEM1("","",.RCER)
"RTN","RCDPEM",98,0)
 D SENDBULL^RCDPEM1
"RTN","RCDPEM",99,0)
 ;
"RTN","RCDPEM",100,0)
MATCHQ K ^TMP($J,"RCDPETOT"),^TMP($J,"RCTOT")
"RTN","RCDPEM",101,0)
 Q
"RTN","RCDPEM",102,0)
 ;
"RTN","RCDPEM",103,0)
LOCKDEP(RCDEP,LOCK) ; Lock/confirm deposit ien RCDEP file 341.1
"RTN","RCDPEM",104,0)
 ; If LOCK = 1 lock deposit
"RTN","RCDPEM",105,0)
 ; If LOCK = 0 unlock deposit
"RTN","RCDPEM",106,0)
 I $G(LOCK) D
"RTN","RCDPEM",107,0)
 . L +^RCY(344.1,RCDEP,0)
"RTN","RCDPEM",108,0)
 . D CONFIRM^RCDPUDEP(RCDEP) ; confirm to prevent changes
"RTN","RCDPEM",109,0)
 I '$G(LOCK) L -^RCY(344.1,RCDEP,0)
"RTN","RCDPEM",110,0)
 Q
"RTN","RCDPEM",111,0)
 ;
"RTN","RCDPEM",112,0)
RCPTDET(RCRZ,RECTDA1,RCER) ; Adds detail to a receipt based on file 344.49
"RTN","RCDPEM",113,0)
 ; RCRZ = ien of ERA entry in file 344.49
"RTN","RCDPEM",114,0)
 ; RECTDA1 = ien of receipt entry in file 344
"RTN","RCDPEM",115,0)
 ; RCER = error array returned if passed by reference
"RTN","RCDPEM",116,0)
 ;
"RTN","RCDPEM",117,0)
 N RCR,RCSPL,RCZ0,RCTRANDA,RCQ,DR,DA,DIE,X,Y,Q,Z0,Z1,Z
"RTN","RCDPEM",118,0)
 ;
"RTN","RCDPEM",119,0)
 S RCR=0 F  S RCR=$O(^RCY(344.49,RCRZ,1,RCR)) Q:'RCR  D
"RTN","RCDPEM",120,0)
 . S RCZ0=$G(^RCY(344.49,RCRZ,1,RCR,0))
"RTN","RCDPEM",121,0)
 . I $P(RCZ0,U)'["." S RCSPL(+RCZ0)=$P(RCZ0,U,9) Q
"RTN","RCDPEM",122,0)
 . I $S(+$P(RCZ0,U,3)=0:$P($G(^RCY(344.49,RCRZ,0)),U,3),1:$P(RCZ0,U,3)<0) S RCSPL(RCZ0\1,+RCZ0)=RCZ0 Q
"RTN","RCDPEM",123,0)
 . S RCTRANDA=$$ADDTRAN^RCDPURET(RECTDA1)
"RTN","RCDPEM",124,0)
 . ;
"RTN","RCDPEM",125,0)
 . I 'RCTRANDA D  Q  ; Error adding receipt detail
"RTN","RCDPEM",126,0)
 .. S RCER(1)=$$SETERR^RCDPEM0() S RCER($O(RCER(""),-1)+1)="  NO DETAIL LINE ADDED TO RECEIPT "_$P($G(^RCY(344,RECTDA1,0)),U)_" FOR LINE #"_$P(RCZ0,U)_" IN EEOB WORKLIST SCRATCH PAD"
"RTN","RCDPEM",127,0)
 . ;
"RTN","RCDPEM",128,0)
 . ;Store receipt line detail
"RTN","RCDPEM",129,0)
 . D DET(RCRZ,RCR,RECTDA1,RCTRANDA)
"RTN","RCDPEM",130,0)
 . S RCSPL(RCZ0\1,+RCZ0)=RCZ0
"RTN","RCDPEM",131,0)
 S Z=0 F  S Z=$O(RCSPL(Z)) Q:'Z  S RCQ=+$G(RCSPL(Z)) I RCQ D
"RTN","RCDPEM",132,0)
 . S Z1=$O(RCSPL(Z,"")) Q:$O(RCSPL(Z,""),-1)=Z1  ; No split occurred
"RTN","RCDPEM",133,0)
 . S Z1=0 F  S Z1=$O(RCSPL(Z,Z1)) Q:'Z1  S Z0=$G(RCSPL(Z,Z1)) D
"RTN","RCDPEM",134,0)
 .. S Q=+$P($G(^RCY(344.4,RCRZ,1,RCQ,0)),U,2) ; EOB detail rec
"RTN","RCDPEM",135,0)
 .. Q:'Q
"RTN","RCDPEM",136,0)
 .. I '$P(Z0,U,7)!($P(Z0,U,2)="") D  ; Suspensed
"RTN","RCDPEM",137,0)
 ... D SPL1^IBCEOBAR(Q,$S($P(Z0,U,2)="":"NO BILL",1:$P(Z0,U,2)),"",$P(Z0,U,6)) ; IA 4050
"RTN","RCDPEM",138,0)
 .. E  D
"RTN","RCDPEM",139,0)
 ... D SPL1^IBCEOBAR(Q,$P(Z0,U,2),$P(Z0,U,7),$P(Z0,U,6)) ; Add the split bill # ; IA 4050
"RTN","RCDPEM",140,0)
 ;
"RTN","RCDPEM",141,0)
 Q
"RTN","RCDPEM",142,0)
 ;
"RTN","RCDPEM",143,0)
DET(RCZ,RCR,RECTDA1,RCTRANDA) ; Store receipt detail
"RTN","RCDPEM",144,0)
 ; RCZ = ien of entry file 344.49
"RTN","RCDPEM",145,0)
 ; RCR = ien of entry in file 344.491
"RTN","RCDPEM",146,0)
 ; RCPROC = Function calling this subroutine
"RTN","RCDPEM",147,0)
 ;        = 1 EFT match to ERA   = 0 manual add receipt
"RTN","RCDPEM",148,0)
 ; RECTDA1 = ien of entry in file 344
"RTN","RCDPEM",149,0)
 ; RCTRANDA = ien of entry in subfile 344.01
"RTN","RCDPEM",150,0)
 ;
"RTN","RCDPEM",151,0)
 N DIE,DA,DR,X,Y,Z,RCUP,RCCOM,RCZ0,RC0
"RTN","RCDPEM",152,0)
 S RC0=$G(^RCY(344.49,RCZ,0))
"RTN","RCDPEM",153,0)
 S RCZ0=$G(^RCY(344.49,RCZ,1,RCR,0))
"RTN","RCDPEM",154,0)
 S DR="",RCUP=+$O(^RCY(344.49,RCZ,1,"B",+RCZ0/1,0)),RCUP=$G(^RCY(344.49,RCZ,1,RCUP,0))
"RTN","RCDPEM",155,0)
 I $P(RCZ0,U,7) S DR=".09////^S X="_+$P(RCZ0,U,7)_"_$C(59)_""PRCA(430,"";"
"RTN","RCDPEM",156,0)
 S DR=DR_".04////"_(+$P(RCZ0,U,3))_";.27////"_RCR_";"
"RTN","RCDPEM",157,0)
 I $P(RC0,U,5)'="" S DR=DR_".1////"_$P(RC0,U,5)_";"
"RTN","RCDPEM",158,0)
 I $P(RC0,U,6)'="" S DR=DR_".08////"_$P(RC0,U,6)_";"
"RTN","RCDPEM",159,0)
 S RCCOM=$P(RCZ0,U,10)
"RTN","RCDPEM",160,0)
 S Z=0 F  S Z=$O(^RCY(344.49,RCZ,1,RCR,1,Z)) Q:'Z  I $P($G(^(Z,0)),U,5)=1 S DR=DR_".28////1;" Q  ; Update receipt line with dec adj flag
"RTN","RCDPEM",161,0)
 I $P(RCUP,U,2)["**ADJ" S DR=DR_"1.02////"_$E($S(RCCOM'="":RCCOM_"/",1:"")_$S($P($P(RCUP,U,2),"ADJ",2):"ERA adjustment - no bill referenced",1:"Total of EFT mismatched to ERA"),1,60)_";"
"RTN","RCDPEM",162,0)
 I $P($G(^RCY(344.49,RCZ,0)),U,4)'="" S DR=DR_".07////"_$P($G(^RCY(344.49,RCZ,0)),U,4)_";"
"RTN","RCDPEM",163,0)
 S DA(1)=RECTDA1,DA=RCTRANDA,DIE="^RCY(344,"_DA(1)_",1,"
"RTN","RCDPEM",164,0)
 D ^DIE
"RTN","RCDPEM",165,0)
 Q
"RTN","RCDPEM",166,0)
 ;
"RTN","RCDPEM1")
0^39^B50720523
"RTN","RCDPEM1",1,0)
RCDPEM1 ;ALB/TMK,DWA,PJH - ERA MATCH TO EFT (cont) ; 5/5/11 1:25pm
"RTN","RCDPEM1",2,0)
 ;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
"RTN","RCDPEM1",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEM1",4,0)
 Q
"RTN","RCDPEM1",5,0)
 ;
"RTN","RCDPEM1",6,0)
BULL(RCFILE,RC0,RCER) ; Add the error to the bulletin text array
"RTN","RCDPEM1",7,0)
 ; RCFILE = null, 344.3 or 344.31, depending on the file being worked
"RTN","RCDPEM1",8,0)
 ; RC0 = the 0-node of the RCFILE entry
"RTN","RCDPEM1",9,0)
 ; RCER = the error text to be placed in the bulletin (passed by ref)
"RTN","RCDPEM1",10,0)
 ;
"RTN","RCDPEM1",11,0)
 N RCHCT,CT,Z
"RTN","RCDPEM1",12,0)
 I '$O(^TMP($J,"RCXM",0)) S ^TMP($J,"RCXM",1)="The following exceptions were encountered attempting",^TMP($J,"RCXM",2)="to post EFT deposits OR to match EFT's with ERA's:",^TMP($J,"RCXM",3)=" "
"RTN","RCDPEM1",13,0)
 S (RCHCT,CT)=+$O(^TMP($J,"RCXM",""),-1)
"RTN","RCDPEM1",14,0)
 S ^TMP($J,"RCXM",0)=$G(^TMP($J,"RCXM",0))+1
"RTN","RCDPEM1",15,0)
 I RC0'="" D
"RTN","RCDPEM1",16,0)
 . D BLD("^TMP($J,""RCXM"")",.CT,RCFILE,RC0)
"RTN","RCDPEM1",17,0)
 . S RCER=$G(RCER)+1,RCHCT=RCHCT+1
"RTN","RCDPEM1",18,0)
 . S ^TMP($J,"RCXM",RCHCT)=$E(^TMP($J,"RCXM",0)_$J("",4),1,4)_$G(^TMP($J,"RCXM",RCHCT))
"RTN","RCDPEM1",19,0)
 S Z=1 F  S Z=$O(RCER(Z)) Q:'Z  S CT=CT+1,^TMP($J,"RCXM",CT)="  "_RCER(Z)
"RTN","RCDPEM1",20,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)="  "
"RTN","RCDPEM1",21,0)
 Q
"RTN","RCDPEM1",22,0)
 ;
"RTN","RCDPEM1",23,0)
SENDBULL ; Sends the bulletin when all processing is complete
"RTN","RCDPEM1",24,0)
 N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,XMSUBJ
"RTN","RCDPEM1",25,0)
 S XMTO("I:G.RCDPE PAYMENTS")=""
"RTN","RCDPEM1",26,0)
 S XMBODY="^TMP($J,""RCXM"")"
"RTN","RCDPEM1",27,0)
 S XMSUBJ="EDI LBOX "_$$FMTE^XLFDT(DT,2)_" EXCEPTIONS EFT DEP/MATCH EFTs TO ERAs"
"RTN","RCDPEM1",28,0)
 D  ;
"RTN","RCDPEM1",29,0)
 . N DUZ
"RTN","RCDPEM1",30,0)
 . S DUZ=.5,DUZ(0)="@"
"RTN","RCDPEM1",31,0)
 . D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
"RTN","RCDPEM1",32,0)
 K ^TMP($J,"RCXM")
"RTN","RCDPEM1",33,0)
 Q
"RTN","RCDPEM1",34,0)
 ;
"RTN","RCDPEM1",35,0)
BLD(RCARRAY,RCT,RCFILE,RC0) ; Build the array for entry 344.31 detail
"RTN","RCDPEM1",36,0)
 ; RCARRAY = the name of the array to be set
"RTN","RCDPEM1",37,0)
 ; RCT = the # of lines already output into this array
"RTN","RCDPEM1",38,0)
 ; RCFILE = 344.3 or 344.31
"RTN","RCDPEM1",39,0)
 ; RC0 = the 0-node of the entry in RCFILE
"RTN","RCDPEM1",40,0)
 ;
"RTN","RCDPEM1",41,0)
 N Z,RC00
"RTN","RCDPEM1",42,0)
 I RCFILE=344.31 D
"RTN","RCDPEM1",43,0)
 . S RC00=$G(^RCY(344.3,+RC0,0))
"RTN","RCDPEM1",44,0)
 . S Z=$$SETSTR^VALM1("  TRACE #: "_$P(RC0,U,4),"",1,61) ; Expand Trace # to 50 characters
"RTN","RCDPEM1",45,0)
 . S RCT=RCT+1,@RCARRAY@(RCT)=Z ; for Ins. Co. below
"RTN","RCDPEM1",46,0)
 . S Z=$$SETSTR^VALM1("  INS CO: "_$E($P(RC0,U,2),1,22)_"/"_$P(RC0,U,3),"",1,76)
"RTN","RCDPEM1",47,0)
 . S RCT=RCT+1,@RCARRAY@(RCT)=Z
"RTN","RCDPEM1",48,0)
 . S Z=$$SETSTR^VALM1("  DEPOSIT DATE: "_$$FMTE^XLFDT($P(RC00,U,7),2),"",1,24)
"RTN","RCDPEM1",49,0)
 . S Z=$$SETSTR^VALM1("  DATE REC'D: "_$S($P(RC00,U,13):$$FMTE^XLFDT($P(RC00,U,13)\1,2),1:""),Z,25,22)
"RTN","RCDPEM1",50,0)
 . S Z=$$SETSTR^VALM1("  PAYMENT AMT: "_$TR($J($P(RC0,U,7),15,2)," "),Z,47,30)
"RTN","RCDPEM1",51,0)
 . S RCT=RCT+1,@RCARRAY@(RCT)=Z
"RTN","RCDPEM1",52,0)
 ;
"RTN","RCDPEM1",53,0)
 I RCFILE=344.3 D
"RTN","RCDPEM1",54,0)
 . S Z=$$SETSTR^VALM1("  DEPOSIT #: "_$P(RC0,U,6),"",1,13)
"RTN","RCDPEM1",55,0)
 . S Z=$$SETSTR^VALM1("  DEPOSIT DATE: "_$$FMTE^XLFDT($P(RC0,U,7),2),Z,16,24)
"RTN","RCDPEM1",56,0)
 . S RCT=RCT+1,@RCARRAY@(RCT)=Z
"RTN","RCDPEM1",57,0)
 . S Z=$$SETSTR^VALM1("  DATE REC'D: "_$S($P(RC0,U,13):$$FMTE^XLFDT($P(RC0,U,13)\1,2),1:""),"",25,22)
"RTN","RCDPEM1",58,0)
 . S Z=$$SETSTR^VALM1("  DEPOSIT AMT: "_$TR($J($P(RC0,U,8),15,2)," "),Z,47,30)
"RTN","RCDPEM1",59,0)
 . S RCT=RCT+1,@RCARRAY@(RCT)=Z
"RTN","RCDPEM1",60,0)
 ;
"RTN","RCDPEM1",61,0)
 Q
"RTN","RCDPEM1",62,0)
 ;
"RTN","RCDPEM1",63,0)
EN1 ; Queue match job for run on demand
"RTN","RCDPEM1",64,0)
 N DIR,X,Y,ZTIO,ZTRTN,ZTSK,ZTDESC,ZTDTH
"RTN","RCDPEM1",65,0)
 S DIR(0)="YA",DIR("A",1)="THIS OPTION QUEUES THE JOB TO MATCH EFTs TO ELECTRONIC ERAs"
"RTN","RCDPEM1",66,0)
 S DIR("A")="ARE YOU SURE YOU WANT TO RUN THIS JOB?: ",DIR("B")="NO"
"RTN","RCDPEM1",67,0)
 W ! D ^DIR K DIR
"RTN","RCDPEM1",68,0)
 I Y'=1 G EN1Q
"RTN","RCDPEM1",69,0)
 L +^RCY(344.3,"ALOCK"):5 I '$T D  G EN1Q
"RTN","RCDPEM1",70,0)
 . S DIR(0)="EA",DIR("A",1)="This job is currently running ... try again later",DIR("A")="Press ENTER to continue: " D ^DIR K DIR
"RTN","RCDPEM1",71,0)
 S ZTIO="",ZTDTH=$$NOW^XLFDT()
"RTN","RCDPEM1",72,0)
 S ZTRTN="MATCH^RCDPEM(1,1)",ZTDESC="AR - MANUAL EFT-ERA MATCH EDI LOCKBOX"
"RTN","RCDPEM1",73,0)
 D ^%ZTLOAD
"RTN","RCDPEM1",74,0)
 W !!,$S($D(ZTSK):"Your job has been queued - task number "_ZTSK,1:"Unable to queue this job.")
"RTN","RCDPEM1",75,0)
 U IO
"RTN","RCDPEM1",76,0)
EN1Q L -^RCY(344.3,"ALOCK")
"RTN","RCDPEM1",77,0)
 Q
"RTN","RCDPEM1",78,0)
 ;
"RTN","RCDPEM1",79,0)
EN2 ; Entrypoint from nightly job to put Nightly and Daily Activity Report
"RTN","RCDPEM1",80,0)
 ; data into the nightly job's status bulletin
"RTN","RCDPEM1",81,0)
 N CT,DATA,Z,Z0,RCHD,T,T0
"RTN","RCDPEM1",82,0)
 S CT=+$O(^TMP($J,"RCXM",""),-1)
"RTN","RCDPEM1",83,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)=""
"RTN","RCDPEM1",84,0)
 I $D(^TMP($J,"RCTOT","EFT_DEP")) D
"RTN","RCDPEM1",85,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)=$J("",12)_"********** TOTALS **********"
"RTN","RCDPEM1",86,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)="DEPOSITS"
"RTN","RCDPEM1",87,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL # UNPOSTED EFT DEPOSITS FOUND: "_+$G(^TMP($J,"RCTOT","EFT_DEP"))
"RTN","RCDPEM1",88,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL # NEW EFT DEPOSITS CREATED: "_+$G(^TMP($J,"RCTOT","DEPOSIT"))
"RTN","RCDPEM1",89,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL # NEW EFT DEPOSIT RECEIPTS CREATED: "_+$G(^TMP($J,"RCTOT","EFT_RECPT"))
"RTN","RCDPEM1",90,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL # EFT DEPOSITS WITH CHECK SUM ERRORS: "_+$G(^TMP($J,"RCTOT","CSUM"))
"RTN","RCDPEM1",91,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL # EFT DEPOSITS WITH OTHER ERRORS: "_+$G(^TMP($J,"RCTOT","ERR"))
"RTN","RCDPEM1",92,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL EFT DEPOSIT AMOUNT POSTED TO REV SRC CD 8NZZ: "_$J(+$G(^TMP($J,"RCTOT","SUSPAMT")),"",2)
"RTN","RCDPEM1",93,0)
 . S CT=CT+1,^TMP($J,"RCXM",CT)=""
"RTN","RCDPEM1",94,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)="EFT-ERA MATCHES"
"RTN","RCDPEM1",95,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL # UNMATCHED ERAs CHECKED: "_+$G(^TMP($J,"RCTOT","EFT"))
"RTN","RCDPEM1",96,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL # ERAs MATCHED TO EFTs: "_+$G(^TMP($J,"RCTOT","MATCH"))_$S($G(^TMP($J,"RCTOT","MATCH"))&$G(^TMP($J,"RCTOT","TOTMIS")):" INCLUDING "_+$G(^TMP($J,"RCTOT","TOTMIS"))_" WITH MISMATCHED TOTALS",1:"")
"RTN","RCDPEM1",97,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)="  TOTAL # ERAs STILL UNMATCHED: "_+$G(^TMP($J,"RCTOT","NO_MATCH"))
"RTN","RCDPEM1",98,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)=""
"RTN","RCDPEM1",99,0)
 K ^TMP("RCDAILYACT",$J),^TMP($J,"RC1")
"RTN","RCDPEM1",100,0)
 ;
"RTN","RCDPEM1",101,0)
 S Z=0 F  S Z=$O(^TMP($J,"RCDPETOT",344.31,Z)) Q:'Z  S Z0=$G(^RCY(344.31,Z,0)) I Z0 S ^TMP($J,"RC1",+Z0,Z)=Z0
"RTN","RCDPEM1",102,0)
 ;
"RTN","RCDPEM1",103,0)
 S (RCHD,Z)=0 F  S Z=$O(^TMP($J,"RCDPETOT",344.3,Z)) Q:'Z  S DATA=$G(^(Z)) D
"RTN","RCDPEM1",104,0)
 . I 'RCHD D HDR(.CT,.RCHD) ; Add headers
"RTN","RCDPEM1",105,0)
 . S Z0=$G(^RCY(344.3,Z,0))
"RTN","RCDPEM1",106,0)
 . S CT=CT+1
"RTN","RCDPEM1",107,0)
 . S ^TMP($J,"RCXM",CT)=""
"RTN","RCDPEM1",108,0)
 . I '$G(DATA) D
"RTN","RCDPEM1",109,0)
 .. S CT=CT+1
"RTN","RCDPEM1",110,0)
 .. S ^TMP($J,"RCXM",CT)=^TMP($J,"RCXM",CT)_"  "_$E($P($G(^RCY(344.1,+$P(Z0,U,3),0)),U)_$J("",15),1,15)_"  "_$E($P($G(^RCY(344,+$O(^RCY(344,"AD",+$P(Z0,U,3),0)),0)),U)_$J("",15),1,15)_"  "
"RTN","RCDPEM1",111,0)
 .. S ^TMP($J,"RCXM",CT)=^TMP($J,"RCXM",CT)_$J(+$P(Z0,U,12),"",2)
"RTN","RCDPEM1",112,0)
 . I $G(DATA) D
"RTN","RCDPEM1",113,0)
 .. S ^TMP($J,"RCXM",CT)=^TMP($J,"RCXM",CT)_"  "_$E($P($G(^RCY(344.1,+$P(DATA,U,5),0)),U)_$J("",15),1,15)_"  "_$E($S($P(DATA,U,5):$P($G(^RCY(344,+DATA,0)),U),1:"")_$J("",15),1,15)_"  "
"RTN","RCDPEM1",114,0)
 .. S ^TMP($J,"RCXM",CT)=^TMP($J,"RCXM",CT)_$J($S($P(DATA,U,3):+$P(DATA,U,2),1:0),"",2)
"RTN","RCDPEM1",115,0)
 . I $P(DATA,U,4) S CT=CT+1,^TMP($J,"RCXM",CT)="    ERROR # REFERENCED ABOVE : "_$P(DATA,U,4)
"RTN","RCDPEM1",116,0)
 . S T=0 F  S T=$O(^TMP($J,"RC1",Z,T)) Q:'T  S T0=$G(^(T)) D
"RTN","RCDPEM1",117,0)
 .. S CT=CT+1
"RTN","RCDPEM1",118,0)
 .. S ^TMP($J,"RCXM",CT)=$J("",5)_$P(T0,U,4)
"RTN","RCDPEM1",119,0)
 .. S CT=CT+1 ; separate TRACE # above from PAYER NAME/ID below
"RTN","RCDPEM1",120,0)
 .. S ^TMP($J,"RCXM",CT)=$J("",5)_$P(T0,U,2)_"/"_$P(T0,U,3)
"RTN","RCDPEM1",121,0)
 .. S CT=CT+1,^TMP($J,"RCXM",CT)=$J("",10)_"PAYMENT AMOUNT: "_$J(+$P(T0,U,7),"",2)_"  MATCH STATUS: "_$$EXTERNAL^DILFD(344.31,.08,,$P(T0,U,8))
"RTN","RCDPEM1",122,0)
 .. S:$O(^TMP($J,"RCDPETOT",344.3,Z)) CT=CT+1,^TMP($J,"RCXM",CT)=" "
"RTN","RCDPEM1",123,0)
 . I $P(DATA,U,3) S ^TMP("RCDAILYACT",$J,DT,Z)=Z0
"RTN","RCDPEM1",124,0)
 ;
"RTN","RCDPEM1",125,0)
 K ^TMP($J,"RC1")
"RTN","RCDPEM1",126,0)
 I $O(^TMP("RCDAILYACT",$J,0)) D  ; Daily activity rep automatic bulletin
"RTN","RCDPEM1",127,0)
 . N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,XMSUBJ
"RTN","RCDPEM1",128,0)
 . K ^TMP($J,"RCDPE_DAR")
"RTN","RCDPEM1",129,0)
 . D RPT1^RCDPEDAR(1,0,DT,DT)
"RTN","RCDPEM1",130,0)
 . K ^TMP("RCDAILYACT",$J)
"RTN","RCDPEM1",131,0)
 . Q:'$O(^TMP($J,"RCDPE_DAR",0))
"RTN","RCDPEM1",132,0)
 . S XMTO("I:G.RCDPE PAYMENTS")=""
"RTN","RCDPEM1",133,0)
 . S XMBODY="^TMP($J,""RCDPE_DAR"")"
"RTN","RCDPEM1",134,0)
 . S XMSUBJ="EDI LBOX - AUTO DAILY ACTIVITY SUMMARY - "_$$FMTE^XLFDT(DT,2)
"RTN","RCDPEM1",135,0)
 . D  ;
"RTN","RCDPEM1",136,0)
 .. N DUZ
"RTN","RCDPEM1",137,0)
 .. S DUZ=.5,DUZ(0)="@"
"RTN","RCDPEM1",138,0)
 .. D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
"RTN","RCDPEM1",139,0)
 . K ^TMP($J,"RCDPE_DAR")
"RTN","RCDPEM1",140,0)
 Q
"RTN","RCDPEM1",141,0)
 ;
"RTN","RCDPEM1",142,0)
HDR(CT,HD) ; Header array set
"RTN","RCDPEM1",143,0)
 ; CT = line count, passed by reference
"RTN","RCDPEM1",144,0)
 ; HD = flag returned as 1 so the header is only output once
"RTN","RCDPEM1",145,0)
 N Q
"RTN","RCDPEM1",146,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)=" "
"RTN","RCDPEM1",147,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)=$J("",20)_"********** EFT DEPOSIT RECORDS **********"
"RTN","RCDPEM1",148,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)="  EFT DEPOSIT      EFT RECEIPT      POSTED AMOUNT"
"RTN","RCDPEM1",149,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)=" "
"RTN","RCDPEM1",150,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)="     TRACE #"
"RTN","RCDPEM1",151,0)
 S CT=CT+1,^TMP($J,"RCXM",CT)="     PAYER NAME/ID"
"RTN","RCDPEM1",152,0)
 S CT=CT+1,Q="",$P(Q,"=",79)="",^TMP($J,"RCXM",CT)=Q
"RTN","RCDPEM1",153,0)
 S HD=1
"RTN","RCDPEM1",154,0)
 Q
"RTN","RCDPEM1",155,0)
 ;
"RTN","RCDPEREC")
0^5^B39701184
"RTN","RCDPEREC",1,0)
RCDPEREC ;ALB/TMK/KML/PJH - RECONCILIATION REPORT FOR EDI LOCKBOX FMS DOCS  ; 8/2/10 4:17pm
"RTN","RCDPEREC",2,0)
 ;;4.5;Accounts Receivable;**208,244,269**;Mar 20, 1995;Build 113
"RTN","RCDPEREC",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPEREC",4,0)
 ;
"RTN","RCDPEREC",5,0)
EN ; Entrypoint for producing the report
"RTN","RCDPEREC",6,0)
 N RCDDT,RCSEL,ZTRTN,ZTDESC,ZTSAVE,ZTSK,%ZIS,POP,DIR,DTOUT,DUOUT
"RTN","RCDPEREC",7,0)
 S DIR(0)="DA^3000101:"_DT_":AEPX",DIR("A")="SELECT THE EFT DEPOSIT DATE TO START WITH: " W ! D ^DIR K DIR
"RTN","RCDPEREC",8,0)
 S RCDDT=$S($D(DTOUT)!$D(DUOUT):"",1:Y)
"RTN","RCDPEREC",9,0)
 Q:'RCDDT
"RTN","RCDPEREC",10,0)
 S DIR("B")="ALL"
"RTN","RCDPEREC",11,0)
 S DIR(0)="SA^A:ALL;N:NOT FULLY TRANSFERRED",DIR("A")="DO YOU WANT (A)LL DEPOSITS OR ONLY THOSE (N)OT FULLY TRANSFERRED?: " W ! D ^DIR K DIR
"RTN","RCDPEREC",12,0)
 S RCSEL=$S($D(DTOUT)!$D(DUOUT):"",1:Y)
"RTN","RCDPEREC",13,0)
 Q:RCSEL=""
"RTN","RCDPEREC",14,0)
 W !
"RTN","RCDPEREC",15,0)
 S %ZIS="QM" D ^%ZIS Q:POP
"RTN","RCDPEREC",16,0)
 I $D(IO("Q")) D  Q
"RTN","RCDPEREC",17,0)
 . S ZTRTN="ENQUE^RCDPEREC",ZTDESC="AR - CR/TR RELATED DOCUMENTS FOR e-PAYMENTS"
"RTN","RCDPEREC",18,0)
 . S ZTSAVE("RCDDT")="",ZTSAVE("RCSEL")=""
"RTN","RCDPEREC",19,0)
 . D ^%ZTLOAD
"RTN","RCDPEREC",20,0)
 . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPEREC",21,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEREC",22,0)
 U IO
"RTN","RCDPEREC",23,0)
 D ENQUE
"RTN","RCDPEREC",24,0)
 Q
"RTN","RCDPEREC",25,0)
 ;
"RTN","RCDPEREC",26,0)
ENQUE ; Queued entrypoint for the report
"RTN","RCDPEREC",27,0)
 ; RCDDT = starting EFT deposit date
"RTN","RCDPEREC",28,0)
 ; RCSEL = 'A' if all deposits included ... 'N' if only those not fully
"RTN","RCDPEREC",29,0)
 ;         transferred out of 8NZZ
"RTN","RCDPEREC",30,0)
 ;
"RTN","RCDPEREC",31,0)
 N Z,Z0,RCSTOP,RCD,RCR,RCSTAT,RCDEP,RCEFT,RCEFT1,RCT,RC0,RC00,RC000,RCTOT,RCTOT1,RCTRANS
"RTN","RCDPEREC",32,0)
 K ^TMP($J,"RCDEP")
"RTN","RCDPEREC",33,0)
 ;
"RTN","RCDPEREC",34,0)
 S (RCSTOP,RCT)=0,RCDDT=RCDDT-.1
"RTN","RCDPEREC",35,0)
 F  S RCDDT=$O(^RCY(344.3,"ADEP",RCDDT)) Q:'RCDDT!RCSTOP  S RCDEP=0 F  S RCDEP=$O(^RCY(344.3,"ADEP",RCDDT,RCDEP)) Q:'RCDEP  S RCEFT=0 F  S RCEFT=$O(^RCY(344.3,"ADEP",RCDDT,RCDEP,RCEFT)) Q:'RCEFT!RCSTOP  D
"RTN","RCDPEREC",36,0)
 . S RCTOT=0,RC0=$G(^RCY(344.3,RCEFT,0))
"RTN","RCDPEREC",37,0)
 . S RCD=$E(RCDDT_$J("",8),1,8)_RCDEP
"RTN","RCDPEREC",38,0)
 . S RCEFT1=0 F  S RCEFT1=$O(^RCY(344.31,"B",RCEFT,RCEFT1)) Q:'RCEFT1!RCSTOP  S RC00=$G(^RCY(344.31,RCEFT1,0)) D
"RTN","RCDPEREC",39,0)
 .. ;
"RTN","RCDPEREC",40,0)
 .. I $D(ZTQUEUED) S RCT=RCT+1 I '(RCT#100),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ Q
"RTN","RCDPEREC",41,0)
 .. ;
"RTN","RCDPEREC",42,0)
 .. I '$D(^TMP($J,"RCDEP",RCD)) S ^TMP($J,"RCDEP",RCD)=$P(RC0,U,6,11),^TMP($J,"RCDEP",RCD,0)=$S($P(RC00,U,9):$$FMSSTAT^RCDPUREC($P(RC00,U,9)),1:"NO CR DOCUMENT"),^TMP($J,"RCDEP",RCD,"EFT")=RCEFT
"RTN","RCDPEREC",43,0)
 .. S RCTRANS=+$P(RC00,U,14) S:'RCTRANS RCTRANS=1
"RTN","RCDPEREC",44,0)
 .. ;
"RTN","RCDPEREC",45,0)
 .. I '$P(RC00,U,8) S ^TMP($J,"RCDEP",RCD,RCTRANS,"RCUNM")=RCEFT1 Q  ; Not matched
"RTN","RCDPEREC",46,0)
 .. ;
"RTN","RCDPEREC",47,0)
 .. I '$O(^RCY(344,"AEFT",RCEFT1,0)) D  Q  ; No receipt
"RTN","RCDPEREC",48,0)
 ... I $P(RC00,U,16)'="" D  Q  ; EFT detail entered on-line
"RTN","RCDPEREC",49,0)
 .... S ^TMP($J,"RCDEP",RCD,RCTRANS)=RCEFT1_U_"ENTERED ON-LINE"_U_$S($P(RC000,U,18):"ERA #"_$P($G(^RCY(344.4,+$P(RC00,U,10),0)),U),1:"PAPER EOB")_U_$P(RC00,U,16)_U_"NO RECEIPT",RCTOT=RCTOT+$P(RC00,U,7)
"RTN","RCDPEREC",50,0)
 ... S ^TMP($J,"RCDEP",RCD,RCTRANS)=RCEFT1_U_"NO TR DOC"_U_$S($P(RC00,U,10):"ERA #"_$P($G(^RCY(344.4,+$P(RC00,U,10),0)),U),1:"PAPER EOB")_"^^NO RECEIPT"
"RTN","RCDPEREC",51,0)
 .. ;
"RTN","RCDPEREC",52,0)
 .. S RCR=0 F  S RCR=$O(^RCY(344,"AEFT",RCEFT1,RCR)) Q:'RCR  S RC000=$G(^RCY(344,RCR,0)) D
"RTN","RCDPEREC",53,0)
 ... S RCTOT=RCTOT+$$PAYTOTAL^RCDPURED(RCR)
"RTN","RCDPEREC",54,0)
 ... S RCSTAT=$$FMSSTAT^RCDPUREC(RCR) S:$P(RCSTAT,U)="" RCSTAT="NO TR DOC"
"RTN","RCDPEREC",55,0)
 ... S ^TMP($J,"RCDEP",RCD,RCTRANS)=RCEFT1_U_$P(RCSTAT,U)_U_$S($P(RC000,U,18):"ERA #"_$P($G(^RCY(344.4,+$P(RC000,U,18),0)),U),1:"PAPER EOB")_U_$P(RCSTAT,U,2)_U_RCR
"RTN","RCDPEREC",56,0)
 . Q:RCSTOP
"RTN","RCDPEREC",57,0)
 . I RCSEL="N",+RCTOT=+$P(RC0,U,8) K ^TMP($J,"RCDEP",RCD) Q
"RTN","RCDPEREC",58,0)
 . S ^TMP($J,"RCDEP",RCD,"TOT")=RCTOT_U_$P(RC0,U,8)
"RTN","RCDPEREC",59,0)
 ;
"RTN","RCDPEREC",60,0)
 ; Output the report
"RTN","RCDPEREC",61,0)
 S RCD="",RCPG=0
"RTN","RCDPEREC",62,0)
 I RCSTOP K ^TMP($J,"RCDEP")
"RTN","RCDPEREC",63,0)
 F  S RCD=$O(^TMP($J,"RCDEP",RCD)) Q:RCD=""!RCSTOP  D  Q:RCSTOP  D TOT(RCD,.RCSTOP,.RCPG)
"RTN","RCDPEREC",64,0)
 . S RC0=$G(^TMP($J,"RCDEP",RCD)) D EFTDEP(RCD,.RCSTOP,.RCPG) ; EFT dep
"RTN","RCDPEREC",65,0)
 . Q:RCSTOP
"RTN","RCDPEREC",66,0)
 . S RCTRANS=0 F  S RCTRANS=$O(^TMP($J,"RCDEP",RCD,RCTRANS)) Q:'RCTRANS!RCSTOP  S RC00=$G(^(RCTRANS)) D  ; EFT detail deposits
"RTN","RCDPEREC",67,0)
 .. S RCSTOP=$$NEWPG(.RCPG) Q:RCSTOP
"RTN","RCDPEREC",68,0)
 .. I RC00="",$D(^TMP($J,"RCDEP",RCD,RCTRANS,"RCUNM")) S Z=$G(^("RCUNM")) D  Q  ; Unmatched
"RTN","RCDPEREC",69,0)
 ... W !,?3,$J("",6),"  UNMATCHED   ",$E($P(Z,U,2)_$J("",30),1,30)_"  "_$E($P(Z,U,3)_$J("",20),1,20)
"RTN","RCDPEREC",70,0)
 ... W !,?13,$P(Z,U,4)
"RTN","RCDPEREC",71,0)
 .. ;
"RTN","RCDPEREC",72,0)
 .. I RC00="" W !,?3,"ERROR IN EFT DETAIL LINE #: ",RCTRANS Q  ; Error
"RTN","RCDPEREC",73,0)
 .. ;
"RTN","RCDPEREC",74,0)
 .. S Z=$G(^RCY(344.31,+RC00,0))
"RTN","RCDPEREC",75,0)
 .. W !,?3,$E(+RC00_$J("",6),1,6)_"  "_$E($P(RC00,U,3)_$J("",10),1,10)_"  "_$E($P(Z,U,2)_$J("",30),1,30)_"  "_$E($P(Z,U,3)_$J("",20),1,20)
"RTN","RCDPEREC",76,0)
 ..; HIPAA 5010 - to accommodate the extended length of the Trace # field from 30 to 50 characters the Trace # will be printed on its own line.  
"RTN","RCDPEREC",77,0)
 .. W !,?13,$E($P(Z,U,4)_$J("",50),1,50)
"RTN","RCDPEREC",78,0)
 .. W !,?43,$E($P(RC00,U,5)_$J("",10),1,10),!,?15,$E($P(RC00,U,2)_$J("",10),1,10)_"  "_$E($P(RC00,U,4)_$J("",15),1,15)
"RTN","RCDPEREC",79,0)
 ;
"RTN","RCDPEREC",80,0)
 I 'RCSTOP,RCPG D ASK(.RCSTOP)
"RTN","RCDPEREC",81,0)
 ;
"RTN","RCDPEREC",82,0)
 I $D(ZTQUEUED) D
"RTN","RCDPEREC",83,0)
 . I $G(RCSTOP) D HDR1(0) W !,"TASK STOPPED BY USER" Q
"RTN","RCDPEREC",84,0)
 . S ZTREQ="@"
"RTN","RCDPEREC",85,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPEREC",86,0)
 K ^TMP($J,"RCDEP")
"RTN","RCDPEREC",87,0)
 Q
"RTN","RCDPEREC",88,0)
 ;
"RTN","RCDPEREC",89,0)
EFTDEP(RCD,RCSTOP,RCPG) ;
"RTN","RCDPEREC",90,0)
 ; RCD = deposit date (FM) concatenated with the deposit #
"RTN","RCDPEREC",91,0)
 N Z,Z0
"RTN","RCDPEREC",92,0)
 I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ Q
"RTN","RCDPEREC",93,0)
 S Z=$G(^TMP($J,"RCDEP",RCD)),Z0=$G(^(RCD,0))
"RTN","RCDPEREC",94,0)
 S RCSTOP=$$NEWPG(.RCPG) Q:RCSTOP
"RTN","RCDPEREC",95,0)
 I $Y+7>IOSL W !! S RCSTOP=$$NEWPG(.RCPG) Q:RCSTOP
"RTN","RCDPEREC",96,0)
 W:'$P(RCPG,U,2) !!
"RTN","RCDPEREC",97,0)
 W !,$E($$FMTE^XLFDT($P(Z,U,2),"2D")_$J("",8),1,8),"  ",$E(+$G(^TMP($J,"RCDEP",RCD,"EFT"))_$J("",6),1,6),"  ",$E($P(Z,U)_$J("",6),1,6),"  ",$J($P(Z,U,3),13,2),"  ",$E($S($P(Z,U,6):$$FMTE^XLFDT($P(Z,U,6),"2D"),1:"UNPOSTED")_$J("",8),1,8)
"RTN","RCDPEREC",98,0)
 W !,?5,$E($P(Z0,U)_$J("",20),1,20),"  ",$P(Z0,U,2)
"RTN","RCDPEREC",99,0)
 Q
"RTN","RCDPEREC",100,0)
 ;
"RTN","RCDPEREC",101,0)
TOT(RCD,RCSTOP,RCPG) ; Output the total lines for the deposit
"RTN","RCDPEREC",102,0)
 S RCSTOP=$$NEWPG(.RCPG) Q:RCSTOP
"RTN","RCDPEREC",103,0)
 W !,$J("",26),"TOTAL AMOUNT SENT VIA 'TR' DOCUMENTS: ",$J($G(^TMP($J,"RCDEP",RCD,"TOT")),15,2)
"RTN","RCDPEREC",104,0)
 W !,$J("",26),"TOTAL AMOUNT STILL TO BE TRANSFERRED: ",$J($P($G(^TMP($J,"RCDEP",RCD,"TOT")),U,2)-$G(^TMP($J,"RCD",RCD,"TOT")),15,2)
"RTN","RCDPEREC",105,0)
 Q
"RTN","RCDPEREC",106,0)
 ;
"RTN","RCDPEREC",107,0)
NEWPG(RCPG) ; Check for new page needed, output header
"RTN","RCDPEREC",108,0)
 ; Function returns 1 if user chooses to stop output
"RTN","RCDPEREC",109,0)
 N RCX,RCZ
"RTN","RCDPEREC",110,0)
 S RCZ=0,RCX=$P(RCPG,U,2)
"RTN","RCDPEREC",111,0)
 I 'RCPG!(($Y+5)>IOSL) D
"RTN","RCDPEREC",112,0)
 . D:RCPG ASK(.RCZ) I RCZ Q
"RTN","RCDPEREC",113,0)
 . D HDR1(.RCPG)
"RTN","RCDPEREC",114,0)
 I RCX S $P(RCPG,U,2)=0
"RTN","RCDPEREC",115,0)
 Q RCZ
"RTN","RCDPEREC",116,0)
 ;
"RTN","RCDPEREC",117,0)
SELECT() ; Select first deposit #
"RTN","RCDPEREC",118,0)
 ; Function returns values selected for first deposit #
"RTN","RCDPEREC",119,0)
 ;
"RTN","RCDPEREC",120,0)
 N DIR,X,Y,DTOUT,DUOUT
"RTN","RCDPEREC",121,0)
 ;
"RTN","RCDPEREC",122,0)
HDR1(RCPG) ;Print report hdr
"RTN","RCDPEREC",123,0)
 ; RCPG = last page #^0/1 for top of page indicator
"RTN","RCDPEREC",124,0)
 N Z,Z0,X
"RTN","RCDPEREC",125,0)
 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
"RTN","RCDPEREC",126,0)
 S RCPG=$G(RCPG)+1_U_1
"RTN","RCDPEREC",127,0)
 W !,"EDI LOCKBOX FUND 5287.4/8NZZ RECONCILIATION REPORT",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",+RCPG
"RTN","RCDPEREC",128,0)
 W !!,"DEP DATE  ENTRY#  DEP #   TOTAL DEP AMT  POST DT   RECEIPT #",!,?5,"CR DOCUMENT           CR DOC STATUS"
"RTN","RCDPEREC",129,0)
 W !,?3,"EFT #   MATCHED TO  PAYER NAME                      PAYER ID            ",!,?13,"TRACE #"
"RTN","RCDPEREC",130,0)
 ; HIPAA 5010 - put receipt # on a separate line to accomodate the increased length of the TRACE # 
"RTN","RCDPEREC",131,0)
 W !,?20,"RECEIPT #"
"RTN","RCDPEREC",132,0)
 W !,?15,"TR DOCUMENT           TR DOC STATUS"
"RTN","RCDPEREC",133,0)
 W !,$TR($J("",IOM)," ","=")
"RTN","RCDPEREC",134,0)
 Q
"RTN","RCDPEREC",135,0)
 ;
"RTN","RCDPEREC",136,0)
ASK(RCSTOP) ;
"RTN","RCDPEREC",137,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEREC",138,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEREC",139,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEREC",140,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEREC",141,0)
 Q
"RTN","RCDPEREC",142,0)
 ;
"RTN","RCDPES10")
0^26^B85948119
"RTN","RCDPES10",1,0)
RCDPES10 ;ALB/DWA/PJH - ERA return file field captions ;08/19/2010
"RTN","RCDPES10",2,0)
 ;;4.5;Accounts Receivable;**269**;Mar 20, 1995;Build 113
"RTN","RCDPES10",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPES10",4,0)
 ;
"RTN","RCDPES10",5,0)
 ; Note: if the 835 flat file changes, make the corresponding changes
"RTN","RCDPES10",6,0)
 ;       in this routine.
"RTN","RCDPES10",7,0)
835 ;;HEADER DATA
"RTN","RCDPES10",8,0)
 ;;835^^Return Message ID^S Y=X_" (ERA HEADER DATA)"
"RTN","RCDPES10",9,0)
 ;;835^^X12/Proprietary flag^S Y=$S(X="X":"X12",1:X)
"RTN","RCDPES10",10,0)
 ;;835^^File Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPES10",11,0)
 ;;835^^File Time^S Y=$E(X,1,2)-$S($E(X,1,2)>12:12,1:0)_":"_$E(X,3,4)_$S($E(X,1,2)=24:" AM",$E(X,1,2)>11:" PM",1:" AM")
"RTN","RCDPES10",12,0)
 ;;835^1^MRA^S Y=""
"RTN","RCDPES10",13,0)
 ;;835^^Payer Name
"RTN","RCDPES10",14,0)
 ;;835^^Payer ID
"RTN","RCDPES10",15,0)
 ;;835^^Trace Number
"RTN","RCDPES10",16,0)
 ;;835^^Date Claims Paid^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPES10",17,0)
 ;;835^^Total ERA Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",18,0)
 ;;835^^Erroneous Provider Tax ID
"RTN","RCDPES10",19,0)
 ;;835^^Tax ID correction Flag^S Y=$S(X="E":"CHANGED BY EPHRA",X="C":"DETERMINED FROM CLAIM DATA",X="":"NO CHANGE MADE",1:X)
"RTN","RCDPES10",20,0)
 ;;835^^Sequence Control #
"RTN","RCDPES10",21,0)
 ;;835^^Sequence #
"RTN","RCDPES10",22,0)
 ;;835^^Last Sequence #
"RTN","RCDPES10",23,0)
 ;;835^^HIPAA Version Code
"RTN","RCDPES10",24,0)
 ;;835^^Payment Method Code
"RTN","RCDPES10",25,0)
 ;;835^^Billing Provider NPI
"RTN","RCDPES10",26,0)
 ;;835^^Contact Information
"RTN","RCDPES10",27,0)
 ;
"RTN","RCDPES10",28,0)
01 ;;PAYER CONTACT INFORMATION
"RTN","RCDPES10",29,0)
 ;;01^^Line Type^S Y=X_" (ERA LEVEL CONTACT DATA)"
"RTN","RCDPES10",30,0)
 ;;01^^ERA Contact Name
"RTN","RCDPES10",31,0)
 ;;01^^ERA Contact Phone
"RTN","RCDPES10",32,0)
 ;;01^^ERA Contact Fax
"RTN","RCDPES10",33,0)
 ;;01^^ERA Contact Email
"RTN","RCDPES10",34,0)
 ;;01^^ERA Payer Website URL
"RTN","RCDPES10",35,0)
 ;
"RTN","RCDPES10",36,0)
02 ;;PAYER ADJUSTMENT RECORD
"RTN","RCDPES10",37,0)
 ;;02^^Line Type^S Y=X_" (ERA LEVEL PAYER ADJUSTMENT RECORD)"
"RTN","RCDPES10",38,0)
 ;;02^^X12 Adjustment Reason Code
"RTN","RCDPES10",39,0)
 ;;02^^Provider Adjustment Identifier
"RTN","RCDPES10",40,0)
 ;;02^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",41,0)
 ;
"RTN","RCDPES10",42,0)
03 ;;PAYER ADJUSTMENT RECORD (2)
"RTN","RCDPES10",43,0)
 ;;03^^Line Type^S Y=X_" (ERA LEVEL PAYER ADJUSTMENT RECORD (2))"
"RTN","RCDPES10",44,0)
 ;;03^^X12 Reason Text
"RTN","RCDPES10",45,0)
 ;
"RTN","RCDPES10",46,0)
05 ;;CLAIM PATIENT ID
"RTN","RCDPES10",47,0)
 ;;05^^Line Type^S Y=X_" (CLAIM LEVEL PATIENT ID DATA)"
"RTN","RCDPES10",48,0)
 ;;05^^Bill #
"RTN","RCDPES10",49,0)
 ;;05^^Patient Last Name
"RTN","RCDPES10",50,0)
 ;;05^^Patient First Name
"RTN","RCDPES10",51,0)
 ;;05^^Patient Middle Name
"RTN","RCDPES10",52,0)
 ;;05^^Patient ID #
"RTN","RCDPES10",53,0)
 ;;05^1^Record Contains Patient Name Change^S Y=""
"RTN","RCDPES10",54,0)
 ;;05^1^Record Contains Patient ID Change^S Y=""
"RTN","RCDPES10",55,0)
 ;;05^^Statement Start Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPES10",56,0)
 ;;05^^Statement End Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPES10",57,0)
 ;;05^^Claim Received Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPES10",58,0)
 ;
"RTN","RCDPES10",59,0)
06 ;;CORRECT PATIENT DATA
"RTN","RCDPES10",60,0)
 ;;06^^Line Type^S Y=X_" (CLAIM LEVEL CORRECT PATIENT DATA)"
"RTN","RCDPES10",61,0)
 ;;06^^Bill #
"RTN","RCDPES10",62,0)
 ;;06^^Corrected Patient Last Name
"RTN","RCDPES10",63,0)
 ;;06^^Corrected Patient First Name
"RTN","RCDPES10",64,0)
 ;;06^^Corrected Patient Middle Name
"RTN","RCDPES10",65,0)
 ;;06^^Corrected Patient ID #
"RTN","RCDPES10",66,0)
 ;
"RTN","RCDPES10",67,0)
10 ;;CLAIM STATUS DATA
"RTN","RCDPES10",68,0)
 ;;10^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM STATUS DATA)"
"RTN","RCDPES10",69,0)
 ;;10^^Bill #
"RTN","RCDPES10",70,0)
 ;;10^^Claim Processed^S Y=$$YN^RCDPESR9(X)
"RTN","RCDPES10",71,0)
 ;;10^^Claim Denied^S Y=$$YN^RCDPESR9(X)
"RTN","RCDPES10",72,0)
 ;;10^^Claim Pended^S Y=$$YN^RCDPESR9(X)
"RTN","RCDPES10",73,0)
 ;;10^^Claim Reversal^S Y=$$YN^RCDPESR9(X)
"RTN","RCDPES10",74,0)
 ;;10^^Claim Status Code
"RTN","RCDPES10",75,0)
 ;;10^1^Crossed Over Name^S Y=""
"RTN","RCDPES10",76,0)
 ;;10^1^Crossed Over ID^S Y=""
"RTN","RCDPES10",77,0)
 ;;10^^Submitted Charge^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",78,0)
 ;;10^^Amount Paid^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",79,0)
 ;;10^^ICN
"RTN","RCDPES10",80,0)
 ;;10^^DRG Code Used
"RTN","RCDPES10",81,0)
 ;;10^^DRG Weight Used^S Y=$J($$ZERO^RCDPESR9(X,1)/100,4)
"RTN","RCDPES10",82,0)
 ;;10^^Discharge Fraction^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",83,0)
 ;;10^^Coverage Expiration Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPES10",84,0)
 ;
"RTN","RCDPES10",85,0)
11 ;;CLAIM STATUS RENDERING PROVIDER INFORMATION
"RTN","RCDPES10",86,0)
 ;;11^^Line Type^S Y=X_" (CLAIM STATUS RENDERING PROVIDER INFORMATION)"
"RTN","RCDPES10",87,0)
 ;;11^^Bill #
"RTN","RCDPES10",88,0)
 ;;11^^Rendering NPI
"RTN","RCDPES10",89,0)
 ;;11^^Entity Type Qualifier
"RTN","RCDPES10",90,0)
 ;;11^^Last Name
"RTN","RCDPES10",91,0)
 ;;11^^First Name
"RTN","RCDPES10",92,0)
 ;
"RTN","RCDPES10",93,0)
12 ;;CLAIM STATUS CORRECTED PRIORITY PAYER
"RTN","RCDPES10",94,0)
 ;;12^^Line Type^S Y=X_" (CLAIM STATUS CORRECTED PRIORITY PAYER)"
"RTN","RCDPES10",95,0)
 ;;12^^Bill #
"RTN","RCDPES10",96,0)
 ;;12^^Corrected Priority Payer Name
"RTN","RCDPES10",97,0)
 ;;12^^Corrected Priority Payer ID Code Type
"RTN","RCDPES10",98,0)
 ;;12^^Corrected Priority Payer ID Code
"RTN","RCDPES10",99,0)
 ;
"RTN","RCDPES10",100,0)
13 ;;CLAIM STATUS OTHER SUBSCRIBER
"RTN","RCDPES10",101,0)
 ;;13^^Line Type^S Y=X_" (CLAIM STATUS OTHER SUBSCRIBER)"
"RTN","RCDPES10",102,0)
 ;;13^^Bill #
"RTN","RCDPES10",103,0)
 ;;13^^Other Subscriber Last Name
"RTN","RCDPES10",104,0)
 ;;13^^Other Subscriber First Name
"RTN","RCDPES10",105,0)
 ;;13^^Other Subscriber Middle Name
"RTN","RCDPES10",106,0)
 ;
"RTN","RCDPES10",107,0)
15 ;;CLAIM STATUS DATA
"RTN","RCDPES10",108,0)
 ;;15^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM STATUS DATA (CONTINUED))"
"RTN","RCDPES10",109,0)
 ;;15^^Bill #
"RTN","RCDPES10",110,0)
 ;;15^^Covered Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",111,0)
 ;;15^1^Discount Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",112,0)
 ;;15^1^Day Limit Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",113,0)
 ;;15^1^Interest Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",114,0)
 ;;15^1^Tax Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",115,0)
 ;;15^1^Total Before Taxes Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",116,0)
 ;;15^^Patient Responsibility Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",117,0)
 ;;15^1^Negative Reimbursement^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",118,0)
 ;
"RTN","RCDPES10",119,0)
17 ;;CLAIM LEVEL PAYER CONTACT INFORMATION
"RTN","RCDPES10",120,0)
 ;;17^^Line Type^S Y=X_" (CLAIM LEVEL PAYER CONTACT INFO)"
"RTN","RCDPES10",121,0)
 ;;17^^Bill #
"RTN","RCDPES10",122,0)
 ;;17^^Contact Name
"RTN","RCDPES10",123,0)
 ;;17^^ERA Contact Phone
"RTN","RCDPES10",124,0)
 ;;17^^ERA Contact Fax
"RTN","RCDPES10",125,0)
 ;;17^^ERA Contact Email
"RTN","RCDPES10",126,0)
 ;;17^^Contact Website
"RTN","RCDPES10",127,0)
 ;
"RTN","RCDPES10",128,0)
20 ;;CLAIM LEVEL ADJUSTMENT DATA
"RTN","RCDPES10",129,0)
 ;;20^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM ADJUSTMENT DATA)"
"RTN","RCDPES10",130,0)
 ;;20^^Bill #
"RTN","RCDPES10",131,0)
 ;;20^^Adjustment Group Code
"RTN","RCDPES10",132,0)
 ;;20^^Adjustment Reason Code
"RTN","RCDPES10",133,0)
 ;;20^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",134,0)
 ;;20^^Quantity^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPES10",135,0)
 ;;20^^Reason Code Text
"RTN","RCDPES10",136,0)
 ;
"RTN","RCDPES10",137,0)
30 ;;CLAIM LEVEL MEDICARE INPT ADJUDICATION DATA
"RTN","RCDPES10",138,0)
 ;;30^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE INPATIENT ADJUDICATION DATA)"
"RTN","RCDPES10",139,0)
 ;;30^^Bill #
"RTN","RCDPES10",140,0)
 ;;30^^Covered Days/Visits^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPES10",141,0)
 ;;30^1^Lifetime Reserve Days Count^S Y=$$ZERO^RCDPESR9(X,,1)
"RTN","RCDPES10",142,0)
 ;;30^1^Lifetime Psych Days Count^S Y=$$ZERO^RCDPESR9(X,,1)
"RTN","RCDPES10",143,0)
 ;;30^^Claim DRG Amt^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",144,0)
 ;;30^1^Claim Disproportionate Share Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",145,0)
 ;;30^1^Claim MSP Pass thru Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",146,0)
 ;;30^1^Claim PPS Capital Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",147,0)
 ;;30^1^PPS-Capital FSP DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",148,0)
 ;;30^1^PPS-Capital HSP DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",149,0)
 ;;30^1^PPS-Capital DSH DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",150,0)
 ;;30^1^Old Capital Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",151,0)
 ;;30^^Non-Covered Days^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPES10",152,0)
 ;
"RTN","RCDPES10",153,0)
35 ;;CLAIM LEVEL MEDICARE ADJUDICATION DATA
"RTN","RCDPES10",154,0)
 ;;35^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE ADJUDICATION DATA)"
"RTN","RCDPES10",155,0)
 ;;35^^Bill #
"RTN","RCDPES10",156,0)
 ;;35^1^PPS-Capital IME Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",157,0)
 ;;35^1^PPS-Operating Hosp Specific DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",158,0)
 ;;35^1^Cost Report Day Count^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPES10",159,0)
 ;;35^1^PPS-Operating Fed Specific DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",160,0)
 ;;35^1^Claim PPS Capital Outlier Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",161,0)
 ;;35^1^Claim Indirect Teaching Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",162,0)
 ;;35^1^Non-payable Professional Component Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",163,0)
 ;;35^1^PPS-Capital Exception Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",164,0)
 ;;35^1^Outpatient Reimbursement %^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPES10",165,0)
 ;;35^1^HCPCS Payable Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",166,0)
 ;;35^1^ESRD Paid Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",167,0)
 ;;35^1^Non-payable Professional Component^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",168,0)
 ;
"RTN","RCDPES10",169,0)
37 ;;CLAIM LEVEL MEDICARE ADJUDICATION DATA REMARKS
"RTN","RCDPES10",170,0)
 ;;37^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE ADJUDICATION DATA REMARKS)"
"RTN","RCDPES10",171,0)
 ;;37^^Bill #
"RTN","RCDPES10",172,0)
 ;;37^^Type^S Y=$S(X="O":"MOA",X="I":"MIA",1:X)
"RTN","RCDPES10",173,0)
 ;;37^^Claim Payment Remark Code
"RTN","RCDPES10",174,0)
 ;;37^^Claim Payment Remark Code Message Text
"RTN","RCDPES10",175,0)
 ;
"RTN","RCDPES10",176,0)
40 ;;SERVICE LINE DATA
"RTN","RCDPES10",177,0)
 ;;40^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA)"
"RTN","RCDPES10",178,0)
 ;;40^^Bill #
"RTN","RCDPES10",179,0)
 ;;40^^Procedure
"RTN","RCDPES10",180,0)
 ;;40^^Revenue Code
"RTN","RCDPES10",181,0)
 ;;40^^Modifier 1
"RTN","RCDPES10",182,0)
 ;;40^^Modifier 2
"RTN","RCDPES10",183,0)
 ;;40^^Modifier 3
"RTN","RCDPES10",184,0)
 ;;40^^Modifier 4
"RTN","RCDPES10",185,0)
 ;;40^^Description
"RTN","RCDPES10",186,0)
 ;;40^^Original Procedure
"RTN","RCDPES10",187,0)
 ;;40^^Original Modifier 1
"RTN","RCDPES10",188,0)
 ;;40^^Original Modifier 2
"RTN","RCDPES10",189,0)
 ;;40^^Original Modifier 3
"RTN","RCDPES10",190,0)
 ;;40^^Original Modifier 4
"RTN","RCDPES10",191,0)
 ;;40^^Original Charge^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",192,0)
 ;;40^^Original Units^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",193,0)
 ;;40^^Amount Paid^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",194,0)
 ;;40^^Covered Units^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",195,0)
 ;;40^^Service From Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPES10",196,0)
 ;;40^^Service To Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPES10",197,0)
 ;;40^^Procedure Type
"RTN","RCDPES10",198,0)
 ;
"RTN","RCDPES10",199,0)
41 ;;SERVICE LINE DATA
"RTN","RCDPES10",200,0)
 ;;41^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA (CONTINUED))"
"RTN","RCDPES10",201,0)
 ;;41^^Bill #
"RTN","RCDPES10",202,0)
 ;;41^^Allowed Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",203,0)
 ;;41^1^Per Diem Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPES10",204,0)
 ;
"RTN","RCDPES10",205,0)
42 ;;SERVICE LINE DATA
"RTN","RCDPES10",206,0)
 ;;42^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA (CONTINUED))"
"RTN","RCDPES10",207,0)
 ;;42^^Bill #
"RTN","RCDPES10",208,0)
 ;;42^^Line Item Remark Code
"RTN","RCDPES10",209,0)
 ;;42^^Line Item Remark Code Text
"RTN","RCDPES10",210,0)
 ;;42^^Provider Line Reference
"RTN","RCDPES10",211,0)
 ;
"RTN","RCDPES10",212,0)
45 ;;SERVICE LINE ADJUSTMENT DATA
"RTN","RCDPES10",213,0)
 ;;45^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE ADJUSTMENT DATA)"
"RTN","RCDPES10",214,0)
 ;;45^^Bill #
"RTN","RCDPES10",215,0)
 ;;45^^Adjustment Group Code
"RTN","RCDPES10",216,0)
 ;;45^^Adjustment Reason Code
"RTN","RCDPES10",217,0)
 ;;45^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPES10",218,0)
 ;;45^^Quantity^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPES10",219,0)
 ;;45^^Reason Code Text
"RTN","RCDPES10",220,0)
 ;
"RTN","RCDPES10",221,0)
46 ;;ADJUSTMENT POLICY REFERENCE
"RTN","RCDPES10",222,0)
 ;;46^^Line Type^S Y=X_" (ADJUSTMENT POLICY REFERENCE)"
"RTN","RCDPES10",223,0)
 ;;46^^Bill #
"RTN","RCDPES10",224,0)
 ;;46^^Payer Policy Preference
"RTN","RCDPES10",225,0)
 ;
"RTN","RCDPES10",226,0)
FDT(X) ; returns MM/DD/YYYY or MM/DD/YY from YYYYMMDD or YYMMDD in X
"RTN","RCDPES10",227,0)
 I $L(X)=8,X?8N S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
"RTN","RCDPES10",228,0)
 I $L(X)=6,X?6N S X=$E(X,3,4)_"/"_$E(X,5,6)_"/"_$E(X,1,2)
"RTN","RCDPES10",229,0)
 Q X
"RTN","RCDPES10",230,0)
 ;
"RTN","RCDPES10",231,0)
ZERO(X,D,NULL) ; Returns numeric value of X without leading 0's
"RTN","RCDPES10",232,0)
 ; or null if no value wanted for 0 amount
"RTN","RCDPES10",233,0)
 ; D = 1 if dollar amt
"RTN","RCDPES10",234,0)
 N Z
"RTN","RCDPES10",235,0)
 I X["." S Z=$P(X,"."),X=+Z_"."_$P(X,".",2)
"RTN","RCDPES10",236,0)
 I X'["." D
"RTN","RCDPES10",237,0)
 . I $G(D) S X=+$E(X,1,$L(X)-2)_"."_$E(X,$L(X)-1,$L(X))
"RTN","RCDPES10",238,0)
 . S X=$S('$G(D):+X,1:$J(X,"",2))
"RTN","RCDPES10",239,0)
 Q $S(X:X,$G(NULL):"",1:X)
"RTN","RCDPES10",240,0)
 ;
"RTN","RCDPES10",241,0)
YN(X) ; Returns YES for X="Y" and NO for X="N"
"RTN","RCDPES10",242,0)
 S X=$S(X="Y":"YES",X="N":"NO",1:X)
"RTN","RCDPES10",243,0)
 Q X
"RTN","RCDPES10",244,0)
 ;
"RTN","RCDPESR0")
0^20^B57243958
"RTN","RCDPESR0",1,0)
RCDPESR0 ;ALB/TMK/DWA - Server auto-update utilities - EDI Lockbox ; 9/30/10 6:05pm
"RTN","RCDPESR0",2,0)
 ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPESR0",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPESR0",4,0)
 ; IA for read access to ^IBM(361.1 = 4051
"RTN","RCDPESR0",5,0)
 ;
"RTN","RCDPESR0",6,0)
DISP(RCMIN,RCMOUT,RCFMT,RCFULL,RCW,RC3444) ; Format the 835 return msg
"RTN","RCDPESR0",7,0)
 ; RCMIN = the name of the array that contains the raw message data
"RTN","RCDPESR0",8,0)
 ;         The data is contained at the next level and the subscript is
"RTN","RCDPESR0",9,0)
 ;         numeric and greater than 0 or the data can be at the
"RTN","RCDPESR0",10,0)
 ;         0-node subsequent to the final subscript.
"RTN","RCDPESR0",11,0)
 ;         If the message array is a global ^TMP($J,"MSG",n), RCMIN
"RTN","RCDPESR0",12,0)
 ;         will equal "^TMP($J,""MSG"")" and the message text will be
"RTN","RCDPESR0",13,0)
 ;         in ^TMP($J,"MSG",1), ^TMP($J,"MSG",2), etc.  OR
"RTN","RCDPESR0",14,0)
 ;         the message text can be defined at TMP($J,"MSG",1,0) ^...,2,0)
"RTN","RCDPESR0",15,0)
 ;         etc.
"RTN","RCDPESR0",16,0)
 ; RCMOUT = the name of the array that should be returned.  This array
"RTN","RCDPESR0",17,0)
 ;          will follow the same convention as the input array.  The
"RTN","RCDPESR0",18,0)
 ;          array will be returned with a numeric final subscript.  If
"RTN","RCDPESR0",19,0)
 ;          RCMOUT is passed as "^TMP($J,""MSG1"")", then the display
"RTN","RCDPESR0",20,0)
 ;          lines will be returned in ^TMP($J,"MSG1",1),
"RTN","RCDPESR0",21,0)
 ;          ^TMP($J,"MSG1",2), etc.  Note the array RCMOUT is killed
"RTN","RCDPESR0",22,0)
 ;          on entry to this call
"RTN","RCDPESR0",23,0)
 ; RCFMT = 0 or null if call should return raw data, 1 to execute the
"RTN","RCDPESR0",24,0)
 ;         transforms attached to the fields
"RTN","RCDPESR0",25,0)
 ; RCFULL = the name of an array if the data should be returned in
"RTN","RCDPESR0",26,0)
 ;          this array, formatted into lines for display.  If not sent,
"RTN","RCDPESR0",27,0)
 ;          only the display data by element is returned in RCMOUT.  If
"RTN","RCDPESR0",28,0)
 ;          RCFULL is sent, the array is killed before populating it
"RTN","RCDPESR0",29,0)
 ; RCW = max # of characters per line to return in array RCFULL
"RTN","RCDPESR0",30,0)
 ; RC3444 = flag that indicates only return bill data, not header data
"RTN","RCDPESR0",31,0)
 ;
"RTN","RCDPESR0",32,0)
 N Z,Z0,Z1,RC,RCCT,RCREF,RCDATA,RCQ,R
"RTN","RCDPESR0",33,0)
 S RCCT=0,RCREF="" K @RCMOUT
"RTN","RCDPESR0",34,0)
 S Z=0 F  S Z=$O(@RCMIN@(Z)) Q:'Z  S Z0=$S($G(@RCMIN@(Z))'="":@RCMIN@(Z),1:$G(@RCMIN@(Z,0))) I Z0'="" S RCQ=0 D
"RTN","RCDPESR0",35,0)
 . I '$G(RCV5),+$P(Z0,U)=835,+$P(Z0,U,16)>0 S RCV5=1
"RTN","RCDPESR0",36,0)
 . F Z1=1:1:$L(Z0,U) I $P(Z0,U,Z1)'="" D  Q:RCQ
"RTN","RCDPESR0",37,0)
 .. S RCDATA=$P(Z0,U,Z1)
"RTN","RCDPESR0",38,0)
 .. I Z1=1 D  Q:RCQ
"RTN","RCDPESR0",39,0)
 ... S RC=""
"RTN","RCDPESR0",40,0)
 ... I RCDATA'="",RCDATA?.N.A,$G(RCV5) D
"RTN","RCDPESR0",41,0)
 .... S RCREF=$S($E(RCDATA,1,3)'="835":$E(RCDATA,1,8),1:"835"),R=RCREF_"^RCDPES10",RC=$P($T(@R),";;",2)
"RTN","RCDPESR0",42,0)
 ... I RCDATA'="",RCDATA?.N.A,'$G(RCV5) D
"RTN","RCDPESR0",43,0)
 .... S RCREF=$S($E(RCDATA,1,3)'="835":$E(RCDATA,1,8),1:"835"),R=RCREF_"^RCDPESR9",RC=$P($T(@R),";;",2)
"RTN","RCDPESR0",44,0)
 ... I RC="" S RCCT=RCCT+1,@RCMOUT@(RCCT)="<<<INVALID LINE TYPE - RAW DATA IS:",RCCT=RCCT+1,@RCMOUT@(RCCT)=Z0,RCDATA=""
"RTN","RCDPESR0",45,0)
 .. Q:RCDATA=""!(RCREF="")!$S(RCREF="835":$G(RC3444),1:0)
"RTN","RCDPESR0",46,0)
 .. S RC=""
"RTN","RCDPESR0",47,0)
 .. I RCREF?.A.N,$G(RCV5) D
"RTN","RCDPESR0",48,0)
 ... S R=RCREF_"+"_Z1_"^RCDPES10",RC=$P($T(@R),";;",2)
"RTN","RCDPESR0",49,0)
 .. I RCREF?.A.N,'$G(RCV5) D
"RTN","RCDPESR0",50,0)
 ... S R=RCREF_"+"_Z1_"^RCDPESR9",RC=$P($T(@R),";;",2)
"RTN","RCDPESR0",51,0)
 .. I RC=""!($P(RC,U)'=RCREF) S:$S(RCDATA'="":1,1:'$P(RC,U,2)) RCCT=RCCT+1,@RCMOUT@(RCCT)="NO DATA DEFINITION PC "_Z1_": "_RCDATA Q
"RTN","RCDPESR0",52,0)
 .. I RC'="" D
"RTN","RCDPESR0",53,0)
 ... N X,X1,Y
"RTN","RCDPESR0",54,0)
 ... S X1=$P(RC,U,4,99)
"RTN","RCDPESR0",55,0)
 ... I $G(RCFMT),X1'="" S X=RCDATA X X1 S RCDATA=Y ; Output transform
"RTN","RCDPESR0",56,0)
 ... Q:RCDATA=""&($P(RC,U,2))  ; Don't output if null data
"RTN","RCDPESR0",57,0)
 ... S RC=$P(RC,U,3)
"RTN","RCDPESR0",58,0)
 ... S RCCT=RCCT+1,@RCMOUT@(RCCT)=$S(Z1=1:"<<<",1:"")_RC_": "_RCDATA_$S(Z1=1:">>>",1:"")
"RTN","RCDPESR0",59,0)
 I $G(RCFULL)'="" D FMTDSP(RCMOUT,RCFULL,$G(RCW),$G(RC3444))
"RTN","RCDPESR0",60,0)
 Q
"RTN","RCDPESR0",61,0)
 ;
"RTN","RCDPESR0",62,0)
FMTDSP(RCMUN,RCMFO,RCW,RCNOH05) ; Format the display data in array named in
"RTN","RCDPESR0",63,0)
 ; RCMUN into lines up to RCW characters wide  RCMUN must be set up the
"RTN","RCDPESR0",64,0)
 ; same as the output of the DISP call above
"RTN","RCDPESR0",65,0)
 ; Returns array named in RCMFO with the last subscript being the line #
"RTN","RCDPESR0",66,0)
 ; Note @RCMFO is killed on entry to this call
"RTN","RCDPESR0",67,0)
 ; Default is 80 if RCW=0 or null
"RTN","RCDPESR0",68,0)
 ; RCNOH05 = flag that if =1, suppresses the '05' header
"RTN","RCDPESR0",69,0)
 ;
"RTN","RCDPESR0",70,0)
 N Z,RCLINE,RCCT,RCCT1,RCMID,RCD,RCSTART,RCLINE,RCDASH
"RTN","RCDPESR0",71,0)
 K @RCMFO
"RTN","RCDPESR0",72,0)
 S:'$G(RCW) RCW=80
"RTN","RCDPESR0",73,0)
 S RCDASH=" "_$TR($J("",RCW-2)," ","-")
"RTN","RCDPESR0",74,0)
 S (RCCT,RCCT1)=0,RCLINE="",RCMID=RCW\2-1
"RTN","RCDPESR0",75,0)
 S Z=0 F  S Z=$O(@RCMUN@(Z)) Q:'Z  S RCD=$G(@RCMUN@(Z)) D
"RTN","RCDPESR0",76,0)
 . I $E(RCD,1,3)="<<<" D  Q  ; New line needed ... record start
"RTN","RCDPESR0",77,0)
 .. I $L(RCLINE)>0 S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
"RTN","RCDPESR0",78,0)
 .. I $L(RCLINE)=0 D
"RTN","RCDPESR0",79,0)
 ... I Z>1 S RCCT=RCCT+1,@RCMFO@(RCCT)=" "
"RTN","RCDPESR0",80,0)
 ... I RCD["<<<Line Type: 05 ",'$G(RCNOH05) S RCCT1=RCCT1+1,RCCT=RCCT+1,@RCMFO@(RCCT)=RCDASH,RCCT=RCCT+1,@RCMFO@(RCCT)="****** ERA DETAIL START ******",RCCT=RCCT+1,@RCMFO@(RCCT)=RCDASH
"RTN","RCDPESR0",81,0)
 ... I $L(RCD)>RCW D  Q
"RTN","RCDPESR0",82,0)
 .... S RCSTART=1
"RTN","RCDPESR0",83,0)
 .... F  S RCCT=RCCT+1,@RCMFO@(RCCT)=$E(RCD,RCSTART,RCSTART+RCW-1),RCSTART=RCSTART+RCW Q:RCSTART>$L(RCD)
"RTN","RCDPESR0",84,0)
 ... S RCCT=RCCT+1,@RCMFO@(RCCT)=RCD
"RTN","RCDPESR0",85,0)
 . ;
"RTN","RCDPESR0",86,0)
 . I $L(RCD)>RCW D  Q  ; Split line if greater than width given
"RTN","RCDPESR0",87,0)
 .. I $L(RCLINE) S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE
"RTN","RCDPESR0",88,0)
 .. S RCSTART=1
"RTN","RCDPESR0",89,0)
 .. F  S RCCT=RCCT+1,@RCMFO@(RCCT)=$E(RCD,RCSTART,RCSTART+RCW-1),RCSTART=RCSTART+RCW Q:RCSTART>$L(RCD)
"RTN","RCDPESR0",90,0)
 .. S RCLINE=""
"RTN","RCDPESR0",91,0)
 . I $L(RCLINE)=0 D  Q  ; Format left side of line
"RTN","RCDPESR0",92,0)
 .. S RCLINE=RCD
"RTN","RCDPESR0",93,0)
 .. ;
"RTN","RCDPESR0",94,0)
 .. I $L(RCLINE)>RCMID S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
"RTN","RCDPESR0",95,0)
 . ;
"RTN","RCDPESR0",96,0)
 . I (RCMID+$L(RCD)+1)>RCW D  Q  ; data too long for right side of line
"RTN","RCDPESR0",97,0)
 .. S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCCT=RCCT+1,@RCMFO@(RCCT)=RCD,RCLINE=""
"RTN","RCDPESR0",98,0)
 . S RCLINE=$E(RCLINE_$J("",RCMID),1,RCMID)_"  "_RCD,RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE,RCLINE=""
"RTN","RCDPESR0",99,0)
 I $L(RCLINE) S RCCT=RCCT+1,@RCMFO@(RCCT)=RCLINE
"RTN","RCDPESR0",100,0)
 Q
"RTN","RCDPESR0",101,0)
 ;
"RTN","RCDPESR0",102,0)
BULLERA(RC,RCTDA,RCXMG,RCSUBJ,RCERR,RCTYP) ; Send a bulletin for entries in 344.5
"RTN","RCDPESR0",103,0)
 ; RC = flags for data to include (one or more can can be used)
"RTN","RCDPESR0",104,0)
 ;   'D': display text   'R': raw data    'F': formatted data from raw
"RTN","RCDPESR0",105,0)
 ;        data in file 344.5
"RTN","RCDPESR0",106,0)
 ; RCTDA = ien of the entry in file 344.5
"RTN","RCDPESR0",107,0)
 ; RCXMG = mail msg # for the ERA
"RTN","RCDPESR0",108,0)
 ; RCSUBJ = subject of the bulletin 
"RTN","RCDPESR0",109,0)
 ; RCERR = error text in array or name of error global
"RTN","RCDPESR0",110,0)
 ; RCTYP = if 0:ERA  1:EEOB
"RTN","RCDPESR0",111,0)
 ;
"RTN","RCDPESR0",112,0)
 N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,Z,Z0,CT,RCXM,RCVAR
"RTN","RCDPESR0",113,0)
 K ^TMP("RCXM_344.5",$J)
"RTN","RCDPESR0",114,0)
 S RCERR=$G(RCERR)
"RTN","RCDPESR0",115,0)
 S RCVAR=$S($E(RCERR,1,5)="^TMP(":RCERR,1:"RCERR")
"RTN","RCDPESR0",116,0)
 S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")="",CT=0,RCTYP=$S('$G(RCTYP):"ERA",1:"EEOB")
"RTN","RCDPESR0",117,0)
 S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="The following electronic "_RCTYP_" was received at your site.",CT=CT+1,^TMP("RCXM_344.5",$J,CT)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
"RTN","RCDPESR0",118,0)
 S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="This message is sent to alert you to conditions regarding this "_RCTYP_".",CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
"RTN","RCDPESR0",119,0)
 I RC["D" D DTXT(RCTDA,.RCXM,.CT) M ^TMP("RCXM_344.5",$J)=RCXM K RCXM
"RTN","RCDPESR0",120,0)
 S Z=0 F  S Z=$O(@RCVAR@(Z)) Q:'Z  I $D(@RCVAR@(Z,"*")) S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z,"*")
"RTN","RCDPESR0",121,0)
 I $G(RCERR)'="",RCVAR="RCERR" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=RCERR,CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
"RTN","RCDPESR0",122,0)
 I $O(@RCVAR@(""))'="" D
"RTN","RCDPESR0",123,0)
 . S Z="" F  S Z=$O(@RCVAR@(Z)) Q:Z=""  D
"RTN","RCDPESR0",124,0)
 .. I $G(@RCVAR@(Z))'="" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z)
"RTN","RCDPESR0",125,0)
 .. I $O(@RCVAR@(Z,0)) S Z0="" F  S Z0=$O(@RCVAR@(Z,Z0)) Q:Z0=""  I Z0'="*" S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=@RCVAR@(Z,Z0)
"RTN","RCDPESR0",126,0)
 I RC["F" D
"RTN","RCDPESR0",127,0)
 . N RCCT1
"RTN","RCDPESR0",128,0)
 . S RCCT1=0
"RTN","RCDPESR0",129,0)
 . K ^TMP($J,"PRCAZ_RAW"),^TMP($J,"PRCAZ_FMT1"),^TMP($J,"PRCAZ_FMT")
"RTN","RCDPESR0",130,0)
 . D DISP("^RCY(344.5,"_RCTDA_",2)","^TMP($J,""PRCAZ_FMT1"")",1,"^TMP($J,""PRCAZ_FMT"")",75)
"RTN","RCDPESR0",131,0)
 . S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="FORMATTED DATA: "
"RTN","RCDPESR0",132,0)
 . S Z=0 F  S Z=$O(^TMP($J,"PRCAZ_FMT",Z)) Q:'Z  S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=^TMP($J,"PRCAZ_FMT",Z)
"RTN","RCDPESR0",133,0)
 . S:RC["R" CT=CT+1,^TMP("RCXM_344.5",$J,CT)=" "
"RTN","RCDPESR0",134,0)
 I RC["R" D
"RTN","RCDPESR0",135,0)
 . S CT=CT+1,^TMP("RCXM_344.5",$J,CT)="RAW DATA: "
"RTN","RCDPESR0",136,0)
 . S Z=0 F  S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z  S CT=CT+1,^TMP("RCXM_344.5",$J,CT)=$G(^RCY(344.5,RCTDA,2,Z,0))
"RTN","RCDPESR0",137,0)
 S XMBODY="^TMP(""RCXM_344.5"",$J)"
"RTN","RCDPESR0",138,0)
 D
"RTN","RCDPESR0",139,0)
 . N DUZ S DUZ=.5,DUZ(0)="@"
"RTN","RCDPESR0",140,0)
 . D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
"RTN","RCDPESR0",141,0)
 K ^TMP($J,"PRCAZ_RAW"),^TMP($J,"PRCAZ_FMT1"),^TMP($J,"PRCAZ_FMT"),^TMP("RCXM_344.5",$J)
"RTN","RCDPESR0",142,0)
 Q
"RTN","RCDPESR0",143,0)
 ;
"RTN","RCDPESR0",144,0)
BULLEFT(RCTDA,RCXMG,RCSUBJ,RCERR) ; Send a bulletin for 'bad' EFT entries
"RTN","RCDPESR0",145,0)
 ; RCTDA = ien of the entry in file 344.3
"RTN","RCDPESR0",146,0)
 ; RCXMG = mail msg # for the EFT
"RTN","RCDPESR0",147,0)
 ; RCSUBJ = subject of the bulletin 
"RTN","RCDPESR0",148,0)
 ; RCERR = error text in array
"RTN","RCDPESR0",149,0)
 N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z,Z0,CT
"RTN","RCDPESR0",150,0)
 S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")="",CT=0
"RTN","RCDPESR0",151,0)
 S CT=CT+1,RCXM(CT)="The following electronic EFT deposit was received at your site.",CT=CT+1,RCXM(CT)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
"RTN","RCDPESR0",152,0)
 S CT=CT+1,RCXM(CT)="This message is sent to alert you to conditions regarding this EFT.",CT=CT+1,RCXM(CT)=" "
"RTN","RCDPESR0",153,0)
 I $G(RCERR)'="" S CT=CT+1,RCXM(CT)=RCERR,CT=CT+1,RCXM(CT)=" "
"RTN","RCDPESR0",154,0)
 I $O(RCERR(""))'="" D
"RTN","RCDPESR0",155,0)
 . S Z="" F  S Z=$O(RCERR(Z)) Q:Z=""  D
"RTN","RCDPESR0",156,0)
 .. I $G(RCERR(Z))'="" S CT=CT+1,RCXM(CT)=RCERR(Z)
"RTN","RCDPESR0",157,0)
 .. I $O(RCERR(Z,0)) S Z0="" F  S Z0=$O(RCERR(Z,Z0)) Q:Z0=""  S CT=CT+1,RCXM(CT)=RCERR(Z,Z0)
"RTN","RCDPESR0",158,0)
 S XMBODY="RCXM"
"RTN","RCDPESR0",159,0)
 D
"RTN","RCDPESR0",160,0)
 . N DUZ S DUZ=.5,DUZ(0)="@"
"RTN","RCDPESR0",161,0)
 . D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
"RTN","RCDPESR0",162,0)
 Q
"RTN","RCDPESR0",163,0)
 ;
"RTN","RCDPESR0",164,0)
DTXT(RCTDA,RCXM,RCNT) ; Add display text to array RCXM(CT)
"RTN","RCDPESR0",165,0)
 ; RCTDA = ien of entry in file 344.5
"RTN","RCDPESR0",166,0)
 ; Send RCNT and RCXM by reference for return values
"RTN","RCDPESR0",167,0)
 N RCDIQ
"RTN","RCDPESR0",168,0)
 D GETS^DIQ(344.5,RCTDA_",",1,"EN","RCDIQ")
"RTN","RCDPESR0",169,0)
 D TXTDE^RCDPEX(RCTDA,.RCDIQ,1,.RCXM,.RCNT)
"RTN","RCDPESR0",170,0)
 Q
"RTN","RCDPESR0",171,0)
 ;
"RTN","RCDPESR0",172,0)
BILLREF(RC3444,RC34441) ; Returns the bill # for the EOB in file 344.4, entry
"RTN","RCDPESR0",173,0)
 ; number RC3444 and subfile entry RC34441
"RTN","RCDPESR0",174,0)
 N RCARR
"RTN","RCDPESR0",175,0)
 D DIQ34441^RCDPEDS(RC3444,RC34441,99,"RCARR")
"RTN","RCDPESR0",176,0)
 Q $G(RCARR(344.41,RC34441,99,"E"))
"RTN","RCDPESR0",177,0)
 ;
"RTN","RCDPESR0",178,0)
GETBILL(DA) ; Called from computed field to find bill reference
"RTN","RCDPESR0",179,0)
 ;  Assumes DA(1)= ien of file 344.4,  DA = ien of file 344.41
"RTN","RCDPESR0",180,0)
 N Z,VAL
"RTN","RCDPESR0",181,0)
 S Z=$G(^RCY(344.4,DA(1),1,DA,0))
"RTN","RCDPESR0",182,0)
 I $P(Z,U,2) S VAL=$$BN1^PRCAFN(+$G(^IBM(361.1,+$P(Z,U,2),0))) ; IA 4051
"RTN","RCDPESR0",183,0)
 I $G(VAL)="" S VAL=$P(Z,U,5)
"RTN","RCDPESR0",184,0)
 Q VAL
"RTN","RCDPESR0",185,0)
 ;
"RTN","RCDPESR2")
0^21^B84144020
"RTN","RCDPESR2",1,0)
RCDPESR2 ;ALB/TMK/DWA - Server auto-upd - EDI Lockbox ; 6/14/11 3:03pm
"RTN","RCDPESR2",2,0)
 ;;4.5;Accounts Receivable;**173,216,208,230,252,264,269**;Mar 20, 1995;Build 113
"RTN","RCDPESR2",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPESR2",4,0)
 ; IA 4042 (IBCEOB)
"RTN","RCDPESR2",5,0)
 ;
"RTN","RCDPESR2",6,0)
TASKERA(RCTDA) ; Task to upd ERA
"RTN","RCDPESR2",7,0)
 ; RCTDA = ien 344.5
"RTN","RCDPESR2",8,0)
 N ZTDTH,ZTUCI,ZTSAVE,ZTIO,ZTDESC,ZTRTN,ZTSK,DIE,DR,DA
"RTN","RCDPESR2",9,0)
 S (ZTSAVE("DT"),ZTSAVE("U"),ZTSAVE("DUZ"))="",ZTSAVE("ZTREQ")="@",ZTRTN="NEWERA^RCDPESR2("_RCTDA_",0)",ZTDTH=$H,ZTIO=""
"RTN","RCDPESR2",10,0)
 D ^%ZTLOAD
"RTN","RCDPESR2",11,0)
 Q
"RTN","RCDPESR2",12,0)
 ;
"RTN","RCDPESR2",13,0)
NEWERA(RCTDA,RCREFILE) ;Tasked
"RTN","RCDPESR2",14,0)
 ; Add new EOB's to IB & ERA tot rec to AR
"RTN","RCDPESR2",15,0)
 ; RCTDA = ien 344.5
"RTN","RCDPESR2",16,0)
 ; RCREFILE = 1: re-filing rec via exc proc
"RTN","RCDPESR2",17,0)
 N RCDUPERR,RCPAYER,RCRTOT,RCE,RCEC,RCERR,RCR1,RCADJ,DIE,DR,DA,Z,Q
"RTN","RCDPESR2",18,0)
 S ZTREQ="@"
"RTN","RCDPESR2",19,0)
 K ^TMP($J,"RCDPERA")
"RTN","RCDPESR2",20,0)
 L +^RCY(344.5,RCTDA):5
"RTN","RCDPESR2",21,0)
 I $D(ZTQUEUED) S DIE="^RCY(344.5,",DA=RCTDA,DR=".05////"_ZTSK_";.04////1" D ^DIE
"RTN","RCDPESR2",22,0)
 I $P($G(^RCY(344.5,RCTDA,0)),U,5),'$G(RCREFILE) S DIE="^RCY(344.5,",DA=RCTDA,DR=".1////4;.08///1" D ^DIE
"RTN","RCDPESR2",23,0)
 S RCR1=$P($G(^RCY(344.5,RCTDA,0)),U,7),RCPAYER=$P($G(^RCY(344.5,RCTDA,3)),U)
"RTN","RCDPESR2",24,0)
 S RCRTOT=$S(RCR1:RCR1,1:$$ERATOT^RCDPESR6(RCTDA,.RCERR)) ; ERA rec
"RTN","RCDPESR2",25,0)
 S RCDUPERR=$S($G(RCERR)="DUP"!($G(RCERR(1))=-2):$G(RCERR(1)),1:0) K RCERR(1)
"RTN","RCDPESR2",26,0)
 I RCRTOT,'RCR1 S DIE="^RCY(344.5,",DR=".07////"_RCRTOT,DA=RCTDA D ^DIE
"RTN","RCDPESR2",27,0)
 D:RCDUPERR'=-2 UPDEOB(RCTDA,5,$S('$G(RCREFILE):RCDUPERR,1:-1)) ; Add EOB det to IB
"RTN","RCDPESR2",28,0)
 I RCRTOT D UPDCON^RCDPESR6(RCRTOT),UPDADJ^RCDPESR6(RCRTOT),UPD3444^RCDPESR6(.RCRTOT) ; Bills added 344.41
"RTN","RCDPESR2",29,0)
 I RCRTOT,RCTDA S DIE="^RCY(344.5,",DR=".08////0;.1///@",DA=RCTDA D ^DIE
"RTN","RCDPESR2",30,0)
 I 'RCRTOT D  G QNEW
"RTN","RCDPESR2",31,0)
 .I RCDUPERR Q:'RCTDA  D  S RCTDA="" Q
"RTN","RCDPESR2",32,0)
 ..I RCDUPERR=-2 D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - DUPLICATE ERA NOT FILED "_$E(RCPAYER,1,20),.RCERR,0)
"RTN","RCDPESR2",33,0)
 ..D TEMPDEL^RCDPESR1(RCTDA)
"RTN","RCDPESR2",34,0)
 .S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" An error occurred while storing ERA data.",RCE(2)="No totals data was stored for this ERA record"_$S('$G(RCREFILE):" and an",1:" on this re-file attempt.")
"RTN","RCDPESR2",35,0)
 .S RCE(3)=$S('$G(RCREFILE):"ERA transmission exception was created.",1:"")
"RTN","RCDPESR2",36,0)
 .D WP^DIE(344.5,RCTDA_",",5,"A","RCE")
"RTN","RCDPESR2",37,0)
 .S DIE="^RCY(344.5,",DA=RCTDA,DR=".07///@;.08////1;.1////1" D ^DIE
"RTN","RCDPESR2",38,0)
 .K RCERR
"RTN","RCDPESR2",39,0)
 .S RCERR(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" The ERA data could not be stored. The AR receipt",RCERR(2)=" for this data must be created/processed manually for the bills included"
"RTN","RCDPESR2",40,0)
 .S RCERR(3)=" in this ERA."_$S('$G(RCREFILE):"",1:"  This error occurred during a refile attempt."),RCERR(4)=" "
"RTN","RCDPESR2",41,0)
 .D BULLERA^RCDPESR0("DF",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - TOTALS FILE EXCEPTION "_$E(RCPAYER,1,20),.RCERR,0)
"RTN","RCDPESR2",42,0)
 .K RCERR
"RTN","RCDPESR2",43,0)
 I $$ADJ^RCDPEU(RCRTOT,.RCADJ) D  ;Bulletin adjs
"RTN","RCDPESR2",44,0)
 .S RCEC=$$ADJERR^RCDPESR3(.RCERR)
"RTN","RCDPESR2",45,0)
 .I RCADJ'=2 S RCEC=RCEC+1,RCERR(RCEC)=" THERE ARE ERA LEVEL ADJUSTMENT(S)",RCEC=RCEC+1,RCERR(RCEC)=" "
"RTN","RCDPESR2",46,0)
 .I RCADJ'=1 S RCEC=RCEC+1,RCERR(RCEC)=" THE FOLLOWING BILL(S) HAVE RETRACTIONS:" D
"RTN","RCDPESR2",47,0)
 ..S (Q,Z)=0 S Z=0 F  S Z=$O(RCADJ(RCRTOT,Z)) Q:'Z  S:'Q RCEC=RCEC+1,RCERR(RCEC)="  " S Q=Q+1,RCERR(RCEC)=RCERR(RCEC)_"  "_RCADJ(RCRTOT,Z) S:Q=4 Q=0
"RTN","RCDPESR2",48,0)
 ..S RCEC=RCEC+1,RCERR(RCEC)=" "
"RTN","RCDPESR2",49,0)
 .D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - ERA HAS ADJ/TAKEBACKS "_$E(RCPAYER,1,20),.RCERR,0)
"RTN","RCDPESR2",50,0)
 ;
"RTN","RCDPESR2",51,0)
QNEW I RCTDA,'$P($G(^RCY(344.5,RCTDA,0)),U,8) D TEMPDEL^RCDPESR1(RCTDA) S RCTDA=""
"RTN","RCDPESR2",52,0)
 I RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U)'="" S DIE="^RCY(344.5,",DR=".04////0;.05///@"_$S('$G(RCR1)&$G(RCRTOT):";.07////"_RCRTOT,1:""),DA=RCTDA D ^DIE
"RTN","RCDPESR2",53,0)
 K ^TMP($J,"RCDPERA")
"RTN","RCDPESR2",54,0)
 I RCTDA L -^RCY(344.5,RCTDA)
"RTN","RCDPESR2",55,0)
 Q
"RTN","RCDPESR2",56,0)
 ;
"RTN","RCDPESR2",57,0)
UPDEOB(RCTDA,RCFILE,DUP) ;Upd 361.1 from ERA msg in 344.5 or .4
"RTN","RCDPESR2",58,0)
 ;RCTDA = ien ERA msg in 344.5 or ;subfile in 344.4
"RTN","RCDPESR2",59,0)
 ;RCFILE = 4 file 344.4, 5 if 344.5
"RTN","RCDPESR2",60,0)
 ;DUP = msg # if dup msg, but not same # or -1 if same msg #
"RTN","RCDPESR2",61,0)
 ;Returned for each bill in ERA:
"RTN","RCDPESR2",62,0)
 ;^TMP($J,"RCDPEOB",n)=Bill ien^AR bill#^SrvDt
"RTN","RCDPESR2",63,0)
 ;^TMP($J,"RCDPEOB",n,"EOB")=EOB ien^amt pd^ins co ptr^rev flg^EEOB pn^amtbld^^^^BPNPI^RNPI^ETQual^LN^FN
"RTN","RCDPESR2",64,0)
 ;^TMP($J,"RCDPEOB","ADJ",x)=adj rec ('02')
"RTN","RCDPESR2",65,0)
 ;Also:
"RTN","RCDPESR2",66,0)
 ;^TMP($J,"RCDPEOB","HDR")=hdr rec from txmn
"RTN","RCDPESR2",67,0)
 ;^TMP($J,"RCDPEOB","CONTACT")=ERA contact rec ('01')
"RTN","RCDPESR2",68,0)
 ;
"RTN","RCDPESR2",69,0)
 N RCGBL,RC,RC0,RCCT,RCCT1,RCEOB,RCBILL,RCDPBNPI,RCMNUM,RCIFN,RCIB,RCERR,RCSTAR,RCET,RCX,RCXMG,Z,Q,DA,DR,DIE,RCPAYER,RCFILED,RCEOBD,RCNOUPD,REFORM,RCSD,RCERR1,C5
"RTN","RCDPESR2",70,0)
 K ^TMP($J,"RCDP-EOB"),^TMP("RCDPERR-EOB",$J)
"RTN","RCDPESR2",71,0)
 ;
"RTN","RCDPESR2",72,0)
 S RCPAYER="",RCFILED=1,RCNOUPD=0
"RTN","RCDPESR2",73,0)
 I RCFILE=5 D
"RTN","RCDPESR2",74,0)
 .S RCGBL=$NA(^RCY(344.5,RCTDA,2))
"RTN","RCDPESR2",75,0)
 .S RCMNUM=+$G(^RCY(344.5,RCTDA,0)),RCXMG=$P($G(^(0)),U,11)
"RTN","RCDPESR2",76,0)
 .I $G(DUP) S RCNOUPD=$S(DUP>0:+DUP,1:RCXMG)
"RTN","RCDPESR2",77,0)
 .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.5,RCTDA,2,1,0))
"RTN","RCDPESR2",78,0)
 .I $P(^TMP($J,"RCDPEOB","HDR"),U)["XFR",'$P($G(^RCY(344.5,RCTDA,0)),U,14) D
"RTN","RCDPESR2",79,0)
 ..D SENDACK^RCDPESR5(RCTDA,1)
"RTN","RCDPESR2",80,0)
 ..S DR=".14////1",DIE="^RCY(344.5,",DA=RCTDA D ^DIE
"RTN","RCDPESR2",81,0)
 ;
"RTN","RCDPESR2",82,0)
 I RCFILE=4 D
"RTN","RCDPESR2",83,0)
 .S RCGBL=$NA(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1))
"RTN","RCDPESR2",84,0)
 .S RCMNUM=$P($G(^RCY(344.4,+RCTDA,0)),U,12),RCXMG=$P($G(^(0)),U,12)
"RTN","RCDPESR2",85,0)
 .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1,1,0))
"RTN","RCDPESR2",86,0)
 ;
"RTN","RCDPESR2",87,0)
 S RCPAYER=$P($G(^TMP($J,"RCDPEOB","HDR")),U,6)
"RTN","RCDPESR2",88,0)
 S RCDPBNPI=$P($G(^TMP($J,"RCDPEOB","HDR")),U,18)
"RTN","RCDPESR2",89,0)
 ;
"RTN","RCDPESR2",90,0)
 ;srv dates
"RTN","RCDPESR2",91,0)
 S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD
"RTN","RCDPESR2",92,0)
 N CP5 S CP5="",RC=1,C5=0 ;retrofit 264 into 269
"RTN","RCDPESR2",93,0)
 F  S RC=$O(@RCGBL@(RC)) Q:'RC  S RC0=$G(^(RC,0)) D
"RTN","RCDPESR2",94,0)
 .I RC0<5 Q
"RTN","RCDPESR2",95,0)
 .I +RC0=5 S C5=RC,CP5=$P(RC0,U,2) Q  ;retrofit 264 into 269
"RTN","RCDPESR2",96,0)
 .I +RC0=40,CP5?1.7N,C5,'$D(@RCSD@(C5)) S @RCSD@(C5)=$P(RC0,U,19) ;serv date
"RTN","RCDPESR2",97,0)
 ;
"RTN","RCDPESR2",98,0)
 S RC=1,(RCCT,RCCT1,RCX,REFORM)=0,RCBILL=""
"RTN","RCDPESR2",99,0)
 S RCERR1=$NA(^TMP("RCERR1",$J)) K @RCERR1
"RTN","RCDPESR2",100,0)
 F  S RC=$O(@RCGBL@(RC)) Q:'RC  S RC0=$G(^(RC,0)) D
"RTN","RCDPESR2",101,0)
 .I RCFILE=5,+RC0=1 D  Q
"RTN","RCDPESR2",102,0)
 ..S ^TMP($J,"RCDPEOB","CONTACT")=RC0
"RTN","RCDPESR2",103,0)
 .;
"RTN","RCDPESR2",104,0)
 .I RCFILE=5,+RC0=2 D  Q
"RTN","RCDPESR2",105,0)
 ..S RCX=RCX+1,^TMP($J,"RCDPEOB","ADJ",RCX)=RC0
"RTN","RCDPESR2",106,0)
 .I RCFILE=5,+RC0=3 D  Q  ; Adding logic for line type 03,Patch 269,DWA
"RTN","RCDPESR2",107,0)
 ..S $P(^TMP($J,"RCDPEOB","ADJ",RCX),U,5)=$P(RC0,U,2)
"RTN","RCDPESR2",108,0)
 .;
"RTN","RCDPESR2",109,0)
 .I +RC0=5 S RCCT=RCCT+1,RCCT1=0 D
"RTN","RCDPESR2",110,0)
 ..S REFORM=0
"RTN","RCDPESR2",111,0)
 ..S Z=$$BILL^RCDPESR1($P(RC0,U,2),$G(@RCSD@(RC)),.RCIB)
"RTN","RCDPESR2",112,0)
 ..I Z S RCBILL=$P($G(^PRCA(430,Z,0)),U) I RCBILL'="",RCBILL'=$P(RC0,U,2) S REFORM=1,$P(RC0,U,2)=RCBILL
"RTN","RCDPESR2",113,0)
 ..S RCBILL=$P(RC0,U,2)
"RTN","RCDPESR2",114,0)
 ..S Z=$S(Z>0:$S($G(RCIB):Z,1:-1),1:-1)
"RTN","RCDPESR2",115,0)
 ..S ^TMP($J,"RCDP-EOB",RCCT,0)=Z_U_RCBILL_U_$G(@RCSD@(RC))
"RTN","RCDPESR2",116,0)
 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,5)=$P(RC0,U,3)_","_$P(RC0,U,4)_" "_$P(RC0,U,5) ;Save pt nm
"RTN","RCDPESR2",117,0)
 ..I Z>0 S Q=+$P($G(^PRCA(430,Z,0)),U,9) I $P($G(^RCD(340,Q,0)),U)["DIC(36," S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,3)=+^RCD(340,Q,0) ;Save ins co
"RTN","RCDPESR2",118,0)
 .;
"RTN","RCDPESR2",119,0)
 .I +RC0>5,REFORM S $P(RC0,U,2)=RCBILL ;
"RTN","RCDPESR2",120,0)
 .I +RC0=10 D  ;Save amt pd/billed, rev flg
"RTN","RCDPESR2",121,0)
 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2)=$S(+$P(RC0,U,11):$J($P(RC0,U,11)/100,"",2),1:0),$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,6)=$J($P(RC0,U,11),"",2)
"RTN","RCDPESR2",122,0)
 ..I $P(RC0,U,6)="Y"!($P(RC0,U,7)=22) S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,4)=1
"RTN","RCDPESR2",123,0)
 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,16,19)
"RTN","RCDPESR2",124,0)
 .I +RC0=11 D  ; Save Rendering Provider information from new style message
"RTN","RCDPESR2",125,0)
 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,3,6)
"RTN","RCDPESR2",126,0)
 ..; End save of Rendering Provider
"RTN","RCDPESR2",127,0)
 .I RCBILL=$P(RC0,U,2) S RCCT1=RCCT1+1,^TMP($J,"RCDP-EOB",RCCT,RCCT1,0)=RC0
"RTN","RCDPESR2",128,0)
 ;
"RTN","RCDPESR2",129,0)
 S RCSTAR=$TR($J("",15)," ","*"),RCET=RCSTAR_"ERROR/WARNING EEOB DETAIL SEQ #"
"RTN","RCDPESR2",130,0)
 S RCCT=0 F  S RCCT=$O(^TMP($J,"RCDP-EOB",RCCT)) Q:'RCCT  S RCIFN=+$G(^(RCCT,0)),RCBILL=$P($G(^(0)),U,2),^TMP($J,"RCDPEOB",RCCT)=$G(^TMP($J,"RCDP-EOB",RCCT,0)) D
"RTN","RCDPESR2",131,0)
 .S RCEOB=-1,RCEOBD=""
"RTN","RCDPESR2",132,0)
 .I $S(RCIFN>0:$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCIFN,0)),U,8),0),U,3)'=102,RCIFN'>0&($G(DUP)'>0):1,1:0) D
"RTN","RCDPESR2",133,0)
 ..S @RCERR1@(RCCT)=" ",@RCERR1@(RCCT,1)=RCET_RCCT_RCSTAR
"RTN","RCDPESR2",134,0)
 ..S @RCERR1@(RCCT,2)="Bill "_RCBILL_" is"_$S(RCIFN>0:" not in an ACTIVE status in your A/R",1:"n't valid/wasn't found so its detail wasn't stored in IB")
"RTN","RCDPESR2",135,0)
 ..S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2)
"RTN","RCDPESR2",136,0)
 ..S @RCERR1@(RCCT,3)="  The reported amount paid on this bill was: "_$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2)
"RTN","RCDPESR2",137,0)
 ..I RCIFN'>0 D
"RTN","RCDPESR2",138,0)
 ...S @RCERR1@(RCCT,4)="  If the bill is not for your site, it must be transferred to the"
"RTN","RCDPESR2",139,0)
 ...S @RCERR1@(RCCT,5)="   correct site and manually adjusted in your AR."
"RTN","RCDPESR2",140,0)
 ...S @RCERR1@(RCCT,6)="  You can perform this transfer using EDI Lockbox ERA/EEOB exception process."
"RTN","RCDPESR2",141,0)
 ...S @RCERR1@(RCCT,7)=" "
"RTN","RCDPESR2",142,0)
 ..D DISP1^RCDPESR5(RCCT,1)
"RTN","RCDPESR2",143,0)
 ..S Q=0 F  S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q  S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0))
"RTN","RCDPESR2",144,0)
 ..S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT)
"RTN","RCDPESR2",145,0)
 ..I RCFILE=5 D  ;Store err if trans-in failed
"RTN","RCDPESR2",146,0)
 ...N RCE,RC,DIE,X,Y,DA,DR
"RTN","RCDPESR2",147,0)
 ...S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$G(@RCERR1@(RCCT,"*"))
"RTN","RCDPESR2",148,0)
 ...S RCE(2)=" ",RCFILED=0
"RTN","RCDPESR2",149,0)
 ...D WP^DIE(344.5,RCTDA_",",5,"A","RCE")
"RTN","RCDPESR2",150,0)
 .I RCIFN>0 D
"RTN","RCDPESR2",151,0)
 ..N RCDUPEOB,RCALLDUP
"RTN","RCDPESR2",152,0)
 ..;Chk rec exists
"RTN","RCDPESR2",153,0)
 ..S RCDUPEOB=0
"RTN","RCDPESR2",154,0)
 ..S RCEOB=$$DUP^RCDPESR3(RCMNUM,RCIFN,$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,2),$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,6)) ;Same msg for update?
"RTN","RCDPESR2",155,0)
 ..I RCEOB,$P(RCEOB,U,2) S RCEOB=0  ;If chksum exists, let below check it
"RTN","RCDPESR2",156,0)
 ..S ^TMP($J,"RCDP-EOB",RCCT,.5,0)="835ERA" ;Needed - checksum
"RTN","RCDPESR2",157,0)
 ..S RCALLDUP=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"","_RCCT_")",RCIFN)
"RTN","RCDPESR2",158,0)
 ..I $S(RCALLDUP:1,RCEOB:$G(DUP)'>0,1:0) D
"RTN","RCDPESR2",159,0)
 ...S RCDUPEOB=1
"RTN","RCDPESR2",160,0)
 ...D DUPREC^RCDPESR6(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,.RCDUPEOB)
"RTN","RCDPESR2",161,0)
 ...S:RCALLDUP RCEOBD=RCALLDUP
"RTN","RCDPESR2",162,0)
 ..;Add stub to 361.1
"RTN","RCDPESR2",163,0)
 ..I 'RCDUPEOB S RCEOB=+$$ADD3611^IBCEOB(RCMNUM,"","",RCIFN,1,"^TMP("_$J_",""RCDP-EOB"","_RCCT_")") ;IA 4042
"RTN","RCDPESR2",164,0)
 ..K ^TMP($J,"RCDP-EOB",RCCT,.5,0)
"RTN","RCDPESR2",165,0)
 ..I RCEOB<0 D:$G(DUP)'>0  Q
"RTN","RCDPESR2",166,0)
 ...S @RCERR1@(RCCT)=" ",^(RCCT,1)=RCET_RCCT_RCSTAR,RCFILED=0
"RTN","RCDPESR2",167,0)
 ...S @RCERR1@(RCCT,2)="Error - EEOB detail not added to IB for bill "_RCBILL,$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=""
"RTN","RCDPESR2",168,0)
 ...S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2)
"RTN","RCDPESR2",169,0)
 ...D DISP1^RCDPESR5(RCCT,1)
"RTN","RCDPESR2",170,0)
 ...S Q=0 F  S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q  S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0))
"RTN","RCDPESR2",171,0)
 ...S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT)
"RTN","RCDPESR2",172,0)
 ..;Upd 361.1, needs ^TMP($J,"RCDPEOB","HDR" and $J,"RCDP-EOB"
"RTN","RCDPESR2",173,0)
 ..I RCDUPEOB'<0 S RCNOUPD=0 D UPD3611^IBCEOB(RCEOB,RCCT,1)
"RTN","RCDPESR2",174,0)
 ..;errors in ^TMP("RCDPERR-EOB",$J
"RTN","RCDPESR2",175,0)
 ..I $O(^TMP("RCDPERR-EOB",$J,0)) D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB")
"RTN","RCDPESR2",176,0)
 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=$S('$G(RCEOBD):RCEOB,1:RCEOBD)
"RTN","RCDPESR2",177,0)
 .K ^TMP("RCDPERR-EOB",$J)
"RTN","RCDPESR2",178,0)
 ;
"RTN","RCDPESR2",179,0)
 I RCNOUPD D DUPERA^RCDPESR3($G(DUP),RCNOUPD)
"RTN","RCDPESR2",180,0)
 I $O(@RCERR1@("")) D BULLS^RCDPESR3(RCFILE,RCTDA,$S(RCNOUPD:RCNOUPD,1:$G(DUP)),$G(RCXMG))
"RTN","RCDPESR2",181,0)
 K ^TMP("RCDPERR-EOB",$J),^TMP($J,"RCDP-EOB"),@RCERR1,@RCSD
"RTN","RCDPESR2",182,0)
 D CLEAN^DILF
"RTN","RCDPESR2",183,0)
 Q
"RTN","RCDPESR3")
0^8^B60020580
"RTN","RCDPESR3",1,0)
RCDPESR3 ;ALB/TMK/PJH - Server auto-update utilities - EDI Lockbox ; 10/14/10 5:01pm
"RTN","RCDPESR3",2,0)
 ;;4.5;Accounts Receivable;**173,214,208,255,269**;Mar 20, 1995;Build 113
"RTN","RCDPESR3",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPESR3",4,0)
 Q
"RTN","RCDPESR3",5,0)
 ;
"RTN","RCDPESR3",6,0)
EFTIN(RCTXN,RCD,XMZ,RCGBL,RCEFLG) ; Adds a new EFT record to AR file 344.3
"RTN","RCDPESR3",7,0)
 ;  from Lockbox EFT msg
"RTN","RCDPESR3",8,0)
 ; RCTXN = the data on the header record of the message text
"RTN","RCDPESR3",9,0)
 ; RCD = array containing formatted mail message header data
"RTN","RCDPESR3",10,0)
 ; XMZ = the mail message number
"RTN","RCDPESR3",11,0)
 ; RCGBL = the name of the array or global where the message is stored
"RTN","RCDPESR3",12,0)
 ; RCEFLG = error flag returned if passed by reference
"RTN","RCDPESR3",13,0)
 ;
"RTN","RCDPESR3",14,0)
 N CT,RC,RC1,RCLAST,RCEFT,RCTDA,RCERR,RCTYP1,DA,DIK,RCZ,Z,Z0,DLAYGO
"RTN","RCDPESR3",15,0)
 ;
"RTN","RCDPESR3",16,0)
 ; Take data out of mail message
"RTN","RCDPESR3",17,0)
 S (RCEFLG,RCLAST)=0,CT=0,RCTYP1="835EFT"
"RTN","RCDPESR3",18,0)
 F  X XMREC Q:XMER<0  D  Q:RCLAST
"RTN","RCDPESR3",19,0)
 . I +XMRG=99,$P(XMRG,U,2)="$" S RCLAST=1 Q
"RTN","RCDPESR3",20,0)
 . S:XMRG'="" CT=CT+1,@RCGBL@(2,"D",CT)=XMRG
"RTN","RCDPESR3",21,0)
 ;
"RTN","RCDPESR3",22,0)
 I 'RCLAST,'$G(RCERR) K @RCGBL S RCERR=2 ;No $ as last character of msg
"RTN","RCDPESR3",23,0)
 ;
"RTN","RCDPESR3",24,0)
 I $G(RCERR)>0 D  G EFTQ
"RTN","RCDPESR3",25,0)
 . D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,.RCERR)
"RTN","RCDPESR3",26,0)
 . S RCEFLG=1
"RTN","RCDPESR3",27,0)
 ;
"RTN","RCDPESR3",28,0)
 ; Add top-level entry to file 344.3
"RTN","RCDPESR3",29,0)
 S RCEFT=$$ADDEFT(RCTXN,XMZ,RCGBL,.RCERR)
"RTN","RCDPESR3",30,0)
 ;
"RTN","RCDPESR3",31,0)
 I $G(RCERR) D  G EFTQ ; 'BAD' EFT's
"RTN","RCDPESR3",32,0)
 . D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,.RCERR)
"RTN","RCDPESR3",33,0)
 . S RCEFLG=1
"RTN","RCDPESR3",34,0)
 ;
"RTN","RCDPESR3",35,0)
 G:'RCEFT EFTQ
"RTN","RCDPESR3",36,0)
 ;
"RTN","RCDPESR3",37,0)
 ; Add the detail data to file 344.31 for this EFT record
"RTN","RCDPESR3",38,0)
 S Z=0 F  S Z=$O(^RCY(344.31,"B",RCEFT,Z)) Q:'Z  S DA=Z,DIK="^RCY(344.31," D ^DIK ; Delete any detail data already there
"RTN","RCDPESR3",39,0)
 ;
"RTN","RCDPESR3",40,0)
 S (RC,RC1,RCZ)=0
"RTN","RCDPESR3",41,0)
 F  S RCZ=$O(@RCGBL@(2,"D",RCZ)) Q:'RCZ  S Z0=$G(^(RCZ)) I Z0'="" D  Q:$G(RCERR)
"RTN","RCDPESR3",42,0)
 . I $P(Z0,U)="01" D  ; Each payer's data
"RTN","RCDPESR3",43,0)
 .. N DA,DIE,DR,X,Y,DO,DD,DIC
"RTN","RCDPESR3",44,0)
 .. S X=RCEFT
"RTN","RCDPESR3",45,0)
 .. S DIC("DR")=".11////0;.04////"_$P(Z0,U,2)_";.08////0"_$S($P(Z0,U,5)'="":";.02////"_$P(Z0,U,5),1:"")_$S($P(Z0,U,6)'="":";.03////"_$P(Z0,U,6),1:"")_";.07////"_$J(+$P(Z0,U,4)/100,"",2)_";.06////"_$S($P(Z0,U,8)'="":1,1:0)
"RTN","RCDPESR3",46,0)
 .. S DIC("DR")=DIC("DR")_";.12///"_$$FDT^RCDPESR9($P(Z0,U,3))_";.13////"_DT_$S($P(Z0,U,7)'="":";.05////"_$P(Z0,U,7),1:"")_$S($P(Z0,U,9)'="":";.15////"_$P(Z0,U,9),1:"")
"RTN","RCDPESR3",47,0)
 .. ;
"RTN","RCDPESR3",48,0)
 .. I $P(Z0,U,8)'="" D  ; tax id error
"RTN","RCDPESR3",49,0)
 ... D TAXERR^RCDPESR1("EFT",$P(Z0,U,5)_"  Payer ID: "_$P(RCTXN,U,6),$P(RCTXN,U,7),$P(RCTXN,U,8)) ; Send bad tax id bulletin
"RTN","RCDPESR3",50,0)
 .. ;
"RTN","RCDPESR3",51,0)
 .. S DIC(0)="L",DIC="^RCY(344.31,",DLAYGO=344.31 D FILE^DICN K DIC,DLAYGO,DO,DD
"RTN","RCDPESR3",52,0)
 .. I Y'>0 D  ; Error filing data
"RTN","RCDPESR3",53,0)
 ... S DIK="^RCY(344.3,",DA=RCEFT D ^DIK
"RTN","RCDPESR3",54,0)
 ... S Z=0 F  S Z=$O(^RCY(344.31,"B",RCEFT,Z)) Q:'Z  S DIK="^RCY(344.31,",DA=Z D ^DIK
"RTN","RCDPESR3",55,0)
 ... S RCEFLG=1,RCERR=3
"RTN","RCDPESR3",56,0)
 ... D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYP1,RCERR)
"RTN","RCDPESR3",57,0)
 ;
"RTN","RCDPESR3",58,0)
 I '$G(RCEFLG) D
"RTN","RCDPESR3",59,0)
 . S DIE="^RCY(344.3,",DA=RCEFT,DR=".09////"_$$CHKSUM(RCEFT) D ^DIE
"RTN","RCDPESR3",60,0)
 ;
"RTN","RCDPESR3",61,0)
EFTQ ;
"RTN","RCDPESR3",62,0)
 D CLEAN^DILF
"RTN","RCDPESR3",63,0)
 Q
"RTN","RCDPESR3",64,0)
 ;
"RTN","RCDPESR3",65,0)
ADDEFT(RCTXN,RCXMZ,RCGBL,RCERR) ; File EFT TOTAL record in file 344.3
"RTN","RCDPESR3",66,0)
 ; RCTXN = the data on the header record of the message text
"RTN","RCDPESR3",67,0)
 ; RCXMZ = the mail message number
"RTN","RCDPESR3",68,0)
 ; RCGBL = the name of the array or global where the message is stored
"RTN","RCDPESR3",69,0)
 ; Function returns the ien of the total record found/added
"RTN","RCDPESR3",70,0)
 ;    and also returns RCERR if passed by reference
"RTN","RCDPESR3",71,0)
 ;
"RTN","RCDPESR3",72,0)
 N RCTDA,RCRCPT,RCDUP,RCHAC,Z,Z0
"RTN","RCDPESR3",73,0)
 S (RCERR,RCTDA)=""
"RTN","RCDPESR3",74,0)
 ;
"RTN","RCDPESR3",75,0)
 I $E($P(RCTXN,U,6),1,3)'="469",$E($P(RCTXN,U,6),1,3)'="569",$E($P(RCTXN,U,6),1,3)'="HAC" D  G ADDQ ; Invalid EFT deposit number
"RTN","RCDPESR3",76,0)
 . N RCDXM,RCCT
"RTN","RCDPESR3",77,0)
 . S RCCT=0
"RTN","RCDPESR3",78,0)
 . S RCCT=RCCT+1,RCDXM(RCCT)="This EFT has an invalid deposit number for EDI Lockbox and has been rejected.",RCCT=RCCT+1,RCDXM(RCCT)=" "
"RTN","RCDPESR3",79,0)
 . S RCCT=RCCT+1,RCDXM(RCCT)=" ",RCCT=RCCT+1,RCDXM(RCCT)="Here are the contents of this message:"
"RTN","RCDPESR3",80,0)
 . D DISP("EDI LBOX INVALID EFT DEPOSIT #",RCCT,.RCDXM,RCXMZ)
"RTN","RCDPESR3",81,0)
 ;
"RTN","RCDPESR3",82,0)
 ; Make sure it's not already there or if so, it has no ptr to a deposit
"RTN","RCDPESR3",83,0)
 ; or if a deposit exists, that the deposit does not yet have a receipt
"RTN","RCDPESR3",84,0)
 S RCDUP=0,RCHAC=$E($P(RCTXN,U,6),1,3)="HAC" ; This is a HAC deposit
"RTN","RCDPESR3",85,0)
 I $P(RCTXN,U,6)'="" D
"RTN","RCDPESR3",86,0)
 . ;Format Deposit Date as FM date
"RTN","RCDPESR3",87,0)
 . N RCDDAT
"RTN","RCDPESR3",88,0)
 . S X=$$FDT^RCDPESR9($P(RCTXN,U,7))
"RTN","RCDPESR3",89,0)
 . S RCDDAT=0,%DT="X" D ^%DT S:Y>0 RCDDAT=Y
"RTN","RCDPESR3",90,0)
 . S Z=0 ; Lookup deposit by deposit #
"RTN","RCDPESR3",91,0)
 . F  S Z=$O(^RCY(344.3,"ADEP",RCDDAT,$P(RCTXN,U,6),Z)) Q:'Z  S Z0=$G(^RCY(344.3,Z,0)) S:'$P(Z0,U,3) RCTDA=Z Q:RCTDA  D  Q
"RTN","RCDPESR3",92,0)
 .. ; Deposit found - find receipt
"RTN","RCDPESR3",93,0)
 .. I $O(^RCY(344,"AD",$P(Z0,U,3),0)) S RCDUP=Z Q
"RTN","RCDPESR3",94,0)
 .. S RCTDA=Z
"RTN","RCDPESR3",95,0)
 ;
"RTN","RCDPESR3",96,0)
 I RCDUP D  ; Send bulletin that duplicate EFT received
"RTN","RCDPESR3",97,0)
 . N RCDXM,RCCT
"RTN","RCDPESR3",98,0)
 . S RCCT=0
"RTN","RCDPESR3",99,0)
 . S RCCT=RCCT+1,RCDXM(RCCT)="This EFT appears to be a duplicate transaction and has been rejected.",RCCT=RCCT+1,RCDXM(RCCT)=" "
"RTN","RCDPESR3",100,0)
 . S RCCT=RCCT+1,RCDXM(RCCT)=" ",RCCT=RCCT+1,RCDXM(RCCT)="Here are the contents of this message:"
"RTN","RCDPESR3",101,0)
 . D DISP("EDI LBOX DUP EFT DEPOSIT RECEIVED",RCCT,.RCDXM,RCXMZ)
"RTN","RCDPESR3",102,0)
 ;
"RTN","RCDPESR3",103,0)
 I 'RCDUP D  ; Add or update the record
"RTN","RCDPESR3",104,0)
 . N RCX,RCDTTM,DIE,DIC,DLAYGO,DD,DA,DO,DR,X,Y,%DT,DINUM
"RTN","RCDPESR3",105,0)
 . ;
"RTN","RCDPESR3",106,0)
 . S X=$$FDT^RCDPESR9($P(RCTXN,U,3))_"@"_$P(RCTXN,U,4)
"RTN","RCDPESR3",107,0)
 . S %DT="XTS" D ^%DT S:Y>0 RCDTTM=Y
"RTN","RCDPESR3",108,0)
 . ;
"RTN","RCDPESR3",109,0)
 . S DIC("DR")=""
"RTN","RCDPESR3",110,0)
 . S DIC("DR")=$S(RCDTTM'="":".02////"_RCDTTM,1:"")
"RTN","RCDPESR3",111,0)
 . S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_".06////"_$P(RCTXN,U,6)_";.07///"_$$FDT^RCDPESR9($P(RCTXN,U,7))
"RTN","RCDPESR3",112,0)
 . S DIC("DR")=DIC("DR")_";.08////"_$$ZERO^RCDPESR9($P(RCTXN,U,8),1)_";.13////"_$$NOW^XLFDT()_";.05////"_RCXMZ_";.14////0;.12////0"
"RTN","RCDPESR3",113,0)
 . ;
"RTN","RCDPESR3",114,0)
 . I RCTDA D  ; Overwrite the data already there
"RTN","RCDPESR3",115,0)
 .. L +^RCY(344.3,RCTDA):1 I '$T S RCTDA=-1 Q
"RTN","RCDPESR3",116,0)
 .. S DIE="^RCY(344.3,",DA=RCTDA,DR=DIC("DR") K DIC D ^DIE
"RTN","RCDPESR3",117,0)
 .. L -^RCY(344.3,RCTDA)
"RTN","RCDPESR3",118,0)
 . ;
"RTN","RCDPESR3",119,0)
 . I 'RCTDA D
"RTN","RCDPESR3",120,0)
 .. S RCX=+$O(^RCY(344.3," "),-1)
"RTN","RCDPESR3",121,0)
 .. F RCX=RCX+1:1 I '$D(^RCY(344.3,RCX,0)) L +^RCY(344.3,RCX,0):1 I $T S X=RCX Q
"RTN","RCDPESR3",122,0)
 .. S DIC(0)="L",DIC="^RCY(344.3,",DLAYGO=344.3,DINUM=RCX
"RTN","RCDPESR3",123,0)
 .. D FILE^DICN K DO,DD,DLAYGO,DIC,DINUM
"RTN","RCDPESR3",124,0)
 .. L -^RCY(344.3,RCX,0)
"RTN","RCDPESR3",125,0)
 .. S RCTDA=$S(Y<0:"",1:+Y)
"RTN","RCDPESR3",126,0)
 . ;
"RTN","RCDPESR3",127,0)
 . I 'RCTDA S RCERR=3 ; Error in add of EFT record to file 344.3 
"RTN","RCDPESR3",128,0)
 ;
"RTN","RCDPESR3",129,0)
ADDQ Q $S(RCTDA>0:RCTDA,1:"")
"RTN","RCDPESR3",130,0)
 ;
"RTN","RCDPESR3",131,0)
CHKSUM(RCTDA) ; Calc the checksum for EFT record stored in RCTDA in 344.3
"RTN","RCDPESR3",132,0)
 ;
"RTN","RCDPESR3",133,0)
 N RCDPCSUM,RCDPDATA,X,Y,Z,Z0
"RTN","RCDPESR3",134,0)
 ;
"RTN","RCDPESR3",135,0)
 S (RCDPCSUM,X)=0,Z0=$G(^RCY(344.3,RCTDA,0))
"RTN","RCDPESR3",136,0)
 ; Use pcs 1-8, leaving out piece 3
"RTN","RCDPESR3",137,0)
 S RCDPDATA=$P(Z0,U,1,8),$P(RCDPDATA,U,3)=""
"RTN","RCDPESR3",138,0)
 S X=RCDPCSUM_RCDPDATA X $S($G(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""") S RCDPCSUM=Y
"RTN","RCDPESR3",139,0)
 ; Use detail iens and pieces 3,4,7 to complete the checksum
"RTN","RCDPESR3",140,0)
 S Z=0 F  S Z=$O(^RCY(344.31,"B",RCTDA,Z)) Q:'Z  S Z0=$G(^RCY(344.31,Z,0)),RCDPDATA=Z_U_$P(Z0,U,3,4)_U_$P(Z0,U,7),X=RCDPCSUM_RCDPDATA X $S($G(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""") S RCDPCSUM=Y
"RTN","RCDPESR3",141,0)
 Q RCDPCSUM
"RTN","RCDPESR3",142,0)
 ;
"RTN","RCDPESR3",143,0)
DISP(RCTIT,RCCT,RCDXM,RCXMZ) ; Sends bulletin with formatted data from message
"RTN","RCDPESR3",144,0)
 ; RCTIT = title of bulletin
"RTN","RCDPESR3",145,0)
 ; RCCT = # of lines previously populated
"RTN","RCDPESR3",146,0)
 ; RCXDM = array containing the text of the bulletin
"RTN","RCDPESR3",147,0)
 N RC,Z
"RTN","RCDPESR3",148,0)
 K ^TMP("RC1",$J),^TMP("RC",$J),^TMP("RCTEMP",$J)
"RTN","RCDPESR3",149,0)
 S RC=1,^TMP("RCTEMP",$J,RC)=$G(^TMP("RCMSGH",$J,0))
"RTN","RCDPESR3",150,0)
 S Z=0 F  S Z=$O(^TMP("RCMSG",$J,2,"D",Z)) Q:'Z  S RC=RC+1,^TMP("RCTEMP",$J,RC)=$G(^TMP("RCMSG",$J,2,"D",Z))
"RTN","RCDPESR3",151,0)
 D DISP^RCDPESR8("^TMP(""RCTEMP"",$J)","^TMP(""RC1"",$J)",1,"^TMP(""RC"",$J)",75)
"RTN","RCDPESR3",152,0)
 S Z=0 F  S Z=$O(^TMP("RC",$J,Z)) Q:'Z  S RCCT=RCCT+1,RCDXM(RCCT)=$G(^TMP("RC",$J,Z))
"RTN","RCDPESR3",153,0)
 D BULLEFT^RCDPESR0("",RCXMZ,RCTIT,.RCDXM)
"RTN","RCDPESR3",154,0)
 K ^TMP("RC1",$J),^TMP("RC",$J),^TMP("RCTEMP",$J)
"RTN","RCDPESR3",155,0)
 Q
"RTN","RCDPESR3",156,0)
 ;
"RTN","RCDPESR3",157,0)
DUP(RCM,RCIFN,RCAMT,RCAMT1) ; EOB in mail message already stored in 361.1?
"RTN","RCDPESR3",158,0)
 ; RCM = msg # EOB was received in
"RTN","RCDPESR3",159,0)
 ; RCIFN = bill ien
"RTN","RCDPESR3",160,0)
 ; RCAMT = amt pd
"RTN","RCDPESR3",161,0)
 ; RCAMT1 = amt reported billed
"RTN","RCDPESR3",162,0)
 ; Returns 0 if none found, entry #^message checksum on file if found
"RTN","RCDPESR3",163,0)
 N Z,DUP,DUP1
"RTN","RCDPESR3",164,0)
 S (DUP,DUP1,Z)=0
"RTN","RCDPESR3",165,0)
 F  S Z=$O(^IBM(361.1,"AC",RCM,Z)) Q:'Z  I +$G(^IBM(361.1,Z,0))=RCIFN D  Q:DUP
"RTN","RCDPESR3",166,0)
 . I '$P($G(^IBM(361.1,Z,100)),U,5) S DUP1=Z Q  ; Partially filed before
"RTN","RCDPESR3",167,0)
 . I +$G(^IBM(361.1,Z,1))=+RCAMT,+$P($G(^IBM(361.1,1,Z,2)),U,4)=+RCAMT1 S DUP=Z_U_+$P($G(^IBM(361.1,Z,100)),U,5) Q
"RTN","RCDPESR3",168,0)
 I 'DUP,DUP1 S DUP=DUP1_"^0"
"RTN","RCDPESR3",169,0)
 Q DUP
"RTN","RCDPESR3",170,0)
 ;
"RTN","RCDPESR3",171,0)
DUPERA(DUP,RCNOUPD) ; Msg for duplicate ERA
"RTN","RCDPESR3",172,0)
 ; RCNOUPD = # of message with duplicate data
"RTN","RCDPESR3",173,0)
 ; DUP = flag = -1 if duplicate message received in same mail msg #
"RTN","RCDPESR3",174,0)
 K ^TMP("RCERR1",$J)
"RTN","RCDPESR3",175,0)
 S ^TMP("RCERR1",$J,1)=$S(DUP>0:"This an exact duplicate of an ERA received previously in mail msg "_RCNOUPD,1:"This ERA message was already fully processed - message was ignored")
"RTN","RCDPESR3",176,0)
 Q
"RTN","RCDPESR3",177,0)
 ;
"RTN","RCDPESR3",178,0)
BULLS(RCFILE,RCTDA,DUP,RCXMSG) ; Error bulletins for ERA
"RTN","RCDPESR3",179,0)
 I RCFILE=5 D BULL1^RCDPESR5(RCTDA,"^TMP(""RCERR1"",$J)",$S($G(DUP)>0:$G(DUP),1:""))
"RTN","RCDPESR3",180,0)
 I RCFILE=4 D BULL2^RCDPESR5(RCTDA,"^TMP(""RCERR1"",$J)",RCXMSG)
"RTN","RCDPESR3",181,0)
 Q
"RTN","RCDPESR3",182,0)
 ;
"RTN","RCDPESR3",183,0)
ADJERR(RCERR) ; Set up adj error text in RCERR(n) - pass by ref
"RTN","RCDPESR3",184,0)
 ; Function returns # of lines for error text
"RTN","RCDPESR3",185,0)
 S RCERR(1)="At least 1 adjustment transaction has been found on this ERA.  Before the",RCERR(2)="   receipt for this ERA can be processed, the appropriate adjustments",RCERR(3)="   must be made using the EEOB Worklist",RCERR(4)=" "
"RTN","RCDPESR3",186,0)
 Q 4
"RTN","RCDPESR3",187,0)
 ;
"RTN","RCDPESR4")
0^16^B76222786
"RTN","RCDPESR4",1,0)
RCDPESR4 ;ALB/TMK/PJH - Server interface 835ERA processing ; 8/23/10 6:19pm
"RTN","RCDPESR4",2,0)
 ;;4.5;Accounts Receivable;**173,216,208,230,269**;Mar 20, 1995;Build 113
"RTN","RCDPESR4",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPESR4",4,0)
 ;
"RTN","RCDPESR4",5,0)
ERAEOBIN(RCTXN,RCD,RCGBL,RCEFLG) ; Store/process 835ERA or 835XFR
"RTN","RCDPESR4",6,0)
 ;  transaction coming into the site
"RTN","RCDPESR4",7,0)
 ; RCTXN = data on the hdr record of the msg text
"RTN","RCDPESR4",8,0)
 ; RCD = array with formatted hdr data
"RTN","RCDPESR4",9,0)
 ; RCGBL = name of the array or global where the msg is stored
"RTN","RCDPESR4",10,0)
 ; RCEFLG = error flag returned if passed by REF
"RTN","RCDPESR4",11,0)
 ;
"RTN","RCDPESR4",12,0)
 N RCLAST,RCBILL,RCTDA,RCMSG,RCERR
"RTN","RCDPESR4",13,0)
 S (RCTDA,RCEFLG)=0
"RTN","RCDPESR4",14,0)
 ;
"RTN","RCDPESR4",15,0)
 ;
"RTN","RCDPESR4",16,0)
 L +^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13))
"RTN","RCDPESR4",17,0)
 S RCMSG=$$EXTERA(RCTXN,.RCLAST,.RCBILL) ; Extract from mail msg
"RTN","RCDPESR4",18,0)
 ;
"RTN","RCDPESR4",19,0)
 ; If full msg received (99^$ record exists), file it
"RTN","RCDPESR4",20,0)
 I 'RCLAST,'$G(RCERR) D  ;No $ as last character of msg
"RTN","RCDPESR4",21,0)
 . S RCERR=2
"RTN","RCDPESR4",22,0)
 ;
"RTN","RCDPESR4",23,0)
 I RCLAST S RCTDA=+$$ADD(RCGBL,RCD("MSG#"),RCMSG,.RCBILL,.RCERR,.RCD)
"RTN","RCDPESR4",24,0)
 ;
"RTN","RCDPESR4",25,0)
 I $G(RCERR)>0 D
"RTN","RCDPESR4",26,0)
 . D ERRUPD^RCDPESR1(RCGBL,.RCD,$P(RCTXN,U),.RCERR)
"RTN","RCDPESR4",27,0)
 . I RCTDA D  ; Store exception msgs in file 344.5
"RTN","RCDPESR4",28,0)
 .. N A,C,Z
"RTN","RCDPESR4",29,0)
 .. S C=1,A(1)="Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
"RTN","RCDPESR4",30,0)
 .. I $G(^TMP("RCERR",$J,"TEXT"))'="" S C=C+1,A(C)=^TMP("RCERR",$J,"TEXT"),C=C+1,A(C)=" "
"RTN","RCDPESR4",31,0)
 .. S Z=0 F  S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z  S C=C+1,A(C)=^(Z)
"RTN","RCDPESR4",32,0)
 .. I $O(A(0)) D WP^DIE(344.5,RCTDA_",",5,"A","A")
"RTN","RCDPESR4",33,0)
 . S RCEFLG=1
"RTN","RCDPESR4",34,0)
 ;
"RTN","RCDPESR4",35,0)
 L -^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13))
"RTN","RCDPESR4",36,0)
 I $P(RCTXN,U)'["XFR",$P(RCTXN,U,12)'="" D TAXERR^RCDPESR1("ERA",$P(RCTXN,U,6)_"  Payer ID: "_$P(RCTXN,U,7),$P(RCTXN,U,11),$P(RCTXN,U,12)) ; Send bad tax id bulletin
"RTN","RCDPESR4",37,0)
 ;
"RTN","RCDPESR4",38,0)
 Q
"RTN","RCDPESR4",39,0)
 ;
"RTN","RCDPESR4",40,0)
EXTERA(RCTXN,RCLAST,RCBILL) ;Extract 835ERA or 835XFR transaction
"RTN","RCDPESR4",41,0)
 ;INPUT:
"RTN","RCDPESR4",42,0)
 ; RCTXN = data on 835ERA/835XFR hdr record
"RTN","RCDPESR4",43,0)
 ; RCLAST = passed by REF and returned=1 if entire record exists
"RTN","RCDPESR4",44,0)
 ;
"RTN","RCDPESR4",45,0)
 ;OUTPUT:
"RTN","RCDPESR4",46,0)
 ; ^TMP("RCMSG",$J,1,"D",line #)=formatted hdr data
"RTN","RCDPESR4",47,0)
 ; ^TMP("RCMSG",$J,2,"D",line #)=raw msg data
"RTN","RCDPESR4",48,0)
 ;  if passed by ref, RCLAST = 1 if '99' record found
"RTN","RCDPESR4",49,0)
 ;  if passed by ref, RCBILL(AR bill number) is returned
"RTN","RCDPESR4",50,0)
 ;    with a 'list' of bills included in the ERA.  If an
"RTN","RCDPESR4",51,0)
 ;    entry = 1, 3rd party bill was found in file 430.
"RTN","RCDPESR4",52,0)
 ;    If the entry = 2, the 3rd party bill found was not active
"RTN","RCDPESR4",53,0)
 ; Function returns existing ien in file 344.5 for multi part ERAs
"RTN","RCDPESR4",54,0)
 ;
"RTN","RCDPESR4",55,0)
 N CT,CT1,LINE,HCT,RCH,RCMSG,RCREFORM,RCINS,RCSTAT,B,RCSD,C5
"RTN","RCDPESR4",56,0)
 S (HCT,RCH)=0
"RTN","RCDPESR4",57,0)
 ;
"RTN","RCDPESR4",58,0)
 ;
"RTN","RCDPESR4",59,0)
 ; Check if sequence control # already exists or if a new record needed
"RTN","RCDPESR4",60,0)
 S RCMSG=+$O(^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13),0))
"RTN","RCDPESR4",61,0)
 S CT=0
"RTN","RCDPESR4",62,0)
 I 'RCMSG D  ; Build display data for the first sequence only
"RTN","RCDPESR4",63,0)
 . S HCT=HCT+1 S LINE(HCT)="Payer Name: "_$P(RCTXN,U,6)
"RTN","RCDPESR4",64,0)
 . S HCT=HCT+1 S LINE(HCT)="Payer ID: "_$P(RCTXN,U,7)
"RTN","RCDPESR4",65,0)
 . S HCT=HCT+1,LINE(HCT)="Trace #: "_$P(RCTXN,U,8)
"RTN","RCDPESR4",66,0)
 . S HCT=HCT+1,LINE(HCT)="Date Paid: "_$$FDT^RCDPESR9($P(RCTXN,U,9))_"    Total Amt Paid: "_$J($P(RCTXN,U,10)/100,0,2)
"RTN","RCDPESR4",67,0)
 . I $P(RCTXN,U)["XFR",$P(RCTXN,U,19)'="" S HCT=HCT+1,LINE(HCT)="Contact Info: "_$P(RCTXN,U,19)
"RTN","RCDPESR4",68,0)
 . M ^TMP("RCMSG",$J,1,"D")=LINE
"RTN","RCDPESR4",69,0)
 . S CT=CT+1,^TMP("RCMSG",$J,2,"D",CT)=RCTXN
"RTN","RCDPESR4",70,0)
 ;
"RTN","RCDPESR4",71,0)
 S CT1=CT
"RTN","RCDPESR4",72,0)
 S ^TMP("RCMSG",$J,0)=RCTXN
"RTN","RCDPESR4",73,0)
 ;
"RTN","RCDPESR4",74,0)
 S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD ;service dates
"RTN","RCDPESR4",75,0)
 S C5=0
"RTN","RCDPESR4",76,0)
 S RCLAST=0
"RTN","RCDPESR4",77,0)
 F  X XMREC Q:XMER<0  D  Q:RCLAST
"RTN","RCDPESR4",78,0)
 . Q:XMRG=""
"RTN","RCDPESR4",79,0)
 . I +XMRG=99,$P(XMRG,U,2)="$" S RCLAST=1 Q
"RTN","RCDPESR4",80,0)
 . S CT=CT+1
"RTN","RCDPESR4",81,0)
 . I +XMRG=5,$P(XMRG,U,2)'="" S C5=CT
"RTN","RCDPESR4",82,0)
 . I +XMRG=40,$P(XMRG,U,2)?1.7N,C5,$P(XMRG,U,19),'$D(@RCSD@(C5)) S ^(C5)=+$P(XMRG,U,19)
"RTN","RCDPESR4",83,0)
 . S ^TMP("RCMSG",$J,2,"D",CT)=XMRG
"RTN","RCDPESR4",84,0)
 ;
"RTN","RCDPESR4",85,0)
 ; reformat bill# if needed
"RTN","RCDPESR4",86,0)
 S RCREFORM=""
"RTN","RCDPESR4",87,0)
 S CT=CT1
"RTN","RCDPESR4",88,0)
 F  S CT=$O(^TMP("RCMSG",$J,2,"D",CT)) Q:'CT  S XMRG=$G(^(CT)) D
"RTN","RCDPESR4",89,0)
 . Q:XMRG=""
"RTN","RCDPESR4",90,0)
 . I +XMRG=5,$P(XMRG,U,2)'="" D
"RTN","RCDPESR4",91,0)
 .. S RCREFORM="",RCSTAT=1
"RTN","RCDPESR4",92,0)
 .. ; Check if bill is in AR & is a 3rd party bill
"RTN","RCDPESR4",93,0)
 .. S RCBILL=$$BILL^RCDPESR1($P(XMRG,U,2),$G(@RCSD@(CT)),.RCINS)
"RTN","RCDPESR4",94,0)
 .. I '$G(RCINS)!(RCBILL<0) S (RCBILL,RCSTAT)=0
"RTN","RCDPESR4",95,0)
 .. I RCBILL S B=$P($G(^PRCA(430,RCBILL,0)),U) I B'=$P(XMRG,U,2) S $P(XMRG,U,2)=B,RCREFORM=B
"RTN","RCDPESR4",96,0)
 .. I RCBILL,$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCBILL,0)),U,8),0),U,3)'=102 S RCSTAT=2
"RTN","RCDPESR4",97,0)
 .. S RCBILL($P(XMRG,U,2))=RCSTAT
"RTN","RCDPESR4",98,0)
 . I RCREFORM'="",+XMRG>5 S $P(XMRG,U,2)=RCREFORM,^TMP("RCMSG",$J,2,"D",CT)=XMRG
"RTN","RCDPESR4",99,0)
 ;
"RTN","RCDPESR4",100,0)
 K @RCSD
"RTN","RCDPESR4",101,0)
 Q RCMSG
"RTN","RCDPESR4",102,0)
 ;
"RTN","RCDPESR4",103,0)
ADD(RCGBL,RCDMSG,RCMSG,RCBILL,RCERR,RCD) ; Add msg(s) in @RCGBL to
"RTN","RCDPESR4",104,0)
 ;  file 344.5
"RTN","RCDPESR4",105,0)
 ; RCGBL = name of the global used to store the msg data
"RTN","RCDPESR4",106,0)
 ; RCDMSG = Mailman msg number the ERA arrived in.
"RTN","RCDPESR4",107,0)
 ; RCMSG = ien of the existing entry in file 344.5 for multipart ERAs
"RTN","RCDPESR4",108,0)
 ; RCBILL(AR bill number) = list of bills included, pass by REF
"RTN","RCDPESR4",109,0)
 ; RCD = array with formatted hdr data
"RTN","RCDPESR4",110,0)
 ;
"RTN","RCDPESR4",111,0)
 ; Errors returned in RCERR and RCERR(n)
"RTN","RCDPESR4",112,0)
 ; Function returns entry # of msg added or "" if none added
"RTN","RCDPESR4",113,0)
 ;
"RTN","RCDPESR4",114,0)
 ;
"RTN","RCDPESR4",115,0)
 N RCHDR,RCTYP,RCIEN
"RTN","RCDPESR4",116,0)
 S RCHDR=$G(^TMP("RCMSGH",$J,0))
"RTN","RCDPESR4",117,0)
 S RCTYP=$P(RCHDR,U)
"RTN","RCDPESR4",118,0)
 S RCIEN=$S($G(RCMSG):RCMSG,1:$$ADDTXN(RCHDR,RCDMSG)) ;File msg hdr
"RTN","RCDPESR4",119,0)
 I RCIEN'>0 S RCERR=3 ;msg hdr can't be filed
"RTN","RCDPESR4",120,0)
 I '$G(RCERR) D LOADDET(RCIEN,RCGBL,RCHDR,.RCBILL,.RCD,.RCERR)
"RTN","RCDPESR4",121,0)
 I '$G(RCERR),'$O(RCERR(0)),RCTYP["835ERA",'$P($G(^RCY(344.5,RCIEN,0)),U,8) D TASKERA^RCDPESR2(RCIEN) ;Task to upd VistA for complete 835ERA only
"RTN","RCDPESR4",122,0)
 ;
"RTN","RCDPESR4",123,0)
 Q $S($G(RCIEN)>0&'$G(RCERR):RCIEN,1:"")
"RTN","RCDPESR4",124,0)
 ;
"RTN","RCDPESR4",125,0)
ADDTXN(RCDATA,RCDMSG) ; Add a trxn for msg in RCDATA to file 344.5
"RTN","RCDPESR4",126,0)
 ; RCDATA = data on the msg hdr record
"RTN","RCDPESR4",127,0)
 ; RCDMSG = Mailman msg number the ERA arrived in
"RTN","RCDPESR4",128,0)
 ;Function returns ien of the new entry in file 344.5 or "" if an error
"RTN","RCDPESR4",129,0)
 ;
"RTN","RCDPESR4",130,0)
 N A,RCY,DLAYGO,DIC,DD,DO,DA,X,Y,Z
"RTN","RCDPESR4",131,0)
 ;
"RTN","RCDPESR4",132,0)
 ;
"RTN","RCDPESR4",133,0)
 S (X,A)=RCDMSG ;Use msg ID as basis for the .01 field
"RTN","RCDPESR4",134,0)
 F Z=1:1 Q:'$D(^RCY(344.5,"B",A))  S A=X_"."_Z
"RTN","RCDPESR4",135,0)
 S X=A
"RTN","RCDPESR4",136,0)
 S DIC(0)="L",DIC="^RCY(344.5,",DLAYGO=344.5
"RTN","RCDPESR4",137,0)
 S DIC("DR")=".02////"_$E($P(RCDATA,U),1,6)_";.03///^S X=""NOW"";.04////0;.06////"_$S($P(RCDATA,U)'["XFR":1,1:0)_$S($P(RCDATA,U,13)'="":";.09////"_+$P(RCDATA,U,13)_";.08////1",1:"")_";.1////2;.11////"_RCDMSG
"RTN","RCDPESR4",138,0)
 I $P(RCDATA,U,6)'="" S DIC("DR")=DIC("DR")_";3.01////"_$P(RCDATA,U,6)
"RTN","RCDPESR4",139,0)
 D FILE^DICN K DO,DD,DLAYGO,DA,DIC
"RTN","RCDPESR4",140,0)
 S RCY=+Y
"RTN","RCDPESR4",141,0)
 ;
"RTN","RCDPESR4",142,0)
 ;
"RTN","RCDPESR4",143,0)
 Q $S(RCY>0:+RCY,1:"")
"RTN","RCDPESR4",144,0)
 ;
"RTN","RCDPESR4",145,0)
LOADDET(RCTDA,RCGBL,RCHDR,RCBILL,RCD,RCERR) ; Load the rest of the text
"RTN","RCDPESR4",146,0)
 ; into the msg
"RTN","RCDPESR4",147,0)
 ; RCTDA = ien in file 344.5
"RTN","RCDPESR4",148,0)
 ; RCGBL = name of the array holding the detail msg text to be loaded
"RTN","RCDPESR4",149,0)
 ; RCHDR = data on ERA hdr record
"RTN","RCDPESR4",150,0)
 ; RCBILL(AR bill number) = list of bills included, pass by REF
"RTN","RCDPESR4",151,0)
 ; RCD = array with formatted hdr data
"RTN","RCDPESR4",152,0)
 ;
"RTN","RCDPESR4",153,0)
 ; OUTPUT: RCERR if any errors found, pass by REF
"RTN","RCDPESR4",154,0)
 ;
"RTN","RCDPESR4",155,0)
 ;
"RTN","RCDPESR4",156,0)
 N RCE,RCDATA,RCMSG,RCFROM,Z,Z0
"RTN","RCDPESR4",157,0)
 K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J)
"RTN","RCDPESR4",158,0)
 M ^TMP("RCTEXT",$J)=@RCGBL@(1,"D")
"RTN","RCDPESR4",159,0)
 M ^TMP("RCRAW",$J)=@RCGBL@(2,"D")
"RTN","RCDPESR4",160,0)
 ;
"RTN","RCDPESR4",161,0)
 S RCDATA=$G(^RCY(344.5,RCTDA,0)),RCMSG=$G(RCD("MSG#")),RCFROM=$G(RCD("FROM"))
"RTN","RCDPESR4",162,0)
 ;
"RTN","RCDPESR4",163,0)
 ; For multi-part ERA, don't update if sequence already filed
"RTN","RCDPESR4",164,0)
 ; Add seq # if not already there
"RTN","RCDPESR4",165,0)
 I $P(RCHDR,U)'["XFR",$P(RCHDR,U,13) Q:$D(^RCY(344.5,RCTDA,"S","B",+$P(RCHDR,U,14)))
"RTN","RCDPESR4",166,0)
 ;
"RTN","RCDPESR4",167,0)
 D STOREM(+$G(RCTDA),"^TMP(""RCTEXT"",$J)","^TMP(""RCRAW"",$J)",.RCE)
"RTN","RCDPESR4",168,0)
 ;
"RTN","RCDPESR4",169,0)
 I $D(RCE("DIERR")) D  ; Extract error
"RTN","RCDPESR4",170,0)
 . N DIE,DA,DR,X,Y
"RTN","RCDPESR4",171,0)
 . D EXTERR^RCDPESR1(.RCERR,.RCE)
"RTN","RCDPESR4",172,0)
 . S:$L($G(RCE)) RCERR(+$O(RCERR(""),-1)+1)=RCE
"RTN","RCDPESR4",173,0)
 . I $D(^RCY(344.5,RCTDA,0)) S DIE="^RCY(344.5,",DR=".1////4",DA=RCTDA D ^DIE
"RTN","RCDPESR4",174,0)
 E  D  ; No error - store rest of data
"RTN","RCDPESR4",175,0)
 . N Z,RCT,RCCT,RCX,RCB ; Add bills included in ERA
"RTN","RCDPESR4",176,0)
 . S RCT=0,RCCT=0,RCX=$J("",4)
"RTN","RCDPESR4",177,0)
 . S Z="" F  S Z=$O(RCBILL(Z)) Q:Z=""  D
"RTN","RCDPESR4",178,0)
 .. N DO,DD,DIC,DLAYGO,X,Y
"RTN","RCDPESR4",179,0)
 .. S:RCT=4 RCCT=RCCT+1,RCB(RCCT)=RCX,RCT=0,RCX=$J("",4) S RCX=RCX_$E($S(+RCBILL(Z):"",1:"*")_Z_$J("",15),1,15),RCT=RCT+1
"RTN","RCDPESR4",180,0)
 .. S DIC(0)="L",DIC("DR")=".02////"_$S($G(RCBILL(Z)):1,1:0),X=Z,DA(1)=RCTDA,DIC="^RCY(344.5,"_DA(1)_",""B"",",DLAYGO=344.54 D FILE^DICN K DO,DD,DLAYGO,DIC
"RTN","RCDPESR4",181,0)
 .. ;
"RTN","RCDPESR4",182,0)
 . I $L(RCX)>4 S RCCT=RCCT+1,RCB(RCCT)=RCX
"RTN","RCDPESR4",183,0)
 . ; Add list of bills to display data
"RTN","RCDPESR4",184,0)
 . I $O(RCB(0)) D WP^DIE(344.5,RCTDA_",",1,"A","RCB")
"RTN","RCDPESR4",185,0)
 . ; Add seq #
"RTN","RCDPESR4",186,0)
 . S DA(1)=RCTDA,DIC="^RCY(344.5,"_DA(1)_",""S"",",DIC(0)="L",X=$P(RCHDR,U,14),DIC("DR")=".02////"_$S($P(RCHDR,U,15)="Y":1,1:0)_";.03///^S X=""NOW"";.04////"_RCMSG,X=+$P(RCHDR,U,14),DLAYGO=344.53
"RTN","RCDPESR4",187,0)
 . D FILE^DICN K DO,DD,DLAYGO,DIC
"RTN","RCDPESR4",188,0)
 . ;
"RTN","RCDPESR4",189,0)
 . I $P(RCHDR,U)["835XFR" D XFR^RCDPESR5(RCTDA,RCFROM,RCMSG,.RCD) Q
"RTN","RCDPESR4",190,0)
 . ;
"RTN","RCDPESR4",191,0)
 . ; Proceed only if not a transfer record
"RTN","RCDPESR4",192,0)
 . I $P(RCDATA,U,9)'="" D  ; Determine if all sequences received yet
"RTN","RCDPESR4",193,0)
 .. N RCOK,RCLAST
"RTN","RCDPESR4",194,0)
 .. S RCOK=1,RCLAST=0
"RTN","RCDPESR4",195,0)
 .. F Z=1:1 Q:'RCOK!RCLAST  D
"RTN","RCDPESR4",196,0)
 ... I 'RCLAST,'$D(^RCY(344.5,RCTDA,"S","B",Z)) S RCOK=0 Q
"RTN","RCDPESR4",197,0)
 ... S Z0=+$O(^RCY(344.5,RCTDA,"S","B",Z,0)),Z0=$G(^RCY(344.5,RCTDA,"S",Z0,0))
"RTN","RCDPESR4",198,0)
 ... I Z0="" S RCOK=0 Q
"RTN","RCDPESR4",199,0)
 ... I $P(Z0,U,2) S RCLAST=1 ; Last sequence received and all before it
"RTN","RCDPESR4",200,0)
 .. ;
"RTN","RCDPESR4",201,0)
 .. I RCOK D
"RTN","RCDPESR4",202,0)
 ... N DA,DIE,DR,X,Y
"RTN","RCDPESR4",203,0)
 ... S DA=RCTDA,DR=".08////0;.1///@",DIE="^RCY(344.5," D ^DIE
"RTN","RCDPESR4",204,0)
 ... I '$O(^RCY(344.5,RCTDA,"B","AV",1,0)) D  ; No valid bills found
"RTN","RCDPESR4",205,0)
 .... N RCE
"RTN","RCDPESR4",206,0)
 .... S RCE(1)="No valid bills for this site were found in this ERA"
"RTN","RCDPESR4",207,0)
 .... S RCE(2)="Review/correct the bill #'s on this ERA in your transmission exceptions"
"RTN","RCDPESR4",208,0)
 .... S RCE(3)="Please contact the Implementation Manager group to report this situation",RCE(4)=" "
"RTN","RCDPESR4",209,0)
 .... D BULLERA^RCDPESR0("D"_$S($O(^RCY(344.5,RCTDA,2,0)):"F",1:""),RCTDA,$G(RCD("MSG#")),"EDI LBOX - NO VALID BILLS ON ERA "_$E($G(RCD("PAYFROM")),1,20),.RCE,0)
"RTN","RCDPESR4",210,0)
 .... S DA=RCTDA,DR=".08////1;.1////6",DIE="^RCY(344.5," D ^DIE
"RTN","RCDPESR4",211,0)
 ;
"RTN","RCDPESR4",212,0)
 ;
"RTN","RCDPESR4",213,0)
 K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J)
"RTN","RCDPESR4",214,0)
 Q
"RTN","RCDPESR4",215,0)
 ;
"RTN","RCDPESR4",216,0)
STOREM(RCTDA,RCDISP,RCTEXT,RCE) ;Store msg text in file 344.5
"RTN","RCDPESR4",217,0)
 ;INPUT:
"RTN","RCDPESR4",218,0)
 ; RCTDA = ien of the entry in file 344.5
"RTN","RCDPESR4",219,0)
 ; RCDISP = name of the array where display msg text is retrieved from
"RTN","RCDPESR4",220,0)
 ;   or "@" to delete the text from the display text field
"RTN","RCDPESR4",221,0)
 ; RCTEXT = name of the array where raw msg text is retrieved from
"RTN","RCDPESR4",222,0)
 ;   or "@" to delete the text from the raw msg field
"RTN","RCDPESR4",223,0)
 ;OUTPUT:
"RTN","RCDPESR4",224,0)
 ; RCE = array of errors (RCE("DIERR")) returned, pass by REF
"RTN","RCDPESR4",225,0)
 ;
"RTN","RCDPESR4",226,0)
 N RCZ,X,Y,DIE
"RTN","RCDPESR4",227,0)
 K RCE("DIERR")
"RTN","RCDPESR4",228,0)
 ;
"RTN","RCDPESR4",229,0)
 I $S($G(RCDISP)="@":1,1:$D(@RCDISP)'<10) D
"RTN","RCDPESR4",230,0)
 . F RCZ=1:1:20 D WP^DIE(344.5,RCTDA_",",1,"AK",""_RCDISP_"","RCE") Q:$S('$D(RCE("DIERR")):1,+RCE("DIERR")=1:$G(RCE("DIERR",1))'=110,1:1)  K:RCZ<20 RCE("DIERR") ; On lock error, retry up to 20 times
"RTN","RCDPESR4",231,0)
 ;
"RTN","RCDPESR4",232,0)
 I '$O(RCE("DIERR",0)),$S($G(RCTEXT)="@":1,1:$D(@RCTEXT)'<10) D
"RTN","RCDPESR4",233,0)
 . F RCZ=1:1:20 D WP^DIE(344.5,RCTDA_",",2,"AK",""_RCTEXT_"","RCE") Q:$S('$D(RCE("DIERR")):1,+RCE("DIERR")=1:$G(RCE("DIERR",1))'=110,1:1)  K:RCZ<20 RCE("DIERR") ; On lock error, retry up to 20 times
"RTN","RCDPESR4",234,0)
 Q
"RTN","RCDPESR5")
0^32^B27780882
"RTN","RCDPESR5",1,0)
RCDPESR5 ;ALB/TMK,DWA - Server interface 835XFR processing ;10/01/02
"RTN","RCDPESR5",2,0)
 ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPESR5",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPESR5",4,0)
 ;
"RTN","RCDPESR5",5,0)
XFR(RCTDA,RCFROM,RCMSG,RCD) ; Send bulletin, update 344.5 for transfer EOB into site
"RTN","RCDPESR5",6,0)
 ; RCTDA = ien in file 344.5 being updated
"RTN","RCDPESR5",7,0)
 ; RCFROM = the sender's mail address from the mail message
"RTN","RCDPESR5",8,0)
 ; RCMSG = message # the data was received in
"RTN","RCDPESR5",9,0)
 ; RCD = array containing formatted header data
"RTN","RCDPESR5",10,0)
 ;
"RTN","RCDPESR5",11,0)
 N RCCT,RCDXM,DA,DR,DIE,X,Y,Z,RCFROMNM
"RTN","RCDPESR5",12,0)
 S Z=$P($P(RCD("SUBJ"),"REF #",2),"#"),RCFROMNM=$TR($P(RCFROM,"@",2),">")
"RTN","RCDPESR5",13,0)
 I RCFROMNM="" S RCFROMNM=RCFROM
"RTN","RCDPESR5",14,0)
 S DA=RCTDA,DR=".05///@;.08////1;.1///3"_$S($P(RCFROM,"@",2)'="":";.12////"_RCFROMNM,1:"")_";.13////^S X=("_+Z_"_$C(59)_"_$P(Z,";",2)_")"_$S($G(RCD("PAYFROM"))'="":";3.01////"_RCD("PAYFROM"),1:"")
"RTN","RCDPESR5",15,0)
 S DIE="^RCY(344.5," D ^DIE
"RTN","RCDPESR5",16,0)
 ;
"RTN","RCDPESR5",17,0)
 D SENDACK(RCTDA,"") ; acknowledge receipt of transferred EOB
"RTN","RCDPESR5",18,0)
 ;
"RTN","RCDPESR5",19,0)
 S RCDXM(1)="An EEOB transmission has been received by the EDI Lockbox",RCDXM(2)="  system that was sent to you from another VistA site.  Please review"
"RTN","RCDPESR5",20,0)
 S RCDXM(3)="  it in EEOB exception processing and file the EEOB if it belongs to your",RCDXM(4)="  site or delete the message to return the EEOB to the site it was sent from."
"RTN","RCDPESR5",21,0)
 S RCDXM(5)=" ",RCDXM(6)="The message was sent by "_RCFROM
"RTN","RCDPESR5",22,0)
 S RCDXM(7)="The mail message number is "_RCMSG
"RTN","RCDPESR5",23,0)
 S RCDXM(8)=" ",RCDXM(9)="EEOB DATA INCLUDED:"
"RTN","RCDPESR5",24,0)
 S RCCT=9
"RTN","RCDPESR5",25,0)
 K ^TMP($J)
"RTN","RCDPESR5",26,0)
 D DISP^RCDPESR0("^RCY(344.5,"_RCTDA_",2)","^TMP($J,""PRCA_EXT"")",1,"^TMP($J,""PRCA_LINES"")",70)
"RTN","RCDPESR5",27,0)
 S Z=0 F  S Z=$O(^TMP($J,"PRCA_LINES",Z)) Q:'Z  S RCCT=RCCT+1,RCDXM(RCCT)=$J("",3)_$G(^TMP($J,"PRCA_LINES",Z))
"RTN","RCDPESR5",28,0)
 D BULLERA^RCDPESR0("",RCTDA,RCMSG,"EDI LBOX EEOB FROM "_$E(RCFROMNM,1,18)_" FOR "_$E($G(RCD("PAYFROM")),1,20),.RCDXM,1)
"RTN","RCDPESR5",29,0)
 K ^TMP($J)
"RTN","RCDPESR5",30,0)
 Q
"RTN","RCDPESR5",31,0)
 ;
"RTN","RCDPESR5",32,0)
SENDACK(RCTDA,RCSTAT) ; Send accept/reject msg to transf 'from' site
"RTN","RCDPESR5",33,0)
 ; RCTDA = ien of entry file 344.5
"RTN","RCDPESR5",34,0)
 ; RCSTAT = flag to indicate what happened
"RTN","RCDPESR5",35,0)
 ;   values:  "" = receipt   1 = accepted   0 = rejected
"RTN","RCDPESR5",36,0)
 ;
"RTN","RCDPESR5",37,0)
 N RC,RC0,RCDOM,RCREF,XMTO,XMBODY,XMZ
"RTN","RCDPESR5",38,0)
 ; Send a mail message to sending site for accept/reject of EOB
"RTN","RCDPESR5",39,0)
 S RC0=$G(^RCY(344.5,RCTDA,0)),RCREF=$P(RC0,U,13)
"RTN","RCDPESR5",40,0)
 S RCDOM="@"_$S($P(RC0,U,12)'="":$P(RC0,U,12),1:$$KSP^XUPARAM("WHERE")) S:RCDOM="@" RCDOM=""
"RTN","RCDPESR5",41,0)
 I RCREF,$P(RCREF,";",2) D
"RTN","RCDPESR5",42,0)
 . ; 835ACK^accept/reject flag (""/0/1)^ien file 344_;_ien file 344.41
"RTN","RCDPESR5",43,0)
 . S RC(1)="835XAK^"_RCSTAT_U_+$P(RCREF,";")_";"_+$P(RCREF,";",2)
"RTN","RCDPESR5",44,0)
 . S XMBODY="RC",XMTO("S.RCDPE EDI LOCKBOX SERVER"_RCDOM)=""
"RTN","RCDPESR5",45,0)
 . D
"RTN","RCDPESR5",46,0)
 .. N DUZ S DUZ=.5,DUZ(0)="@"
"RTN","RCDPESR5",47,0)
 .. D SENDMSG^XMXAPI(.5,"TRANSFER EEOB ACKNOWLEDGEMENT",XMBODY,.XMTO,,.XMZ)
"RTN","RCDPESR5",48,0)
 Q
"RTN","RCDPESR5",49,0)
 ;
"RTN","RCDPESR5",50,0)
FILEEOB(RCTDA) ; Files trans-in EOB in IB
"RTN","RCDPESR5",51,0)
 N DIE,DA,DR,X,Y,RCE
"RTN","RCDPESR5",52,0)
 D UPDEOB^RCDPESR2(RCTDA,5)
"RTN","RCDPESR5",53,0)
 I $D(^RCY(344.5,RCTDA,0)) D
"RTN","RCDPESR5",54,0)
 . S DIE="^RCY(344.5,",DR=".04////0;.05///@;.1////5",DA=RCTDA D ^DIE
"RTN","RCDPESR5",55,0)
 Q
"RTN","RCDPESR5",56,0)
 ;
"RTN","RCDPESR5",57,0)
BULL1(RCTDA,RCERR,DUP) ; Send bulletin for EDI Lockbox EOB exceptions
"RTN","RCDPESR5",58,0)
 ; RCTDA = ien of entry in file 344.5
"RTN","RCDPESR5",59,0)
 ; RCERR = the name of the error global
"RTN","RCDPESR5",60,0)
 ; DUP = ien of existing entry in file 344.4 if ERA is duplicate
"RTN","RCDPESR5",61,0)
 ;
"RTN","RCDPESR5",62,0)
 N RCSUBJ
"RTN","RCDPESR5",63,0)
 S RCSUBJ="EDI LBOX "_$S(DUP:"ERA - DUPLICATE TRANSMISSION MSG #"_DUP,1:" EEOB - EXCEPTIONS")_" "_$E($P($G(^RCY(344.5,RCTDA,3)),U),1,20)
"RTN","RCDPESR5",64,0)
 S RCSUBJ=$E(RCSUBJ,1,65)
"RTN","RCDPESR5",65,0)
 S DUP=+$G(DUP)
"RTN","RCDPESR5",66,0)
 D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),RCSUBJ,RCERR,0)
"RTN","RCDPESR5",67,0)
 Q
"RTN","RCDPESR5",68,0)
 ;
"RTN","RCDPESR5",69,0)
BULL2(RCTDA,RCERR,RCXMG) ; Send bulletin for EOB transfer received at site
"RTN","RCDPESR5",70,0)
 ; RCTDA = ien of entry in file 344.5
"RTN","RCDPESR5",71,0)
 ; RCXMG = incoming message #
"RTN","RCDPESR5",72,0)
 ; RCERR = the name of the error global
"RTN","RCDPESR5",73,0)
 ;
"RTN","RCDPESR5",74,0)
 N RCDIQ,RCXM,RCXM1,XMBODY,XMZ,XMTO,RC,Z,Q,RCSUBJ
"RTN","RCDPESR5",75,0)
 S RCSUBJ="EDI LBOX EEOB DETAIL RE-FILE ATTEMPTED TO IB"
"RTN","RCDPESR5",76,0)
 S XMTO("I:G.RCDPE PAYMENTS")="",RC=0
"RTN","RCDPESR5",77,0)
 K ^TMP("RCERR_BULL2",$J)
"RTN","RCDPESR5",78,0)
 S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="The following EEOB was received at your site.",RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="It was received on: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" in mail msg # "_RCXMG_"."
"RTN","RCDPESR5",79,0)
 S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="The initial attempt to file this data in IB failed and this message",RC=RC+1,^TMP("RCERR_BULL2",$J,RC)="is the result of a subsequent attempt to file this EEOB detail data in IB"
"RTN","RCDPESR5",80,0)
 S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=" "
"RTN","RCDPESR5",81,0)
 D GETS^DIQ(344.4,+RCTDA_",","*","IEN","RCDIQ")
"RTN","RCDPESR5",82,0)
 D TXT0^RCDPEX31(+RCTDA,.RCDIQ,.RCXM,0)
"RTN","RCDPESR5",83,0)
 S Z=0 F  S Z=$O(RCXM(Z)) Q:'Z  S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=RCXM(Z)
"RTN","RCDPESR5",84,0)
 I $G(RCERR)'="",$E(RCERR,1,5)'="^TMP(" S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=RCERR,RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=" "
"RTN","RCDPESR5",85,0)
 S RCERR=$S($E(RCERR,1,5)="^TMP(":RCERR,1:"RCERR")
"RTN","RCDPESR5",86,0)
 I $O(@RCERR@(""))'="" D
"RTN","RCDPESR5",87,0)
 . S Z="" F  S Z=$O(@RCERR@(Z)) Q:Z=""  D
"RTN","RCDPESR5",88,0)
 .. I $G(@RCERR@(Z))'="" S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=@RCERR@(Z)
"RTN","RCDPESR5",89,0)
 .. I $O(@RCERR@(Z,0)) S Q="" F  S Q=$O(@RCERR@(Z,Q)) Q:Q=""  S RC=RC+1,^TMP("RCERR_BULL2",$J,RC)=@RCERR@(Z,Q)
"RTN","RCDPESR5",90,0)
 S XMBODY="^TMP(""RCERR_BULL2"","_$J_")"
"RTN","RCDPESR5",91,0)
 D
"RTN","RCDPESR5",92,0)
 . N DUZ S DUZ=.5,DUZ(0)="@"
"RTN","RCDPESR5",93,0)
 . D SENDMSG^XMXAPI(.5,$E(RCSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
"RTN","RCDPESR5",94,0)
 K ^TMP("RCERR_BULL2",$J)
"RTN","RCDPESR5",95,0)
 Q
"RTN","RCDPESR5",96,0)
 ;
"RTN","RCDPESR5",97,0)
DISP1(RCCT,RCNOH) ; Extract formatted EOB detail for bill
"RTN","RCDPESR5",98,0)
 ; RCCT = bill seq# within ERA transmission
"RTN","RCDPESR5",99,0)
 ; RCNOH = 1 if no header text needed on 05 rec
"RTN","RCDPESR5",100,0)
 ;
"RTN","RCDPESR5",101,0)
 ; Error array returned in ^TMP("RCERR1",$J)
"RTN","RCDPESR5",102,0)
 ;
"RTN","RCDPESR5",103,0)
 N RC1,RC2,RCCT1,Z,RCV5
"RTN","RCDPESR5",104,0)
 I +$P($G(^RCY(344.5,RCTDA,2,1,0)),U,16)>0 S RCV5=1
"RTN","RCDPESR5",105,0)
 D DISP^RCDPESR0("^TMP($J,""RCDP-EOB"","_RCCT_")","RC1",1)
"RTN","RCDPESR5",106,0)
 D FMTDSP^RCDPESR0("RC1","RC2",75,RCNOH)
"RTN","RCDPESR5",107,0)
 S Z=0,RCCT1=$O(^TMP("RCERR1",$J,RCCT," "),-1)
"RTN","RCDPESR5",108,0)
 F  S Z=$O(RC2(Z)) Q:'Z  S RCCT1=RCCT1+1,^TMP("RCERR1",$J,RCCT,RCCT1)=RC2(Z)
"RTN","RCDPESR5",109,0)
 Q
"RTN","RCDPESR5",110,0)
 ;
"RTN","RCDPESR6")
0^22^B43157350
"RTN","RCDPESR6",1,0)
RCDPESR6 ;ALB/TMK/DWA - Server auto-update file 344.4 - EDI Lockbox ; 8/6/10 12:14pm
"RTN","RCDPESR6",2,0)
 ;;4.5;Accounts Receivable;**173,214,208,230,252,269**;Mar 20, 1995;Build 113
"RTN","RCDPESR6",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPESR6",4,0)
 ;
"RTN","RCDPESR6",5,0)
UPD3444(RCRTOT) ; Add EOB detail to list in 344.41 for file 344.4 entry RCRTOT
"RTN","RCDPESR6",6,0)
 ; If passed by reference, RCRTOT is returned = "" if errors
"RTN","RCDPESR6",7,0)
 ;
"RTN","RCDPESR6",8,0)
 N RC,RCCOM1,RCCOM2,RCCT,RC1,RC2,RCDPNM,RCEOB,RCNPI1,RCNPI2,DA,DR,DO,DD,DLAYGO,DIC,DIK,X,Y,Z
"RTN","RCDPESR6",9,0)
 S RC=0 F  S RC=$O(^TMP($J,"RCDPEOB",RC)) Q:'RC  S RC1=$G(^(RC)),RC2=$G(^(RC,"EOB")),RCEOB=+RC2 D  Q:'RCRTOT
"RTN","RCDPESR6",10,0)
 . ; Upd 344.41 with reference to this record if it doesn't already exist
"RTN","RCDPESR6",11,0)
 . I RCEOB>0 Q:$D(^RCY(344.4,RCRTOT,1,"AC",RCEOB,RC))
"RTN","RCDPESR6",12,0)
 . I RCEOB'>0,$S($P(RC1,U,2)'="":$D(^RCY(344.4,RCRTOT,1,"AD",$P(RC1,U,2),RC)),1:0) Q
"RTN","RCDPESR6",13,0)
 . ; Disregard ECME reject related EEOBs
"RTN","RCDPESR6",14,0)
 . I RCEOB'>0,'$P(RC2,U,2),$P(RC1,U,2)?1.7N,$$REJECT^IBNCPDPU($P(RC1,U,2),$P(RC1,U,3)) Q
"RTN","RCDPESR6",15,0)
 . S DA(1)=RCRTOT,X=RC,DIC="^RCY(344.4,"_DA(1)_",1,",DIC(0)="L",DLAYGO=344.41
"RTN","RCDPESR6",16,0)
 . S DIC("DR")=$S($G(RCEOB)>0:".02////"_RCEOB,1:".05////"_$P(RC1,U,2)_";.07////1")
"RTN","RCDPESR6",17,0)
 . I $P(RC2,U,2)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".03///"_$P(RC2,U,2) ; amt
"RTN","RCDPESR6",18,0)
 . I $P(RC2,U,3)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".04////"_$P(RC2,U,3) ; ins co
"RTN","RCDPESR6",19,0)
 . I $P(RC2,U,4) S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".14////1" ; reversal
"RTN","RCDPESR6",20,0)
 . I $P(RC2,U,5)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".15////^S X=$E($P(RC2,U,5),1,30)" ; Patient name
"RTN","RCDPESR6",21,0)
 . ; Process Billing Prov NPI, Rendering/Servicing NPI & name
"RTN","RCDPESR6",22,0)
 . S (RCCOM1,RCCOM2)=""
"RTN","RCDPESR6",23,0)
 . S RCNPI1=$P(RC2,U,10),RCNPI2=$P(RC2,U,11)
"RTN","RCDPESR6",24,0)
 . I RCNPI1'="",'$$CHKDGT^XUSNPI(RCNPI1) S RCCOM1="The Billing Provider NPI received on the 835 ("_$E(RCNPI1,1,10)_") is not a valid format."
"RTN","RCDPESR6",25,0)
 . I RCNPI2'="",'$$CHKDGT^XUSNPI(RCNPI2) S RCCOM2="The "_$S($P(RC2,U,12)=1:"Rendering",1:"Servicing")_" NPI received on the 835 ("_$E(RCNPI2,1,10)_") is not a valid format."
"RTN","RCDPESR6",26,0)
 . I RCCOM1="" S DIC("DR")=DIC("DR")_";.18////^S X=$P(RC2,U,10)"  ;Billing Provider NPI
"RTN","RCDPESR6",27,0)
 . I RCCOM2="" S DIC("DR")=DIC("DR")_";.19////^S X=$P(RC2,U,11)"  ;Rendering Provider NPI
"RTN","RCDPESR6",28,0)
 . S RCDPNM=$P(RC2,U,13) I $P(RC2,U,14)]"" S RCDPNM=RCDPNM_$S(RCDPNM]"":",",1:"")_$P(RC2,U,14)
"RTN","RCDPESR6",29,0)
 . S DIC("DR")=DIC("DR")_";.2////^S X=$P(RC2,U,12);.21////^S X=RCDPNM"  ; Entity Type Qualifier ^ Last name,First Name
"RTN","RCDPESR6",30,0)
 . S DIC("DR")=DIC("DR")_";.22////^S X=RCCOM1;.23////^S X=RCCOM2"  ;Comment on Billing provider^comment on rendering/servicing provider NPI
"RTN","RCDPESR6",31,0)
 . D FILE^DICN K DO,DD,DLAYGO,DIC,DIK
"RTN","RCDPESR6",32,0)
 . S RCCT=+Y
"RTN","RCDPESR6",33,0)
 . I RCCT<0 D  Q
"RTN","RCDPESR6",34,0)
 .. S DA=RCRTOT,DIK="^RCY(344.4," D ^DIK
"RTN","RCDPESR6",35,0)
 .. S RCRTOT=0
"RTN","RCDPESR6",36,0)
 . ; If there is no IB EOB record, store the raw data in 344.411
"RTN","RCDPESR6",37,0)
 . I RC1'>0!(RCEOB'>0) D
"RTN","RCDPESR6",38,0)
 .. N RCDATA,RCC,RCDA
"RTN","RCDPESR6",39,0)
 .. S RCC=2,RCDATA(1)=$G(^TMP($J,"RCDPEOB","HDR"))
"RTN","RCDPESR6",40,0)
 .. S Z=0 F  S Z=$O(^TMP($J,"RCDPEOB",RCCT,Z)) Q:'Z  S RCC=RCC+1,RCDATA(RCC)=$G(^TMP($J,"RCDPEOB",RCCT,Z))
"RTN","RCDPESR6",41,0)
 .. S RCDA(1)=RCRTOT,RCDA=RCCT
"RTN","RCDPESR6",42,0)
 .. D WP^DIE(344.41,$$IENS^DILF(.RCDA),1,"A","RCDATA")
"RTN","RCDPESR6",43,0)
 Q
"RTN","RCDPESR6",44,0)
 ;
"RTN","RCDPESR6",45,0)
 ;
"RTN","RCDPESR6",46,0)
ERATOT(RCTDA,RCERR) ; File ERA TOTAL rec in 344.4 from entry RCTDA in 344.5
"RTN","RCDPESR6",47,0)
 ; RCTDA = ien file 344.5
"RTN","RCDPESR6",48,0)
 ; Returns: the ien file 344.4
"RTN","RCDPESR6",49,0)
 ;          RCERR if passed by reference, with error text
"RTN","RCDPESR6",50,0)
 ;          RCERR(1)=duplicated message
"RTN","RCDPESR6",51,0)
 N RCTYPE,RCDA,RCMETH,RCTRACE,RCID,RCDT,RCAMT,RCDUP,RCZ,RCX,RCPAYER,DIE,DIK,DIC,DLAYGO,DD,DO,DR,DA,X,Y,Z0,Z1
"RTN","RCDPESR6",52,0)
 S (RCERR,RCDA)=""
"RTN","RCDPESR6",53,0)
 S RCZ=$G(^RCY(344.5,RCTDA,2,1,0))
"RTN","RCDPESR6",54,0)
 S RCTYPE=$P(RCZ,U),RCTRACE=$P(RCZ,U,8),RCID=$P(RCZ,U,7),RCPAYER=$P(RCZ,U,6),RCMETH=$P(RCZ,U,17)
"RTN","RCDPESR6",55,0)
 ; Need header record as first entry in field
"RTN","RCDPESR6",56,0)
 I RCTYPE'["835ERA" S RCERR="No header record found in message.  An EEOB exception record was created" G ERATOTQ
"RTN","RCDPESR6",57,0)
 ;
"RTN","RCDPESR6",58,0)
 S RCDT=$$FMDT^RCDPESR1($P(RCZ,U,9)),RCAMT=$J(($P(RCZ,U,10)/100),0,2)
"RTN","RCDPESR6",59,0)
 ;Elec ERA's must have a trace # and an ins co id
"RTN","RCDPESR6",60,0)
 I RCTRACE=""!(RCID="") S RCERR="Trace # or ins ID missing on ERA transaction.  An EEOB exception record was created." G ERATOTQ
"RTN","RCDPESR6",61,0)
 ; Make sure it's not already there
"RTN","RCDPESR6",62,0)
 S (RCDUP,Z1)=0
"RTN","RCDPESR6",63,0)
 F  S Z1=$O(^RCY(344.4,"ATRID",RCTRACE,RCID,Z1)) Q:'Z1  S Z0=$G(^RCY(344.4,Z1,0)) I $P(Z0,U,4)=RCDT,+$P(Z0,U,5)=+RCAMT S RCDUP=1 Q
"RTN","RCDPESR6",64,0)
 ;
"RTN","RCDPESR6",65,0)
 I RCDUP,$P(Z0,U,8) D  G ERATOTQ ; Receipt already exists - no update
"RTN","RCDPESR6",66,0)
 . S RCERR="This is a duplicate ERA and has already been posted",RCERR(1)=-2
"RTN","RCDPESR6",67,0)
 I RCDUP S RCERR="DUP",RCERR(1)=$S($P(Z0,U,12)'=$P($G(^RCY(344.5,RCTDA,0)),U,11):$P(Z0,U,12),1:-1) G ERATOTQ
"RTN","RCDPESR6",68,0)
 ;
"RTN","RCDPESR6",69,0)
 S RCX=+$O(^RCY(344.4," "),-1)
"RTN","RCDPESR6",70,0)
 S DIC(0)="L",DIC="^RCY(344.4,",DLAYGO=344.4
"RTN","RCDPESR6",71,0)
 S DIC("DR")=".02////"_RCTRACE_";.03////"_RCID_";.04////"_RCDT_";.05////"_RCAMT_";.06////"_$P(RCZ,U,6)_";.09////0;.12////"_$P($G(^RCY(344.5,RCTDA,0)),U,11)_";.07////"_$$NOW^XLFDT()_";.1////1"
"RTN","RCDPESR6",72,0)
 I RCMETH'="" S DIC("DR")=DIC("DR")_";.15////"_RCMETH
"RTN","RCDPESR6",73,0)
 F RCX=RCX+1:1 L +^RCY(344.4,RCX,0):1 I $T,'$D(^RCY(344.4,RCX,0)) S X=RCX Q
"RTN","RCDPESR6",74,0)
 D FILE^DICN K DO,DLAYGO,DD,DIC
"RTN","RCDPESR6",75,0)
 L -^RCY(344.4,RCX,0)
"RTN","RCDPESR6",76,0)
 S RCDA=$S(Y<0:"",1:+Y)
"RTN","RCDPESR6",77,0)
 I 'RCDA D
"RTN","RCDPESR6",78,0)
 . S RCERR="An error was encountered that prevented the adding of an ERA totals record.  An EEOB exception record was created."
"RTN","RCDPESR6",79,0)
 ;
"RTN","RCDPESR6",80,0)
ERATOTQ Q RCDA
"RTN","RCDPESR6",81,0)
 ;
"RTN","RCDPESR6",82,0)
UPDCON(RCRTOT) ; Add contact information to file 344.4 for an ERA
"RTN","RCDPESR6",83,0)
 N DIE,DA,DR,Z,Q,X,Y,A,TYPE
"RTN","RCDPESR6",84,0)
 S Z=$G(^TMP($J,"RCDPEOB","CONTACT"))
"RTN","RCDPESR6",85,0)
 Q:$TR($P(Z,U,3,9),U)=""
"RTN","RCDPESR6",86,0)
 S DA=RCRTOT,DIE="^RCY(344.4,",DR=""
"RTN","RCDPESR6",87,0)
 ;
"RTN","RCDPESR6",88,0)
 ; If old format do
"RTN","RCDPESR6",89,0)
 I +$P($G(^TMP($J,"RCDPEOB","HDR")),U,16)'>0 D
"RTN","RCDPESR6",90,0)
 . F Q=2:1:8 S DR=DR_$S(DR'="":";3.0",1:"3.0")_(Q-1)_"///"_$S($P(Z,U,Q)="":"@",1:"/"_$P(Z,U,Q))
"RTN","RCDPESR6",91,0)
 ;
"RTN","RCDPESR6",92,0)
 ; If new format (5010) do
"RTN","RCDPESR6",93,0)
 I +$P($G(^TMP($J,"RCDPEOB","HDR")),U,16)>0 D
"RTN","RCDPESR6",94,0)
 . N CNT S CNT=0
"RTN","RCDPESR6",95,0)
 . I $P(Z,U,2)'="" S DR="3.01////"_$P(Z,U,2)
"RTN","RCDPESR6",96,0)
 .I $P(Z,U,3)'="" S DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,3)_";3.03////TE",CNT=CNT+1
"RTN","RCDPESR6",97,0)
 .I $P(Z,U,4)'="" D
"RTN","RCDPESR6",98,0)
 ..S:CNT=1 DR=DR_$S(DR'="":";3.04",1:"3.04")_"////"_$P(Z,U,4)_";3.05////FX"
"RTN","RCDPESR6",99,0)
 ..S:CNT=0 DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,4)_";3.03////FX"
"RTN","RCDPESR6",100,0)
 ..S CNT=CNT+1
"RTN","RCDPESR6",101,0)
 .I $P(Z,U,5)'="" D
"RTN","RCDPESR6",102,0)
 ..S:CNT=2 DR=DR_$S(DR'="":";3.06",1:"3.06")_"////"_$P(Z,U,5)_";3.07////EM"
"RTN","RCDPESR6",103,0)
 ..S:CNT=1 DR=DR_$S(DR'="":";3.04",1:"3.04")_"////"_$P(Z,U,5)_";3.05////EM"
"RTN","RCDPESR6",104,0)
 ..S:CNT=0 DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,5)_";3.03////EM"
"RTN","RCDPESR6",105,0)
 . I $P(Z,U,6)'="" S DR=DR_$S(DR'="":";5.01",1:"5.01")_"////"_$P(Z,U,6)
"RTN","RCDPESR6",106,0)
 D ^DIE
"RTN","RCDPESR6",107,0)
 Q
"RTN","RCDPESR6",108,0)
 ;
"RTN","RCDPESR6",109,0)
UPDADJ(RCRTOT) ; Add ERA level adj data to file 344.4
"RTN","RCDPESR6",110,0)
 N Z,Z0,DA,DIC,DLAYGO,DR,X,Y,DO,DD
"RTN","RCDPESR6",111,0)
 ; Remove any already there
"RTN","RCDPESR6",112,0)
 S Z=0 F  S Z=$O(^RCY(344.4,RCRTOT,2,Z)) Q:'Z  S DA(1)=RCRTOT,DA=Z D ^DIK
"RTN","RCDPESR6",113,0)
 ;
"RTN","RCDPESR6",114,0)
 S Z=0 F  S Z=$O(^TMP($J,"RCDPEOB","ADJ",Z)) Q:'Z  S Z0=$G(^(Z)) D
"RTN","RCDPESR6",115,0)
 . S DIC(0)="L",X=$P(Z0,U,3)_" ",DA(1)=RCRTOT,DIC="^RCY(344.4,"_DA(1)_",2,",DIC("DR")=$S($P(Z0,U,2)'="":".02////"_$P(Z0,U,2),1:"")
"RTN","RCDPESR6",116,0)
 . S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_$S($P(Z0,U,4)'="":".03////"_$J(-$P(Z0,U,4)/100,"",2),1:"")
"RTN","RCDPESR6",117,0)
 . S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_$S($P(Z0,U,5)'="":".04////"_$P(Z0,U,5),1:""),DLAYGO=344.42
"RTN","RCDPESR6",118,0)
 . S:$O(^RCY(344.4,RCRTOT,2,"B",X,0)) X=""""_X_""""
"RTN","RCDPESR6",119,0)
 . D FILE^DICN K DIC,DO,DD
"RTN","RCDPESR6",120,0)
 Q
"RTN","RCDPESR6",121,0)
 ;
"RTN","RCDPESR6",122,0)
DUPREC(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,RCDUPEOB) ; Overflow from RCDPESR2
"RTN","RCDPESR6",123,0)
 S ^TMP("RCERR1",$J,RCCT)=" ",^TMP("RCERR1",$J,RCCT,1)=RCET_RCCT_RCSTAR
"RTN","RCDPESR6",124,0)
 S ^TMP("RCERR1",$J,RCCT,2)="(Warning): EEOB detail already filed for "_RCBILL_" - "_$S(RCALLDUP:"Duplicate not stored",1:"EEOB updated"),^TMP("RCERR1",$J,RCCT,3)=" " S:RCFILE=5 ^TMP("RCERR1",$J,RCCT,"*")=^TMP("RCERR1",$J,RCCT,2)
"RTN","RCDPESR6",125,0)
 I RCALLDUP S RCEOB="",RCDUPEOB=-1 Q
"RTN","RCDPESR6",126,0)
 S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=RCEOB
"RTN","RCDPESR6",127,0)
 Q
"RTN","RCDPESR6",128,0)
 ;
"RTN","RCDPESR9")
0^30^B71424370
"RTN","RCDPESR9",1,0)
RCDPESR9 ;ALB/TMK,DWA - ERA return file field captions ;09-SEP-2003
"RTN","RCDPESR9",2,0)
 ;;4.5;Accounts Receivable;**173,252,269**;Mar 20, 1995;Build 113
"RTN","RCDPESR9",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPESR9",4,0)
 ;
"RTN","RCDPESR9",5,0)
 ; Note: if the 835 flat file changes, make the corresponding changes
"RTN","RCDPESR9",6,0)
 ;       in this routine.
"RTN","RCDPESR9",7,0)
835 ;;HEADER DATA
"RTN","RCDPESR9",8,0)
 ;;835^^Return Message ID^S Y=X_" (ERA HEADER DATA)"
"RTN","RCDPESR9",9,0)
 ;;835^^X12/Proprietary flag^S Y=$S(X="X":"X12",1:X)
"RTN","RCDPESR9",10,0)
 ;;835^^File Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPESR9",11,0)
 ;;835^^File Time^S Y=$E(X,1,2)-$S($E(X,1,2)>12:12,1:0)_":"_$E(X,3,4)_$S($E(X,1,2)=24:" AM",$E(X,1,2)>11:" PM",1:" AM")
"RTN","RCDPESR9",12,0)
 ;;835^1^MRA^S Y=""
"RTN","RCDPESR9",13,0)
 ;;835^^Payer Name
"RTN","RCDPESR9",14,0)
 ;;835^^Payer ID
"RTN","RCDPESR9",15,0)
 ;;835^^Trace Number
"RTN","RCDPESR9",16,0)
 ;;835^^Date Claims Paid^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPESR9",17,0)
 ;;835^^Total ERA Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",18,0)
 ;;835^^Erroneous Provider Tax ID
"RTN","RCDPESR9",19,0)
 ;;835^^Tax ID correction Flag^S Y=$S(X="E":"CHANGED BY EPHRA",X="C":"DETERMINED FROM CLAIM DATA",X="":"NO CHANGE MADE",1:X)
"RTN","RCDPESR9",20,0)
 ;;835^^Sequence Control #
"RTN","RCDPESR9",21,0)
 ;;835^^Sequence #
"RTN","RCDPESR9",22,0)
 ;;835^^Last Sequence #
"RTN","RCDPESR9",23,0)
 ;;835^^Contact Information
"RTN","RCDPESR9",24,0)
 ;;835^^Payment Method Code
"RTN","RCDPESR9",25,0)
 ;;835^^Billing Provider NPI
"RTN","RCDPESR9",26,0)
 ;
"RTN","RCDPESR9",27,0)
01 ;;PAYER CONTACT INFORMATION
"RTN","RCDPESR9",28,0)
 ;;01^^Line Type^S Y=X_" (ERA LEVEL CONTACT DATA)"
"RTN","RCDPESR9",29,0)
 ;;01^^ERA Contact Name
"RTN","RCDPESR9",30,0)
 ;;01^^ERA Contact #1
"RTN","RCDPESR9",31,0)
 ;;01^^ERA Contact #1 Type^S Y=$$EXTERNAL^DILFD(344.4,3.03,,X)
"RTN","RCDPESR9",32,0)
 ;;01^^ERA Contact #2
"RTN","RCDPESR9",33,0)
 ;;01^^ERA Contact #2 Type^S Y=$$EXTERNAL^DILFD(344.4,3.05,,X)
"RTN","RCDPESR9",34,0)
 ;;01^^ERA Contact #3
"RTN","RCDPESR9",35,0)
 ;;01^^ERA Contact #3 Type^S Y=$$EXTERNAL^DILFD(344.4,3.07,,X)
"RTN","RCDPESR9",36,0)
 ;
"RTN","RCDPESR9",37,0)
02 ;;PAYER ADJUSTMENT RECORD
"RTN","RCDPESR9",38,0)
 ;;02^^Line Type^S Y=X_" (ERA LEVEL PAYER ADJUSTMENT RECORD)"
"RTN","RCDPESR9",39,0)
 ;;02^^X12 Adjustment Reason Code
"RTN","RCDPESR9",40,0)
 ;;02^^Provider Adjustment Identifier
"RTN","RCDPESR9",41,0)
 ;;02^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",42,0)
 ;;02^^X12 Reason Text
"RTN","RCDPESR9",43,0)
 ;
"RTN","RCDPESR9",44,0)
05 ;;CLAIM PATIENT ID
"RTN","RCDPESR9",45,0)
 ;;05^^Line Type^S Y=X_" (CLAIM LEVEL PATIENT ID DATA)"
"RTN","RCDPESR9",46,0)
 ;;05^^Bill #
"RTN","RCDPESR9",47,0)
 ;;05^^Patient Last Name
"RTN","RCDPESR9",48,0)
 ;;05^^Patient First Name
"RTN","RCDPESR9",49,0)
 ;;05^^Patient Middle Name
"RTN","RCDPESR9",50,0)
 ;;05^^Patient ID #
"RTN","RCDPESR9",51,0)
 ;;05^1^Record Contains Patient Name Change^S Y=""
"RTN","RCDPESR9",52,0)
 ;;05^1^Record Contains Patient ID Change^S Y=""
"RTN","RCDPESR9",53,0)
 ;;05^^Statement Start Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPESR9",54,0)
 ;;05^^Statement End Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPESR9",55,0)
 ;
"RTN","RCDPESR9",56,0)
06 ;;CORECT PATIENT DATA
"RTN","RCDPESR9",57,0)
 ;;06^^Line Type^S Y=X_" (CLAIM LEVEL CORRECT PATIENT DATA)"
"RTN","RCDPESR9",58,0)
 ;;06^^Bill #
"RTN","RCDPESR9",59,0)
 ;;06^^Corrected Patient Last Name
"RTN","RCDPESR9",60,0)
 ;;06^^Corrected Patient First Name
"RTN","RCDPESR9",61,0)
 ;;06^^Corrected Patient Middle Name
"RTN","RCDPESR9",62,0)
 ;;06^^Corrected Patient ID #
"RTN","RCDPESR9",63,0)
 ;
"RTN","RCDPESR9",64,0)
10 ;;CLAIM STATUS DATA
"RTN","RCDPESR9",65,0)
 ;;10^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM STATUS DATA)"
"RTN","RCDPESR9",66,0)
 ;;10^^Bill #
"RTN","RCDPESR9",67,0)
 ;;10^^Claim Processed^S Y=$$YN^RCDPESR9(X)
"RTN","RCDPESR9",68,0)
 ;;10^^Claim Denied^S Y=$$YN^RCDPESR9(X)
"RTN","RCDPESR9",69,0)
 ;;10^^Claim Pended^S Y=$$YN^RCDPESR9(X)
"RTN","RCDPESR9",70,0)
 ;;10^^Claim Reversal^S Y=$$YN^RCDPESR9(X)
"RTN","RCDPESR9",71,0)
 ;;10^^Claim Status Code
"RTN","RCDPESR9",72,0)
 ;;10^1^Crossed Over Name^S Y=""
"RTN","RCDPESR9",73,0)
 ;;10^1^Crossed Over ID^S Y=""
"RTN","RCDPESR9",74,0)
 ;;10^^Submitted Charge^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",75,0)
 ;;10^^Amount Paid^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",76,0)
 ;;10^^ICN
"RTN","RCDPESR9",77,0)
 ;;10^^DRG Code Used
"RTN","RCDPESR9",78,0)
 ;;10^^DRG Weight Used^S Y=$J($$ZERO^RCDPESR9(X,1)/100,4)
"RTN","RCDPESR9",79,0)
 ;;10^^Discharge Fraction^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",80,0)
 ;;10^^Rendering NPI
"RTN","RCDPESR9",81,0)
 ;;10^^Entity Type Qualifier
"RTN","RCDPESR9",82,0)
 ;;10^^Last Name
"RTN","RCDPESR9",83,0)
 ;;10^^First Name
"RTN","RCDPESR9",84,0)
 ;
"RTN","RCDPESR9",85,0)
15 ;;CLAIM STATUS DATA
"RTN","RCDPESR9",86,0)
 ;;15^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM STATUS DATA (CONTINUED))"
"RTN","RCDPESR9",87,0)
 ;;15^^Bill #
"RTN","RCDPESR9",88,0)
 ;;15^^Covered Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",89,0)
 ;;15^1^Discount Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",90,0)
 ;;15^1^Day Limit Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",91,0)
 ;;15^1^Interest Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",92,0)
 ;;15^1^Tax Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",93,0)
 ;;15^1^Total Before Taxes Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",94,0)
 ;;15^^Patient Responsibility Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",95,0)
 ;;15^1^Negative Reimbursement^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",96,0)
 ;
"RTN","RCDPESR9",97,0)
17 ;;CLAIM LEVEL PAYER CONTACT INFORMATION
"RTN","RCDPESR9",98,0)
 ;;17^^Line Type^S Y=X_" (CLAIM LEVEL PAYER CONTACT INFO)"
"RTN","RCDPESR9",99,0)
 ;;17^^Bill #
"RTN","RCDPESR9",100,0)
 ;;17^^Contact Name
"RTN","RCDPESR9",101,0)
 ;;17^^Contact #1
"RTN","RCDPESR9",102,0)
 ;;17^^Contact #1 Type^S Y=$$EXTERNAL^DILFD(361.1,25.03,,X)
"RTN","RCDPESR9",103,0)
 ;;17^^Contact #2
"RTN","RCDPESR9",104,0)
 ;;17^^Contact #2 Type^S Y=$$EXTERNAL^DILFD(361.1,25.05,,X)
"RTN","RCDPESR9",105,0)
 ;;17^^Contact #3
"RTN","RCDPESR9",106,0)
 ;;17^^Contact #3 Type^S Y=$$EXTERNAL^DILFD(361.1,25.07,,X)
"RTN","RCDPESR9",107,0)
 ;
"RTN","RCDPESR9",108,0)
20 ;;CLAIM LEVEL ADJUSTMENT DATA
"RTN","RCDPESR9",109,0)
 ;;20^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM ADJUSTMENT DATA)"
"RTN","RCDPESR9",110,0)
 ;;20^^Bill #
"RTN","RCDPESR9",111,0)
 ;;20^^Adjustment Group Code
"RTN","RCDPESR9",112,0)
 ;;20^^Adjustment Reason Code
"RTN","RCDPESR9",113,0)
 ;;20^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",114,0)
 ;;20^^Quantity^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPESR9",115,0)
 ;;20^^Reason Code Text
"RTN","RCDPESR9",116,0)
 ;
"RTN","RCDPESR9",117,0)
30 ;;CLAIM LEVEL MEDICARE INPT ADJUDICATION DATA
"RTN","RCDPESR9",118,0)
 ;;30^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE INPATIENT ADJUDICATION DATA)"
"RTN","RCDPESR9",119,0)
 ;;30^^Bill #
"RTN","RCDPESR9",120,0)
 ;;30^^Covered Days/Visits^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPESR9",121,0)
 ;;30^1^Lifetime Reserve Days Count^S Y=$$ZERO^RCDPESR9(X,,1)
"RTN","RCDPESR9",122,0)
 ;;30^1^Lifetime Psych Days Count^S Y=$$ZERO^RCDPESR9(X,,1)
"RTN","RCDPESR9",123,0)
 ;;30^^Claim DRG Amt^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",124,0)
 ;;30^1^Claim Disproportionate Share Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",125,0)
 ;;30^1^Claim MSP Pass thru Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",126,0)
 ;;30^1^Claim PPS Capital Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",127,0)
 ;;30^1^PPS-Capital FSP DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",128,0)
 ;;30^1^PPS-Capital HSP DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",129,0)
 ;;30^1^PPS-Capital DSH DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",130,0)
 ;;30^1^Old Capital Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",131,0)
 ;;30^^Non-Covered Days^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPESR9",132,0)
 ;
"RTN","RCDPESR9",133,0)
35 ;;CLAIM LEVEL MEDICARE ADJUDICATION DATA
"RTN","RCDPESR9",134,0)
 ;;35^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE ADJUDICATION DATA)"
"RTN","RCDPESR9",135,0)
 ;;35^^Bill #
"RTN","RCDPESR9",136,0)
 ;;35^1^PPS-Capital IME Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",137,0)
 ;;35^1^PPS-Operating Hosp Specific DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",138,0)
 ;;35^1^Cost Report Day Count^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPESR9",139,0)
 ;;35^1^PPS-Operating Fed Specific DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",140,0)
 ;;35^1^Claim PPS Capital Outlier Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",141,0)
 ;;35^1^Claim Indirect Teaching Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",142,0)
 ;;35^1^Non-payable Professional Component Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",143,0)
 ;;35^1^PPS-Capital Exception Amt^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",144,0)
 ;;35^1^Outpatient Reimbursement %^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPESR9",145,0)
 ;;35^1^HCPCS Payable Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",146,0)
 ;;35^1^ESRD Paid Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",147,0)
 ;;35^1^Non-payable Professional Component^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",148,0)
 ;
"RTN","RCDPESR9",149,0)
37 ;;CLAIM LEVEL MEDICARE ADJUDICATION DATA REMARKS
"RTN","RCDPESR9",150,0)
 ;;37^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE ADJUDICATION DATA REMARKS)"
"RTN","RCDPESR9",151,0)
 ;;37^^Bill #
"RTN","RCDPESR9",152,0)
 ;;37^^Type^S Y=$S(X="O":"MOA",X="I":"MIA",1:X)
"RTN","RCDPESR9",153,0)
 ;;37^^Claim Payment Remark Code
"RTN","RCDPESR9",154,0)
 ;;37^^Claim Payment Remark Code Message Text
"RTN","RCDPESR9",155,0)
 ;
"RTN","RCDPESR9",156,0)
40 ;;SERVICE LINE DATA
"RTN","RCDPESR9",157,0)
 ;;40^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA)"
"RTN","RCDPESR9",158,0)
 ;;40^^Bill #
"RTN","RCDPESR9",159,0)
 ;;40^^Procedure
"RTN","RCDPESR9",160,0)
 ;;40^^Revenue Code
"RTN","RCDPESR9",161,0)
 ;;40^^Modifier 1
"RTN","RCDPESR9",162,0)
 ;;40^^Modifier 2
"RTN","RCDPESR9",163,0)
 ;;40^^Modifier 3
"RTN","RCDPESR9",164,0)
 ;;40^^Modifier 4
"RTN","RCDPESR9",165,0)
 ;;40^^Description
"RTN","RCDPESR9",166,0)
 ;;40^^Original Procedure
"RTN","RCDPESR9",167,0)
 ;;40^^Original Modifier 1
"RTN","RCDPESR9",168,0)
 ;;40^^Original Modifier 2
"RTN","RCDPESR9",169,0)
 ;;40^^Original Modifier 3
"RTN","RCDPESR9",170,0)
 ;;40^^Original Modifier 4
"RTN","RCDPESR9",171,0)
 ;;40^^Original Charge^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",172,0)
 ;;40^^Original Units^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",173,0)
 ;;40^^Amount Paid^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",174,0)
 ;;40^^Covered Units^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",175,0)
 ;;40^^Service From Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPESR9",176,0)
 ;;40^^Service To Date^S Y=$$FDT^RCDPESR9(X)
"RTN","RCDPESR9",177,0)
 ;;40^^Procedure Type
"RTN","RCDPESR9",178,0)
 ;;40^^Applies to Billing Line
"RTN","RCDPESR9",179,0)
 ;
"RTN","RCDPESR9",180,0)
41 ;;SERVICE LINE DATA
"RTN","RCDPESR9",181,0)
 ;;41^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA (CONTINUED))"
"RTN","RCDPESR9",182,0)
 ;;41^^Bill #
"RTN","RCDPESR9",183,0)
 ;;41^^Allowed Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",184,0)
 ;;41^1^Per Diem Amount^S Y=$$ZERO^RCDPESR9(X,1,1)
"RTN","RCDPESR9",185,0)
 ;
"RTN","RCDPESR9",186,0)
42 ;;SERVICE LINE DATA
"RTN","RCDPESR9",187,0)
 ;;42^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA (CONTINUED))"
"RTN","RCDPESR9",188,0)
 ;;42^^Bill #
"RTN","RCDPESR9",189,0)
 ;;42^^Line Item Remark Code
"RTN","RCDPESR9",190,0)
 ;;42^^Line Item Remark Code Text
"RTN","RCDPESR9",191,0)
 ;
"RTN","RCDPESR9",192,0)
45 ;;SERVICE LINE ADJUSTMENT DATA
"RTN","RCDPESR9",193,0)
 ;;45^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE ADJUSTMENT DATA)"
"RTN","RCDPESR9",194,0)
 ;;45^^Bill #
"RTN","RCDPESR9",195,0)
 ;;45^^Adjustment Group Code
"RTN","RCDPESR9",196,0)
 ;;45^^Adjustment Reason Code
"RTN","RCDPESR9",197,0)
 ;;45^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1)
"RTN","RCDPESR9",198,0)
 ;;45^^Quantity^S Y=$$ZERO^RCDPESR9(X)
"RTN","RCDPESR9",199,0)
 ;;45^^Reason Code Text
"RTN","RCDPESR9",200,0)
 ;
"RTN","RCDPESR9",201,0)
FDT(X) ; returns MM/DD/YYYY or MM/DD/YY from YYYYMMDD or YYMMDD in X
"RTN","RCDPESR9",202,0)
 I $L(X)=8,X?8N S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
"RTN","RCDPESR9",203,0)
 I $L(X)=6,X?6N S X=$E(X,3,4)_"/"_$E(X,5,6)_"/"_$E(X,1,2)
"RTN","RCDPESR9",204,0)
 Q X
"RTN","RCDPESR9",205,0)
 ;
"RTN","RCDPESR9",206,0)
ZERO(X,D,NULL) ; Returns numeric value of X without leading 0's
"RTN","RCDPESR9",207,0)
 ; or null if no value wanted for 0 amount
"RTN","RCDPESR9",208,0)
 ; D = 1 if dollar amt
"RTN","RCDPESR9",209,0)
 N Z
"RTN","RCDPESR9",210,0)
 I X["." S Z=$P(X,"."),X=+Z_"."_$P(X,".",2)
"RTN","RCDPESR9",211,0)
 I X'["." D
"RTN","RCDPESR9",212,0)
 . I $G(D) S X=+$E(X,1,$L(X)-2)_"."_$E(X,$L(X)-1,$L(X))
"RTN","RCDPESR9",213,0)
 . S X=$S('$G(D):+X,1:$J(X,"",2))
"RTN","RCDPESR9",214,0)
 Q $S(X:X,$G(NULL):"",1:X)
"RTN","RCDPESR9",215,0)
 ;
"RTN","RCDPESR9",216,0)
YN(X) ; Returns YES for X="Y" and NO for X="N"
"RTN","RCDPESR9",217,0)
 S X=$S(X="Y":"YES",X="N":"NO",1:X)
"RTN","RCDPESR9",218,0)
 Q X
"RTN","RCDPESR9",219,0)
 ;
"RTN","RCDPETR")
0^31^B58479252
"RTN","RCDPETR",1,0)
RCDPETR ;ALB/TMK,PJH - EOB TRANSFER IN/TRANSFER OUT REPORTS ; 9/17/10 6:31pm
"RTN","RCDPETR",2,0)
 ;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
"RTN","RCDPETR",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPETR",4,0)
 ; IA for read access to ^IBM(361.1 = 4051
"RTN","RCDPETR",5,0)
 Q
"RTN","RCDPETR",6,0)
 ;
"RTN","RCDPETR",7,0)
RPT ; Transfer In/Out Report
"RTN","RCDPETR",8,0)
 N DIR,X,Y,POP,RCRPT,RCDT1,RCDT2,ZTRTN,ZTSK,ZTDESC,%ZIS
"RTN","RCDPETR",9,0)
 S DIR(0)="SBO^I:TRANSFER IN REPORT;O:TRANSFER OUT REPORT;B:BOTH REPORTS",DIR("A")="SELECT REPORT" D ^DIR K DIR
"RTN","RCDPETR",10,0)
 I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
"RTN","RCDPETR",11,0)
 S RCRPT=Y
"RTN","RCDPETR",12,0)
 S DIR("?")="ENTER THE EARLIEST TRANSFERRED FROM/TO DATE TO INCLUDE ON THE REPORT"
"RTN","RCDPETR",13,0)
 S DIR(0)="DAO^:"_DT_":APE",DIR("A")="START DATE: " D ^DIR K DIR
"RTN","RCDPETR",14,0)
 I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
"RTN","RCDPETR",15,0)
 S RCDT1=Y
"RTN","RCDPETR",16,0)
 S DIR("?")="ENTER THE LATEST TRANSFERRED FROM/TO DATE TO INCLUDE ON THE REPORT"
"RTN","RCDPETR",17,0)
 S DIR(0)="DAO^"_RCDT1_":"_DT_":APE",DIR("A")="END DATE: " D ^DIR K DIR
"RTN","RCDPETR",18,0)
 I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
"RTN","RCDPETR",19,0)
 S RCDT2=Y
"RTN","RCDPETR",20,0)
 ; Ask device
"RTN","RCDPETR",21,0)
 S %ZIS="QM" D ^%ZIS G:POP RPTQ
"RTN","RCDPETR",22,0)
 I $D(IO("Q")) D  G RPTQ
"RTN","RCDPETR",23,0)
 . S ZTRTN="EN^RCDPETR("_RCRPT_","_RCDT1_","_RCDT2_")",ZTDESC="AR - EDI LOCKBOX TRANSFERRED EEOB REPORT"
"RTN","RCDPETR",24,0)
 . D ^%ZTLOAD
"RTN","RCDPETR",25,0)
 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPETR",26,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPETR",27,0)
 U IO
"RTN","RCDPETR",28,0)
 D EN(RCRPT,RCDT1,RCDT2)
"RTN","RCDPETR",29,0)
RPTQ Q
"RTN","RCDPETR",30,0)
 ;
"RTN","RCDPETR",31,0)
EN(RCRPT,RCDT1,RCDT2) ; Entry point for queued job
"RTN","RCDPETR",32,0)
 N Q,Z,Z0,Z1,Z2,ZCT,RCSTOP,RCPG,RCDAT,RCDAT1,RCCT,RCACC,RCNOT,RCRCV,RCNRCV
"RTN","RCDPETR",33,0)
 K ^TMP($J,"RCDPE_TROUT"),^("RCDPE_TRIN")
"RTN","RCDPETR",34,0)
 S (RCSTOP,ZCT)=0
"RTN","RCDPETR",35,0)
 I RCRPT="O"!(RCRPT="B") D  ; Transfer out
"RTN","RCDPETR",36,0)
 . S Z=RCDT1-.0001
"RTN","RCDPETR",37,0)
 . F  S Z=$O(^RCY(344.4,"ATOUT",Z)) Q:'Z!RCSTOP  S Z0=0 F  S Z0=$O(^RCY(344.4,"ATOUT",Z,Z0)) Q:'Z0!(Z0>RCDT2)!RCSTOP  S Z1=0 F  S Z1=$O(^RCY(344.4,"ATOUT",Z,Z0,Z1)) Q:'Z1  D  Q:RCSTOP
"RTN","RCDPETR",38,0)
 .. Q:$$STOP(.ZCT,.RCSTOP,0)
"RTN","RCDPETR",39,0)
 .. ; EOB transferred out was found in date range
"RTN","RCDPETR",40,0)
 .. S ^TMP($J,"RCDPE_TROUT",Z,Z0,Z1)=$G(^RCY(344.4,Z0,1,Z1,0))
"RTN","RCDPETR",41,0)
 .. ; sbscrpts are: date,ien file 344.4,ien file 344.41
"RTN","RCDPETR",42,0)
 ;
"RTN","RCDPETR",43,0)
 I 'RCSTOP,(RCRPT="I"!(RCRPT="B")) D  ; Transfer in
"RTN","RCDPETR",44,0)
 . S Z=RCDT1-.0001 ;  Look for accepted ones
"RTN","RCDPETR",45,0)
 . F  S Z=$O(^IBM(361.1,"ATIN",Z)) Q:'Z!(Z>RCDT2)!RCSTOP  S Z0="" F  S Z0=$O(^IBM(361.1,"ATIN",Z,Z0)) Q:Z0=""!RCSTOP  S Z1=0 F  S Z1=$O(^IBM(361.1,"ATIN",Z,Z0,Z1)) Q:'Z1  D  Q:RCSTOP  ; IA 4051
"RTN","RCDPETR",46,0)
 .. ; EOB transfer in/accepted was found in date range
"RTN","RCDPETR",47,0)
 .. Q:$$STOP(.ZCT,.RCSTOP,0)
"RTN","RCDPETR",48,0)
 .. S ^TMP($J,"RCDPE_TRIN",Z,361.1,Z0,Z1)=$G(^IBM(361.1,Z1,0)) ; IA 4051
"RTN","RCDPETR",49,0)
 .. ;sbscrpts are: date,file,transferred from name,ien file 361.1
"RTN","RCDPETR",50,0)
 .. S ^TMP($J,"RCDPE_TRIN",Z,361.1,Z0,Z1,7)=$G(^IBM(361.1,Z1,7)) ; IA 4051
"RTN","RCDPETR",51,0)
 .. S ^TMP($J,"RCDPE_TRIN",Z,361.1,Z0,Z1,1)=$G(^IBM(361.1,Z1,1)) ; IA 4051
"RTN","RCDPETR",52,0)
 . Q:RCSTOP
"RTN","RCDPETR",53,0)
 . S Z=RCDT1-.0001 ;  Look for pending accept ones
"RTN","RCDPETR",54,0)
 . F  S Z=$O(^RCY(344.5,"ATIN",Z)) Q:Z'!(Z>RCDT2)!RCSTOP  S Z0="" F  S Z0=$O(^RCY(344.5,"ATIN",Z,Z0)) Q:Z0=""!RCSTOP  S Z1=0 F  S Z1=$O(^RCY(344.5,"ATIN",Z,Z0,Z1)) Q:'Z1  D  Q:RCSTOP
"RTN","RCDPETR",55,0)
 .. ; EOB transfer in/pending acceptance was found in date range
"RTN","RCDPETR",56,0)
 .. S ^TMP($J,"RCDPE_TRIN",Z,344.5,Z0,Z1)=$G(^RCY(344.5,Z1,0))
"RTN","RCDPETR",57,0)
 .. ;sbscrpts are: date,file,transferred from name,ien file 344.5
"RTN","RCDPETR",58,0)
 ;
"RTN","RCDPETR",59,0)
 G:RCSTOP ENQ
"RTN","RCDPETR",60,0)
 S (RCPG,RCCT,Z,RCACC,RCNOT,RCRCV,RCNRCV)=0
"RTN","RCDPETR",61,0)
 F  S Z=$O(^TMP($J,"RCDPE_TROUT",Z)) Q:'Z!RCSTOP  S Z0="" F  S Z0=$O(^TMP($J,"RCDPE_TROUT",Z,Z0)) Q:Z0=""!RCSTOP  S Z1=0 F  S Z1=$O(^TMP($J,"RCDPE_TROUT",Z,Z0,Z1)) Q:'Z1  S RCDAT=$G(^(Z1)) D  Q:RCSTOP
"RTN","RCDPETR",62,0)
 . I 'RCPG!(($Y+5)>IOSL) D HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2) Q:RCSTOP
"RTN","RCDPETR",63,0)
 . S Q=$$SETSTR^VALM1($P(RCDAT,U,5),"",1,11)
"RTN","RCDPETR",64,0)
 . S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P(RCDAT,U,12),"2D"),Q,14,8)
"RTN","RCDPETR",65,0)
 . S Q=$$SETSTR^VALM1($P($G(^DIC(4,+$P(RCDAT,U,11),0)),U),Q,24,20)
"RTN","RCDPETR",66,0)
 . S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P($G(^RCY(344.4,+Z0,0)),U,4),"2D"),Q,46,8)
"RTN","RCDPETR",67,0)
 . S Q=$$SETSTR^VALM1($J(+$P(RCDAT,U,3),"",2),Q,56,12)
"RTN","RCDPETR",68,0)
 . S Q=$$SETSTR^VALM1($S('$P(RCDAT,U,16):"NOT REC'D",$P(RCDAT,U,10)="":"REC'D",$P(RCDAT,U,10)=0:"NOT ACCPTD",1:"ACCPTD"),Q,70,10)
"RTN","RCDPETR",69,0)
 . I '$P(RCDAT,U,16) S RCNRCV=RCNRCV+1
"RTN","RCDPETR",70,0)
 . I $P(RCDAT,U,16)=1,$P(RCDAT,U,10)="" S RCRCV=RCRCV+1
"RTN","RCDPETR",71,0)
 . I $P(RCDAT,U,10) S RCACC=RCACC+1
"RTN","RCDPETR",72,0)
 . I $P(RCDAT,U,10)=0 S RCNOT=RCNOT+1
"RTN","RCDPETR",73,0)
 . D SETLINE(Q,.RCCT)
"RTN","RCDPETR",74,0)
 ;
"RTN","RCDPETR",75,0)
 G:RCSTOP ENQ
"RTN","RCDPETR",76,0)
 ; 
"RTN","RCDPETR",77,0)
 I RCRPT="B"!(RCRPT="O") D
"RTN","RCDPETR",78,0)
 . I '$O(^TMP($J,"RCDPE_TROUT",0)) D  Q
"RTN","RCDPETR",79,0)
 .. D HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2) Q:RCSTOP
"RTN","RCDPETR",80,0)
 .. D SETLINE("** THERE WERE NO EEOBs TRANSFERRED OUT WITHIN THE DATE RANGE SELECTED",.RCCT)
"RTN","RCDPETR",81,0)
 . I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2) Q:RCSTOP
"RTN","RCDPETR",82,0)
 . D SETLINE(" ",.RCCT)
"RTN","RCDPETR",83,0)
 . D SETLINE(" TOTAL # EEOBs NOT CONFIRMED AS 'RECEIVED' BY OTHER SITES: "_RCNRCV,.RCCT)
"RTN","RCDPETR",84,0)
 . D SETLINE(" TOTAL # EEOBs STILL JUST 'RECEIVED' BY OTHER SITES: "_RCRCV,.RCCT)
"RTN","RCDPETR",85,0)
 . D SETLINE(" TOTAL # EEOBs ACCEPTED BY OTHER SITES: "_RCACC,.RCCT)
"RTN","RCDPETR",86,0)
 . D SETLINE(" TOTAL # EEOBs NOT ACCEPTED BY OTHER SITES: "_RCNOT,.RCCT)
"RTN","RCDPETR",87,0)
 ;
"RTN","RCDPETR",88,0)
 G:RCSTOP ENQ
"RTN","RCDPETR",89,0)
 ;
"RTN","RCDPETR",90,0)
 I RCPG D ASK(.RCSTOP) G:RCSTOP ENQ
"RTN","RCDPETR",91,0)
 S (RCACC,RCNOT,RCPG)=0
"RTN","RCDPETR",92,0)
 S Z=0 F  S Z=$O(^TMP($J,"RCDPE_TRIN",Z)) Q:'Z  S Z0=0 F  S Z0=$O(^TMP($J,"RCDPE_TRIN",Z,Z0)) Q:'Z0  S Z1="" F  S Z1=$O(^TMP($J,"RCDPE_TRIN",Z,Z0,Z1)) Q:Z1=""  S Z2=0 F  S Z2=$O(^TMP($J,"RCDPE_TRIN",Z,Z0,Z1,Z2)) Q:'Z2  D
"RTN","RCDPETR",93,0)
 . S RCDAT=$G(^TMP($J,"RCDPE_TRIN",Z,Z0,Z1,Z2))
"RTN","RCDPETR",94,0)
 . I Z0=361.1 S RCDAT(7)=$G(^TMP($J,"RCDPE_TRIN",Z,Z0,Z1,Z2,7)),RCDAT(1)=$G(^(1))
"RTN","RCDPETR",95,0)
 . I 'RCPG!(($Y+5)>IOSL) D HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2) Q:RCSTOP
"RTN","RCDPETR",96,0)
 . I Z0=361.1 D
"RTN","RCDPETR",97,0)
 .. S Q=$$SETSTR^VALM1($$BN1^PRCAFN(+RCDAT),"",1,11)
"RTN","RCDPETR",98,0)
 .. S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P(RCDAT,U,5),"2D"),Q,14,8)
"RTN","RCDPETR",99,0)
 .. S Q=$$SETSTR^VALM1($P(RCDAT(7),U),Q,24,20)
"RTN","RCDPETR",100,0)
 .. S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P(RCDAT,U,6),"2D"),Q,46,8)
"RTN","RCDPETR",101,0)
 .. S Q=$$SETSTR^VALM1($J(+$P(RCDAT(1),U),"",2),Q,56,12)
"RTN","RCDPETR",102,0)
 .. S Q=$$SETSTR^VALM1("ACCEPTED",Q,70,10)
"RTN","RCDPETR",103,0)
 .. S RCACC=RCACC+1
"RTN","RCDPETR",104,0)
 . E  D
"RTN","RCDPETR",105,0)
 .. D RAWBILL(Z2,.RCDAT1)
"RTN","RCDPETR",106,0)
 .. S RCDAT1=+$O(RCDAT1(0)),RCDAT1=$G(RCDAT1(RCDAT1))
"RTN","RCDPETR",107,0)
 .. S Q=$$SETSTR^VALM1($P(RCDAT1,U),"",1,11)
"RTN","RCDPETR",108,0)
 .. S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P(RCDAT,U,3),"2D"),Q,14,8)
"RTN","RCDPETR",109,0)
 .. S Q=$$SETSTR^VALM1($P(RCDAT,U,12),Q,24,20)
"RTN","RCDPETR",110,0)
 .. S Q=$$SETSTR^VALM1($S($G(RCDAT1(0)):$E(RCDAT1(0),5,6)_"/"_$E(RCDAT1(0),7,8)_"/"_$E(RCDAT1(0),3,4),1:""),Q,46,8)
"RTN","RCDPETR",111,0)
 .. S Q=$$SETSTR^VALM1($J(+$P(RCDAT1,U,2),"",2),Q,56,12)
"RTN","RCDPETR",112,0)
 .. S Q=$$SETSTR^VALM1("PENDING",Q,70,10)
"RTN","RCDPETR",113,0)
 .. S RCNOT=RCNOT+1
"RTN","RCDPETR",114,0)
 . D SETLINE(Q,.RCCT)
"RTN","RCDPETR",115,0)
 ;
"RTN","RCDPETR",116,0)
 G:RCSTOP ENQ
"RTN","RCDPETR",117,0)
 ; 
"RTN","RCDPETR",118,0)
 I RCRPT="B"!(RCRPT="I") D
"RTN","RCDPETR",119,0)
 . I '$O(^TMP($J,"RCDPE_TRIN",0)) D  Q
"RTN","RCDPETR",120,0)
 .. D HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2) Q:RCSTOP
"RTN","RCDPETR",121,0)
 .. D SETLINE("** THERE WERE NO EEOBs TRANSFERRED 'IN' WITHIN THE DATE RANGE SELECTED",.RCCT)
"RTN","RCDPETR",122,0)
 . I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2) Q:RCSTOP
"RTN","RCDPETR",123,0)
 . D SETLINE(" ",.RCCT)
"RTN","RCDPETR",124,0)
 . D SETLINE(" TOTAL # EEOBs YOU ACCEPTED: "_RCACC,.RCCT)
"RTN","RCDPETR",125,0)
 . D SETLINE(" TOTAL # EEOBs STILL PENDING: "_RCNOT,.RCCT)
"RTN","RCDPETR",126,0)
 ;
"RTN","RCDPETR",127,0)
ENQ I '$D(ZTQUEUED) D ^%ZISC I 'RCSTOP,RCPG D ASK(.RCSTOP)
"RTN","RCDPETR",128,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPETR",129,0)
 K ^TMP($J,"RCDPE_TROUT"),^("RCDPE_TRIN")
"RTN","RCDPETR",130,0)
 Q
"RTN","RCDPETR",131,0)
 ;
"RTN","RCDPETR",132,0)
HDR(RCCT,RCPG,RCSTOP,RCINOUT,RCDT1,RCDT2) ;Prints report heading
"RTN","RCDPETR",133,0)
 ; Function returns RCPG = current page # and RCCT = running line count
"RTN","RCDPETR",134,0)
 ;   and RCSTOP = 1 if user aborted print
"RTN","RCDPETR",135,0)
 ; Parameters must be passed by reference
"RTN","RCDPETR",136,0)
 N Z,Z0
"RTN","RCDPETR",137,0)
 I RCPG!($E(IOST,1,2)="C-") D  Q:RCSTOP
"RTN","RCDPETR",138,0)
 . I RCPG&($E(IOST,1,2)="C-") D ASK(.RCSTOP) Q:RCSTOP
"RTN","RCDPETR",139,0)
 . W @IOF,*13 ; Write form feed
"RTN","RCDPETR",140,0)
 S RCPG=RCPG+1
"RTN","RCDPETR",141,0)
 S Z0="EDI LOCKBOX EEOBs TRANSFERRED "_$S(RCINOUT=1:"OUT",1:"IN")_" REPORT"
"RTN","RCDPETR",142,0)
 S Z=$$SETSTR^VALM1($J("",80-$L(Z0)\2)_Z0,"",1,79)
"RTN","RCDPETR",143,0)
 S Z=$$SETSTR^VALM1("Page: "_RCPG,Z,70,10)
"RTN","RCDPETR",144,0)
 D SETLINE(Z,.RCCT)
"RTN","RCDPETR",145,0)
 S Z0="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z0=$J("",80-$L(Z0)\2)_Z0
"RTN","RCDPETR",146,0)
 S Z=$$SETSTR^VALM1(Z0,"",1,79)
"RTN","RCDPETR",147,0)
 D SETLINE(Z,.RCCT)
"RTN","RCDPETR",148,0)
 D SETLINE(" ",.RCCT)
"RTN","RCDPETR",149,0)
 D SETLINE("DATE RANGE SELECTED: "_$$FMTE^XLFDT(RCDT1,2)_"-"_$$FMTE^XLFDT(RCDT2,2),.RCCT)
"RTN","RCDPETR",150,0)
 D SETLINE(" ",.RCCT)
"RTN","RCDPETR",151,0)
 S Z=$$SETSTR^VALM1($E("BILL #"_$J("",13),1,13)_"TRANS DT"_$J("",2)_$E("TRANS "_$S(RCINOUT=1:"TO",1:"FROM")_$J("",21),1,21)_"EEOB DATE"_$J("",2)_$E("AMT PAID"_$J("",14),1,14)_"STATUS","",1,80)
"RTN","RCDPETR",152,0)
 D SETLINE(Z,.RCCT)
"RTN","RCDPETR",153,0)
 D SETLINE($TR($J("",IOM-1)," ","="),.RCCT)
"RTN","RCDPETR",154,0)
 I $$STOP(99,.RCSTOP,0)
"RTN","RCDPETR",155,0)
 Q
"RTN","RCDPETR",156,0)
 ;
"RTN","RCDPETR",157,0)
SETLINE(Z,RCCT) ; Writes line
"RTN","RCDPETR",158,0)
 ; Z = txt to output
"RTN","RCDPETR",159,0)
 ; RCCT = line counter
"RTN","RCDPETR",160,0)
 S RCCT=RCCT+1
"RTN","RCDPETR",161,0)
 W !,Z
"RTN","RCDPETR",162,0)
 Q
"RTN","RCDPETR",163,0)
 ;
"RTN","RCDPETR",164,0)
ASK(RCSTOP) ; Ask to continue
"RTN","RCDPETR",165,0)
 ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
"RTN","RCDPETR",166,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPETR",167,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPETR",168,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPETR",169,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPETR",170,0)
 Q
"RTN","RCDPETR",171,0)
 ;
"RTN","RCDPETR",172,0)
STOP(CT,RCSTOP,RCPG) ; Function returns 1 if queued job/user requested forced exit
"RTN","RCDPETR",173,0)
 ; Function returns CT if passed by ref to only check every 100 records
"RTN","RCDPETR",174,0)
 S CT=CT+1
"RTN","RCDPETR",175,0)
 I (CT#100) Q 0
"RTN","RCDPETR",176,0)
 I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q 1
"RTN","RCDPETR",177,0)
 Q 0
"RTN","RCDPETR",178,0)
 ;
"RTN","RCDPETR",179,0)
RAWBILL(RC3445,RCDAT) ; Returns bill specific data for entry in file 344.5
"RTN","RCDPETR",180,0)
 ; RC3445 = Ien file 344.5
"RTN","RCDPETR",181,0)
 ; FUNCTION RETURNS RCDAT(SEQ #)=Bill #^amt pd^EOB date  (pass by ref)
"RTN","RCDPETR",182,0)
 N DAT,Z,Z0,RCT
"RTN","RCDPETR",183,0)
 S (RCT,Z)=0 F  S Z=$O(^RCY(344.5,RC3445,2,Z)) Q:'Z  S Z0=$G(^(Z,0)) D
"RTN","RCDPETR",184,0)
 . I +Z0=835 S RCDAT(0)=$P(Z0,U,3) Q
"RTN","RCDPETR",185,0)
 . I +Z0=10 S RCT=RCT+1,RCDAT(RCT)=$P(Z0,U,2)_U_$J($P(Z0,U,11)/100,"",2)
"RTN","RCDPETR",186,0)
 Q
"RTN","RCDPETR",187,0)
 ;
"RTN","RCDPEWL")
0^1^B44600003
"RTN","RCDPEWL",1,0)
RCDPEWL ;ALB/TMK/KML - ELECTRONIC EOB MESSAGE WORKLIST ; 5/24/11 4:46pm
"RTN","RCDPEWL",2,0)
 ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPEWL",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEWL",4,0)
 ; IA for read access to ^IBM(361.1 = 4051
"RTN","RCDPEWL",5,0)
 ;
"RTN","RCDPEWL",6,0)
EN ; Main entry point
"RTN","RCDPEWL",7,0)
 N RCFASTXT,DA,DIC,X,Y,RCERA,RCNOED
"RTN","RCDPEWL",8,0)
 D FULL^VALM1
"RTN","RCDPEWL",9,0)
 ;
"RTN","RCDPEWL",10,0)
 S DIR(0)="SA^L:LIST;S:SPECIFIC",DIR("A")="DO YOU WANT A (L)IST OF ERAs OR A (S)PECIFIC ONE?: ",DIR("B")="LIST" W ! D ^DIR K DIR
"RTN","RCDPEWL",11,0)
 G:$D(DTOUT)!$D(DUOUT) ENQ
"RTN","RCDPEWL",12,0)
 I Y="S" D  G ENQ
"RTN","RCDPEWL",13,0)
 . S DIC="^RCY(344.4,",DIC(0)="AEMQ" D ^DIC
"RTN","RCDPEWL",14,0)
 . I Y>0 D WL^RCDPEWL7(+Y)
"RTN","RCDPEWL",15,0)
 ;
"RTN","RCDPEWL",16,0)
 D PARAMS^RCDPEWL0
"RTN","RCDPEWL",17,0)
 I '$D(^TMP("RCERA_PARAMS",$J)) G ENQ
"RTN","RCDPEWL",18,0)
 D EN^VALM("RCDPE WORKLIST ERA LIST")
"RTN","RCDPEWL",19,0)
 ;
"RTN","RCDPEWL",20,0)
ENQ Q
"RTN","RCDPEWL",21,0)
 ;
"RTN","RCDPEWL",22,0)
DISP(RCERA,RCNOED) ; Entry to worklist from receipt processing
"RTN","RCDPEWL",23,0)
 ; RCERA = ien of entry in file 344.49
"RTN","RCDPEWL",24,0)
 ; RCNOED = 1 if receipt exists/no editing allowed
"RTN","RCDPEWL",25,0)
 ;        = 2 if no edit and called from receipt processing
"RTN","RCDPEWL",26,0)
 ;
"RTN","RCDPEWL",27,0)
 N DUOUT,DTOUT,DIC,DIK,X,Y,DIR,RCQUIT,DA,DIE,DR,RCSCR,RC0,RC5,RCDAT,RCUNM
"RTN","RCDPEWL",28,0)
 ;
"RTN","RCDPEWL",29,0)
 S RCSCR("NOEDIT")=+$G(RCNOED)
"RTN","RCDPEWL",30,0)
 S RCQUIT=0,RC0=$G(^RCY(344.4,RCERA,0)),RC5=$G(^RCY(344.4,RCERA,5))
"RTN","RCDPEWL",31,0)
 ;I $$HACERA^RCDPEU(RCERA) S DIR(0)="YA",DIR("A")="THIS ERA IS FROM CHAMPVA (HAC) - ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR("B")="YES" D ^DIR K DIR G:Y'=1 DISPQ
"RTN","RCDPEWL",32,0)
 I 'RCSCR("NOEDIT"),'$O(^RCY(344.49,"B",RCERA,0)) D  G:RCQUIT DISPQ
"RTN","RCDPEWL",33,0)
 . S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="NO WORKLIST SCRATCH PAD ENTRY EXISTS FOR THIS ERA",DIR("A")="DO YOU WANT TO CREATE ONE NOW?: "
"RTN","RCDPEWL",34,0)
 . W ! D ^DIR K DIR
"RTN","RCDPEWL",35,0)
 . I Y'=1 S RCERA=-1,RCQUIT=1 Q
"RTN","RCDPEWL",36,0)
 . ;
"RTN","RCDPEWL",37,0)
 . I $P(RC0,U,15)'="" W !!,"PAYMENT METHOD CODE REPORTED: "_$P(RC0,U,15),!
"RTN","RCDPEWL",38,0)
 . I $P(RC0,U,15)="" W !!,"NO PAYMENT METHOD CODE REPORTED",!
"RTN","RCDPEWL",39,0)
 . ;I $P(RC0,U,9)=0,$P(RC0,U,13)="",'$$HACERA^RCDPEU(RCERA) D  Q:RCQUIT
"RTN","RCDPEWL",40,0)
 . I $P(RC0,U,9)=0,$P(RC5,U,2)="" D  Q:RCQUIT
"RTN","RCDPEWL",41,0)
 .. S RCQUIT=0,RCUNM=0
"RTN","RCDPEWL",42,0)
 .. I +$P(RC0,U,5)=0,"ACH"'[(U_$P(RC0,U,15)_U) D  Q:RCQUIT!RCUNM
"RTN","RCDPEWL",43,0)
 ... S DIR("A",1)="THIS ERA HAS NO PAYMENT ASSOCIATED WITH IT AND CAN BE MARKED AS",DIR("A",2)="'MATCH-0 PAYMENT' TO REMOVE IT FROM THE ERA AGING REPORT IF NO PAPER CHECK OR",DIR("A",3)="EFT IS EXPECTED TO BE RECEIVED FOR THIS ERA"
"RTN","RCDPEWL",44,0)
 ... S DIR("?")="DO NOT RESPOND YES HERE UNLESS YOU ARE SURE THERE WILL BE NO EFT OR PAPER",DIR("?",1)=" CHECK TO BE RECEIVED FOR THIS 0-PAYMENT ERA"
"RTN","RCDPEWL",45,0)
 ... S DIR("A")="DO YOU WANT TO DO THIS?: "
"RTN","RCDPEWL",46,0)
 ... S DIR(0)="YA"
"RTN","RCDPEWL",47,0)
 ... D ^DIR K DIR
"RTN","RCDPEWL",48,0)
 ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEWL",49,0)
 ... I Y'=1 Q
"RTN","RCDPEWL",50,0)
 ... S DIE="^RCY(344.4,",DR=".09////3;.14////3",DA=RCERA D ^DIE S RCUNM=1
"RTN","RCDPEWL",51,0)
 .. I 'RCUNM D
"RTN","RCDPEWL",52,0)
 ... S DIR("A",1)="THIS ERA DOES NOT HAVE A MATCHING EFT",DIR("A")="ENTER THE NUMBER OF THE PAPER CHECK YOU RECEIVED FOR THIS ERA: ",DIR(0)="344.01,.07A"
"RTN","RCDPEWL",53,0)
 ... I $P(RC5,U,2)'="" S DIR("B")=$P(RC5,U,2)
"RTN","RCDPEWL",54,0)
 ... I $G(DIR("B"))="",$P(RC0,U,2)'="" S DIR("B")=$P(RC0,U,2)
"RTN","RCDPEWL",55,0)
 ... W ! D ^DIR K DIR
"RTN","RCDPEWL",56,0)
 ... I $D(DTOUT)!$D(DUOUT)!(Y="") D  S RCQUIT=1 Q
"RTN","RCDPEWL",57,0)
 .... S DIR(0)="EA",DIR("A",1)="THERE MUST EITHER BE A PAPER CHECK OR AN EFT FOR THIS ERA",DIR("A")="PRESS RETURN TO CONTINUE " W !!  D ^DIR K DIR
"RTN","RCDPEWL",58,0)
 ... S RCDAT("CHECK#")=Y
"RTN","RCDPEWL",59,0)
 ... S DIR(0)="344.01,.1O",DIR("B")=$$FMTE^XLFDT($P(RC0,U,4),2)
"RTN","RCDPEWL",60,0)
 ... W ! D ^DIR K DIR
"RTN","RCDPEWL",61,0)
 ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEWL",62,0)
 ... S RCDAT("CHECKDT")=Y
"RTN","RCDPEWL",63,0)
 ... S DIR(0)="344.01,.08O"
"RTN","RCDPEWL",64,0)
 ... W ! D ^DIR K DIR
"RTN","RCDPEWL",65,0)
 ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEWL",66,0)
 ... S RCDAT("BANK")=Y
"RTN","RCDPEWL",67,0)
 ... S DIR("A",1)="ERA #"_RCERA_" (TRACE #:"_$P(RC0,U,2)_") MATCHED TO PAPER CHECK "_RCDAT("CHECK#"),DIR("A")="IS THIS CORRECT?: ",DIR(0)="YA",DIR("B")="YES" W ! D ^DIR K DIR
"RTN","RCDPEWL",68,0)
 ... I Y'=1 S RCQUIT=1 Q
"RTN","RCDPEWL",69,0)
 ... S DIE="^RCY(344.4,",DA=RCERA,DR=".13////"_RCDAT("CHECK#")_";.09////2" D ^DIE
"RTN","RCDPEWL",70,0)
 ;
"RTN","RCDPEWL",71,0)
 S RCSCR=+$O(^RCY(344.49,"B",RCERA,0))
"RTN","RCDPEWL",72,0)
 I 'RCSCR D  ; Build the entry in file 344.49
"RTN","RCDPEWL",73,0)
 . I RCSCR("NOEDIT") D  Q
"RTN","RCDPEWL",74,0)
 .. S DIR("A")="NO WORKLIST ENTRY EXISTS FOR THIS ERA - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
"RTN","RCDPEWL",75,0)
 . ;
"RTN","RCDPEWL",76,0)
 . S RCSCR=+$$ADDREC(RCERA,.RCDAT)
"RTN","RCDPEWL",77,0)
 . I RCSCR D  Q:'RCSCR
"RTN","RCDPEWL",78,0)
 .. F X=1:1:6 L +^RCY(344.4,RCSCR):5 Q:$T  I X=6 D  Q
"RTN","RCDPEWL",79,0)
 ... S DA=RCSCR,DIK="^RCY(344.49," D ^DIK S RCSCR=0
"RTN","RCDPEWL",80,0)
 ... S DIR(0)="EA",DIR("A",1)="ANOTHER USER HAS LOCKED THIS ENTRY - NEW RECORD NOT CREATED",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL",81,0)
 .. Q:'RCSCR
"RTN","RCDPEWL",82,0)
 .. D SETBATCH^RCDPEWLB(RCSCR)
"RTN","RCDPEWL",83,0)
 .. D ADDLINES^RCDPEWLA(RCSCR)
"RTN","RCDPEWL",84,0)
 .. K ^TMP($J,"BATCHES")
"RTN","RCDPEWL",85,0)
 ;
"RTN","RCDPEWL",86,0)
 I RCSCR D  G:'RCSCR DISPQ
"RTN","RCDPEWL",87,0)
 . Q:'$$BAT^RCDPEWL7(RCSCR)
"RTN","RCDPEWL",88,0)
 . I 'RCSCR("NOEDIT"),'$G(^TMP("RCBATCH_SELECTED",$J)) L +^RCY(344.4,RCSCR):5 I '$T W !!,"Another user is currently editing this entry",! S DIR(0)="E" D ^DIR K DIR S RCSCR=0 Q
"RTN","RCDPEWL",89,0)
 . D EN^VALM("RCDPE EOB WORKLIST")
"RTN","RCDPEWL",90,0)
 ;
"RTN","RCDPEWL",91,0)
DISPQ L -^RCY(344.4,+$G(RCERA))
"RTN","RCDPEWL",92,0)
 Q
"RTN","RCDPEWL",93,0)
 ;
"RTN","RCDPEWL",94,0)
INIT ; -- set up initial variables
"RTN","RCDPEWL",95,0)
 N RCQUIT,RCREV,RCSORT
"RTN","RCDPEWL",96,0)
 S VALMCNT=0,VALMBG=1
"RTN","RCDPEWL",97,0)
 S RCQUIT=0
"RTN","RCDPEWL",98,0)
 I '$D(RCSCR) S VALMQUIT=1 Q
"RTN","RCDPEWL",99,0)
 S RCREV=+$O(^RCY(344.49,RCSCR,2,"B",DUZ,0))
"RTN","RCDPEWL",100,0)
 I $P($G(^RCY(344.49,RCSCR,2,RCREV,0)),U,2)=1 S $P(^TMP($J,"RC_SORTPARM"),U,2)=1
"RTN","RCDPEWL",101,0)
 S RCSORT=$$SELSORT^RCDPEWLA(.RCQUIT)
"RTN","RCDPEWL",102,0)
 I $G(RCQUIT) S VALMQUIT=1
"RTN","RCDPEWL",103,0)
 I '$G(RCQUIT) D BLD^RCDPEWL1(RCSORT)
"RTN","RCDPEWL",104,0)
 Q
"RTN","RCDPEWL",105,0)
 ;
"RTN","RCDPEWL",106,0)
ADDREC(RCERA,RCDAT) ; Add a record to file 344.49
"RTN","RCDPEWL",107,0)
 ; RCERA = ien of file 344.4
"RTN","RCDPEWL",108,0)
 ; RCDAT = array containing additional data to add to new entry
"RTN","RCDPEWL",109,0)
 ;
"RTN","RCDPEWL",110,0)
 N DIC,DLAYGO,X,Y,DO,DD,RCY,DINUM
"RTN","RCDPEWL",111,0)
 S RCY=0,DIC("DR")=""
"RTN","RCDPEWL",112,0)
 S DIC(0)="L",DLAYGO=344.49,(DINUM,X)=RCERA,DIC="^RCY(344.49,"
"RTN","RCDPEWL",113,0)
 I $G(RCDAT("CHECK#"))'="" S DIC("DR")=".04////"_RCDAT("CHECK#")_";"
"RTN","RCDPEWL",114,0)
 I $G(RCDAT("CHECKDT"))'="" S DIC("DR")=DIC("DR")_".05////"_RCDAT("CHECKDT")_";"
"RTN","RCDPEWL",115,0)
 I $G(RCDAT("BANK"))'="" S DIC("DR")=DIC("DR")_".06////"_RCDAT("BANK")_";"
"RTN","RCDPEWL",116,0)
 K DD,DO D FILE^DICN K DIC
"RTN","RCDPEWL",117,0)
 I Y>0 S RCY=+Y
"RTN","RCDPEWL",118,0)
 Q RCY
"RTN","RCDPEWL",119,0)
 ;
"RTN","RCDPEWL",120,0)
HDR ; Creates header lines for the selected ERA display
"RTN","RCDPEWL",121,0)
 N X,Z,RC,RC5,RCT
"RTN","RCDPEWL",122,0)
 I '$G(RCSCR) S VALMQUIT=1 Q
"RTN","RCDPEWL",123,0)
 S RC=$G(^RCY(344.4,+RCSCR,0)),RC5=$G(^RCY(344.4,+RCSCR,5))
"RTN","RCDPEWL",124,0)
 ; HIPAA 5010 - Payer Name extended from 35 to 60
"RTN","RCDPEWL",125,0)
 ; needs to go on separate line
"RTN","RCDPEWL",126,0)
 S VALMHDR(1)=$E("ERA Entry #: "_$P(RC,U)_$J("",31),1,31)_"Total Amt Pd: "_$J(+$P(RC,U,5),"",2)
"RTN","RCDPEWL",127,0)
 S VALMHDR(2)="Payer Name/ID: "_$P(RC,U,6)_"/"_$P(RC,U,3)
"RTN","RCDPEWL",128,0)
 S Z=+$O(^RCY(344.31,"AERA",+RCSCR,0))
"RTN","RCDPEWL",129,0)
 ; HIPAA 5010 - Trace # - increased in length from 30 to 50; needs to be on a separate line
"RTN","RCDPEWL",130,0)
 I Z S VALMHDR(3)="EFT #/TRACE #: "_$P($G(^RCY(344.3,+$G(^RCY(344.31,Z,0)),0)),U)_"/"_$P(RC,U,2)
"RTN","RCDPEWL",131,0)
 I 'Z,$P(RC5,U,2)'="" S VALMHDR(3)="PAPER CHECK #: "_$P(RC5,U,2)
"RTN","RCDPEWL",132,0)
 S RCT=2
"RTN","RCDPEWL",133,0)
 I $G(^TMP("RCBATCH_SELECTED",$J)) D
"RTN","RCDPEWL",134,0)
 . N Z,Z0
"RTN","RCDPEWL",135,0)
 . S Z=+$G(^TMP("RCBATCH_SELECTED",$J)),Z0=$G(^RCY(344.49,RCSCR,3,Z,0))
"RTN","RCDPEWL",136,0)
 . S RCT=RCT+1,VALMHDR(RCT)="BATCH: "_Z_"  "_$P(Z0,U,2)_"  "_$$EXTERNAL^DILFD(344.493,.03,"",$P(Z0,U,3))
"RTN","RCDPEWL",137,0)
 I $G(RCSCR("NOEDIT")) S RCT=RCT+1,VALMHDR(RCT)="*** RECEIPT ALREADY CREATED ("_$P($G(^RCY(344,+$P(RC,U,8),0)),U)_") ***"
"RTN","RCDPEWL",138,0)
 Q
"RTN","RCDPEWL",139,0)
 ;
"RTN","RCDPEWL",140,0)
FNL ; -- Clean up list
"RTN","RCDPEWL",141,0)
 K ^TMP("RCDPE-EOB_WLDX",$J),^TMP("RCDPE-EOB_WL",$J),^TMP($J,"RC_SORTPARM"),^TMP($J,"RC_BILL")
"RTN","RCDPEWL",142,0)
 D CLEAN^VALM10,CLEAR^VALM1
"RTN","RCDPEWL",143,0)
 K RCFASTXT
"RTN","RCDPEWL",144,0)
 Q
"RTN","RCDPEWL",145,0)
 ;
"RTN","RCDPEWL",146,0)
SEL(RCDA) ; Select entry from worklist scratch pad screen
"RTN","RCDPEWL",147,0)
 ; RCDA = array returned if selections made
"RTN","RCDPEWL",148,0)
 ;    RCDA(n)=ien of entry(s) in file 344.41 
"RTN","RCDPEWL",149,0)
 ;            where n = the line # selected  
"RTN","RCDPEWL",150,0)
 K RCDA
"RTN","RCDPEWL",151,0)
 N VALMY
"RTN","RCDPEWL",152,0)
 D EN^VALM2($G(XQORNOD(0)),"S")
"RTN","RCDPEWL",153,0)
 S RCDA=0 F  S RCDA=$O(VALMY(RCDA)) Q:'RCDA  S RCDA(RCDA)=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCDA)),U,2,5)
"RTN","RCDPEWL",154,0)
 Q
"RTN","RCDPEWL",155,0)
 ;
"RTN","RCDPEWL",156,0)
NOEDIT ; Display no edit allowed if receipt exists
"RTN","RCDPEWL",157,0)
 N DIR,X,Y
"RTN","RCDPEWL",158,0)
 S DIR(0)="EA",DIR("A",1)="THIS ACTION IS NOT AVAILABLE SINCE THE ERA ALREADY HAS A RECEIPT."
"RTN","RCDPEWL",159,0)
 S DIR("A")="PRESS RETURN TO CONTINUE "
"RTN","RCDPEWL",160,0)
 W ! D ^DIR K DIR W !
"RTN","RCDPEWL",161,0)
 Q
"RTN","RCDPEWL",162,0)
 ;
"RTN","RCDPEWL",163,0)
NOBATCH ; Display action not allowed if working at batch level not the ERA level
"RTN","RCDPEWL",164,0)
 N DIR,X,Y
"RTN","RCDPEWL",165,0)
 S DIR(0)="EA",DIR("A",1)="THIS ACTION IS NOT VALID WHEN IN A BATCH WITHIN THE ERA."
"RTN","RCDPEWL",166,0)
 S DIR("A")="PRESS RETURN TO CONTINUE "
"RTN","RCDPEWL",167,0)
 W ! D ^DIR K DIR W !
"RTN","RCDPEWL",168,0)
 Q
"RTN","RCDPEWL",169,0)
 ;
"RTN","RCDPEWL0")
0^27^B83670852
"RTN","RCDPEWL0",1,0)
RCDPEWL0 ;ALB/TMK/PJH - ELECTRONIC EOB WORKLIST ACTIONS ; 9/13/10 11:09am
"RTN","RCDPEWL0",2,0)
 ;;4.5;Accounts Receivable;**173,208,252,269**;Mar 20, 1995;Build 113
"RTN","RCDPEWL0",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPEWL0",4,0)
 Q
"RTN","RCDPEWL0",5,0)
 ;
"RTN","RCDPEWL0",6,0)
PARAMS ; Select params for ERA list
"RTN","RCDPEWL0",7,0)
 ; Return ^TMP("RCERA_PARAMS",$J) array
"RTN","RCDPEWL0",8,0)
 N DIR,X,Y,RCDFR,RCDTO,RCPAYR,RCQUIT,DUOUT,DTOUT
"RTN","RCDPEWL0",9,0)
 K ^TMP("RCERA_PARAMS",$J)
"RTN","RCDPEWL0",10,0)
 S RCQUIT=0
"RTN","RCDPEWL0",11,0)
 W !!,"SELECT PARAMETERS FOR DISPLAYING THE LIST OF ERAs"
"RTN","RCDPEWL0",12,0)
 S DIR(0)="SA^U:UNPOSTED;P:POSTED;B:BOTH",DIR("B")="UNPOSTED",DIR("A")="ERA POSTING STATUS: " W ! D ^DIR K DIR
"RTN","RCDPEWL0",13,0)
 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ
"RTN","RCDPEWL0",14,0)
 S ^TMP("RCERA_PARAMS",$J,"RCPOST")=Y
"RTN","RCDPEWL0",15,0)
 S DIR(0)="SA^N:NOT MATCHED;M:MATCHED;B:BOTH",DIR("B")="BOTH",DIR("A")="ERA-EFT MATCH STATUS: " W ! D ^DIR K DIR
"RTN","RCDPEWL0",16,0)
 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ
"RTN","RCDPEWL0",17,0)
 S ^TMP("RCERA_PARAMS",$J,"RCMATCH")=Y
"RTN","RCDPEWL0",18,0)
 ;
"RTN","RCDPEWL0",19,0)
DT1 S RCDTO=DT,RCDFR=0
"RTN","RCDPEWL0",20,0)
 S RCQUIT=0,DIR(0)="YA",DIR("A")="LIMIT THE SELECTION TO A DATE RANGE WHEN THE ERA WAS RECEIVED?: ",DIR("B")="NO" W ! D ^DIR K DIR
"RTN","RCDPEWL0",21,0)
 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ
"RTN","RCDPEWL0",22,0)
 I Y=1 S RCQUIT=0 D  I RCQUIT K ^TMP("RCERA_PARAMS",$J,"RCDT") G DT1
"RTN","RCDPEWL0",23,0)
 . S DIR(0)="DA",DIR("A")="EARLIEST DATE: " D ^DIR K DIR
"RTN","RCDPEWL0",24,0)
 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEWL0",25,0)
 . S RCDFR=Y
"RTN","RCDPEWL0",26,0)
 . S DIR(0)="DA^"_RCDFR_";"_DT,DIR("A")="LATEST DATE: " D ^DIR K DIR
"RTN","RCDPEWL0",27,0)
 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEWL0",28,0)
 . S RCDTO=Y
"RTN","RCDPEWL0",29,0)
 S ^TMP("RCERA_PARAMS",$J,"RCDT")=(RCDFR_U_RCDTO)
"RTN","RCDPEWL0",30,0)
 ;
"RTN","RCDPEWL0",31,0)
PAYR S RCQUIT=0,DIR(0)="SA^A:ALL;R:RANGE",DIR("A")="(A)LL PAYERS, (R)ANGE OF PAYER NAMES: ",DIR("B")="ALL" W ! D ^DIR K DIR
"RTN","RCDPEWL0",32,0)
 I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 G PARAMSQ
"RTN","RCDPEWL0",33,0)
 S RCPAYR=Y,^TMP("RCERA_PARAMS",$J,"RCPAYR")=Y
"RTN","RCDPEWL0",34,0)
 I RCPAYR="A" G PARAMSQ
"RTN","RCDPEWL0",35,0)
 I RCPAYR="R" D  I RCQUIT K ^TMP("RCERA_PARAMS",$J,"RCPAYR") G PAYR
"RTN","RCDPEWL0",36,0)
 . W !,"NAMES YOU SELECT HERE WILL BE THE PAYER NAMES FROM THE ERA, NOT THE INS FILE"
"RTN","RCDPEWL0",37,0)
 . S DIR("?")="ENTER A NAME BETWEEN 1 AND 30 CHARACTERS IN UPPERCASE"
"RTN","RCDPEWL0",38,0)
 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="START WITH PAYER NAME: " W ! D ^DIR K DIR
"RTN","RCDPEWL0",39,0)
 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEWL0",40,0)
 . S RCPAYR("FROM")=Y,$P(^TMP("RCERA_PARAMS",$J,"RCPAYR"),U,2)=Y
"RTN","RCDPEWL0",41,0)
 . S DIR("?")="ENTER A NAME BETWEEN 1 AND 30 CHARACTERS IN UPPERCASE"
"RTN","RCDPEWL0",42,0)
 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="GO TO PAYER NAME: ",DIR("B")=$E(RCPAYR("FROM"),1,27)_"ZZZ" W ! D ^DIR K DIR
"RTN","RCDPEWL0",43,0)
 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
"RTN","RCDPEWL0",44,0)
 . S $P(^TMP("RCERA_PARAMS",$J,"RCPAYR"),U,3)=Y
"RTN","RCDPEWL0",45,0)
 W !
"RTN","RCDPEWL0",46,0)
 ;
"RTN","RCDPEWL0",47,0)
PARAMSQ ;
"RTN","RCDPEWL0",48,0)
 D PARAMS^RCDPEWLD(.RCQUIT)
"RTN","RCDPEWL0",49,0)
 Q
"RTN","RCDPEWL0",50,0)
 ;
"RTN","RCDPEWL0",51,0)
FILTER(Y) ; Returns 1 if record in entry Y in 344.4 passes
"RTN","RCDPEWL0",52,0)
 ; the edits for the worklist selection of ERAs
"RTN","RCDPEWL0",53,0)
 ; Parameters found in ^TMP("RCERA_PARAMS",$J)
"RTN","RCDPEWL0",54,0)
 N OK,RCPOST,RCMATCH,RCDFR,RCDTO,RCPAYFR,RCPAYTO,RCPAYR,RC0
"RTN","RCDPEWL0",55,0)
 S OK=1,RC0=$G(^RCY(344.4,Y,0))
"RTN","RCDPEWL0",56,0)
 ;
"RTN","RCDPEWL0",57,0)
 S RCMATCH=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH")),RCPOST=$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))
"RTN","RCDPEWL0",58,0)
 S RCDFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTO=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2)
"RTN","RCDPEWL0",59,0)
 S RCPAYR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U),RCPAYFR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,2),RCPAYTO=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,3)
"RTN","RCDPEWL0",60,0)
 ;
"RTN","RCDPEWL0",61,0)
 ; If receipt exists, scratchpad must exist
"RTN","RCDPEWL0",62,0)
 ;I $P(RC0,U,8),'$D(^RCY(344.49,+Y,0)) S OK=0 G FQ
"RTN","RCDPEWL0",63,0)
 ; Post status
"RTN","RCDPEWL0",64,0)
 I $S(RCPOST="B":0,RCPOST="U":$P(RC0,U,14),1:'$P(RC0,U,14)) S OK=0 G FQ
"RTN","RCDPEWL0",65,0)
 ; Match status
"RTN","RCDPEWL0",66,0)
 I $S(RCMATCH="B":0,RCMATCH="N":$P(RC0,U,9),1:'$P(RC0,U,9)) S OK=0 G FQ
"RTN","RCDPEWL0",67,0)
 ; dt rec'd range
"RTN","RCDPEWL0",68,0)
 I $S(RCDFR=0:0,1:$P(RC0,U,7)\1<RCDFR) S OK=0 G FQ
"RTN","RCDPEWL0",69,0)
 I $S(RCDTO=DT:0,1:$P(RC0,U,7)\1>RCDTO) S OK=0 G FQ
"RTN","RCDPEWL0",70,0)
 ; Payer name
"RTN","RCDPEWL0",71,0)
 I RCPAYR'="A" D  G:'OK FQ
"RTN","RCDPEWL0",72,0)
 . N Q
"RTN","RCDPEWL0",73,0)
 . S Q=$$UPPER^RCDPEWL7($P(RC0,U,6))
"RTN","RCDPEWL0",74,0)
 . I $S(Q=RCPAYFR:1,Q=RCPAYTO:1,Q]RCPAYFR:RCPAYTO]Q,1:0) Q
"RTN","RCDPEWL0",75,0)
 . S OK=0
"RTN","RCDPEWL0",76,0)
FQ Q OK
"RTN","RCDPEWL0",77,0)
 ;
"RTN","RCDPEWL0",78,0)
SPLIT ; Split line in ERA list
"RTN","RCDPEWL0",79,0)
 N RCLINE,RCZ,RCDA,Q,Q0,Z,Z0,DIR,X,Y,CT,L,L1,RCONE,RCQUIT
"RTN","RCDPEWL0",80,0)
 D FULL^VALM1
"RTN","RCDPEWL0",81,0)
 I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G SPLITQ
"RTN","RCDPEWL0",82,0)
 W !!,"SELECT THE ENTRY THAT HAS A LINE YOU NEED TO SPLIT/EDIT",!
"RTN","RCDPEWL0",83,0)
 D SEL^RCDPEWL(.RCDA)
"RTN","RCDPEWL0",84,0)
 S Z=+$O(RCDA(0)) G:'$G(RCDA(Z)) SPLITQ
"RTN","RCDPEWL0",85,0)
 S RCLINE=+RCDA(Z),Z0=+$O(^TMP("RCDPE-EOB_WLDX",$J,Z_".999"),-1)
"RTN","RCDPEWL0",86,0)
 S RCZ=Z F  S RCZ=$O(^TMP("RCDPE-EOB_WLDX",$J,RCZ)) Q:'RCZ!(RCZ\1'=Z)  D
"RTN","RCDPEWL0",87,0)
 . S Q=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCZ)),U,2)
"RTN","RCDPEWL0",88,0)
 . Q:'Q
"RTN","RCDPEWL0",89,0)
 . S RCZ(RCZ)=Q
"RTN","RCDPEWL0",90,0)
 . S Q0=0 F  S Q0=$O(^RCY(344.49,RCSCR,1,Q,1,Q0)) Q:'Q0  I "01"[$P($G(^(Q0,0)),U,2) K RCZ(RCZ) Q
"RTN","RCDPEWL0",91,0)
 I '$O(RCZ(0)) D  G SPLITQ
"RTN","RCDPEWL0",92,0)
 . S DIR(0)="EA",DIR("A",1)="THIS ENTRY HAS NO LINES AVAILABLE TO EDIT/SPLIT",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL0",93,0)
 S RCQUIT=0
"RTN","RCDPEWL0",94,0)
 I $P($G(^RCY(344.49,RCSCR,1,RCLINE,0)),U,13) D  G:RCQUIT SPLITQ
"RTN","RCDPEWL0",95,0)
 . S DIR("A",1)="WARNING!  THIS LINE HAS ALREADY BEEN VERIFIED",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
"RTN","RCDPEWL0",96,0)
 . I Y'=1 S RCQUIT=1
"RTN","RCDPEWL0",97,0)
 S CT=0,CT=CT+1,DIR("?",CT)="Enter the line # that you want to split or edit:",RCONE=1
"RTN","RCDPEWL0",98,0)
 S L=Z F  S L=$O(RCZ(L)) Q:'L  D
"RTN","RCDPEWL0",99,0)
 . S L1=+$G(^TMP("RCDPE-EOB_WLDX",$J,L))
"RTN","RCDPEWL0",100,0)
 . S CT=CT+1
"RTN","RCDPEWL0",101,0)
 . S DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1,0)),CT=CT+1,DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1+1,0)) S RCONE(1)=$S(RCONE:L,1:"") S RCONE=0
"RTN","RCDPEWL0",102,0)
 S DIR("?")=" ",Y=-1
"RTN","RCDPEWL0",103,0)
 I $G(RCONE(1)) S Y=+RCONE(1) K DIR G:'Y SPLITQ
"RTN","RCDPEWL0",104,0)
 I '$G(RCONE(1)) D  K DIR I $D(DTOUT)!$D(DUOUT)!(Y\1'=Z) G SPLITQ
"RTN","RCDPEWL0",105,0)
 . F  S DIR(0)="NAO^"_(Z+.001)_":"_Z0_":3",DIR("A")="WHICH LINE OF ENTRY "_Z_" DO YOU WANT TO SPLIT/EDIT?: " S:$G(RCONE(1))'="" DIR("B")=RCONE(1) D ^DIR Q:'Y!$D(DUOUT)!$D(DTOUT)  D  Q:Y>0
"RTN","RCDPEWL0",106,0)
 .. I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !!,"LINE "_Y_" DOES NOT EXIST - TRY AGAIN",! S Y=-1 Q
"RTN","RCDPEWL0",107,0)
 .. I '$D(RCZ(Y)) W !!,"LINE "_Y_" HAS BEEN USED IN A DISTRIBUTE ADJ ACTION AND CAN'T BE EDITED",! S Y=-1 Q
"RTN","RCDPEWL0",108,0)
 .. S Q=+$O(^RCY(344.49,RCSCR,1,"B",Y,0))
"RTN","RCDPEWL0",109,0)
 ;
"RTN","RCDPEWL0",110,0)
 K ^TMP("RCDPE_SPLIT_REBLD",$J)
"RTN","RCDPEWL0",111,0)
 D SPLIT^RCDPEWL3(RCSCR,+Y)
"RTN","RCDPEWL0",112,0)
 I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
"RTN","RCDPEWL0",113,0)
 ;
"RTN","RCDPEWL0",114,0)
SPLITQ S VALMBCK="R"
"RTN","RCDPEWL0",115,0)
 Q
"RTN","RCDPEWL0",116,0)
 ;
"RTN","RCDPEWL0",117,0)
PRTERA ; View/prt
"RTN","RCDPEWL0",118,0)
 N DIC,X,Y,RCSCR
"RTN","RCDPEWL0",119,0)
 S DIC="^RCY(344.4,",DIC(0)="AEMQ" D ^DIC
"RTN","RCDPEWL0",120,0)
 Q:Y'>0
"RTN","RCDPEWL0",121,0)
 S RCSCR=+Y
"RTN","RCDPEWL0",122,0)
 D PRERA1
"RTN","RCDPEWL0",123,0)
 Q
"RTN","RCDPEWL0",124,0)
 ;
"RTN","RCDPEWL0",125,0)
PRERA ; RCSCR is assumed to be defined
"RTN","RCDPEWL0",126,0)
 D FULL^VALM1 ; Protocol entry
"RTN","RCDPEWL0",127,0)
PRERA1 ; Option entry
"RTN","RCDPEWL0",128,0)
 N %ZIS,ZTRTN,ZTSAVE,ZTDESC,POP,DIR,X,Y,RCERADET
"RTN","RCDPEWL0",129,0)
 S DIR("?",1)="INCLUDING EXPANDED DETAIL WILL SIGNIFICANTLY INCREASE THE SIZE OF THIS REPORT",DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE"
"RTN","RCDPEWL0",130,0)
 S DIR("?")="LISTED.  IF YOU WANT JUST SUMMARY DATA FOR EACH EEOB, DO NOT INCLUDE IT."
"RTN","RCDPEWL0",131,0)
 S DIR(0)="YA",DIR("A")="DO YOU WANT TO INCLUDE EXPANDED EEOB DETAIL?: ",DIR("B")="NO" W ! D ^DIR K DIR
"RTN","RCDPEWL0",132,0)
 I $D(DUOUT)!$D(DTOUT) G PRERAQ
"RTN","RCDPEWL0",133,0)
 S RCERADET=+Y
"RTN","RCDPEWL0",134,0)
 S %ZIS="QM" D ^%ZIS G:POP PRERAQ
"RTN","RCDPEWL0",135,0)
 I $D(IO("Q")) D  G PRERAQ
"RTN","RCDPEWL0",136,0)
 . S ZTRTN="VPERA^RCDPEWL0("_RCSCR_","_RCERADET_")",ZTDESC="AR - Print ERA From Worklist"
"RTN","RCDPEWL0",137,0)
 . D ^%ZTLOAD
"RTN","RCDPEWL0",138,0)
 . W !!,$S($D(ZTSK):"Your task # "_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPEWL0",139,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEWL0",140,0)
 U IO
"RTN","RCDPEWL0",141,0)
 D VPERA(RCSCR,RCERADET)
"RTN","RCDPEWL0",142,0)
 Q
"RTN","RCDPEWL0",143,0)
 ;
"RTN","RCDPEWL0",144,0)
VPERA(RCSCR,RCERADET) ; Queued entry
"RTN","RCDPEWL0",145,0)
 ; RCSCR = ien of entry in file 344.4
"RTN","RCDPEWL0",146,0)
 ; RCERADET = 1 if inclusion of all EOB details from file 361.1 is
"RTN","RCDPEWL0",147,0)
 ;  desired, 0 if not
"RTN","RCDPEWL0",148,0)
 N Z,Z0,RCSTOP,RCZ,RCPG,RCDOT,RCDIQ,RCDIQ1,RCDIQ2,RCXM1,RC,RCSCR1,RC3611
"RTN","RCDPEWL0",149,0)
 K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"RC_SUMALL")
"RTN","RCDPEWL0",150,0)
 S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)=""
"RTN","RCDPEWL0",151,0)
 D GETS^DIQ(344.4,RCSCR_",","*","IEN","RCDIQ")
"RTN","RCDPEWL0",152,0)
 D TXT0^RCDPEX31(RCSCR,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned flds
"RTN","RCDPEWL0",153,0)
 I $O(^RCY(344.4,RCSCR,2,0)) S RC=RC+1,RCXM1(RC)="  **ERA LEVEL ADJUSTMENTS**"
"RTN","RCDPEWL0",154,0)
 S RCSCR1=0 F  S RCSCR1=$O(^RCY(344.4,RCSCR,2,RCSCR1)) Q:'RCSCR1  D
"RTN","RCDPEWL0",155,0)
 . K RCDIQ2
"RTN","RCDPEWL0",156,0)
 . D GETS^DIQ(344.42,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ2")
"RTN","RCDPEWL0",157,0)
 . D TXT2^RCDPEX31(RCSCR,RCSCR1,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs
"RTN","RCDPEWL0",158,0)
 S RCSCR1=0 F  S RCSCR1=$O(^RCY(344.4,RCSCR,1,RCSCR1)) Q:'RCSCR1  D
"RTN","RCDPEWL0",159,0)
 . K RCDIQ1
"RTN","RCDPEWL0",160,0)
 . D GETS^DIQ(344.41,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ1")
"RTN","RCDPEWL0",161,0)
 . D TXT00^RCDPEX31(RCSCR,RCSCR1,.RCDIQ1,.RCXM1,.RC)
"RTN","RCDPEWL0",162,0)
 . ;HIPAA 5010 
"RTN","RCDPEWL0",163,0)
 . N PNAME4
"RTN","RCDPEWL0",164,0)
 . S PNAME4=$$PNM4^RCDPEWL1(RCSCR,RCSCR1)
"RTN","RCDPEWL0",165,0)
 . I $L(PNAME4)<32 D
"RTN","RCDPEWL0",166,0)
 . .S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_PNAME4_$J("",41),1,41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1),RCXM1(RC)=" "
"RTN","RCDPEWL0",167,0)
 . I $L(PNAME4)>31 D
"RTN","RCDPEWL0",168,0)
 . .S RC=RC+1,RCXM1(RC-1)=$J("",41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1)
"RTN","RCDPEWL0",169,0)
 . .S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_PNAME4,1,78),RCXM1(RC)=" "
"RTN","RCDPEWL0",170,0)
 . D PROV^RCDPEWLD(RCSCR,RCSCR1,.RCXM1,.RC)
"RTN","RCDPEWL0",171,0)
 . S RC3611=$P($G(^RCY(344.4,RCSCR,1,RCSCR1,0)),U,2)
"RTN","RCDPEWL0",172,0)
 . I RCERADET D
"RTN","RCDPEWL0",173,0)
 .. I 'RC3611 D  Q
"RTN","RCDPEWL0",174,0)
 ... D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_RCSCR1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75,1)
"RTN","RCDPEWL0",175,0)
 ..;
"RTN","RCDPEWL0",176,0)
 .. E  D  ; Detail record is in 361.1
"RTN","RCDPEWL0",177,0)
 ... K ^TMP("PRCA_EOB",$J)
"RTN","RCDPEWL0",178,0)
 ... D GETEOB^IBCECSA6(RC3611,2)
"RTN","RCDPEWL0",179,0)
 ... I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors
"RTN","RCDPEWL0",180,0)
 ... S Z=0 F  S Z=$O(^TMP("PRCA_EOB",$J,RC3611,Z)) Q:'Z  S RC=RC+1,^TMP($J,"RC_SUMOUT",RC)=$G(^TMP("PRCA_EOB",$J,RC3611,Z))
"RTN","RCDPEWL0",181,0)
 ... S RC=RC+2,^TMP($J,"RC_SUMOUT",RC-1)=" ",^TMP($J,"RC_SUMOUT",RC)=" "
"RTN","RCDPEWL0",182,0)
 ... K ^TMP("PRCA_EOB",$J)
"RTN","RCDPEWL0",183,0)
 . I $D(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2)) D
"RTN","RCDPEWL0",184,0)
 .. S RC=RC+1,RCXM1(RC)="  **EXCEPTION RESOLUTION LOG DATA**"
"RTN","RCDPEWL0",185,0)
 .. S Z=0 F  S Z=$O(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)) Q:'Z  S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)
"RTN","RCDPEWL0",186,0)
 . S RC=RC+1,RCXM1(RC)=" "
"RTN","RCDPEWL0",187,0)
 . S Z0=+$O(^TMP($J,"RC_SUMALL"," "),-1)
"RTN","RCDPEWL0",188,0)
 . S Z=0 F  S Z=$O(RCXM1(Z)) Q:'Z  S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=RCXM1(Z)
"RTN","RCDPEWL0",189,0)
 . K RCXM1 S RC=0
"RTN","RCDPEWL0",190,0)
 . S Z=0 F  S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z  S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=$G(^TMP($J,"RC_SUMOUT",Z))
"RTN","RCDPEWL0",191,0)
 S RCSTOP=0,Z=""
"RTN","RCDPEWL0",192,0)
 F  S Z=$O(^TMP($J,"RC_SUMALL",Z)) Q:'Z  D  Q:RCSTOP
"RTN","RCDPEWL0",193,0)
 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q
"RTN","RCDPEWL0",194,0)
 . I 'RCPG!(($Y+5)>IOSL) D  I RCSTOP Q
"RTN","RCDPEWL0",195,0)
 .. D:RCPG ASK(.RCSTOP) I RCSTOP Q
"RTN","RCDPEWL0",196,0)
 .. D HDR(.RCPG)
"RTN","RCDPEWL0",197,0)
 . W !,$G(^TMP($J,"RC_SUMALL",Z))
"RTN","RCDPEWL0",198,0)
 ;
"RTN","RCDPEWL0",199,0)
 I 'RCSTOP,RCPG D ASK(.RCSTOP)
"RTN","RCDPEWL0",200,0)
 ;
"RTN","RCDPEWL0",201,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPEWL0",202,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPEWL0",203,0)
 ;
"RTN","RCDPEWL0",204,0)
PRERAQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"SUMALL")
"RTN","RCDPEWL0",205,0)
 S VALMBCK="R"
"RTN","RCDPEWL0",206,0)
 Q
"RTN","RCDPEWL0",207,0)
 ;
"RTN","RCDPEWL0",208,0)
HDR(RCPG) ;Report hdr
"RTN","RCDPEWL0",209,0)
 ; RCPG = last page #
"RTN","RCDPEWL0",210,0)
 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
"RTN","RCDPEWL0",211,0)
 S RCPG=$G(RCPG)+1
"RTN","RCDPEWL0",212,0)
 W !,?5,"EDI LOCKBOX WORKLIST - ERA DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=")
"RTN","RCDPEWL0",213,0)
 Q
"RTN","RCDPEWL0",214,0)
 ;
"RTN","RCDPEWL0",215,0)
ASK(RCSTOP) ;
"RTN","RCDPEWL0",216,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEWL0",217,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEWL0",218,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEWL0",219,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEWL0",220,0)
 Q
"RTN","RCDPEWL0",221,0)
 ;
"RTN","RCDPEWL2")
0^2^B84334841
"RTN","RCDPEWL2",1,0)
RCDPEWL2 ;ALB/TMK/KML - ELECTRONIC EOB WORKLIST ACTIONS ; 7/7/10 6:43pm
"RTN","RCDPEWL2",2,0)
 ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPEWL2",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEWL2",4,0)
 ; IA for call to OPTION^IBJTLA = 4121
"RTN","RCDPEWL2",5,0)
 ; IA for call to ASK^IBRREL = 306
"RTN","RCDPEWL2",6,0)
 ; IA call for EN1AR^IBECEA = 4047
"RTN","RCDPEWL2",7,0)
 ; IA call for MAIN^IBOHPT1 = 4048
"RTN","RCDPEWL2",8,0)
 ; IA for read access to ^IBM(361.1 = 4051
"RTN","RCDPEWL2",9,0)
 Q
"RTN","RCDPEWL2",10,0)
 ;
"RTN","RCDPEWL2",11,0)
VP(RCSCR,RCDAZ) ; View/Print EOB Detail data from file 361.1
"RTN","RCDPEWL2",12,0)
 ; RCSCR = ien of entry in file 344.4
"RTN","RCDPEWL2",13,0)
 ; RCDAZ = array subscripted by a sequential # and
"RTN","RCDPEWL2",14,0)
 ;   RCDAZ(n) = one of 3 formats
"RTN","RCDPEWL2",15,0)
 ;     ERA level adjustments
"RTN","RCDPEWL2",16,0)
 ;          ADJ^the ien of the adj in 344.42
"RTN","RCDPEWL2",17,0)
 ;     EOB exists in file 361.1:
"RTN","RCDPEWL2",18,0)
 ;          ien of line in 344.41^ien of 361.1
"RTN","RCDPEWL2",19,0)
 ;     EOB doesn't exist in 361.1:
"RTN","RCDPEWL2",20,0)
 ;          ien of line in 344.41^-1
"RTN","RCDPEWL2",21,0)
 ;
"RTN","RCDPEWL2",22,0)
 N RCDA,%ZIS,ZTRTN,ZTSAVE,ZTDESC,POP
"RTN","RCDPEWL2",23,0)
 ; Ask device
"RTN","RCDPEWL2",24,0)
 S %ZIS="QM" D ^%ZIS G:POP VPQ
"RTN","RCDPEWL2",25,0)
 I $D(IO("Q")) D  G VPQ
"RTN","RCDPEWL2",26,0)
 . S ZTRTN="VPOUT^RCDPEWL2",ZTDESC="AR - Print EEOB Detail from Worklist"
"RTN","RCDPEWL2",27,0)
 . S ZTSAVE("RC*")=""
"RTN","RCDPEWL2",28,0)
 . D ^%ZTLOAD
"RTN","RCDPEWL2",29,0)
 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPEWL2",30,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEWL2",31,0)
 U IO
"RTN","RCDPEWL2",32,0)
 ;
"RTN","RCDPEWL2",33,0)
VPOUT ; Entrypoint for queued job
"RTN","RCDPEWL2",34,0)
 N Z,Z0,RCSTOP,RCPG,RCREF,RC3611,RCDASH,RCDT,RC1,RC3444,RCZ,RCZ0
"RTN","RCDPEWL2",35,0)
 ;
"RTN","RCDPEWL2",36,0)
 K ^TMP("PRCA_EOB",$J),^TMP("PRCA_EOB1",$J)
"RTN","RCDPEWL2",37,0)
 S RCDT=DT,(RCSTOP,RCPG)=0,RC3444=RCSCR,RCDASH="",$P(RCDASH,"-",71)=""
"RTN","RCDPEWL2",38,0)
 I '$O(RCDAZ(0)) G VPQ
"RTN","RCDPEWL2",39,0)
 S RCZ=0 F  S RCZ=$O(RCDAZ(RCZ)) Q:'RCZ  D
"RTN","RCDPEWL2",40,0)
 . S RCREF=$P(RCDAZ(RCZ),U),RC3611=+$P(RCDAZ(RCZ),U,2)
"RTN","RCDPEWL2",41,0)
 . K ^TMP("PRCA_EOB1",$J,RC3611)
"RTN","RCDPEWL2",42,0)
 . ;
"RTN","RCDPEWL2",43,0)
 . I $E(RCREF,1,3)["ADJ" D  Q
"RTN","RCDPEWL2",44,0)
 .. ;Display ERA level adj
"RTN","RCDPEWL2",45,0)
 .. S RCZ0=$G(^RCY(344.4,RCSCR,2,RC3611,0))
"RTN","RCDPEWL2",46,0)
 .. S ^TMP("PRCA_EOB",$J,"ADJ",1)="ERA LEVEL ADJUSTMENT #"_RC3611
"RTN","RCDPEWL2",47,0)
 .. S ^TMP("PRCA_EOB",$J,"ADJ",2)="   ADJUSTMENT REFERENCE #: "_$P(RCZ0,U)
"RTN","RCDPEWL2",48,0)
 .. S ^TMP("PRCA_EOB",$J,"ADJ",3)="   ADJUSTMENT REASON CODE: "_$P(RCZ0,U,2)
"RTN","RCDPEWL2",49,0)
 .. S ^TMP("PRCA_EOB",$J,"ADJ",4)="        ADJUSTMENT AMOUNT: "_$J(+$P(RCZ0,U,3),"",2)
"RTN","RCDPEWL2",50,0)
 .. S ^TMP("PRCA_EOB",$J,"ADJ",5)=RCDASH
"RTN","RCDPEWL2",51,0)
 . ;
"RTN","RCDPEWL2",52,0)
 . I $P(RCDAZ(RCZ),U,2)'>0 D  Q
"RTN","RCDPEWL2",53,0)
 .. ;Display formatted raw data - no EOB data in 361.1
"RTN","RCDPEWL2",54,0)
 .. K ^TMP($J,"RC_SUMRAW")
"RTN","RCDPEWL2",55,0)
 .. D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_+RCDAZ(RCZ)_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP(""PRCA_EOB"",$J,0)")
"RTN","RCDPEWL2",56,0)
 .. S ^TMP("PRCA_EOB1",$J,RC3611,1)="CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,+RCDAZ(RCZ))_"*** NOT IDENTIFIED IN A/R ****"_$S($P($G(^RCY(344.4,RCSCR,1,+RCDAZ(RCZ),0)),U,14):" (REVERSAL)",1:"")
"RTN","RCDPEWL2",57,0)
 .. K ^TMP($J,"RC_SUMRAW")
"RTN","RCDPEWL2",58,0)
 .. S ^TMP("PRCA_EOB",$J,+$O(^TMP("PRCA_EOB",$J,""),-1)+1)=RCDASH
"RTN","RCDPEWL2",59,0)
 . ;
"RTN","RCDPEWL2",60,0)
 . K ^TMP("PRCA_EOB1",$J,RC3611)
"RTN","RCDPEWL2",61,0)
 . S ^TMP("PRCA_EOB1",$J,RC3611,1)="CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,+RCDAZ(RCZ))_$S($P($G(^RCY(344.4,RCSCR,1,+RCDAZ(RCZ),0)),U,14):" (REVERSAL)",1:"")
"RTN","RCDPEWL2",62,0)
 . D GETEOB^IBCECSA6(RC3611,2)
"RTN","RCDPEWL2",63,0)
 . I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors
"RTN","RCDPEWL2",64,0)
 . S ^TMP("PRCA_EOB",$J,+$O(^TMP("PRCA_EOB",$J,""),-1)+1)=RCDASH
"RTN","RCDPEWL2",65,0)
 . ;
"RTN","RCDPEWL2",66,0)
 S RC3611="" F  S RC3611=$O(^TMP("PRCA_EOB",$J,RC3611)) Q:RC3611=""!RCSTOP  D
"RTN","RCDPEWL2",67,0)
 . S RC1=1
"RTN","RCDPEWL2",68,0)
 . S Z0=0 F  S Z0=$O(^TMP("PRCA_EOB",$J,RC3611,Z0)) Q:'Z0  D  Q:RCSTOP
"RTN","RCDPEWL2",69,0)
 .. I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q
"RTN","RCDPEWL2",70,0)
 .. I 'RCPG!(($Y+5)>IOSL) D  I RCSTOP Q
"RTN","RCDPEWL2",71,0)
 ... D:RCPG ASK(.RCSTOP) I RCSTOP Q
"RTN","RCDPEWL2",72,0)
 ... D RHDR(RCSCR,RCDT,.RCPG)
"RTN","RCDPEWL2",73,0)
 .. I RC1 W !!,$G(^TMP("PRCA_EOB1",$J,RC3611,1)) S RC1=0
"RTN","RCDPEWL2",74,0)
 .. W !,$G(^TMP("PRCA_EOB",$J,RC3611,Z0))
"RTN","RCDPEWL2",75,0)
 I 'RCSTOP,RCPG D ASK(.RCSTOP)
"RTN","RCDPEWL2",76,0)
 ;
"RTN","RCDPEWL2",77,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPEWL2",78,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPEWL2",79,0)
 ;
"RTN","RCDPEWL2",80,0)
VPQ K ^TMP("PRCA_EOB",$J),^TMP("PRCA_EOB1",$J)
"RTN","RCDPEWL2",81,0)
 S VALMBCK="R"
"RTN","RCDPEWL2",82,0)
 Q
"RTN","RCDPEWL2",83,0)
 ;
"RTN","RCDPEWL2",84,0)
TPJI ; Jump to Third Party Joint Inquiry for the claim
"RTN","RCDPEWL2",85,0)
 D FULL^VALM1
"RTN","RCDPEWL2",86,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G TPJIQ
"RTN","RCDPEWL2",87,0)
 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
"RTN","RCDPEWL2",88,0)
 D OPTION^IBJTLA ; IA 4121
"RTN","RCDPEWL2",89,0)
 D RESTMP^RCDPEWL6
"RTN","RCDPEWL2",90,0)
 ;
"RTN","RCDPEWL2",91,0)
TPJIQ S VALMBCK="R"
"RTN","RCDPEWL2",92,0)
 Q
"RTN","RCDPEWL2",93,0)
 ;
"RTN","RCDPEWL2",94,0)
FAP ; Jump to Full Account Profile
"RTN","RCDPEWL2",95,0)
 D FULL^VALM1
"RTN","RCDPEWL2",96,0)
 ;
"RTN","RCDPEWL2",97,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G FAPQ
"RTN","RCDPEWL2",98,0)
 ;
"RTN","RCDPEWL2",99,0)
 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
"RTN","RCDPEWL2",100,0)
 D EN^PRCAAPR("ALL"),RET K DTOUT
"RTN","RCDPEWL2",101,0)
 D RESTMP^RCDPEWL6
"RTN","RCDPEWL2",102,0)
 ;
"RTN","RCDPEWL2",103,0)
FAPQ S VALMBCK="R"
"RTN","RCDPEWL2",104,0)
 Q
"RTN","RCDPEWL2",105,0)
 ;
"RTN","RCDPEWL2",106,0)
RELHOLD ; Jump to Release Hold function
"RTN","RCDPEWL2",107,0)
 N DIR,X,Y,RCDA,RCSCR
"RTN","RCDPEWL2",108,0)
 D FULL^VALM1
"RTN","RCDPEWL2",109,0)
 ;
"RTN","RCDPEWL2",110,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G RELHQ
"RTN","RCDPEWL2",111,0)
 ;
"RTN","RCDPEWL2",112,0)
 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
"RTN","RCDPEWL2",113,0)
 D ^IBRREL,RET ; IA = 306
"RTN","RCDPEWL2",114,0)
 D RESTMP^RCDPEWL6
"RTN","RCDPEWL2",115,0)
 ;
"RTN","RCDPEWL2",116,0)
RELHQ S VALMBCK="R"
"RTN","RCDPEWL2",117,0)
 Q
"RTN","RCDPEWL2",118,0)
 ;
"RTN","RCDPEWL2",119,0)
CMRPT ; Jump to claims matching report
"RTN","RCDPEWL2",120,0)
 N DIR,X,Y,RCIBY
"RTN","RCDPEWL2",121,0)
 D FULL^VALM1
"RTN","RCDPEWL2",122,0)
 ;
"RTN","RCDPEWL2",123,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G CMQ
"RTN","RCDPEWL2",124,0)
 ;
"RTN","RCDPEWL2",125,0)
 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
"RTN","RCDPEWL2",126,0)
 D ^RCDPRTP,RET
"RTN","RCDPEWL2",127,0)
 D RESTMP^RCDPEWL6
"RTN","RCDPEWL2",128,0)
 ;
"RTN","RCDPEWL2",129,0)
CMQ S VALMBCK="R"
"RTN","RCDPEWL2",130,0)
 Q
"RTN","RCDPEWL2",131,0)
 ;
"RTN","RCDPEWL2",132,0)
CHGMNT ; Jump to charge maintenance
"RTN","RCDPEWL2",133,0)
 N DIR,X,Y,RCSCR
"RTN","RCDPEWL2",134,0)
 D FULL^VALM1
"RTN","RCDPEWL2",135,0)
 ;
"RTN","RCDPEWL2",136,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G CHMQ
"RTN","RCDPEWL2",137,0)
 ;
"RTN","RCDPEWL2",138,0)
 I $D(^XUSEC("PRCA EDI LOCKBOX CHARGES",DUZ)) D
"RTN","RCDPEWL2",139,0)
 . M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
"RTN","RCDPEWL2",140,0)
 . D EN1AR^IBECEA ; IA 4047
"RTN","RCDPEWL2",141,0)
 . D RESTMP^RCDPEWL6
"RTN","RCDPEWL2",142,0)
 E  D
"RTN","RCDPEWL2",143,0)
 . S DIR(0)="EA",DIR("A",1)="YOU DO NOT HAVE THE KEY NEEDED TO ACCESS THIS OPTION.",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL2",144,0)
 ;
"RTN","RCDPEWL2",145,0)
 S VALMBCK="R"
"RTN","RCDPEWL2",146,0)
CHMQ Q
"RTN","RCDPEWL2",147,0)
 ;
"RTN","RCDPEWL2",148,0)
LSTHLD ; Jump to list current/on hold charges
"RTN","RCDPEWL2",149,0)
 N DIR,X,Y,RCIBY
"RTN","RCDPEWL2",150,0)
 D FULL^VALM1
"RTN","RCDPEWL2",151,0)
 ;
"RTN","RCDPEWL2",152,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G LHQ
"RTN","RCDPEWL2",153,0)
 ;
"RTN","RCDPEWL2",154,0)
 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
"RTN","RCDPEWL2",155,0)
 D MAIN^IBOHPT1,RET ; IA 4048
"RTN","RCDPEWL2",156,0)
 D RESTMP^RCDPEWL6
"RTN","RCDPEWL2",157,0)
 ;
"RTN","RCDPEWL2",158,0)
 S VALMBCK="R"
"RTN","RCDPEWL2",159,0)
LHQ Q
"RTN","RCDPEWL2",160,0)
 ;
"RTN","RCDPEWL2",161,0)
REEST ; Jump to re-establish bill
"RTN","RCDPEWL2",162,0)
 N PRC
"RTN","RCDPEWL2",163,0)
 D FULL^VALM1
"RTN","RCDPEWL2",164,0)
 ;
"RTN","RCDPEWL2",165,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G REESTQ
"RTN","RCDPEWL2",166,0)
 ;
"RTN","RCDPEWL2",167,0)
 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
"RTN","RCDPEWL2",168,0)
 D ^PRCAWREA K DTOUT
"RTN","RCDPEWL2",169,0)
 D RESTMP^RCDPEWL6
"RTN","RCDPEWL2",170,0)
 D RET
"RTN","RCDPEWL2",171,0)
 ;
"RTN","RCDPEWL2",172,0)
REESTQ S VALMBCK="R"
"RTN","RCDPEWL2",173,0)
 Q
"RTN","RCDPEWL2",174,0)
 ;
"RTN","RCDPEWL2",175,0)
BILLCOM ; Jump to bill comment log
"RTN","RCDPEWL2",176,0)
 D FULL^VALM1
"RTN","RCDPEWL2",177,0)
 ;
"RTN","RCDPEWL2",178,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G BILLCOMQ
"RTN","RCDPEWL2",179,0)
 ;
"RTN","RCDPEWL2",180,0)
 M ^TMP("RC_SAVE_TMP",$J)=^TMP($J)
"RTN","RCDPEWL2",181,0)
 D ^PRCACM K DTOUT
"RTN","RCDPEWL2",182,0)
 D RET
"RTN","RCDPEWL2",183,0)
 D RESTMP^RCDPEWL6
"RTN","RCDPEWL2",184,0)
 ;
"RTN","RCDPEWL2",185,0)
BILLCOMQ S VALMBCK="R"
"RTN","RCDPEWL2",186,0)
 Q
"RTN","RCDPEWL2",187,0)
 ;
"RTN","RCDPEWL2",188,0)
ASK(RCSTOP) ;
"RTN","RCDPEWL2",189,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEWL2",190,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEWL2",191,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEWL2",192,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEWL2",193,0)
 Q
"RTN","RCDPEWL2",194,0)
 ;
"RTN","RCDPEWL2",195,0)
RHDR(RCSCR,RCDT,RCPG) ;Prints EOB detail report heading
"RTN","RCDPEWL2",196,0)
 N Z
"RTN","RCDPEWL2",197,0)
 S Z=$G(^RCY(344.4,RCSCR,0))
"RTN","RCDPEWL2",198,0)
 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
"RTN","RCDPEWL2",199,0)
 S RCPG=RCPG+1
"RTN","RCDPEWL2",200,0)
 W !,?15,"EDI LOCKBOX EEOB DETAIL FROM WORKLIST",?55,$$FMTE^XLFDT(RCDT,2),?70,"Page: ",RCPG
"RTN","RCDPEWL2",201,0)
 ; HIPAA 5010 - TRACE # increased in length from 30 to 50 characters therefore it needs to be displayed on its own line
"RTN","RCDPEWL2",202,0)
 W !!,$E(" ERA NUMBER: "_RCSCR_$J("",25),1,25)_"ERA DATE: "_$$FMTE^XLFDT($P(Z,U,4)),!,"INS COMPANY: "_$P(Z,U,6)_"/"_$P(Z,U,3)
"RTN","RCDPEWL2",203,0)
 W !,"ERA TRACE #: "_$P(Z,U,2)
"RTN","RCDPEWL2",204,0)
 W !,$TR($J("",IOM)," ","=")
"RTN","RCDPEWL2",205,0)
 Q
"RTN","RCDPEWL2",206,0)
 ;
"RTN","RCDPEWL2",207,0)
RET ; Pause before returning to list
"RTN","RCDPEWL2",208,0)
 N DIR,X,Y
"RTN","RCDPEWL2",209,0)
 S DIR(0)="EA",DIR("A")="RETURN TO CONTINUE" W ! D ^DIR K DIR
"RTN","RCDPEWL2",210,0)
 Q
"RTN","RCDPEWL2",211,0)
 ;
"RTN","RCDPEWL2",212,0)
NOWAY ; Msg for unidentified bill
"RTN","RCDPEWL2",213,0)
 N DIR,X,Y
"RTN","RCDPEWL2",214,0)
 S DIR(0)="EA",DIR("A",1)="THIS BILL IS NOT IDENTIFIED IN YOUR A/R",DIR("A")="THIS FUNCTION IS NOT AVAILABLE ... RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL2",215,0)
 Q
"RTN","RCDPEWL2",216,0)
 ;
"RTN","RCDPEWL2",217,0)
NOWAY1 ; Msg for ERA level Adjustment 
"RTN","RCDPEWL2",218,0)
 N DIR,X,Y
"RTN","RCDPEWL2",219,0)
 S DIR(0)="EA",DIR("A",1)="THIS IS AN ERA LEVEL ADJUSTMENT - NO DATA EXISTS FOR IT IN YOUR AR",DIR("A")="PRESS ENTER TO CONTINUE" W ! D ^DIR K DIR
"RTN","RCDPEWL2",220,0)
 Q
"RTN","RCDPEWL2",221,0)
 ;
"RTN","RCDPEWL2",222,0)
SET1(RCIBY,RCDA,RCDA1,RC3444,RCREF) ; Set up variables for receipt/ERA
"RTN","RCDPEWL2",223,0)
 S RCDA1=+RCIBY("IBEOB"),RCDA=+$P(RCIBY("IBEOB"),U,2),RC3444=+$P(RCIBY("IBEOB"),U,3),RCREF=+$P(RCIBY("IBEOB"),U,4)
"RTN","RCDPEWL2",224,0)
 Q
"RTN","RCDPEWL2",225,0)
 ;
"RTN","RCDPEWL2",226,0)
CHKFILE ; If the user leaves the split line screen without filing - double check
"RTN","RCDPEWL2",227,0)
 ; that they didn't want to file it.
"RTN","RCDPEWL2",228,0)
 N DIR,X,Y
"RTN","RCDPEWL2",229,0)
 D FULL^VALM1 W !!
"RTN","RCDPEWL2",230,0)
 I $G(^TMP("RCDPE_EOB_SPLIT_OK",$J)),$O(RCSPLIT(0)) D
"RTN","RCDPEWL2",231,0)
 . S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="YOU HAVE NOT FILED THESE CHANGES",DIR("A")="DO YOU WANT TO FILE THEM BEFORE YOU EXIT?: " D ^DIR K DIR
"RTN","RCDPEWL2",232,0)
 . I Y=1 D FILESP^RCDPEWL8
"RTN","RCDPEWL2",233,0)
 K ^TMP($J,"RCDPE_SPLIT_FILE")
"RTN","RCDPEWL2",234,0)
 Q
"RTN","RCDPEWL2",235,0)
 ;
"RTN","RCDPEWL2",236,0)
EDITSP ; Action that edits the split lines
"RTN","RCDPEWL2",237,0)
 ; RCLINE,RCSCR must already exist
"RTN","RCDPEWL2",238,0)
 N DA,RCEDIT,RCDONE,RCDEF,RCSAVE,RCSAVE1
"RTN","RCDPEWL2",239,0)
 D FULL^VALM1
"RTN","RCDPEWL2",240,0)
 ;
"RTN","RCDPEWL2",241,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G EDITQ
"RTN","RCDPEWL2",242,0)
 ;
"RTN","RCDPEWL2",243,0)
 D SEL(.RCEDIT)
"RTN","RCDPEWL2",244,0)
 G:'RCEDIT EDITQ
"RTN","RCDPEWL2",245,0)
 S RCDONE=0
"RTN","RCDPEWL2",246,0)
 M RCSAVE=RCSPLIT,RCSAVE1=RCDIR S RCDEF=$G(RCSPLIT(RCEDIT)),RCSPLIT=RCEDIT
"RTN","RCDPEWL2",247,0)
 D EDIT^RCDPEWL3(RCSCR,RCLINE,.RCDIR,.RCSPLIT,RCDEF,.RCDONE)
"RTN","RCDPEWL2",248,0)
 I '$D(RCSPLIT(RCSAVE)) K RCSPLIT M RCSPLIT=RCSAVE K RCDIR M RCDIR=RCSAVE1
"RTN","RCDPEWL2",249,0)
 D INIT^RCDPEWL3
"RTN","RCDPEWL2",250,0)
EDITQ S VALMBCK="R"
"RTN","RCDPEWL2",251,0)
 Q
"RTN","RCDPEWL2",252,0)
 ;
"RTN","RCDPEWL2",253,0)
PREOB ; Print/View EOB detail
"RTN","RCDPEWL2",254,0)
 N RCDA,RCDAZ,Z,Z0
"RTN","RCDPEWL2",255,0)
 D FULL^VALM1
"RTN","RCDPEWL2",256,0)
 D SEL^RCDPEWL(.RCDA)
"RTN","RCDPEWL2",257,0)
 S RCDA=+$O(RCDA(0)),RCDA=$G(RCDA(RCDA))
"RTN","RCDPEWL2",258,0)
 I RCDA="" G PREOBQ
"RTN","RCDPEWL2",259,0)
 S RCDA=$P($G(^RCY(344.49,RCSCR,1,+RCDA,0)),U,9)
"RTN","RCDPEWL2",260,0)
 F RCDAZ=1:1:$L(RCDA,",") S RCDAZ(RCDAZ)=$P(RCDA,",",RCDAZ)
"RTN","RCDPEWL2",261,0)
 S Z=0 F  S Z=$O(RCDAZ(Z)) Q:'Z  D
"RTN","RCDPEWL2",262,0)
 . ;
"RTN","RCDPEWL2",263,0)
 . S Z0=RCDAZ(Z)
"RTN","RCDPEWL2",264,0)
 . I $E(Z0,1,3)="ADJ" D  Q
"RTN","RCDPEWL2",265,0)
 .. I $G(^RCY(344.4,RCSCR,2,+$P(Z0,"ADJ",2),0))'="" S RCDAZ(Z)="ADJ^"_+$P(Z0,"ADJ",2)
"RTN","RCDPEWL2",266,0)
 . ;
"RTN","RCDPEWL2",267,0)
 . S Z0=$G(^RCY(344.4,RCSCR,1,+Z0,0))
"RTN","RCDPEWL2",268,0)
 . S RCDAZ(Z)=+Z0_U_$S($P(Z0,U,2):$P(Z0,U,2),1:-1) Q
"RTN","RCDPEWL2",269,0)
 ;
"RTN","RCDPEWL2",270,0)
 D VP(RCSCR,.RCDAZ)
"RTN","RCDPEWL2",271,0)
 ;
"RTN","RCDPEWL2",272,0)
PREOBQ S VALMBCK="R"
"RTN","RCDPEWL2",273,0)
 Q
"RTN","RCDPEWL2",274,0)
 ;
"RTN","RCDPEWL2",275,0)
RESEARCH ; Invoke the research menu
"RTN","RCDPEWL2",276,0)
 ;
"RTN","RCDPEWL2",277,0)
 K ^TMP($J,"RC_VALMBG")
"RTN","RCDPEWL2",278,0)
 S ^TMP($J,"RC_VALMBG")=$G(VALMBG)
"RTN","RCDPEWL2",279,0)
 D FULL^VALM1
"RTN","RCDPEWL2",280,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV G RQ
"RTN","RCDPEWL2",281,0)
 ;
"RTN","RCDPEWL2",282,0)
 D EN^VALM("RCDPE EOB RESEARCH")
"RTN","RCDPEWL2",283,0)
 ;
"RTN","RCDPEWL2",284,0)
RQ K ^TMP($J,"RC_VALMBG")
"RTN","RCDPEWL2",285,0)
 Q
"RTN","RCDPEWL2",286,0)
 ;
"RTN","RCDPEWL2",287,0)
SEL(RCEDIT) ;
"RTN","RCDPEWL2",288,0)
 N VALMY
"RTN","RCDPEWL2",289,0)
 D EN^VALM2($G(XQORNOD(0)),"S")
"RTN","RCDPEWL2",290,0)
 S RCEDIT=+$O(VALMY(0))
"RTN","RCDPEWL2",291,0)
 Q
"RTN","RCDPEWL2",292,0)
 ;
"RTN","RCDPEWL2",293,0)
EXIT ; Exits back to ERA menu actions from research
"RTN","RCDPEWL2",294,0)
 S VALMBCK="Q"
"RTN","RCDPEWL2",295,0)
 Q
"RTN","RCDPEWL2",296,0)
 ;
"RTN","RCDPEWL2",297,0)
WL(RCRCPT) ; Entrypoint to the ERA Worklist from Receipt Processing
"RTN","RCDPEWL2",298,0)
 ;RCRCPT = ien of entry in file 344
"RTN","RCDPEWL2",299,0)
 N DIR,X,Y,Z
"RTN","RCDPEWL2",300,0)
 D FULL^VALM1
"RTN","RCDPEWL2",301,0)
 S Z=+$O(^RCY(344.4,"AREC",RCRCPT,0))
"RTN","RCDPEWL2",302,0)
 I 'Z D  G WLQ
"RTN","RCDPEWL2",303,0)
 . S DIR("A")="THIS RECEIPT IS NOT ASSOCIATED WITH AN ERA RECORD - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
"RTN","RCDPEWL2",304,0)
 ;
"RTN","RCDPEWL2",305,0)
 I '$D(^RCY(344.49,Z,0)) D  G WLQ
"RTN","RCDPEWL2",306,0)
 . S DIR("A")="NO ERA WORKLIST SCRATCHPAD EXISTS FOR THIS ERA - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
"RTN","RCDPEWL2",307,0)
 ;
"RTN","RCDPEWL2",308,0)
 D DISP^RCDPEWL(Z,2)
"RTN","RCDPEWL2",309,0)
 ;
"RTN","RCDPEWL2",310,0)
WLQ S VALMBCK="R"
"RTN","RCDPEWL2",311,0)
 Q
"RTN","RCDPEWL2",312,0)
 ;
"RTN","RCDPEWL2",313,0)
NOTAV ; Display not available msg
"RTN","RCDPEWL2",314,0)
 N DIR,X,Y
"RTN","RCDPEWL2",315,0)
 ;
"RTN","RCDPEWL2",316,0)
 S DIR(0)="EA",DIR("A")="THIS ACTION NOT CURRENTLY AVAILABLE - PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL2",317,0)
 S VALMBCK="R"
"RTN","RCDPEWL2",318,0)
 Q
"RTN","RCDPEWL2",319,0)
 ;
"RTN","RCDPEWL4")
0^10^B48717166
"RTN","RCDPEWL4",1,0)
RCDPEWL4 ;ALB/TMK/PJH - ELECTRONIC EOB WORKLIST ACTIONS ; 7/30/10 6:55pm
"RTN","RCDPEWL4",2,0)
 ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPEWL4",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEWL4",4,0)
 ; RCSCR variable must be defined for this routine
"RTN","RCDPEWL4",5,0)
 Q
"RTN","RCDPEWL4",6,0)
 ;
"RTN","RCDPEWL4",7,0)
DISTADJ(RCFR,RCTO,RCAMT,RCCOM) ; Action that distributes an adjustment amount
"RTN","RCDPEWL4",8,0)
 ; against another line item's payment
"RTN","RCDPEWL4",9,0)
 ; Assumes RCSCR = ien of the entry in file 344.49
"RTN","RCDPEWL4",10,0)
 ; RCFR = ien of entry in 344.491 that has a negative net
"RTN","RCDPEWL4",11,0)
 ; RCTO = ien of entry in 344.491 that will be decremented
"RTN","RCDPEWL4",12,0)
 ; RCAMT = the amount being adjusted (positive #)
"RTN","RCDPEWL4",13,0)
 ; RCCOM = the comment to place on the decrease adjustment
"RTN","RCDPEWL4",14,0)
 ;
"RTN","RCDPEWL4",15,0)
 N RCFRX,RCREF,RCFR0,RCFR1,RCFR10,RCTO0,RCTO1,RCTO10,RCY,DIK,DA,DR,DIC,X,Y,DLAYGO,DD,DO,DIE,DIR
"RTN","RCDPEWL4",16,0)
 I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL Q
"RTN","RCDPEWL4",17,0)
 S RCFR0=$G(^RCY(344.49,RCSCR,1,RCFR,0)),RCTO0=$G(^RCY(344.49,RCSCR,1,RCTO,0)),RCFRX=+$O(^RCY(344.49,RCSCR,1,"B",RCFR0\1,0)),RCFRX=$G(^RCY(344.49,RCSCR,1,RCFRX,0))
"RTN","RCDPEWL4",18,0)
 S RCREF=$P($P(RCFRX,U,2),"**ADJ",2),RCREF=$S(RCREF="":"",RCREF=0:$P(RCFRX,U,9),1:$P($G(^RCY(344.4,RCSCR,2,+RCREF,0)),U))
"RTN","RCDPEWL4",19,0)
 S RCFR1=+$O(^RCY(344.49,RCSCR,1,"B",RCFR0\1,0)),RCTO1=+$O(^RCY(344.49,RCSCR,1,"B",RCTO0\1,0))
"RTN","RCDPEWL4",20,0)
 S RCFR10=$G(^RCY(344.49,RCSCR,1,RCFR1,0)),RCTO10=$G(^RCY(344.49,RCSCR,1,RCTO1,0))
"RTN","RCDPEWL4",21,0)
 S RCFR0=$G(^RCY(344.49,RCSCR,1,RCFR,0)),RCTO0=$G(^RCY(344.49,RCSCR,1,RCTO,0))
"RTN","RCDPEWL4",22,0)
 S DA(2)=RCSCR,DA(1)=RCFR
"RTN","RCDPEWL4",23,0)
 S DIC("DR")=".02////1;.03////"_RCAMT_";.04////"_$S($P(RCTO0,U,2)'="":$P(RCTO0,U,2),RCREF'="":RCREF,1:"UNKNOWN")
"RTN","RCDPEWL4",24,0)
 S DIC("DR")=DIC("DR")_";.05////0;.06////0;.09////RETRACTED FUNDS DEDUCTED FROM OTHER PAYMENT ON THIS ERA",DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
"RTN","RCDPEWL4",25,0)
 S DLAYGO=344.4911,DIC(0)="L",X=+$O(^RCY(344.49,RCSCR,1,RCFR,1,"B",""),-1)+1
"RTN","RCDPEWL4",26,0)
 D FILE^DICN K DIC,DD,DO,DLAYGO
"RTN","RCDPEWL4",27,0)
 S RCY=+Y
"RTN","RCDPEWL4",28,0)
 I RCY'>0 D  Q
"RTN","RCDPEWL4",29,0)
 . S DIR(0)="EA",DIR("A",1)="PROBLEM ADDING ADJUSTMENT - NO DISTRIBUTION PERFORMED",DIR("A")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
"RTN","RCDPEWL4",30,0)
 ;
"RTN","RCDPEWL4",31,0)
 S DA(2)=RCSCR,DA(1)=RCTO
"RTN","RCDPEWL4",32,0)
 S DIC("DR")=".02////0;.03////"_$J(-RCAMT,"",2)
"RTN","RCDPEWL4",33,0)
 S DIC("DR")=DIC("DR")_";.04////"_$S($P(RCFR0,U,2)'="":$P(RCFR0,U,2),RCREF'="":RCREF,1:"UNKNOWN")_";.05////"_$S($P($G(^RCY(344.49,RCSCR,1,RCTO1,0)),U,2)'["**ADJ":"1;.08////0",1:0)_";.06////0"_$S(RCCOM'="":";.09////"_RCCOM,1:"")
"RTN","RCDPEWL4",34,0)
 S DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
"RTN","RCDPEWL4",35,0)
 S DLAYGO=344.4911,DIC(0)="L",X=+$O(^RCY(344.49,RCSCR,1,RCTO,1,"B",""),-1)+1
"RTN","RCDPEWL4",36,0)
 D FILE^DICN K DIC,DD,DO,DLAYGO
"RTN","RCDPEWL4",37,0)
 S RCY=+Y
"RTN","RCDPEWL4",38,0)
 ;
"RTN","RCDPEWL4",39,0)
 I RCY'>0 D  Q
"RTN","RCDPEWL4",40,0)
 . N DA
"RTN","RCDPEWL4",41,0)
 . S DA(2)=RCSCR,DA(1)=RCFR,DA=RCY,DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1," D ^DIK
"RTN","RCDPEWL4",42,0)
 . S DIR(0)="EA",DIR("A",1)="PROBLEM ADDING ADJUSTMENT - NO DISTRIBUTION PERFORMED",DIR("A")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
"RTN","RCDPEWL4",43,0)
 ;
"RTN","RCDPEWL4",44,0)
 S DA(1)=RCSCR,DA=RCFR,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(RCFR0,U,6)+RCAMT,"",2)_";.08////"_$J($P(RCFR0,U,8)+RCAMT,"",2) D ^DIE
"RTN","RCDPEWL4",45,0)
 S DA=RCFR1,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(RCFR10,U,6)+RCAMT,"",2) D ^DIE
"RTN","RCDPEWL4",46,0)
 S DA(1)=RCSCR,DA=RCTO,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(RCTO0,U,6)-RCAMT,"",2)_";.03////"_$J($P(RCTO0,U,3)-RCAMT,"",2)_";.08////"_$J($P(RCTO0,U,8)-RCAMT,"",2) D ^DIE
"RTN","RCDPEWL4",47,0)
 S DA(1)=RCSCR,DA=RCTO1,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".06////"_$J($P(RCTO10,U,6)-RCAMT,"",2)_";.03////"_$J($P(RCTO10,U,3)-RCAMT,"",2)_";.08////"_$J($P(RCTO10,U,8)-RCAMT,"",2) D ^DIE
"RTN","RCDPEWL4",48,0)
 D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
"RTN","RCDPEWL4",49,0)
 Q
"RTN","RCDPEWL4",50,0)
 ;
"RTN","RCDPEWL4",51,0)
NEWREC ; Create a new receipt from scratch pad entry
"RTN","RCDPEWL4",52,0)
 N Z,Z0,RCOK,RCRECTDA,RCSTOP,DIR,X,Y,RECTDA,CT,DIE,DA,DR,RCER,RCPAYTY,RCHAC,RCDEP,DIC
"RTN","RCDPEWL4",53,0)
 D FULL^VALM1
"RTN","RCDPEWL4",54,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV^RCDPEWL2 G NEWRECQ
"RTN","RCDPEWL4",55,0)
 S (RCSTOP,RCOK)=0,VALMBCK="R"
"RTN","RCDPEWL4",56,0)
 S RECTDA=$P($G(^RCY(344.49,RCSCR,0)),U,2)
"RTN","RCDPEWL4",57,0)
 I 'RECTDA S RECTDA=$P($G(^RCY(344.4,RCSCR,0)),U,8)
"RTN","RCDPEWL4",58,0)
 I RECTDA D  G NEWRECQ
"RTN","RCDPEWL4",59,0)
 . S DIR(0)="EA",DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - "_$P($G(^RCY(344,+$P($G(^RCY(344.49,RCSCR,0)),U,2),0)),U)_" - NO RECEIPT CREATED",DIR("A")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
"RTN","RCDPEWL4",60,0)
 S DIR("A",1)="THIS ACTION WILL CREATE THE RECEIPT FOR THIS ERA.  ONCE THE RECEIPT IS",DIR("A",2)=" CREATED HERE, NO MORE AUTOMATIC ADJUSTMENTS MAY BE MADE FOR THIS ERA.",DIR("A",3)=" "
"RTN","RCDPEWL4",61,0)
 S DIR("A")="ARE YOU SURE YOU ARE READY TO CREATE THIS RECEIPT?: ",DIR("B")="NO",DIR(0)="YA"
"RTN","RCDPEWL4",62,0)
 W ! D ^DIR K DIR W !
"RTN","RCDPEWL4",63,0)
 I Y'=1 S DIR(0)="EA",DIR("A")="NO RECEIPT CREATED - PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR G NEWRECQ
"RTN","RCDPEWL4",64,0)
 I $$HASADJ^RCDPEWL8(RCSCR,.RCOK) D  G NEWRECQ
"RTN","RCDPEWL4",65,0)
 . S DIR(0)="EA",DIR("A",1)="AT LEAST ONE LINE ITEM WAS FOUND WITH A NEGATIVE PAYMENT AMOUNT",DIR("A")="NO RECEIPT CAN BE CREATED - PRESS RETURN TO CONTINUE " D ^DIR K DIR S RCSTOP=1
"RTN","RCDPEWL4",66,0)
 I 'RCOK S DIR(0)="EA",DIR("A")="NO RECEIPT CAN BE CREATED - NO POSTABLE LINE ITEMS WERE FOUND" W ! D ^DIR K DIR G NEWRECQ
"RTN","RCDPEWL4",67,0)
 ;
"RTN","RCDPEWL4",68,0)
 S RCHAC=$$HACERA^RCDPEU(RCSCR)
"RTN","RCDPEWL4",69,0)
 S RCPAYTY=$S(RCHAC:8,$P($G(^RCY(344.4,+RCSCR,5)),U,2)="":14,1:4)
"RTN","RCDPEWL4",70,0)
 S RCDEP=""
"RTN","RCDPEWL4",71,0)
 I RCPAYTY=4 D
"RTN","RCDPEWL4",72,0)
 . N RCOK1
"RTN","RCDPEWL4",73,0)
 . F  D  Q:RCOK1
"RTN","RCDPEWL4",74,0)
 .. S RCOK1=1
"RTN","RCDPEWL4",75,0)
 .. S DIC="^RCY(344.1,",DIC("S")="I $P(^(0),U,12)=1",DIC(0)="AEMQ" D ^DIC
"RTN","RCDPEWL4",76,0)
 .. Q:Y'>0
"RTN","RCDPEWL4",77,0)
 .. S RCDEP=+Y
"RTN","RCDPEWL4",78,0)
 .. I RCDEP,$$TOOOLD^RCDPEWLA(RCDEP) S RCOK1=0,RCDEP=""
"RTN","RCDPEWL4",79,0)
 S RECTDA=$$BLDRCPT^RCDPUREC(DT,+RCDEP_$S(RCPAYTY=4:"ERACHK",1:""),+$O(^RC(341.1,"AC",+RCPAYTY,0))) ; Note:ERA with paper check is type 4, but receipt needs to start with an 'E'
"RTN","RCDPEWL4",80,0)
 I 'RECTDA W ! S DIR(0)="EA",DIR("A",1)="A PROBLEM WAS ENCOUNTERED ADDING THE RECEIPT - NO RECEIPT ADDED",DIR("A")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR G NEWRECQ
"RTN","RCDPEWL4",81,0)
 ;
"RTN","RCDPEWL4",82,0)
 D RCPTDET^RCDPEM(RCSCR,RECTDA,.RCER)
"RTN","RCDPEWL4",83,0)
 ;
"RTN","RCDPEWL4",84,0)
 S DIE="^RCY(344.49,",DA=RCSCR,DR=".02////"_RECTDA D ^DIE
"RTN","RCDPEWL4",85,0)
 S DIE="^RCY(344.4,",DA=RCSCR,DR=".08////"_RECTDA D ^DIE
"RTN","RCDPEWL4",86,0)
 S Z=+$O(^RCY(344.31,"AERA",RCSCR,0))
"RTN","RCDPEWL4",87,0)
 S DIE="^RCY(344,",DA=RECTDA,DR=".18////"_RCSCR_$S(Z:";.17////"_Z,1:"")_$S(RCPAYTY=4:";.06////"_RCDEP,1:"")_$S($P($G(^RCY(344.31,Z,0)),U,15)'="":";.16////"_$P(^RCY(344.31,Z,0),U,15),1:"") D ^DIE
"RTN","RCDPEWL4",88,0)
 ;
"RTN","RCDPEWL4",89,0)
 I $O(RCER(0)) D
"RTN","RCDPEWL4",90,0)
 . S CT=1,DIR(0)="EA",DIR("A",1)="THE FOLLOWING PROBLEMS OCCURRED WHILE ADDING THE RECEIPT: "
"RTN","RCDPEWL4",91,0)
 . S Z=0 F  S Z=$O(RCER(Z)) Q:'Z  S CT=CT+1,DIR("A",CT)=RCER(Z)
"RTN","RCDPEWL4",92,0)
 . S DIR("A")="PRESS RETURN TO CONTINUE "
"RTN","RCDPEWL4",93,0)
 . W ! D ^DIR K DIR
"RTN","RCDPEWL4",94,0)
 ;
"RTN","RCDPEWL4",95,0)
 S DIR(0)="YA",DIR("A")="DO YOU WANT TO GO TO RECEIPT PROCESSING NOW? ",DIR("A",1)=" ",DIR("A",2)="RECEIPT "_$P($G(^RCY(344,+RECTDA,0)),U)_" HAS BEEN CREATED FOR THIS ERA",DIR("B")="YES" W ! D ^DIR K DIR
"RTN","RCDPEWL4",96,0)
 I Y=1 S RCRECTDA=RECTDA D EN^VALM("RCDP RECEIPT PROFILE")
"RTN","RCDPEWL4",97,0)
 S RCSCR=0
"RTN","RCDPEWL4",98,0)
 S VALMBCK="Q"
"RTN","RCDPEWL4",99,0)
 ;
"RTN","RCDPEWL4",100,0)
NEWRECQ Q
"RTN","RCDPEWL4",101,0)
 ;
"RTN","RCDPEWL4",102,0)
VRECPT ; Preview receipt lines
"RTN","RCDPEWL4",103,0)
 N RCZ,RCOK,Z,Z0,DIR,X,Y
"RTN","RCDPEWL4",104,0)
 D FULL^VALM1
"RTN","RCDPEWL4",105,0)
 S VALMBCK="R"
"RTN","RCDPEWL4",106,0)
 I $G(^TMP("RCBATCH_SELECTED",$J)) D NOBATCH^RCDPEWL Q
"RTN","RCDPEWL4",107,0)
 I $O(^RCY(344.49,RCSCR,3,0)) D  Q:'RCOK
"RTN","RCDPEWL4",108,0)
 . S RCOK=1
"RTN","RCDPEWL4",109,0)
 . S Z=0 F  S Z=$O(^RCY(344.49,RCSCR,3,Z)) Q:'Z  I '$P($G(^(Z,0)),U,3) S RCOK=0 Q
"RTN","RCDPEWL4",110,0)
 . I 'RCOK S DIR(0)="EA",DIR("A",1)="A RECEIPT CANNOT BE PREVIEWED UNTIL ALL BATCHES FOR THIS ERA ARE MARKED AS",DIR("A",2)="'READY TO POST'",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL4",111,0)
 ;
"RTN","RCDPEWL4",112,0)
 S Z=0 F  S Z=$O(^RCY(344.49,RCSCR,1,Z)) Q:'Z  I $P(Z,".",2) S Z0=$G(^(Z,0)) I $P(Z0,U,6)<0 S RCZ($P(Z0,U))=$P(Z0,U,2)_U_$P(Z0,U,6)
"RTN","RCDPEWL4",113,0)
 I $O(RCZ(""))'="" D
"RTN","RCDPEWL4",114,0)
 . W !,"THE FOLLOWING LINES HAVE A NET PAYMENT LESS THAN 0.  THESE LINES MUST HAVE",!,"THIS NEGATIVE AMOUNT DISTRIBUTED TO OTHER LINE(S) IN THE ERA BEFORE A",!,"RECEIPT CAN BE CREATED."
"RTN","RCDPEWL4",115,0)
 . S Z="" F  S Z=$O(RCZ(Z)) Q:Z=""  W !,$J("",5)_$J(Z,10)_"  "_$E($P(RCZ(Z),U)_$J("",15),1,15)_"  "_$J(+$P(RCZ(Z),U,2),"",2)
"RTN","RCDPEWL4",116,0)
 . W !
"RTN","RCDPEWL4",117,0)
 . S DIR(0)="E" D ^DIR K DIR
"RTN","RCDPEWL4",118,0)
 ;
"RTN","RCDPEWL4",119,0)
 D EN^VALM("RCDPE EOB RECEIPT PREVIEW")
"RTN","RCDPEWL4",120,0)
 S VALMBCK=$S('$G(RCSCR):"Q",1:"R")
"RTN","RCDPEWL4",121,0)
 Q
"RTN","RCDPEWL4",122,0)
 ;
"RTN","RCDPEWL5")
0^9^B56283493
"RTN","RCDPEWL5",1,0)
RCDPEWL5 ;ALB/TMK/PJH - ELECTRONIC EOB WORKLIST ACTIONS ; 7/30/10 6:52pm
"RTN","RCDPEWL5",2,0)
 ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPEWL5",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEWL5",4,0)
 Q
"RTN","RCDPEWL5",5,0)
 ;
"RTN","RCDPEWL5",6,0)
INIT ; Build receipt preview
"RTN","RCDPEWL5",7,0)
 N X,Z,Z1,Z10,Z0,Z2,RCZ
"RTN","RCDPEWL5",8,0)
 K ^TMP("RCDPE_EOB_PREVIEW",$J)
"RTN","RCDPEWL5",9,0)
 S VALMCNT=0,VALMBG=1
"RTN","RCDPEWL5",10,0)
 S Z=0 F  S Z=$O(^RCY(344.49,RCSCR,1,Z)) Q:'Z  S Z0=$G(^(Z,0)) D
"RTN","RCDPEWL5",11,0)
 . I $P(Z0,U)\1=+Z0 S Z2=$P(Z0,U,2)
"RTN","RCDPEWL5",12,0)
 . I $P($P(Z0,U),".",2) D
"RTN","RCDPEWL5",13,0)
 .. S:$P(Z0,U,2)="" $P(Z0,U,2)=Z2
"RTN","RCDPEWL5",14,0)
 .. S RCZ=$S(+$P(Z0,U,6)=0:0,+$P(Z0,U,6)<0:-1,$P(Z0,U,7):1,1:2)
"RTN","RCDPEWL5",15,0)
 .. S RCZ(RCZ,Z)=Z0
"RTN","RCDPEWL5",16,0)
 .. S Z1=0 F  S Z1=$O(^RCY(344.49,RCSCR,1,Z,1,Z1)) Q:'Z1  S Z10=$G(^(Z1,0)) D
"RTN","RCDPEWL5",17,0)
 ... I $P(Z10,U,5)=1 S RCZ(RCZ,Z,"ADJ",Z1)="Dec adj $"_$J(0-$P(Z10,U,3),"",2)_" pending - ",RCZ(RCZ,Z,"ADJ",Z1,1)=$J("",4)_$P(Z10,U,9)
"RTN","RCDPEWL5",18,0)
 F RCZ=1,2,0,-1 D
"RTN","RCDPEWL5",19,0)
 . Q:'$D(RCZ(RCZ))
"RTN","RCDPEWL5",20,0)
 . I RCZ=1 D SET("PAYMENTS (LINES FOR RECEIPT):")
"RTN","RCDPEWL5",21,0)
 . I RCZ=0,VALMCNT>0 D SET(" ") D SET("ZERO DOLLAR PAYMENTS:")
"RTN","RCDPEWL5",22,0)
 . I RCZ=-1,VALMCNT>0 D SET(" ") D SET("LINES WITH NEGATIVE BALANCES STILL NEEDING TO BE DISTRIBUTED:")
"RTN","RCDPEWL5",23,0)
 . S Z=0 F  S Z=$O(RCZ(RCZ,Z)) Q:'Z  S Z0=RCZ(RCZ,Z) D
"RTN","RCDPEWL5",24,0)
 .. S X=""
"RTN","RCDPEWL5",25,0)
 .. S X=$$SETFLD^VALM1($P(Z0,U),X,"LINE #")
"RTN","RCDPEWL5",26,0)
 .. S X=$$SETFLD^VALM1($S($P(Z0,U,7):$$BN1^PRCAFN($P(Z0,U,7)),1:$S(RCZ=0:"",1:"[SUSPENSE]")_$S($P(Z0,U,2)["**ADJ"&'$P($P(Z0,U,2),"ADJ",2):"TOTALS MISMATCH ADJ",1:$P(Z0,U,2))),X,"ACCOUNT")
"RTN","RCDPEWL5",27,0)
 .. S X=$$SETFLD^VALM1($J(+$P(Z0,U,6),"",2),X,"AMOUNT")
"RTN","RCDPEWL5",28,0)
 .. D SET(X)
"RTN","RCDPEWL5",29,0)
 .. S Z1=0 F  S Z1=$O(RCZ(RCZ,Z,"ADJ",Z1)) Q:'Z1  D SET($J("",12)_$G(RCZ(RCZ,Z,"ADJ",Z1))) S Z2=0 F  S Z2=$O(RCZ(RCZ,Z,"ADJ",Z1,Z2)) Q:'Z2  D SET($J("",12)_$G(RCZ(RCZ,Z,"ADJ",Z1,Z2)))
"RTN","RCDPEWL5",30,0)
 Q
"RTN","RCDPEWL5",31,0)
 ;
"RTN","RCDPEWL5",32,0)
SET(X) ;
"RTN","RCDPEWL5",33,0)
 S VALMCNT=VALMCNT+1
"RTN","RCDPEWL5",34,0)
 S ^TMP("RCDPE_EOB_PREVIEW",$J,VALMCNT,0)=X
"RTN","RCDPEWL5",35,0)
 Q
"RTN","RCDPEWL5",36,0)
 ;
"RTN","RCDPEWL5",37,0)
HDR ;
"RTN","RCDPEWL5",38,0)
 D HDR^RCDPEWL
"RTN","RCDPEWL5",39,0)
 Q
"RTN","RCDPEWL5",40,0)
 ;
"RTN","RCDPEWL5",41,0)
FNL ;
"RTN","RCDPEWL5",42,0)
 K ^TMP("RCDPE_EOB_PREVIEW",$J)
"RTN","RCDPEWL5",43,0)
 Q
"RTN","RCDPEWL5",44,0)
 ;
"RTN","RCDPEWL5",45,0)
RCOMM ; Allow entry of receipt comment to be moved to line on receipt
"RTN","RCDPEWL5",46,0)
 N RCEDIT
"RTN","RCDPEWL5",47,0)
 D FULL^VALM1
"RTN","RCDPEWL5",48,0)
 ;
"RTN","RCDPEWL5",49,0)
 I $G(RCSCR("NOEDIT"))=2 D NOTAV^RCDPEWL2 G RCOMMQ
"RTN","RCDPEWL5",50,0)
 ;
"RTN","RCDPEWL5",51,0)
 D SEL^RCDPEWL2(.RCEDIT)
"RTN","RCDPEWL5",52,0)
 G:'RCEDIT RCOMMQ
"RTN","RCDPEWL5",53,0)
 ;
"RTN","RCDPEWL5",54,0)
RCOMMQ S VALMBCK="R"
"RTN","RCDPEWL5",55,0)
 Q
"RTN","RCDPEWL5",56,0)
 ;
"RTN","RCDPEWL5",57,0)
SUSPERA ; Option entrypoint to select an ERA to be posted to suspense
"RTN","RCDPEWL5",58,0)
 N DIC,X,Y,RCERA,RCSCR,DTOUT,DUOUT,DIR
"RTN","RCDPEWL5",59,0)
 S DIC(0)="AEMQ",DIC="^RCY(344.4,",DIC("S")="I '$P(^(0),U,8),'$G(^(20))"
"RTN","RCDPEWL5",60,0)
 D ^DIC K DIC
"RTN","RCDPEWL5",61,0)
 I Y'>0 Q
"RTN","RCDPEWL5",62,0)
 S RCERA=+Y
"RTN","RCDPEWL5",63,0)
 S DIR(0)="YA",DIR("B")="YES",DIR("A")="DO YOU WANT TO PRINT/VIEW THE ERA FIRST?: " W ! D ^DIR K DIR
"RTN","RCDPEWL5",64,0)
 Q:$D(DUOUT)!$D(DTOUT)
"RTN","RCDPEWL5",65,0)
 I Y=1 S RCSCR=RCERA D PRERA^RCDPEWL0
"RTN","RCDPEWL5",66,0)
 D SUSP(RCERA,0)
"RTN","RCDPEWL5",67,0)
 Q
"RTN","RCDPEWL5",68,0)
 ;
"RTN","RCDPEWL5",69,0)
SUSP(RCERA,LM) ; Function to send receipt to suspense for ERA
"RTN","RCDPEWL5",70,0)
 ; RCERA = ien of entry in file 344.4
"RTN","RCDPEWL5",71,0)
 ; LM = flag to indicate it was called from list manager protocol
"RTN","RCDPEWL5",72,0)
 ;    =  1 if true, 0 if false
"RTN","RCDPEWL5",73,0)
 N DIR,X,Y,RC0,RCCOM,RCER,RCPAYTY,RECTDA,RCTRANDA,DIE,DA,DR,Z,DTOUT,DUOUT,RC5
"RTN","RCDPEWL5",74,0)
 S RC0=$G(^RCY(344.4,RCERA,0)),RC5=$G(^RCY(344.4,RCERA,5))
"RTN","RCDPEWL5",75,0)
 I $G(LM) D FULL^VALM1
"RTN","RCDPEWL5",76,0)
 I $$HACERA^RCDPEU(RCERA) D  G SUSPQ
"RTN","RCDPEWL5",77,0)
 . S DIR(0)="EA",DIR("A")="THIS IS NOT A VALID ACTION FOR AN ERA FROM HAC" W ! D ^DIR K DIR
"RTN","RCDPEWL5",78,0)
 S DIR(0)="YA",DIR("B")="NO"
"RTN","RCDPEWL5",79,0)
 I $P(RC0,U,5) D
"RTN","RCDPEWL5",80,0)
 . S DIR("A",1)="THIS WILL CREATE A RECEIPT THAT WILL MOVE THE FUNDS ($"_$J($P(RC0,U,5),"",2)_")",DIR("A",2)="FOR THIS ENTIRE ERA TO YOUR SUSPENSE ACCOUNT",Z=3
"RTN","RCDPEWL5",81,0)
 E  D
"RTN","RCDPEWL5",82,0)
 . S DIR("A",1)="THIS WILL CREATE AND POST A RECEIPT FOR $0.00 FOR THIS ERA",Z=2
"RTN","RCDPEWL5",83,0)
 S DIR("A",Z+1)=" ",DIR("A",Z+2)="***ALL POSTINGS TO A/R FOR ANY CLAIMS IN THIS ERA MUST BE DONE MANUALLY***",DIR("A",Z+3)=" "
"RTN","RCDPEWL5",84,0)
 S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
"RTN","RCDPEWL5",85,0)
 W ! D ^DIR K DIR
"RTN","RCDPEWL5",86,0)
 I Y'=1 D NOACT G SUSPQ
"RTN","RCDPEWL5",87,0)
 S DIR("A",1)="ENTER A 1-60 CHARACTER COMMENT TO BE PLACED ON THE RECEIPT: ",DIR("A")=">: ",DIR(0)="FA^1:60",DIR("B")="REF ERA #:"_RCERA_"  FROM "_$E($P(RC0,U,6),1,20) W ! D ^DIR K DIR
"RTN","RCDPEWL5",88,0)
 I $D(DTOUT)!$D(DUOUT) D NOACT G SUSPQ
"RTN","RCDPEWL5",89,0)
 S RCCOM=Y
"RTN","RCDPEWL5",90,0)
 S RCPAYTY=$S($P(RC5,U,2)="":14,1:4)
"RTN","RCDPEWL5",91,0)
 S RECTDA=$$BLDRCPT^RCDPUREC(DT,"",+$O(^RC(341.1,"AC",+RCPAYTY,0)))
"RTN","RCDPEWL5",92,0)
 I 'RECTDA D  G SUSPQ
"RTN","RCDPEWL5",93,0)
 . S DIR(0)="EA",DIR("A",1)="A PROBLEM WAS ENCOUNTERED ADDING THE RECEIPT",DIR("A")="NO ACTION TAKEN - RETURN TO CONTINUE: " W ! D ^DIR K DIR
"RTN","RCDPEWL5",94,0)
 ;
"RTN","RCDPEWL5",95,0)
 S RCTRANDA=$$ADDTRAN^RCDPURET(RECTDA)
"RTN","RCDPEWL5",96,0)
 S DR=".04////"_(+$P(RC0,U,5))_$S($P(RC5,U,2)'="":";.13////"_$P(RC5,U,2),1:"")_$S(RCCOM'="":";1.02////"_RCCOM,1:"")
"RTN","RCDPEWL5",97,0)
 S DA(1)=RECTDA,DA=RCTRANDA,DIE="^RCY(344,"_DA(1)_",1,"
"RTN","RCDPEWL5",98,0)
 D ^DIE
"RTN","RCDPEWL5",99,0)
 ;
"RTN","RCDPEWL5",100,0)
 I $D(^RCY(344.49,RCERA,0)) S DIE="^RCY(344.49,",DA=RCERA,DR=".02////"_RECTDA D ^DIE
"RTN","RCDPEWL5",101,0)
 S DIE="^RCY(344.4,",DA=RCERA,DR=".08////"_RECTDA_";20.01///^S X=""NOW"";20.02////"_DUZ D ^DIE
"RTN","RCDPEWL5",102,0)
 S Z=+$O(^RCY(344.31,"AERA",RCERA,0))
"RTN","RCDPEWL5",103,0)
 S DIE="^RCY(344,",DA=RECTDA,DR=".18////"_RCERA_$S(Z:";.17////"_Z,1:"") D ^DIE
"RTN","RCDPEWL5",104,0)
 ;
"RTN","RCDPEWL5",105,0)
 D PROCESS^RCDPURE1(RECTDA,1)
"RTN","RCDPEWL5",106,0)
 I '$P(RC0,U,5) S DIE="^RCY(344.4,",DA=RCERA,DR=".09////3;.14////1" D ^DIE
"RTN","RCDPEWL5",107,0)
 S DIR(0)="E" W ! D ^DIR K DIR
"RTN","RCDPEWL5",108,0)
 ;
"RTN","RCDPEWL5",109,0)
SUSPQ I $G(LM) S VALMBCK="R"
"RTN","RCDPEWL5",110,0)
 Q
"RTN","RCDPEWL5",111,0)
 ;
"RTN","RCDPEWL5",112,0)
REVIEW ; Enter review information on worklist and turn review display on/off
"RTN","RCDPEWL5",113,0)
 ; Assumes RCSCR = ien of the entry in file 344.49
"RTN","RCDPEWL5",114,0)
 ;
"RTN","RCDPEWL5",115,0)
 N Z,RC,RCDA,RCZ,DIC,DA,DIE,DR,X,Y,DIR,REVCHG,RCUSPREF,RCLSTREV,RCREV
"RTN","RCDPEWL5",116,0)
 D FULL^VALM1
"RTN","RCDPEWL5",117,0)
 ;
"RTN","RCDPEWL5",118,0)
 S REVCHG=""
"RTN","RCDPEWL5",119,0)
 S DIR(0)="YA",RC=+$P($G(^TMP($J,"RC_SORTPARM")),U,2)
"RTN","RCDPEWL5",120,0)
 S DIR("A",1)="REVIEW DATA DISPLAY IS CURRENTLY TURNED "_$P("OFF^ON",U,RC+1),DIR("A")="DO YOU WANT TO TURN IT "_$P("ON^OFF",U,RC+1)_"?: ",DIR("B")=$S('RC:"YES",1:"NO") W ! D ^DIR K DIR
"RTN","RCDPEWL5",121,0)
 I Y=1 S $P(^TMP($J,"RC_SORTPARM"),U,2)=((RC+1)#2),REVCHG=1
"RTN","RCDPEWL5",122,0)
 S RCUSPREF=+$O(^RCY(344.49,RCSCR,2,"B",DUZ,0))
"RTN","RCDPEWL5",123,0)
 ;
"RTN","RCDPEWL5",124,0)
 I 'RCUSPREF D  ; Add the user pref record
"RTN","RCDPEWL5",125,0)
 . S RCUSPREF=+$$ADDUSER(RCSCR,DUZ)
"RTN","RCDPEWL5",126,0)
 S RCLSTREV=+$P($G(^RCY(344.49,RCSCR,2,RCUSPREF,0)),U,2)
"RTN","RCDPEWL5",127,0)
 S DA(1)=RCSCR,DA=RCUSPREF
"RTN","RCDPEWL5",128,0)
 I DA,RCLSTREV'=$P($G(^TMP($J,"RC_SORTPARM")),U,2) D  ; Update user pref
"RTN","RCDPEWL5",129,0)
 . S DIE="^RCY(344.49,"_DA(1)_",2,",DR=".02////"_+$P($G(^TMP($J,"RC_SORTPARM")),U,2) D ^DIE
"RTN","RCDPEWL5",130,0)
 W !
"RTN","RCDPEWL5",131,0)
 I '$P(^TMP($J,"RC_SORTPARM"),U,2) G REVIEWQ
"RTN","RCDPEWL5",132,0)
 ;
"RTN","RCDPEWL5",133,0)
 D SEL^RCDPEWL(.RCDA)
"RTN","RCDPEWL5",134,0)
 S RCZ=+$O(RCDA(0)),RCZ=+$G(RCDA(RCZ)) G:'RCZ REVIEWQ
"RTN","RCDPEWL5",135,0)
 ;
"RTN","RCDPEWL5",136,0)
 S RCREV=0
"RTN","RCDPEWL5",137,0)
 I '$O(^RCY(344.49,RCSCR,1,"AC",DUZ,RCZ,0)) D
"RTN","RCDPEWL5",138,0)
 . S RCREV=$$NEWREV(RCSCR,RCZ,DUZ)
"RTN","RCDPEWL5",139,0)
 E  D
"RTN","RCDPEWL5",140,0)
 . N DIR,X,Y
"RTN","RCDPEWL5",141,0)
 . S DIR("A")="(A)DD or (E)DIT A REVIEW COMMENT?: ",DIR("B")="ADD",DIR(0)="SA^A:ADD;E:EDIT" W ! D ^DIR K DIR
"RTN","RCDPEWL5",142,0)
 . I $D(DUOUT)!$D(DTOUT) Q
"RTN","RCDPEWL5",143,0)
 . ;
"RTN","RCDPEWL5",144,0)
 . I Y="E" D  Q  ; Edit a review entry entered by same user
"RTN","RCDPEWL5",145,0)
 .. N DA,DR,DIE,X,Y
"RTN","RCDPEWL5",146,0)
 .. S DA(1)=RCSCR,DA=RCZ,DIC="^RCY(344.49,"_DA(1)_",1,"_DA_",4,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=DUZ" D ^DIC
"RTN","RCDPEWL5",147,0)
 .. S RCREV=$S(Y>0:+Y,1:0)
"RTN","RCDPEWL5",148,0)
 .. I RCREV S DA(2)=RCSCR,DA(1)=RCZ,DA=RCREV,DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DR=".03;.04////^S X=$$NOW^XLFDT()" D ^DIE
"RTN","RCDPEWL5",149,0)
 . ;
"RTN","RCDPEWL5",150,0)
 . S RCREV=$$NEWREV(RCSCR,RCZ,DUZ)
"RTN","RCDPEWL5",151,0)
 ;
"RTN","RCDPEWL5",152,0)
 I RCREV S DIE("NO^")="",DA(1)=RCSCR,DA=RCZ,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".11R;I X=0 S Y=""@10"";.12////^S X=DUZ;S Y=""@20"";@10;.12///@;@20" D ^DIE K DIE
"RTN","RCDPEWL5",153,0)
 D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
"RTN","RCDPEWL5",154,0)
 S REVCHG=""
"RTN","RCDPEWL5",155,0)
 ;
"RTN","RCDPEWL5",156,0)
REVIEWQ I $G(REVCHG) D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
"RTN","RCDPEWL5",157,0)
 S VALMBCK="R"
"RTN","RCDPEWL5",158,0)
 Q
"RTN","RCDPEWL5",159,0)
 ;
"RTN","RCDPEWL5",160,0)
NEWREV(RCSCR,RCZ,RCDUZ) ; Enter a new review comment
"RTN","RCDPEWL5",161,0)
 ; RCSCR = ien of entry in file 344.49
"RTN","RCDPEWL5",162,0)
 ; RCZ = ien of the EEOB (seq #)
"RTN","RCDPEWL5",163,0)
 ; RCDUZ =DUZ of user entering the comment
"RTN","RCDPEWL5",164,0)
 ; Function returns 0 if no new comment, ien of comment if added
"RTN","RCDPEWL5",165,0)
 N DA,X,Y,DIC,DIK,DLAYGO,DO,DD,RCREV,RCNOW
"RTN","RCDPEWL5",166,0)
 S RCNOW=$$NOW^XLFDT() W !!,"REVIEW DATE/TIME: "_$$FMTE^XLFDT(RCNOW,"2")
"RTN","RCDPEWL5",167,0)
 S DA(2)=RCSCR,DA(1)=RCZ,X=RCNOW,DIC("DR")=".02////"_RCDUZ_";.03",DLAYGO=344.492,DIC(0)="L"
"RTN","RCDPEWL5",168,0)
 S DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
"RTN","RCDPEWL5",169,0)
 K DO,DD
"RTN","RCDPEWL5",170,0)
 D FILE^DICN K DO,DD,DIC,DLAYGO
"RTN","RCDPEWL5",171,0)
 S RCREV=+Y
"RTN","RCDPEWL5",172,0)
 I RCREV'>0 S RCREV=0 G NEWREVQ
"RTN","RCDPEWL5",173,0)
 I '$O(^RCY(344.49,DA(2),1,DA(1),4,RCREV,0)) S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DA=RCREV D ^DIK S RCREV=0 ; No comment - delete entry
"RTN","RCDPEWL5",174,0)
 ;
"RTN","RCDPEWL5",175,0)
NEWREVQ Q RCREV
"RTN","RCDPEWL5",176,0)
 ;
"RTN","RCDPEWL5",177,0)
NOACT ;
"RTN","RCDPEWL5",178,0)
 N DIR,X,Y
"RTN","RCDPEWL5",179,0)
 S DIR(0)="EA",DIR("A")="NO ACTION TAKEN - RETURN TO CONTINUE: " W ! D ^DIR K DIR
"RTN","RCDPEWL5",180,0)
 Q
"RTN","RCDPEWL5",181,0)
 ;
"RTN","RCDPEWL5",182,0)
ADDUSER(RCSCR,RCDUZ) ; Add user record to user preferences multiple in file 344.49 and initialize all preferences
"RTN","RCDPEWL5",183,0)
 ; RCSCR = ien of entry in file 344.49
"RTN","RCDPEWL5",184,0)
 ; RCDUZ  = the ien of the user
"RTN","RCDPEWL5",185,0)
 N DIC,DA,X,Y,DLAYGO,DO,DD
"RTN","RCDPEWL5",186,0)
 S Y=+$O(^RCY(344.49,RCSCR,2,"B",RCDUZ,0))
"RTN","RCDPEWL5",187,0)
 I Y G ADDUQ
"RTN","RCDPEWL5",188,0)
 S DLAYGO=344.492,DA(1)=RCSCR,DIC(0)="L",X=RCDUZ,DIC="^RCY(344.49,"_DA(1)_",2,",DIC("DR")=".02////0;.03////N"
"RTN","RCDPEWL5",189,0)
 D FILE^DICN K DIC,DLAYGO
"RTN","RCDPEWL5",190,0)
ADDUQ Q $S(Y>0:Y,1:0)
"RTN","RCDPEWL5",191,0)
 ;
"RTN","RCDPEWL7")
0^4^B84756815
"RTN","RCDPEWL7",1,0)
RCDPEWL7 ;ALB/TMK/KML - EDI LOCKBOX WORKLIST ERA DISPLAY SCREEN ; 7/7/10 6:43pm
"RTN","RCDPEWL7",2,0)
 ;;4.5;Accounts Receivable;**208,222,269**;Mar 20, 1995;Build 113
"RTN","RCDPEWL7",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEWL7",4,0)
 Q
"RTN","RCDPEWL7",5,0)
 ;
"RTN","RCDPEWL7",6,0)
BLD(RCSORT) ; Build list with sort criteria
"RTN","RCDPEWL7",7,0)
 ; RCSORT = the sort levels to use to display the data in ^ pieces
"RTN","RCDPEWL7",8,0)
 ;  piece 1 = the codes for the first level sort (sort code;null or -)
"RTN","RCDPEWL7",9,0)
 ;  piece 2 = the codes for the second level sort
"RTN","RCDPEWL7",10,0)
 ;     sort code is the type of data to sort by;- indicates reverse order
"RTN","RCDPEWL7",11,0)
 N Z,Z1,RCT,RCZ
"RTN","RCDPEWL7",12,0)
 S (RCT,VALMCNT)=0
"RTN","RCDPEWL7",13,0)
 I '$D(^TMP($J,"RCERA_LIST")) D
"RTN","RCDPEWL7",14,0)
 . S Z=0 F  S Z=$O(^TMP("RCDPE-ERA_WLDX",$J,Z)) Q:'Z  S RCZ=$P($G(^(Z)),U,2) D
"RTN","RCDPEWL7",15,0)
 .. I $$FILTER^RCDPEWL0(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,$P(RCSORT,U)),$$SL(RCZ,$P(RCSORT,U,2)),RCZ)=""
"RTN","RCDPEWL7",16,0)
 . K ^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCDPE-ERA_WL",$J)
"RTN","RCDPEWL7",17,0)
 ;
"RTN","RCDPEWL7",18,0)
 S Z=""
"RTN","RCDPEWL7",19,0)
 I RCSORT'["PN;-" D
"RTN","RCDPEWL7",20,0)
 . F  S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z=""  S Z1="" F  S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1=""  D EXTRACT(Z,Z1,.RCT)
"RTN","RCDPEWL7",21,0)
 ;
"RTN","RCDPEWL7",22,0)
 I $P(RCSORT,U)["PN;-" D
"RTN","RCDPEWL7",23,0)
 . F  S Z=$O(^TMP($J,"RCERA_LIST",Z),-1) Q:Z=""  S Z1="" F  S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1=""  D EXTRACT(Z,Z1,.RCT)
"RTN","RCDPEWL7",24,0)
 ;
"RTN","RCDPEWL7",25,0)
 I $P(RCSORT,U,2)["PN;-" D
"RTN","RCDPEWL7",26,0)
 . F  S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z=""  S Z1="" F  S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1),-1) Q:Z1=""  D EXTRACT(Z,Z1,.RCT)
"RTN","RCDPEWL7",27,0)
 ;
"RTN","RCDPEWL7",28,0)
 I '$O(^TMP($J,"RCERA_LIST",0)) D SET("No ERAs left for your selection criteria")
"RTN","RCDPEWL7",29,0)
 K ^TMP($J,"RCERA_LIST")
"RTN","RCDPEWL7",30,0)
 S ^TMP("RCERA_PARAMS",$J,"SORT")=RCSORT
"RTN","RCDPEWL7",31,0)
 Q
"RTN","RCDPEWL7",32,0)
 ;
"RTN","RCDPEWL7",33,0)
EXTRACT(RCSRT1,RCSRT2,RCT) ; Extract the data
"RTN","RCDPEWL7",34,0)
 ; RCSRT1 = data value at 1st sort level
"RTN","RCDPEWL7",35,0)
 ; RCSRT2 = data value at 2nd sort level
"RTN","RCDPEWL7",36,0)
 ; RCT = running entry counter - returned if passed by ref
"RTN","RCDPEWL7",37,0)
 N FIRST,RCZ,RC0,RCEFT,RCSTAT,RCPOST,X,Z,Z0
"RTN","RCDPEWL7",38,0)
 S RCZ=0 F  S RCZ=$O(^TMP($J,"RCERA_LIST",RCSRT1,RCSRT2,RCZ)) Q:'RCZ  D
"RTN","RCDPEWL7",39,0)
 . S RCT=RCT+1,RC0=$G(^RCY(344.4,RCZ,0))
"RTN","RCDPEWL7",40,0)
 . S RCEFT=+$O(^RCY(344.31,"AERA",RCZ,0))
"RTN","RCDPEWL7",41,0)
 . S RCSTAT=$S('RCEFT:U_$S($P(RC0,U,15)="CHK":"(CHECK PAYMENT EXPECTED)",$P(RC0,U,15)="NON":"(NO PAYMENT EXPECTED)",$P(RC0,U,9)=2:"(CHECK PAYMENT CHOSEN)",1:"N/A"),1:$$FMSSTAT^RCDPUREC(+$P($G(^RCY(344.31,RCEFT,0)),U,9)))
"RTN","RCDPEWL7",42,0)
 . S RCPOST=$S(RCEFT:"EFT RECEIPT STATUS: ",1:"")_$P(RCSTAT,U,2)
"RTN","RCDPEWL7",43,0)
 . ; kl - epayments patch - display of ERA # needs to account for 10 digits;  TRACE # has been updated from 30 to 50 characters
"RTN","RCDPEWL7",44,0)
 . S X=$E(RCT_$J("",4),1,4)_$S($D(^RCY(344.49,RCZ)):" ",1:"-")_$E($P(RC0,U)_$J("",10),1,10)_"  "_$E($P(RC0,U,2)_$J("",50),1,50)
"RTN","RCDPEWL7",45,0)
 . D SET(X,RCT,RCZ)
"RTN","RCDPEWL7",46,0)
 . S X=$J("",40)_$J($$FMTE^XLFDT($P(RC0,U,7),"2D"),8)_$J("",5)_$J(+$P(RC0,U,5),12,2)
"RTN","RCDPEWL7",47,0)
 . S $E(X,73,80)=$$FMTE^XLFDT($P(RC0,U,7),"2D")
"RTN","RCDPEWL7",48,0)
 . D SET(X,RCT,RCZ)
"RTN","RCDPEWL7",49,0)
 . S X=$J("",12)_$E($P(RC0,U,6)_$J("",30),1,30)_"  APPROX # EEOBs: "_+$$CTEEOB^RCDPEWLB(RCZ)
"RTN","RCDPEWL7",50,0)
 . D SET(X,RCT,RCZ)
"RTN","RCDPEWL7",51,0)
 . S X=$J("",12)_$E($$EXTERNAL^DILFD(344.4,.09,"",$P(RC0,U,9))_$J("",30),1,30)_"  "_RCPOST
"RTN","RCDPEWL7",52,0)
 . D SET(X,RCT)
"RTN","RCDPEWL7",53,0)
 . I $G(^TMP("RCERA_PARAMS",$J,"BATCHON")) D
"RTN","RCDPEWL7",54,0)
 .. S Z=0 F  S Z=$O(^RCY(344.49,RCZ,3,Z)) Q:'Z  S Z0=$G(^(Z,0)) I Z0'="" D
"RTN","RCDPEWL7",55,0)
 ... S X=$J("",12)_$E("- BATCH #"_$P(Z0,U)_$J("",4),1,13)_" "_$E($P(Z0,U,2)_$J("",30),1,30)_"  "_$S('$P(Z0,U,3):"NOT ",1:"")_"READY TO POST"
"RTN","RCDPEWL7",56,0)
 ... D SET(X,RCT)
"RTN","RCDPEWL7",57,0)
 . D SET(" ",RCT)
"RTN","RCDPEWL7",58,0)
 S VALMSG="'-' Before the ERA # indicates no scratchpad entry yet"
"RTN","RCDPEWL7",59,0)
 ;
"RTN","RCDPEWL7",60,0)
 Q
"RTN","RCDPEWL7",61,0)
 ;
"RTN","RCDPEWL7",62,0)
SL(Y,SORT) ; Returns data for sort level from entry Y in file 344.4
"RTN","RCDPEWL7",63,0)
 ; SORT = the sort data in ';' delimited pieces
"RTN","RCDPEWL7",64,0)
 ;    pc 1 = code for sort data
"RTN","RCDPEWL7",65,0)
 ;    pc 2 = the order requested (- or null)
"RTN","RCDPEWL7",66,0)
 ;  
"RTN","RCDPEWL7",67,0)
 N RC0,DAT,SORT1,SORT2
"RTN","RCDPEWL7",68,0)
 S SORT1=$P(SORT,";"),SORT2=$P(SORT,";",2)
"RTN","RCDPEWL7",69,0)
 S RC0=$G(^RCY(344.4,Y,0)),DAT=" "
"RTN","RCDPEWL7",70,0)
 ; No sort
"RTN","RCDPEWL7",71,0)
 I SORT="" G SLQ
"RTN","RCDPEWL7",72,0)
 ; Amt paid
"RTN","RCDPEWL7",73,0)
 I SORT1="AP" D  G SLQ
"RTN","RCDPEWL7",74,0)
 . S DAT=SORT2_+$P(RC0,U,5)
"RTN","RCDPEWL7",75,0)
 ; ERA date pd
"RTN","RCDPEWL7",76,0)
 I SORT1="DP" D  G SLQ
"RTN","RCDPEWL7",77,0)
 . S DAT=SORT2_($P(RC0,U,4)\1)
"RTN","RCDPEWL7",78,0)
 ; Payer name
"RTN","RCDPEWL7",79,0)
 I SORT1="PN" D  G SLQ
"RTN","RCDPEWL7",80,0)
 . S DAT=$$UPPER($P(RC0,U,6))
"RTN","RCDPEWL7",81,0)
 ; ERA date received
"RTN","RCDPEWL7",82,0)
 I SORT1="DR" D  G SLQ
"RTN","RCDPEWL7",83,0)
 . S DAT=SORT2_($P(RC0,U,7)\1)
"RTN","RCDPEWL7",84,0)
 ;
"RTN","RCDPEWL7",85,0)
SLQ Q $S(DAT'="":DAT,1:" ")
"RTN","RCDPEWL7",86,0)
 ;
"RTN","RCDPEWL7",87,0)
INIT ; Entry point for List template to build the display of ERAs
"RTN","RCDPEWL7",88,0)
 ;
"RTN","RCDPEWL7",89,0)
 ; Parameters for selecting ERAs to be included in the list are
"RTN","RCDPEWL7",90,0)
 ; contained in the global ^TMP("RCERA_PARAMS",$J,parameter name)
"RTN","RCDPEWL7",91,0)
 ;
"RTN","RCDPEWL7",92,0)
 N RCZ,RC0,RCT,RCTT,RCQUIT,RCDTFR,RCDTTO,DTOUT,DUOUT,DIR,X,Y,Z,Z1,RCPOST,RCEFT,RCINDX
"RTN","RCDPEWL7",93,0)
 D CLEAN^VALM10
"RTN","RCDPEWL7",94,0)
 K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST")
"RTN","RCDPEWL7",95,0)
 ;
"RTN","RCDPEWL7",96,0)
 S (RCT,RCTT,RCQUIT)=0
"RTN","RCDPEWL7",97,0)
 ;
"RTN","RCDPEWL7",98,0)
 S RCDTFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTTO=$S($P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2):$P(^("RCDT"),U,2),1:DT)
"RTN","RCDPEWL7",99,0)
 ;
"RTN","RCDPEWL7",100,0)
 S RCINDX=$S(RCDTFR:RCDTFR-.00000001,1:0)
"RTN","RCDPEWL7",101,0)
 F  S RCINDX=$O(^RCY(344.4,"AFD",RCINDX)) Q:'RCINDX!(RCINDX\1>RCDTTO)!RCQUIT  S RCZ=0 F  S RCZ=$O(^RCY(344.4,"AFD",RCINDX,RCZ)) Q:'RCZ  D  Q:RCQUIT
"RTN","RCDPEWL7",102,0)
 . ;
"RTN","RCDPEWL7",103,0)
 . S RCTT=RCTT+1 I '(RCTT#5000) D  Q:RCQUIT
"RTN","RCDPEWL7",104,0)
 .. S DIR("A",1)=RCTT_" ERA RECORDS HAVE ALREADY BEEN SEARCHED USING YOUR CRITERIA",DIR("A",2)="LAST DATE SEARCHED WAS "_$$FMTE^XLFDT(RCINDX,"2D"),DIR("A")="DO YOU WANT TO CONTINUE THIS SEARCH?: "
"RTN","RCDPEWL7",105,0)
 .. S DIR("B")="NO",DIR("?")="RESPOND NO HERE AND RESTART TO SELECT A DATE RANGE TO LIMIT THE SEARCH",DIR(0)="YA" W ! D ^DIR K DIR
"RTN","RCDPEWL7",106,0)
 .. I Y=1!$D(DTOUT) W !,$S($D(DTOUT):"TIME OUT - ",1:""),"SEARCH CONTINUED",! Q
"RTN","RCDPEWL7",107,0)
 .. I $D(DUOUT)!(Y=0) S RCQUIT=1 Q
"RTN","RCDPEWL7",108,0)
 . ;
"RTN","RCDPEWL7",109,0)
 . S RC0=$G(^RCY(344.4,RCZ,0))
"RTN","RCDPEWL7",110,0)
 . I $$FILTER^RCDPEWL0(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,"DR"),$$SL(RCZ,""),RCZ)=""
"RTN","RCDPEWL7",111,0)
 ;
"RTN","RCDPEWL7",112,0)
 ; Output the list
"RTN","RCDPEWL7",113,0)
 I 'RCQUIT D
"RTN","RCDPEWL7",114,0)
 . D:$D(^TMP($J,"RCERA_LIST")) BLD("DR^N")
"RTN","RCDPEWL7",115,0)
 . I '$O(^TMP("RCDPE-ERA_WL",$J,0)) D
"RTN","RCDPEWL7",116,0)
 .. S DIR(0)="EA",DIR("A",1)="THERE ARE NO ERAs MATCHING YOUR SELECTION CRITERIA",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR S RCQUIT=1
"RTN","RCDPEWL7",117,0)
 I RCQUIT K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST") S VALMQUIT=""
"RTN","RCDPEWL7",118,0)
 Q
"RTN","RCDPEWL7",119,0)
 ;
"RTN","RCDPEWL7",120,0)
HDR ; Header for ERA list
"RTN","RCDPEWL7",121,0)
 N X
"RTN","RCDPEWL7",122,0)
 S X=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH"))
"RTN","RCDPEWL7",123,0)
 S VALMHDR(1)=$E("SELECTED:  MATCH STATUS: "_$S(X="N":"NOT MATCHED",X="M":"MATCHED",1:"BOTH")_$J("",38),1,38)
"RTN","RCDPEWL7",124,0)
 S X=$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))
"RTN","RCDPEWL7",125,0)
 S VALMHDR(1)=VALMHDR(1)_"  POST STATUS: "_$S(X="U":"UNPOSTED",X="P":"POSTED",1:"BOTH")
"RTN","RCDPEWL7",126,0)
 S X=$G(^TMP("RCERA_PARAMS",$J,"RCDT"))
"RTN","RCDPEWL7",127,0)
 S VALMHDR(2)=$J("",11)_"DATE RANGE  : "_$S($P(X,U):$$FMTE^XLFDT($P(X,U),2)_$S($P(X,U,2):"-"_$$FMTE^XLFDT($P(X,U,2),2),1:""),1:"NONE SELECTED")
"RTN","RCDPEWL7",128,0)
 S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))
"RTN","RCDPEWL7",129,0)
 S VALMHDR(3)=$J("",11)_$S($P(X,U)="A"!(X=""):"ALL PAYERS",1:"PAYERS: "_$P(X,U,2)_"-"_$P(X,U,3))
"RTN","RCDPEWL7",130,0)
 S X=$G(^TMP("RCERA_PARAMS",$J,"RCERA_TRACE#"))
"RTN","RCDPEWL7",131,0)
 S VALMHDR(4)="#   ERA #         TRACE#"
"RTN","RCDPEWL7",132,0)
 Q
"RTN","RCDPEWL7",133,0)
 ;
"RTN","RCDPEWL7",134,0)
FNL ; -- Clean up list
"RTN","RCDPEWL7",135,0)
 K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCERA_PARAMS",$J),^TMP($J,"RCERA_LIST")
"RTN","RCDPEWL7",136,0)
 Q
"RTN","RCDPEWL7",137,0)
 ;
"RTN","RCDPEWL7",138,0)
SET(X,RCSEQ,RCSEQ1) ; -- set arrays
"RTN","RCDPEWL7",139,0)
 ; X = the data to set into the global
"RTN","RCDPEWL7",140,0)
 ; RCSEQ = the selectable line #
"RTN","RCDPEWL7",141,0)
 ; RCSEQ1 = the ien of the entry in file 344.4
"RTN","RCDPEWL7",142,0)
 S VALMCNT=VALMCNT+1,^TMP("RCDPE-ERA_WL",$J,VALMCNT,0)=X
"RTN","RCDPEWL7",143,0)
 I $G(RCSEQ) S ^TMP("RCDPE-ERA_WL",$J,"IDX",VALMCNT,RCSEQ)=$G(RCSEQ1)
"RTN","RCDPEWL7",144,0)
 I $G(RCSEQ1) S ^TMP("RCDPE-ERA_WLDX",$J,RCSEQ)=VALMCNT_U_RCSEQ1
"RTN","RCDPEWL7",145,0)
 Q
"RTN","RCDPEWL7",146,0)
 ;
"RTN","RCDPEWL7",147,0)
ENTERWL ; Enter the worklist with an ERA
"RTN","RCDPEWL7",148,0)
 D WL($$SEL())
"RTN","RCDPEWL7",149,0)
 D BLD($G(^TMP("RCERA_PARAMS",$J,"SORT")))
"RTN","RCDPEWL7",150,0)
 S VALMBCK="R"
"RTN","RCDPEWL7",151,0)
 Q
"RTN","RCDPEWL7",152,0)
 ;
"RTN","RCDPEWL7",153,0)
SEL() ; Select an ERA from the ERA list
"RTN","RCDPEWL7",154,0)
 N RCDA,VALMY
"RTN","RCDPEWL7",155,0)
 D FULL^VALM1
"RTN","RCDPEWL7",156,0)
 D EN^VALM2($G(XQORNOD(0)),"S")
"RTN","RCDPEWL7",157,0)
 S RCERA=0
"RTN","RCDPEWL7",158,0)
 S RCDA=0 F  S RCDA=$O(VALMY(RCDA)) Q:'RCDA  S RCERA=+$P($G(^TMP("RCDPE-ERA_WLDX",$J,RCDA)),U,2)
"RTN","RCDPEWL7",159,0)
 ;
"RTN","RCDPEWL7",160,0)
 Q RCERA
"RTN","RCDPEWL7",161,0)
 ;
"RTN","RCDPEWL7",162,0)
WL(RCERA) ; Enter worklist
"RTN","RCDPEWL7",163,0)
 ; RCERA = ien of the ERA entry in file 344.4
"RTN","RCDPEWL7",164,0)
 N RC0,RCNOED,RCQUIT,RCSORT,DA,DIE,X,Y,DR,DIR,DTOUT,DUOUT
"RTN","RCDPEWL7",165,0)
 Q:RCERA'>0
"RTN","RCDPEWL7",166,0)
 S (RCQUIT,RCNOED)=0,RC0=$G(^RCY(344.4,RCERA,0)),RCSORT=""
"RTN","RCDPEWL7",167,0)
 I $P(RC0,U,8) D
"RTN","RCDPEWL7",168,0)
 . I '$D(^RCY(344.49,RCERA,0)) D  Q
"RTN","RCDPEWL7",169,0)
 .. S RCQUIT=1
"RTN","RCDPEWL7",170,0)
 .. W ! S DIR(0)="EA",DIR("A",1)="A SCRATCH PAD WAS NOT CREATED FOR THIS ERA BEFORE POSTING",DIR("A",2)="USE THE VIEW/PRINT ERA OPTION TO SEE ITS DETAIL",DIR("A")="PRESS RETURN TO CONTINUE: " D ^DIR K DIR Q
"RTN","RCDPEWL7",171,0)
 . ;
"RTN","RCDPEWL7",172,0)
 . S RCNOED=+$P(RC0,U,8)
"RTN","RCDPEWL7",173,0)
 . S DIR(0)="EA",DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - YOU MAY ONLY VIEW ITS SCRATCH PAD",DIR("A")="PRESS RETURN TO CONTINUE "
"RTN","RCDPEWL7",174,0)
 . W ! D ^DIR K DIR W !
"RTN","RCDPEWL7",175,0)
 I 'RCQUIT D
"RTN","RCDPEWL7",176,0)
 . N RCQUIT
"RTN","RCDPEWL7",177,0)
 . D DISP^RCDPEWL(RCERA,RCNOED)
"RTN","RCDPEWL7",178,0)
 ;
"RTN","RCDPEWL7",179,0)
 I 'RCQUIT,$G(^TMP("RCBATCH_SELECTED",$J)) D
"RTN","RCDPEWL7",180,0)
 . S DA(1)=RCERA,DA=+$G(^TMP("RCBATCH_SELECTED",$J)),DR=".05////0",DIE="^RCY(344.49,"_DA(1)_",3," D ^DIE
"RTN","RCDPEWL7",181,0)
 . L -^RCY(344.49,DA(1),3,DA,0)
"RTN","RCDPEWL7",182,0)
 . K ^TMP("RCBATCH_SELECTED",$J)
"RTN","RCDPEWL7",183,0)
 E  D
"RTN","RCDPEWL7",184,0)
 . L -^RCY(344.4,RCERA,0)
"RTN","RCDPEWL7",185,0)
 Q
"RTN","RCDPEWL7",186,0)
 ;
"RTN","RCDPEWL7",187,0)
PRERA ; View/Print ERA from ERA list menu
"RTN","RCDPEWL7",188,0)
 N RCSCR
"RTN","RCDPEWL7",189,0)
 S RCSCR=$$SEL()
"RTN","RCDPEWL7",190,0)
 I RCSCR>0 D PRERA^RCDPEWL0
"RTN","RCDPEWL7",191,0)
 S VALMBCK="R"
"RTN","RCDPEWL7",192,0)
 Q
"RTN","RCDPEWL7",193,0)
 ;
"RTN","RCDPEWL7",194,0)
BAT(RCERA) ; Select batch, if needed
"RTN","RCDPEWL7",195,0)
 ; Returns 1 if batch selected OK or no batch needed
"RTN","RCDPEWL7",196,0)
 ; RCERA = ien of entry in file 344.49
"RTN","RCDPEWL7",197,0)
 N RCINUSE,RCQUIT,RCADJ,RC0,RCOK,DIR,DTOUT,DUOUT,X,Y,Z
"RTN","RCDPEWL7",198,0)
 K ^TMP("RCBATCH_SELECTED",$J)
"RTN","RCDPEWL7",199,0)
 S RCOK=1
"RTN","RCDPEWL7",200,0)
 I '$O(^RCY(344.49,RCERA,3,0)) G BATQ
"RTN","RCDPEWL7",201,0)
 S RC0=$G(^RCY(344.4,RCERA,0))
"RTN","RCDPEWL7",202,0)
 S (RCQUIT,RCADJ)=0
"RTN","RCDPEWL7",203,0)
 I $$HASADJ^RCDPEWL8(RCERA) D
"RTN","RCDPEWL7",204,0)
 . S RCADJ=1
"RTN","RCDPEWL7",205,0)
 . S DIR("A",1)="THIS ERA HAS NEGATIVE ADJUSTMENTS THAT NEED TO BE DISTRIBUTED TO OTHER",DIR("A",2)="PAYMENTS ON THE ERA.  YOU CANNOT SELECT ANY INDIVIDUAL BATCHES UNTIL",DIR("A",3)="THE DISTRIBUTIONS ARE COMPLETE."
"RTN","RCDPEWL7",206,0)
 . S DIR("A")="PRESS RETURN TO CONTINUE: ",DIR(0)="EA" W ! D ^DIR K DIR
"RTN","RCDPEWL7",207,0)
 S RCINUSE=+$O(^RCY(344.49,"AINUSE",1,RCERA,0))
"RTN","RCDPEWL7",208,0)
 I RCINUSE D
"RTN","RCDPEWL7",209,0)
 . N OK,Z
"RTN","RCDPEWL7",210,0)
 . Q:RCADJ!$P(RC0,U,8)
"RTN","RCDPEWL7",211,0)
 . S OK=0 S Z=0 F  S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z  I '$P($G(^RCY(344.49,RCERA,3,Z,0)),U,5) S OK=1 Q
"RTN","RCDPEWL7",212,0)
 . I 'OK D  Q
"RTN","RCDPEWL7",213,0)
 .. S DIR("A",1)="ALL BATCHES WITHIN THIS ERA ARE CURRENTLY IN USE - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR S RCQUIT=1,RCOK=0 Q
"RTN","RCDPEWL7",214,0)
 . W !!,"AT LEAST 1 BATCH WITHIN THIS ERA IS CURRENTLY IN USE",!,"AT THIS TIME, YOU CAN ONLY ACCESS INDIVIDUAL BATCHES",!
"RTN","RCDPEWL7",215,0)
 . D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
"RTN","RCDPEWL7",216,0)
 . I RCQUIT S RCOK=0
"RTN","RCDPEWL7",217,0)
 E  D
"RTN","RCDPEWL7",218,0)
 . Q:$P(RC0,U,8)!RCADJ  ; Always require the entire ERA be used
"RTN","RCDPEWL7",219,0)
 . S DIR(0)="SA^E:(E)NTIRE ERA;B:(B)ATCH",DIR("A")="DO YOU WANT THE (E)NTIRE ERA OR JUST A (B)ATCH?: " W ! D ^DIR K DIR
"RTN","RCDPEWL7",220,0)
 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1,RCOK=0 Q
"RTN","RCDPEWL7",221,0)
 . I Y="E" D  Q
"RTN","RCDPEWL7",222,0)
 .. S RCQUIT=1 F Z=1:1:2 L +^RCY(344.4,RCERA,0):5 I $T S RCQUIT=0 Q
"RTN","RCDPEWL7",223,0)
 .. I RCQUIT S RCOK=0,DIR(0)="EA",DIR("A",1)="ANOTHER USER IS CURRENTLY USING THIS ERA, TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR Q
"RTN","RCDPEWL7",224,0)
 . D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
"RTN","RCDPEWL7",225,0)
 . I RCQUIT S RCOK=0
"RTN","RCDPEWL7",226,0)
 ;
"RTN","RCDPEWL7",227,0)
BATQ Q RCOK
"RTN","RCDPEWL7",228,0)
 ;
"RTN","RCDPEWL7",229,0)
UPPER(X) ; Function returns X as all upper case
"RTN","RCDPEWL7",230,0)
 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","RCDPEWL7",231,0)
 ;
"RTN","RCDPEWL8")
0^19^B74316733
"RTN","RCDPEWL8",1,0)
RCDPEWL8 ;ALB/TMK/PJH - EDI LOCKBOX WORKLIST ERA LEVEL ; 8/24/10 11:40am
"RTN","RCDPEWL8",2,0)
 ;;4.5;Accounts Receivable;**208,269**;Mar 20, 1995;Build 113
"RTN","RCDPEWL8",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEWL8",4,0)
 Q
"RTN","RCDPEWL8",5,0)
 ;
"RTN","RCDPEWL8",6,0)
FILESP ; Action that files the split lines
"RTN","RCDPEWL8",7,0)
 ; Assumes RCDIR,RCLINE,RCSCR,RCSPLIT array defined
"RTN","RCDPEWL8",8,0)
 N RCTOT,Z,RCZ0,RCZ1,DTOUT,DUOUT,DIR,X,Y,DIE,DA,DR,DIC,DD,DO,DLAYGO,RCZ,RCZZ,RCZT
"RTN","RCDPEWL8",9,0)
 D FULL^VALM1
"RTN","RCDPEWL8",10,0)
 I '$G(^TMP("RCDPE_EOB_SPLIT_OK",$J)) D  Q
"RTN","RCDPEWL8",11,0)
 . S VALMBCK="R"
"RTN","RCDPEWL8",12,0)
 . F Z=2,3 S RCTOT(Z)=$$TOT^RCDPEWL3(Z,.RCSPLIT)
"RTN","RCDPEWL8",13,0)
 . S DIR(0)="EA"
"RTN","RCDPEWL8",14,0)
 . S DIR("A",1)="TOTAL "_$S(+RCTOT(2)'=+$P(RCDIR,U,2):"PAYMENTS",1:"ADJUSTMENTS")_$S(+RCTOT(3)=+$P(RCDIR,U,3):"",+RCTOT(2)'=+$P(RCDIR,U,2):" AND ADJUSTMENTS",1:"")_" DO NOT MATCH THE ORIGINAL AMOUNT(s):"
"RTN","RCDPEWL8",15,0)
 . S DIR("A",2)=$E("  ORIG PAY AMT: "_$J(+$P(RCDIR,U,2),"",2)_$J("",35),1,35)_" ORIG ADJ AMT: "_$J(+$P(RCDIR,U,3),"",2)
"RTN","RCDPEWL8",16,0)
 . S DIR("A",3)=$E("   AMT ENTERED: "_$J(+RCTOT(2),"",2)_$J("",35),1,35)_"  AMT ENTERED: "_$J(+RCTOT(3),"",2)
"RTN","RCDPEWL8",17,0)
 . S DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL8",18,0)
 ;
"RTN","RCDPEWL8",19,0)
 S DA(1)=RCSCR
"RTN","RCDPEWL8",20,0)
 S RCZ0=+$P(RCLINE,U,2),RCZZ=+$G(^RCY(344.49,DA(1),1,RCZ0,0)),RCZZ(1)=""
"RTN","RCDPEWL8",21,0)
 S RCZ=+$O(RCSPLIT(0))
"RTN","RCDPEWL8",22,0)
 I RCZ D
"RTN","RCDPEWL8",23,0)
 . S DIE="^RCY(344.49,"_DA(1)_",1,",DA=RCZ0,RCZT=$P(RCSPLIT(RCZ),U,2)+$P(RCSPLIT(RCZ),U,3)
"RTN","RCDPEWL8",24,0)
 . S DR=".02////"_$P(RCSPLIT(RCZ),U)_";.05////"_$J(+$P(RCSPLIT(RCZ),U,2),"",2)_";.06////"_$J(+RCZT,"",2)_";.08////"_$J($P(RCSPLIT(RCZ),U,3),"",2)
"RTN","RCDPEWL8",25,0)
 . S DR=DR_";.07///"_$S($P(RCSPLIT(RCZ),U,5):"/"_$P(RCSPLIT(RCZ),U,5),1:"@")_";.03////"_$S(RCZT'<0:$J(+RCZT,"",2),1:"0.00")_$S($P(RCSPLIT(RCZ),U,6)'="":";.1///"_$S($P(RCSPLIT(RCZ),U,6)'="@":"/^S X=$P(RCSPLIT(RCZ),U,6)",1:"@"),1:"")
"RTN","RCDPEWL8",26,0)
 . D ^DIE,UPD^RCDPEWL3(DA(1),DA)
"RTN","RCDPEWL8",27,0)
 . I $P(RCDIR,U,3) D
"RTN","RCDPEWL8",28,0)
 .. N DA
"RTN","RCDPEWL8",29,0)
 .. S DA(2)=RCSCR,DA(1)=RCZ0,DA=1,DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
"RTN","RCDPEWL8",30,0)
 .. S RCZZ(1)=$G(^RCY(344.49,DA(2),1,DA(1),1,1,0))
"RTN","RCDPEWL8",31,0)
 .. S DR=".03////"_$J(+$P(RCSPLIT(RCZ),U,3),"",2)_$S($P(RCSPLIT(RCZ),U,4)'="":".09////"_$P(RCSPLIT(RCZ),U,4),1:"")
"RTN","RCDPEWL8",32,0)
 .. D ^DIE
"RTN","RCDPEWL8",33,0)
 F  S RCZ=$O(RCSPLIT(RCZ)) Q:'RCZ  D
"RTN","RCDPEWL8",34,0)
 . S DIC(0)="L",DLAYGO=344.491,DIC="^RCY(344.49,"_DA(1)_",1,",X=+$O(^RCY(344.49,RCSCR,1,"B",RCZZ\1+.999),-1)+.001
"RTN","RCDPEWL8",35,0)
 . S DIC("DR")=".02////"_$P(RCSPLIT(RCZ),U)_";.05////"_$J(+$P(RCSPLIT(RCZ),U,2),"",2)_";.08////"_$J(+$P(RCSPLIT(RCZ),U,3),"",2)_";.06////"_$J($P(RCSPLIT(RCZ),U,2)+$P(RCSPLIT(RCZ),U,3),"",2)
"RTN","RCDPEWL8",36,0)
 . I $P(RCSPLIT(RCZ),U,6)'="" S DIC("DR")=DIC("DR")_";.1///"_$S($P(RCSPLIT(RCZ),U,6)'="@":"/^S X=$P(RCSPLIT(RCZ),U,6)",1:"@")
"RTN","RCDPEWL8",37,0)
 . I $P(RCSPLIT(RCZ),U,5) S DIC("DR")=DIC("DR")_";.07////"_$P(RCSPLIT(RCZ),U,5)
"RTN","RCDPEWL8",38,0)
 . K DD,DO D FILE^DICN K DIC,DLAYGO,DD,DO
"RTN","RCDPEWL8",39,0)
 . S RCZ1=+Y
"RTN","RCDPEWL8",40,0)
 . I Y D UPD^RCDPEWL3(RCSCR,RCZ1)
"RTN","RCDPEWL8",41,0)
 . I Y,$P(RCDIR,U,3) D
"RTN","RCDPEWL8",42,0)
 .. N DA
"RTN","RCDPEWL8",43,0)
 .. S DA(2)=RCSCR,DA(1)=RCZ1,X=1,DIC(0)="L",DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
"RTN","RCDPEWL8",44,0)
 .. S DIC("DR")=".02////"_$P(RCZZ(1),U,2)_";.03////"_$J(+$P(RCSPLIT(RCZ),U,3),"",2)_$S($P(RCSPLIT(RCZ),U,4)'="":";.09////"_$P(RCSPLIT(RCZ),U,4),$P(RCZZ(1),U,9)'="":";.09////"_$P(RCZZ(1),U,9),1:"")
"RTN","RCDPEWL8",45,0)
 .. F Z=4:1:8 I $P(RCZZ(1),U,Z)'="" S DIC("DR")=DIC("DR")_";"_(Z/100)_"////"_$P(RCZZ(1),U,Z)
"RTN","RCDPEWL8",46,0)
 .. D FILE^DICN K DIC,DLAYGO,DD,DO
"RTN","RCDPEWL8",47,0)
 K ^TMP($J,"RCDPE_SPLIT_FILE")
"RTN","RCDPEWL8",48,0)
 S VALMBCK="Q"
"RTN","RCDPEWL8",49,0)
 Q
"RTN","RCDPEWL8",50,0)
 ;
"RTN","RCDPEWL8",51,0)
SELBAT(RCERA,RCQUIT) ; Select a batch
"RTN","RCDPEWL8",52,0)
 ; If batch is selected, global ^TMP("RCBATCH_SELECTED",$J) is set = 
"RTN","RCDPEWL8",53,0)
 ;   batch ien selected
"RTN","RCDPEWL8",54,0)
 ; RCQUIT = 1 if selection not made
"RTN","RCDPEWL8",55,0)
 N RCBAT,DA,DIE,X,Y,DIC,DUOUT,DTOUT,DIR,DR
"RTN","RCDPEWL8",56,0)
 S RCQUIT=0
"RTN","RCDPEWL8",57,0)
 S DA(1)=RCERA,DIC(0)="AEMQ",DIC="^RCY(344.49,"_DA(1)_",3,",DIC("S")="I '$P(^(0),U,5)" D ^DIC
"RTN","RCDPEWL8",58,0)
 I Y'>0 S RCQUIT=1 Q
"RTN","RCDPEWL8",59,0)
 S RCBAT=+Y
"RTN","RCDPEWL8",60,0)
 L +^RCY(344.4,RCERA,0):5 I '$T S DIR("A",1)="ANOTHER USER HAS JUST ACCESSED THE ENTIRE ERA - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR S RCQUIT=1 Q
"RTN","RCDPEWL8",61,0)
 L +^RCY(344.49,RCERA,3,RCBAT,0):5 I '$T!$P($G(^(0)),U,5) S DIR("A",1)="ANOTHER USER HAS JUST OPENED THIS BATCH - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)=-"EA" W ! D ^DIR K DIR S RCQUIT=1 Q
"RTN","RCDPEWL8",62,0)
 S DA=RCBAT,DA(1)=RCERA,DIE="^RCY(344.49,"_DA(1)_",3,",DR=".05////1" D ^DIE L -^RCY(344.49,RCERA,3,RCBAT,0)
"RTN","RCDPEWL8",63,0)
 I $P($G(^RCY(344.49,RCERA,3,RCBAT,0)),U,3) D
"RTN","RCDPEWL8",64,0)
 . S DIR(0)="EA",DIR("A",1)="** WARNING - THIS BATCH HAS BEEN FLAGGED AS READY TO POST",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL8",65,0)
 S ^TMP("RCBATCH_SELECTED",$J)=RCBAT
"RTN","RCDPEWL8",66,0)
 L -^RCY(344.4,RCERA,0)
"RTN","RCDPEWL8",67,0)
 Q
"RTN","RCDPEWL8",68,0)
 ;
"RTN","RCDPEWL8",69,0)
SORT ; Select a new sort for the list of ERAs
"RTN","RCDPEWL8",70,0)
 D FULL^VALM1
"RTN","RCDPEWL8",71,0)
 N RCSORT,DUOUT,DTOUT,DIR,X,Y,RCS1,RCS2,RCORD
"RTN","RCDPEWL8",72,0)
 S VALMBCK="R"
"RTN","RCDPEWL8",73,0)
 S DIR("L",1)="  SELECT A FIRST LEVEL SORT",DIR("L",2)=" "
"RTN","RCDPEWL8",74,0)
 S DIR("L",3)="    A  AMOUNT PAID      E  ERA PAID DATE"
"RTN","RCDPEWL8",75,0)
 S DIR("L")="    P  PAYER NAME       D  DATE ERA RECEIVED"
"RTN","RCDPEWL8",76,0)
 S DIR(0)="S^A:AMOUNT PAID;E:ERA PAID DATE;P:PAYER NAME;D:DATE ERA RECEIVED",DIR("B")=$P($P(DIR(0),"D:",2),";")
"RTN","RCDPEWL8",77,0)
 W ! D ^DIR K DIR
"RTN","RCDPEWL8",78,0)
 I $D(DTOUT)!$D(DUOUT) Q
"RTN","RCDPEWL8",79,0)
 S RCS1=$S(Y="A":"AP",Y="E":"DP",Y="P":"PN",1:"DR")
"RTN","RCDPEWL8",80,0)
 S RCORD=$$ORD(.RCS1)
"RTN","RCDPEWL8",81,0)
 Q:'$D(RCS1)
"RTN","RCDPEWL8",82,0)
 S $P(RCSORT,U)=(RCS1_";"_RCORD)
"RTN","RCDPEWL8",83,0)
 K X
"RTN","RCDPEWL8",84,0)
 S X(1)=$S(RCS1'="AP":"A:AMOUNT PAID",1:"E:ERA PAID DATE")
"RTN","RCDPEWL8",85,0)
 S X(2)=$S(RCS1'="AP"&(RCS1'="DP"):"E:ERA PAID DATE",1:"P:PAYER NAME")
"RTN","RCDPEWL8",86,0)
 S X(3)=$S(RCS1="DR":"P:PAYER NAME",1:"D:DATE ERA RECEIVED")
"RTN","RCDPEWL8",87,0)
 S DIR(0)="S^N:NONE;"_X(1)_";"_X(2)_";"_X(3)
"RTN","RCDPEWL8",88,0)
 S DIR("B")="NONE"
"RTN","RCDPEWL8",89,0)
 S DIR("L",1)="  SELECT A SECOND LEVEL SORT",DIR("L",2)=" "
"RTN","RCDPEWL8",90,0)
 S DIR("L",3)="    N  NONE"_$J("",13)_$P(X(1),":")_"  "_$P(X(1),":",2)
"RTN","RCDPEWL8",91,0)
 S DIR("L")="    "_$E($P(X(2),":")_"  "_$P(X(2),":",2)_$J("",20),1,20)_$P(X(3),":")_"  "_$P(X(3),":",2)
"RTN","RCDPEWL8",92,0)
 K X W ! D ^DIR K DIR
"RTN","RCDPEWL8",93,0)
 I $D(DTOUT)!$D(DUOUT) Q
"RTN","RCDPEWL8",94,0)
 S RCS2=$S(Y="N":"N",Y="A":"AP",Y="E":"DP",Y="P":"PN",1:"DR")
"RTN","RCDPEWL8",95,0)
 S RCORD=$$ORD(.RCS2)
"RTN","RCDPEWL8",96,0)
 Q:'$D(RCS2)
"RTN","RCDPEWL8",97,0)
 S $P(RCSORT,U,2)=(RCS2_";"_RCORD)
"RTN","RCDPEWL8",98,0)
 K ^TMP($J,"RCERA_LIST") D BLD^RCDPEWL7(RCSORT)
"RTN","RCDPEWL8",99,0)
 Q
"RTN","RCDPEWL8",100,0)
 ;
"RTN","RCDPEWL8",101,0)
ORD(RCS) ; Select an order for the sorted field code in RCS
"RTN","RCDPEWL8",102,0)
 ; Kill RCS if nothing selected, passed by reference
"RTN","RCDPEWL8",103,0)
 ; Returns '-' if reverse order selected
"RTN","RCDPEWL8",104,0)
 N DIR,X,Y,ORD,RCQUIT
"RTN","RCDPEWL8",105,0)
 S RCQUIT=0,ORD=""
"RTN","RCDPEWL8",106,0)
 I RCS="N" G ORDQ
"RTN","RCDPEWL8",107,0)
 I RCS="PN" D  G ORDQ
"RTN","RCDPEWL8",108,0)
 . S DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST"
"RTN","RCDPEWL8",109,0)
 . S DIR("B")=$P($P(DIR(0),"F:",2),";")
"RTN","RCDPEWL8",110,0)
 . S DIR("A")="  SORT (F)IRST TO LAST OR (L)AST TO FIRST?: "
"RTN","RCDPEWL8",111,0)
 . D ^DIR K DIR
"RTN","RCDPEWL8",112,0)
 . I $D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
"RTN","RCDPEWL8",113,0)
 . S ORD=$S(Y="F":"",1:"-")
"RTN","RCDPEWL8",114,0)
 ;
"RTN","RCDPEWL8",115,0)
 I RCS="AP" D  G ORDQ
"RTN","RCDPEWL8",116,0)
 . S DIR("A")="  SORT (L)OWEST TO HIGHEST OR (H)IGHEST TO LOWEST?: "
"RTN","RCDPEWL8",117,0)
 . S DIR(0)="SA^L:LOWEST TO HIGHEST;H:HIGHEST TO LOWEST"
"RTN","RCDPEWL8",118,0)
 . S DIR("B")=$P($P(DIR(0),"L:",2),";")
"RTN","RCDPEWL8",119,0)
 . D ^DIR K DIR
"RTN","RCDPEWL8",120,0)
 . I $D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
"RTN","RCDPEWL8",121,0)
 . S ORD=$S(Y="L":"",1:"-")
"RTN","RCDPEWL8",122,0)
 ;
"RTN","RCDPEWL8",123,0)
 I RCS="DP"!(RCS="DR") D  G ORDQ
"RTN","RCDPEWL8",124,0)
 . S DIR("A")="  SORT (E)ARLIEST TO LATEST OR (L)ATEST TO EARLIEST?: "
"RTN","RCDPEWL8",125,0)
 . S DIR(0)="SA^E:EARLIEST TO LATEST;L:LATEST TO EARLIEST"
"RTN","RCDPEWL8",126,0)
 . S DIR("B")=$P($P(DIR(0),"E:",2),";")
"RTN","RCDPEWL8",127,0)
 . D ^DIR K DIR
"RTN","RCDPEWL8",128,0)
 . I $D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
"RTN","RCDPEWL8",129,0)
 . S ORD=$S(Y="E":"",1:"-")
"RTN","RCDPEWL8",130,0)
 ;
"RTN","RCDPEWL8",131,0)
 ; Invalid sort code
"RTN","RCDPEWL8",132,0)
 S RCQUIT=1
"RTN","RCDPEWL8",133,0)
 ;
"RTN","RCDPEWL8",134,0)
ORDQ I RCQUIT K RCS
"RTN","RCDPEWL8",135,0)
 Q ORD
"RTN","RCDPEWL8",136,0)
 ;
"RTN","RCDPEWL8",137,0)
BATDSP ; Ask Display/Hide batch info on ERA list screen
"RTN","RCDPEWL8",138,0)
 N DIR,X,Y,RCZ,DUOUT,DTOUT
"RTN","RCDPEWL8",139,0)
 D FULL^VALM1
"RTN","RCDPEWL8",140,0)
 S RCZ=+$G(^TMP("RCERA_PARAMS",$J,"BATCHON"))
"RTN","RCDPEWL8",141,0)
 S DIR("A",1)="BATCH INFO DISPLAY IS CURRENTLY TURNED "_$S('RCZ:"OFF",1:"ON"),DIR("A")="DO YOU WANT TO TURN IT "_$S('RCZ:"ON",1:"OFF")_" NOW?: "
"RTN","RCDPEWL8",142,0)
 S DIR(0)="YA",DIR("B")="YES" W ! D ^DIR K DIR
"RTN","RCDPEWL8",143,0)
 S VALMBCK="R"
"RTN","RCDPEWL8",144,0)
 Q:$D(DUOUT)!$D(DTOUT)!'Y
"RTN","RCDPEWL8",145,0)
 S ^TMP("RCERA_PARAMS",$J,"BATCHON")=$S(RCZ:0,1:1)
"RTN","RCDPEWL8",146,0)
 D BLD^RCDPEWL7($G(^TMP("RCERA_PARAMS",$J,"SORT")))
"RTN","RCDPEWL8",147,0)
 Q
"RTN","RCDPEWL8",148,0)
 ;
"RTN","RCDPEWL8",149,0)
HASADJ(RCSCR,RCOK) ; Function=1 if WL entry has any adj not yet distributed
"RTN","RCDPEWL8",150,0)
 ; RCSCR = ien of entry in file 344.49
"RTN","RCDPEWL8",151,0)
 ; RCOK = if passed by reference, returns 1 if ANY postable lines exist
"RTN","RCDPEWL8",152,0)
 N Z,Z0,RCSTOP
"RTN","RCDPEWL8",153,0)
 S RCSTOP=0,RCOK=0
"RTN","RCDPEWL8",154,0)
 S Z=0 F  S Z=$O(^RCY(344.49,RCSCR,1,Z)) Q:'Z  S Z0=$G(^(Z,0)) D  Q:RCSTOP
"RTN","RCDPEWL8",155,0)
 . ;HIPAA 5010 - negative value now takes precedence over adjustment
"RTN","RCDPEWL8",156,0)
 . I $P(Z0,U,6)>0!$O(^RCY(344.49,RCSCR,1,Z,1,0)) S RCOK=1
"RTN","RCDPEWL8",157,0)
 . I $P(Z0,U,6)<0 S RCSTOP=1
"RTN","RCDPEWL8",158,0)
 Q RCSTOP
"RTN","RCDPEWL8",159,0)
 ;
"RTN","RCDPEWL8",160,0)
VERIF ; Entrypoint to verification options
"RTN","RCDPEWL8",161,0)
 N DIR,X,Y,RCQUIT,DTOUT,DUOUT
"RTN","RCDPEWL8",162,0)
 D FULL^VALM1
"RTN","RCDPEWL8",163,0)
 ;
"RTN","RCDPEWL8",164,0)
 W !!!!
"RTN","RCDPEWL8",165,0)
 S RCQUIT=0
"RTN","RCDPEWL8",166,0)
 F  D  Q:RCQUIT
"RTN","RCDPEWL8",167,0)
 . W !,"VERIFY EEOBs:",!,?10,"1",$J("",5),"MANUAL MARK AS VERIFIED",!,?10,"2",$J("",5),"REPORT OF UNVERIFIED WITH DISCREPANCIES",!,?10,"3",$J("",5),"QUIT AND RETURN TO WORKLIST"
"RTN","RCDPEWL8",168,0)
 . S DIR(0)="SAO^1:MANUAL VERIFICATION;2:REPORT UNVERIFIED DISCREPANCIES;3:QUIT"
"RTN","RCDPEWL8",169,0)
 . S DIR("A")="Select Action: ",DIR("B")="QUIT" W ! D ^DIR K DIR
"RTN","RCDPEWL8",170,0)
 . I Y=3!(Y="")!$D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
"RTN","RCDPEWL8",171,0)
 . ;
"RTN","RCDPEWL8",172,0)
 . I Y=1 D MVER^RCDPEV(RCERA) W !! Q
"RTN","RCDPEWL8",173,0)
 . ;
"RTN","RCDPEWL8",174,0)
 . I Y=2 D RPT^RCDPEV0(RCERA) W !! Q
"RTN","RCDPEWL8",175,0)
 ;
"RTN","RCDPEWL8",176,0)
VERIFQ S VALMBCK="R"
"RTN","RCDPEWL8",177,0)
 Q
"RTN","RCDPEWL8",178,0)
 ;
"RTN","RCDPEWL8",179,0)
BATED ; Entrypoint to batch edit options
"RTN","RCDPEWL8",180,0)
 N DIC,DA,DUOUT,DTOUT,DIR,X,Y,RCQUIT
"RTN","RCDPEWL8",181,0)
 D FULL^VALM1
"RTN","RCDPEWL8",182,0)
 ;
"RTN","RCDPEWL8",183,0)
 W !!!!
"RTN","RCDPEWL8",184,0)
 S RCQUIT=0
"RTN","RCDPEWL8",185,0)
 I '$O(^RCY(344.49,RCERA,3,0)) W !,"***** THERE ARE CURRENTLY NO BATCHES DEFINED FOR THIS ERA *****",!
"RTN","RCDPEWL8",186,0)
 ; No menu if entering from a batch level
"RTN","RCDPEWL8",187,0)
 I $G(^TMP("RCBATCH_SELECTED",$J)) W !,"EDITING BATCH #"_+^TMP("RCBATCH_SELECTED",$J) D EDIT^RCDPEWLB(RCERA,+^TMP("RCBATCH_SELECTED",$J)) G BATEDQ
"RTN","RCDPEWL8",188,0)
 F  D  Q:RCQUIT
"RTN","RCDPEWL8",189,0)
 . I '$D(^XUSEC("PRCA ERA BATCH MAINT",DUZ)) D  Q
"RTN","RCDPEWL8",190,0)
 .. S RCQUIT=1
"RTN","RCDPEWL8",191,0)
 .. S DIR(0)="EA",DIR("A")="YOU DO NOT HAVE SECURITY ACCESS TO THIS ACTION - PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
"RTN","RCDPEWL8",192,0)
 . W !,"BATCH MAINTENANCE:",!,?10,"1",$J("",5),"EDIT BATCH",!,?10,"2",$J("",5),"NEW BATCH ASSIGNMENT",!,?10,"3",$J("",5),"MARK ALL READY TO POST",!,?10,"4",$J("",5),"BATCH SUMMARY REPORT",!,?10,"5",$J("",5),"QUIT AND RETURN TO WORKLIST"
"RTN","RCDPEWL8",193,0)
 . S DIR(0)="SAO^1:EDIT BATCH;2:NEW BATCHES;3:MARK ALL;4:BATCH SUMMARY;5:QUIT"
"RTN","RCDPEWL8",194,0)
 . S DIR("A")="Select Action: ",DIR("B")="Quit" W ! D ^DIR K DIR
"RTN","RCDPEWL8",195,0)
 . I Y="5"!(Y="")!$D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
"RTN","RCDPEWL8",196,0)
 . ;
"RTN","RCDPEWL8",197,0)
 . I Y=1 D  W !! Q
"RTN","RCDPEWL8",198,0)
 .. I '$O(^RCY(344.49,RCERA,3,0)) D NOTSET^RCDPEWLC Q
"RTN","RCDPEWL8",199,0)
 .. S DIR("B")="ONE",DIR(0)="SA^A:ALL;O:ONE",DIR("A")="EDIT(A)LL or (O)NE BATCH?: " W ! D ^DIR K DIR
"RTN","RCDPEWL8",200,0)
 .. I $D(DTOUT)!$D(DUOUT) Q
"RTN","RCDPEWL8",201,0)
 .. I Y="A" D EDITALL^RCDPEWLB(RCERA) Q
"RTN","RCDPEWL8",202,0)
 .. S DA(1)=RCERA,DIC="^RCY(344.49,"_DA(1)_",3,",DIC(0)="AEMQ" D ^DIC
"RTN","RCDPEWL8",203,0)
 .. Q:Y'>0
"RTN","RCDPEWL8",204,0)
 .. D EDIT^RCDPEWLB(RCERA,+Y)
"RTN","RCDPEWL8",205,0)
 . ;
"RTN","RCDPEWL8",206,0)
 . I Y=2 D REBATCH^RCDPEWLB(RCERA) W !! Q
"RTN","RCDPEWL8",207,0)
 . ;
"RTN","RCDPEWL8",208,0)
 . I Y=3 D MARKALL^RCDPEWLB(RCERA) W !! Q
"RTN","RCDPEWL8",209,0)
 . ;
"RTN","RCDPEWL8",210,0)
 . I Y=4 D SUMRPT^RCDPEWLC(RCERA) W !! Q
"RTN","RCDPEWL8",211,0)
 ;
"RTN","RCDPEWL8",212,0)
BATEDQ S VALMBCK="R"
"RTN","RCDPEWL8",213,0)
 Q
"RTN","RCDPEWL8",214,0)
 ;
"RTN","RCDPEX")
0^28^B76642906
"RTN","RCDPEX",1,0)
RCDPEX ;ALB/TMK,DWA - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.5 ; 9/29/10 6:01pm
"RTN","RCDPEX",2,0)
 ;;4.5;Accounts Receivable;**173,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPEX",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEX",4,0)
 Q
"RTN","RCDPEX",5,0)
 ;
"RTN","RCDPEX",6,0)
UPD ; Update (File) ERA msgs manually from EOB exception list for file 344.5
"RTN","RCDPEX",7,0)
 N RCDA,RCOK,RCTDA,ZTSK,RCTSK,RCTYP,RCU,RC0
"RTN","RCDPEX",8,0)
 D FULL^VALM1
"RTN","RCDPEX",9,0)
 D SEL(.RCDA,1)
"RTN","RCDPEX",10,0)
 S RCDA=$O(RCDA(""))
"RTN","RCDPEX",11,0)
 I RCDA="" G UPDQ
"RTN","RCDPEX",12,0)
 S RCTDA=+RCDA(RCDA)
"RTN","RCDPEX",13,0)
 I '$$LOCK(RCTDA) G UPDQ
"RTN","RCDPEX",14,0)
 S RC0=$G(^RCY(344.5,RCTDA,0))
"RTN","RCDPEX",15,0)
 ;
"RTN","RCDPEX",16,0)
 I RC0="" D  G UPDQ
"RTN","RCDPEX",17,0)
 . W !,*7,"ERA #",RCDA," is no longer in exception file" S RCOK=""
"RTN","RCDPEX",18,0)
 . D PAUSE^VALM1
"RTN","RCDPEX",19,0)
 I $P(RC0,U,5) S RCOK=1 D  G:'RCOK UPDQ
"RTN","RCDPEX",20,0)
 . N ZTSK
"RTN","RCDPEX",21,0)
 . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0  ;Task not scheduled
"RTN","RCDPEX",22,0)
 . I "12"[ZTSK(1) W *7,!,"This record has already been scheduled for update.  Task # is: ",$P(RC0,U,5) S RCOK="" D PAUSE^VALM1
"RTN","RCDPEX",23,0)
 ;
"RTN","RCDPEX",24,0)
 S RCTYP=$P(RC0,U,2)
"RTN","RCDPEX",25,0)
 S RCU=$S(RCTYP="835ERA":"NEWERA^RCDPESR2("_RCTDA_",1)",RCTYP="835XFR":"FILEEOB^RCDPESR5("_RCTDA_")",1:"")
"RTN","RCDPEX",26,0)
 I RCU="" W !,*7,"This message has an invalid 'type' - can't update" D PAUSE^VALM1 G UPDQ
"RTN","RCDPEX",27,0)
 S RCTSK=$$TASK(RCU,RCTDA)
"RTN","RCDPEX",28,0)
 I RCTSK W !,"File update has been tasked (#",RCTSK,")"
"RTN","RCDPEX",29,0)
 I 'RCTSK W !,*7,"File update could not be tasked.  Please try again later!!!"
"RTN","RCDPEX",30,0)
 D PAUSE^VALM1
"RTN","RCDPEX",31,0)
 ;
"RTN","RCDPEX",32,0)
 D BLD^RCDPEX1
"RTN","RCDPEX",33,0)
UPDQ I $G(RCTDA) L -^RCY(344.5,RCTDA,0)
"RTN","RCDPEX",34,0)
 S VALMBCK="R"
"RTN","RCDPEX",35,0)
 Q
"RTN","RCDPEX",36,0)
 ;
"RTN","RCDPEX",37,0)
VP ; View/Print ERA Messages - File 344.5
"RTN","RCDPEX",38,0)
 N DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,RCDA,RCTDA,RCRAW,POP
"RTN","RCDPEX",39,0)
 D FULL^VALM1,SEL(.RCDA,1)
"RTN","RCDPEX",40,0)
 S RCDA=$O(RCDA(""))
"RTN","RCDPEX",41,0)
 G:'RCDA VPQ
"RTN","RCDPEX",42,0)
 S RCTDA=$G(RCDA(RCDA))
"RTN","RCDPEX",43,0)
 S DIR(0)="YA",DIR("A")="DO YOU WANT TO INCLUDE DATA THE WAY IT WAS RECEIVED (RAW DATA)?: ",DIR("B")="N" D ^DIR K DIR
"RTN","RCDPEX",44,0)
 I $D(DUOUT)!$D(DTOUT) G VPQ
"RTN","RCDPEX",45,0)
 S RCRAW=+Y
"RTN","RCDPEX",46,0)
 ; Ask device
"RTN","RCDPEX",47,0)
 N %ZIS,ZTRTN,ZTSAVE,ZTDESC
"RTN","RCDPEX",48,0)
 S %ZIS="QM" D ^%ZIS G:POP VPQ
"RTN","RCDPEX",49,0)
 I $D(IO("Q")) D  G VPQ
"RTN","RCDPEX",50,0)
 . S ZTRTN="VPOUT^RCDPEX",ZTDESC="AR - Print EEOB Exception Message"
"RTN","RCDPEX",51,0)
 . S ZTSAVE("RCTDA")="",ZTSAVE("RCRAW")=""
"RTN","RCDPEX",52,0)
 . D ^%ZTLOAD
"RTN","RCDPEX",53,0)
 . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPEX",54,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEX",55,0)
 U IO
"RTN","RCDPEX",56,0)
 ;
"RTN","RCDPEX",57,0)
VPOUT ; Entrypoint for queued job
"RTN","RCDPEX",58,0)
 N Z,Z0,RCSTOP,RCPG,RCXM,RCXM1,RC,RCZ,RCTDAC,RCV5
"RTN","RCDPEX",59,0)
 K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
"RTN","RCDPEX",60,0)
 S RCTDAC=RCTDA_",",RCV5=0
"RTN","RCDPEX",61,0)
 ;
"RTN","RCDPEX",62,0)
 D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCZ")
"RTN","RCDPEX",63,0)
 D TXTDE(RCTDA,.RCZ,1,.RCXM,.RC)
"RTN","RCDPEX",64,0)
 ;
"RTN","RCDPEX",65,0)
 I $O(^RCY(344.5,RCTDA,"EX",0)) D
"RTN","RCDPEX",66,0)
 . S RC=RC+1,RCXM(RC)="**EXCEPTION MESSAGES**"
"RTN","RCDPEX",67,0)
 . D TXTDE(RCTDA,.RCZ,5,.RCXM,.RC)
"RTN","RCDPEX",68,0)
 ;
"RTN","RCDPEX",69,0)
 K ^TMP("RCSAVE",$J)
"RTN","RCDPEX",70,0)
 M ^TMP("RCSAVE",$J)=^RCY(344.5,RCTDA,2)
"RTN","RCDPEX",71,0)
 I +$P($G(^TMP("RCSAVE",$J,1,0)),U,16)>0 S RCV5=1
"RTN","RCDPEX",72,0)
 S Z=0 F  S Z=$O(^TMP("RCSAVE",$J,Z)) Q:'Z  I $P($G(^(Z,0)),U)["835" K ^(0) Q  ; Get rid of header node
"RTN","RCDPEX",73,0)
 D DISP^RCDPESR0("^TMP(""RCSAVE"",$J)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75) ; Get formatted 'raw' data
"RTN","RCDPEX",74,0)
 K ^TMP("RCSAVE",$J)
"RTN","RCDPEX",75,0)
 I $G(RCRAW) D
"RTN","RCDPEX",76,0)
 . S RC=$O(^TMP($J,"RCOUT",""),-1)+1,^TMP($J,"RCOUT",RC)=" "
"RTN","RCDPEX",77,0)
 . S RC=RC+1,^TMP($J,"RCOUT",RC)="**RAW DATA**"
"RTN","RCDPEX",78,0)
 . S Z=0 F  S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z  D
"RTN","RCDPEX",79,0)
 .. F Z0=1:80:$L($G(^RCY(344.5,RCTDA,2,Z,0))) S RC=RC+1,^TMP($J,"RCOUT",RC)=$E($G(^RCY(344.5,RCTDA,2,Z,0)),Z0,Z0+79)
"RTN","RCDPEX",80,0)
 ;
"RTN","RCDPEX",81,0)
 S (RCPG,RCSTOP,Z)=0
"RTN","RCDPEX",82,0)
 F  S Z=$O(RCXM(Z)) Q:'Z  S ^TMP($J,"RCOUT",Z-999)=RCXM(Z)
"RTN","RCDPEX",83,0)
 S Z=""
"RTN","RCDPEX",84,0)
 F  S Z=$O(^TMP($J,"RCOUT",Z)) Q:'Z  D  Q:RCSTOP
"RTN","RCDPEX",85,0)
 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q
"RTN","RCDPEX",86,0)
 . I 'RCPG!(($Y+5)>IOSL) D  I RCSTOP Q
"RTN","RCDPEX",87,0)
 .. D:RCPG ASK(.RCSTOP) I RCSTOP Q
"RTN","RCDPEX",88,0)
 .. D HDR(RCTDA,.RCPG)
"RTN","RCDPEX",89,0)
 . W !,$G(^TMP($J,"RCOUT",Z))
"RTN","RCDPEX",90,0)
 I 'RCSTOP,RCPG D ASK(.RCSTOP)
"RTN","RCDPEX",91,0)
 ;
"RTN","RCDPEX",92,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPEX",93,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPEX",94,0)
 ;
"RTN","RCDPEX",95,0)
VPQ K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
"RTN","RCDPEX",96,0)
 S VALMBCK="R"
"RTN","RCDPEX",97,0)
 Q
"RTN","RCDPEX",98,0)
 ;
"RTN","RCDPEX",99,0)
SEL(RCDA,ONE) ; Select entry(s) from list
"RTN","RCDPEX",100,0)
 ; RCDA = array returned if selections made
"RTN","RCDPEX",101,0)
 ;    RCDA(n)=ien of bill selected in file 344.5
"RTN","RCDPEX",102,0)
 ; ONE = if set to 1, only one selection can be made at a time
"RTN","RCDPEX",103,0)
 N RC
"RTN","RCDPEX",104,0)
 K RCDA
"RTN","RCDPEX",105,0)
 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
"RTN","RCDPEX",106,0)
 S RCDA=0 F  S RCDA=$O(VALMY(RCDA)) Q:'RCDA  S RC=$G(^TMP("RCDPEX-EOBDX",$J,RCDA)),RCDA(RCDA)=+$P(RC,U,2)
"RTN","RCDPEX",107,0)
 Q
"RTN","RCDPEX",108,0)
 ;
"RTN","RCDPEX",109,0)
 ;
"RTN","RCDPEX",110,0)
DEL ; Delete messages from messages list - file 344.5
"RTN","RCDPEX",111,0)
 N RCDA,RCOK,RCTDA,RCTDAC,RCTYP,RCU,RC0,DIR,RCT,RCE,RCDIQ,RCX,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ,XMZ
"RTN","RCDPEX",112,0)
 D FULL^VALM1
"RTN","RCDPEX",113,0)
 S RCTDA=0
"RTN","RCDPEX",114,0)
 D SEL(.RCDA,1)
"RTN","RCDPEX",115,0)
 S RCDA=$O(RCDA(""))
"RTN","RCDPEX",116,0)
 I RCDA="" G DELQ
"RTN","RCDPEX",117,0)
 W !
"RTN","RCDPEX",118,0)
 S DIR(0)="YA",DIR("A",1)="This action will PERMANENTLY delete an EDI Lockbox message from your system",DIR("A",2)="A bulletin will be sent to report the deletion",DIR("A",3)=" "
"RTN","RCDPEX",119,0)
 S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
"RTN","RCDPEX",120,0)
 D ^DIR K DIR
"RTN","RCDPEX",121,0)
 G:Y'=1 DELQ
"RTN","RCDPEX",122,0)
 S RCTDA=+RCDA(RCDA),RCTDAC=RCTDA_","
"RTN","RCDPEX",123,0)
 I '$$LOCK(RCTDA) G DELQ
"RTN","RCDPEX",124,0)
 S RC0=$G(^RCY(344.5,RCTDA,0))
"RTN","RCDPEX",125,0)
 ;
"RTN","RCDPEX",126,0)
 I $P(RC0,U,5) S RCOK=1 D  G:'RCOK DELQ
"RTN","RCDPEX",127,0)
 . N ZTSK
"RTN","RCDPEX",128,0)
 . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0  ;Task not scheduled
"RTN","RCDPEX",129,0)
 . I "12"[ZTSK(1) W *7,!,"This message is currently scheduled for update.  Task # is: ",$P(RC0,U,11) S RCOK="" D PAUSE^VALM1
"RTN","RCDPEX",130,0)
 ;
"RTN","RCDPEX",131,0)
 S DIR(0)="YA",DIR("A",1)=" ",DIR("A",2)="",$P(DIR("A",2),"*",54)="",DIR("A",3)="* This EDI Lockbox message is about to be PERMANENTLY deleted!! *",DIR("A",4)=DIR("A",2),DIR("A",5)=" "
"RTN","RCDPEX",132,0)
 S DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
"RTN","RCDPEX",133,0)
 W ! D ^DIR W ! K DIR
"RTN","RCDPEX",134,0)
 I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ
"RTN","RCDPEX",135,0)
 ;
"RTN","RCDPEX",136,0)
 D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCDIQ")
"RTN","RCDPEX",137,0)
 S RCE=0
"RTN","RCDPEX",138,0)
 D TXTDE(RCTDA,.RCDIQ,1,.RCX,.RCE)
"RTN","RCDPEX",139,0)
 S RCE=RCE+1,RCX(RCE)="RAW MESSAGE DATA:"
"RTN","RCDPEX",140,0)
 D TXTDE(RCTDA,.RCDIQ,2,.RCX,.RCE)
"RTN","RCDPEX",141,0)
 D DELMSG(RCTDA)
"RTN","RCDPEX",142,0)
 I $D(^RCY(344.5,RCTDA)) D  G DELQ
"RTN","RCDPEX",143,0)
 . W !,"Message not deleted - problem with delete" D PAUSE^VALM1
"RTN","RCDPEX",144,0)
 ;
"RTN","RCDPEX",145,0)
 I $P(RC0,U,2)["XFR",'$P(RC0,U,14) D
"RTN","RCDPEX",146,0)
 . S DIR(0)="YA"
"RTN","RCDPEX",147,0)
 . S DIR("A")="ARE YOU DELETING THIS BECAUSE THE EEOB DOES NOT BELONG TO YOUR SITE?: ",DIR("B")="YES",DIR("?")="IF YOU RESPOND YES TO THIS QUESTION, A REJECT MESSAGE WILL BE SENT BACK TO",DIR("?",1)=" THE SENDING SITE FOR THIS EEOB"
"RTN","RCDPEX",148,0)
 .  W ! D ^DIR K DIR
"RTN","RCDPEX",149,0)
 . Q:Y'=1
"RTN","RCDPEX",150,0)
 . D SENDACK^RCDPESR5(RCTDA,0) ; Send reject notice
"RTN","RCDPEX",151,0)
 S RCT(1)="Electronic EDI Lockbox message "_$P(RC0,U)_" has been deleted"
"RTN","RCDPEX",152,0)
 S RCT(2)=" "
"RTN","RCDPEX",153,0)
 S RCT(3)="DELETED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_"   "_$$FMTE^XLFDT($$NOW^XLFDT,2)
"RTN","RCDPEX",154,0)
 S RCT(4)=" ",RCE=+$O(RCT(""),-1)
"RTN","RCDPEX",155,0)
 S Z=0 F  S Z=$O(RCX(Z)) Q:'Z  S RCE=RCE+1,RCT(RCE)=RCX(Z)
"RTN","RCDPEX",156,0)
 S RCE=RCE+1,RCT(RCE)=" "
"RTN","RCDPEX",157,0)
 S XMSUBJ="EDI LBOX MESSAGE DELETED",XMBODY="RCT",XMDUZ="",XMTO("G.RCDPE PAYMENTS")=""
"RTN","RCDPEX",158,0)
 N DUZ S DUZ=.5,DUZ(0)="@"
"RTN","RCDPEX",159,0)
 D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
"RTN","RCDPEX",160,0)
 ;
"RTN","RCDPEX",161,0)
 W !,"A bulletin has been sent to report this deletion",!
"RTN","RCDPEX",162,0)
 D PAUSE^VALM1
"RTN","RCDPEX",163,0)
 ;
"RTN","RCDPEX",164,0)
 D BLD^RCDPEX1
"RTN","RCDPEX",165,0)
DELQ L -^RCY(344.5,RCTDA,0)
"RTN","RCDPEX",166,0)
 S VALMBCK="R"
"RTN","RCDPEX",167,0)
 Q
"RTN","RCDPEX",168,0)
 ;
"RTN","RCDPEX",169,0)
DELMSG(RCTDA) ; Delete message from temporary message holding file 344.5
"RTN","RCDPEX",170,0)
 ;
"RTN","RCDPEX",171,0)
 N DIK,DA,Y S DIK="^RCY(344.5,",DA=RCTDA D ^DIK
"RTN","RCDPEX",172,0)
 Q
"RTN","RCDPEX",173,0)
 ;
"RTN","RCDPEX",174,0)
TASK(RCRTN,RCTDA) ; Schedule the task to update data base from message
"RTN","RCDPEX",175,0)
 ; RCRTN = routine to task
"RTN","RCDPEX",176,0)
 ; RCTDA = internal entry of message in file 344.5
"RTN","RCDPEX",177,0)
 ;
"RTN","RCDPEX",178,0)
 N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE
"RTN","RCDPEX",179,0)
 S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EEOB EXCEPTION PROCESSING",ZTSAVE("RC*")="",ZTRTN=RCRTN
"RTN","RCDPEX",180,0)
 D ^%ZTLOAD
"RTN","RCDPEX",181,0)
 I $G(ZTSK),$G(^RCY(344.5,RCTDA,0)) D
"RTN","RCDPEX",182,0)
 . S DIE="^RCY(344.5,",DR=".05////"_ZTSK_";.04////1;.08////0",DA=RCTDA D ^DIE
"RTN","RCDPEX",183,0)
 Q $G(ZTSK)
"RTN","RCDPEX",184,0)
 ;
"RTN","RCDPEX",185,0)
LOCK(RCTDA) ; Attempt to lock message file entry RCTDA in file 344.5
"RTN","RCDPEX",186,0)
 ; Return 1 if successful, 0 if not able to lock
"RTN","RCDPEX",187,0)
 ;
"RTN","RCDPEX",188,0)
 N OK
"RTN","RCDPEX",189,0)
 S OK=1
"RTN","RCDPEX",190,0)
 L +^RCY(344.5,RCTDA,0):5
"RTN","RCDPEX",191,0)
 I '$T D
"RTN","RCDPEX",192,0)
 . I '$D(DIQUIET) W !,*7,"Another user is editing this entry ... please try again later" D PAUSE^VALM1
"RTN","RCDPEX",193,0)
 . S OK=0
"RTN","RCDPEX",194,0)
 Q OK
"RTN","RCDPEX",195,0)
 ;
"RTN","RCDPEX",196,0)
HDR(RCTDA,RCPG) ;Prints report heading
"RTN","RCDPEX",197,0)
 ; RCTDA = ien of file 344.5
"RTN","RCDPEX",198,0)
 ; RCPG = page # last printed
"RTN","RCDPEX",199,0)
 N Z
"RTN","RCDPEX",200,0)
 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
"RTN","RCDPEX",201,0)
 I 'RCPG D
"RTN","RCDPEX",202,0)
 . N RCX,RCZ
"RTN","RCDPEX",203,0)
 . D TXT0(RCTDA,.RCZ,.RCX,0) ; Get 0-node captioned fields
"RTN","RCDPEX",204,0)
 . S Z=0 F  S Z=$O(RCX(Z)) Q:'Z  S ^TMP($J,"RCHDR_EX",Z)=RCX(Z)
"RTN","RCDPEX",205,0)
 S RCPG=RCPG+1
"RTN","RCDPEX",206,0)
 W !,?15,"EDI LBOX - EEOB EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!
"RTN","RCDPEX",207,0)
 S Z=0 F  S Z=$O(^TMP($J,"RCHDR_EX",Z)) Q:'Z  W !,$G(^(Z))
"RTN","RCDPEX",208,0)
 W !,$TR($J("",IOM)," ","=")
"RTN","RCDPEX",209,0)
 Q
"RTN","RCDPEX",210,0)
 ;
"RTN","RCDPEX",211,0)
ASK(RCSTOP) ; Ask to stop
"RTN","RCDPEX",212,0)
 ; RCSTOP: passed by ref, flag to stop processing
"RTN","RCDPEX",213,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEX",214,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEX",215,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEX",216,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEX",217,0)
 Q
"RTN","RCDPEX",218,0)
 ; ***
"RTN","RCDPEX",219,0)
 ; *** Entrypoints TXT* assume these parameter definitions ***
"RTN","RCDPEX",220,0)
 ; ***
"RTN","RCDPEX",221,0)
 ; FUNCTIONs returns RCXM1 and RCCT if passed by reference
"RTN","RCDPEX",222,0)
 ; RCTDA = ien, file 344.5
"RTN","RCDPEX",223,0)
 ; RCXM1 = the array returned with text, captioned
"RTN","RCDPEX",224,0)
 ; RCCT = # of lines already in array (optional)
"RTN","RCDPEX",225,0)
 ; RCDIQ = the array returned from GETS^DIQ
"RTN","RCDPEX",226,0)
 ; ***
"RTN","RCDPEX",227,0)
 ;
"RTN","RCDPEX",228,0)
TXT0(RCTDA,RCDIQ,RCXM1,RCCT) ; Append 0-node captioned data to array RCXM1
"RTN","RCDPEX",229,0)
 ; See above for parameter definitions
"RTN","RCDPEX",230,0)
 ;
"RTN","RCDPEX",231,0)
 N RCZ,RCTDAC,LINE,DAT,Z,Z0
"RTN","RCDPEX",232,0)
 S LINE="",RCCT=+$G(RCCT),RCTDAC=RCTDA_","
"RTN","RCDPEX",233,0)
 S Z=0 F  S Z=$O(RCDIQ(344.5,RCTDAC,Z)) Q:'Z!(Z'<1)  D
"RTN","RCDPEX",234,0)
 . S Z0=$$GET1^DID(344.5,Z,,"LABEL")
"RTN","RCDPEX",235,0)
 . S DAT=Z0_": "_$G(RCDIQ(344.5,RCTDAC,Z,"E"))
"RTN","RCDPEX",236,0)
 . I $L(DAT)>39 S:$L(LINE) RCCT=RCCT+1,RCXM1(RCCT)=LINE S RCCT=RCCT+1,RCXM1(RCCT)=DAT,LINE="" Q
"RTN","RCDPEX",237,0)
 . I $L(LINE) D  Q:LINE=""  ; Left side exists
"RTN","RCDPEX",238,0)
 .. I $L(LINE)+$L(DAT)>75 S RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=DAT Q
"RTN","RCDPEX",239,0)
 .. S LINE=LINE_"  "_DAT,RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=""
"RTN","RCDPEX",240,0)
 . S LINE=$E(DAT_$J("",39),1,39)
"RTN","RCDPEX",241,0)
 I $L(LINE) S RCCT=RCCT+1,RCXM1(RCCT)=LINE
"RTN","RCDPEX",242,0)
 S:RCCT RCCT=RCCT+1,RCXM1(RCCT)=" "
"RTN","RCDPEX",243,0)
 Q
"RTN","RCDPEX",244,0)
 ;
"RTN","RCDPEX",245,0)
TXTDE(RCTDA,RCDIQ,RCNODE,RCXM1,RCCT) ; Append display data to array RCXM1
"RTN","RCDPEX",246,0)
 ; See above for parameter definitions
"RTN","RCDPEX",247,0)
 ; RCNODE = the WP field # to return
"RTN","RCDPEX",248,0)
 ;
"RTN","RCDPEX",249,0)
 N RCCT1,LINE,Z,RCTDAC
"RTN","RCDPEX",250,0)
 S LINE="",RCCT=+$G(RCCT),RCCT1=RCCT
"RTN","RCDPEX",251,0)
 S RCTDAC=RCTDA_","
"RTN","RCDPEX",252,0)
 S Z=0 F  S Z=$O(RCDIQ(344.5,RCTDAC,RCNODE,Z)) Q:'Z  D
"RTN","RCDPEX",253,0)
 . S RCCT=RCCT+1,RCXM1(RCCT)=$G(RCDIQ(344.5,RCTDAC,RCNODE,Z))
"RTN","RCDPEX",254,0)
 S:RCCT'=RCCT1 RCCT=RCCT+1,RCXM1(RCCT)=" "
"RTN","RCDPEX",255,0)
 Q
"RTN","RCDPEX",256,0)
 ;
"RTN","RCDPEX2")
0^29^B15963944
"RTN","RCDPEX2",1,0)
RCDPEX2 ;ALB/TMK/KML/PJH - ELECTRONIC EOB DETAIL EXCEPTION MAIN LIST TEMPLATE ; 4/8/11 1:50pm
"RTN","RCDPEX2",2,0)
 ;;4.5;Accounts Receivable;**173,269**;Mar 20, 1995;Build 113
"RTN","RCDPEX2",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPEX2",4,0)
 ;
"RTN","RCDPEX2",5,0)
INIT ; -- set up inital variables
"RTN","RCDPEX2",6,0)
 S U="^",VALMCNT=0,VALMBG=1
"RTN","RCDPEX2",7,0)
 D BLD
"RTN","RCDPEX2",8,0)
 Q
"RTN","RCDPEX2",9,0)
 ;
"RTN","RCDPEX2",10,0)
REBLD ; Set up formatted global
"RTN","RCDPEX2",11,0)
 ;
"RTN","RCDPEX2",12,0)
BLD ; -- build list of messages from file 344.4
"RTN","RCDPEX2",13,0)
 N RCBILL,RCSUB,RCSEQ,RCMSG1,RCEXC,RCS,RCER,RCDPDATA,RCX,RCX1,RC0,DA,X,DR,Y
"RTN","RCDPEX2",14,0)
 K ^TMP("RCDPEX_SUM-EOB",$J),^TMP("RCDPEX_SUM-EOBDX",$J)
"RTN","RCDPEX2",15,0)
 S (RCMSG,RCSEQ,VALMCNT)=0
"RTN","RCDPEX2",16,0)
 ;
"RTN","RCDPEX2",17,0)
 ; Extract from 344.4
"RTN","RCDPEX2",18,0)
 S RCER=0
"RTN","RCDPEX2",19,0)
 F  S RCER=$O(^RCY(344.4,"AEXC",RCER)) Q:'RCER  F  S RCMSG=$O(^RCY(344.4,"AEXC",RCER,RCMSG)) Q:'RCMSG  D
"RTN","RCDPEX2",20,0)
 . ;Extract trace #, ins co name/id, ERA Date
"RTN","RCDPEX2",21,0)
 . S RCSUB=RCMSG_",",DR=".02:.06",DA=RCMSG K DA(1) D DIQ3444(DA,DR)
"RTN","RCDPEX2",22,0)
 . ; HIPPA 5010 - display of the Trace # on a separate line due to the increased length from 30 to 50 characters   
"RTN","RCDPEX2",23,0)
 . S RCX("TRACE")=$G(RCDPDATA(344.4,RCSUB,.02,"E"))
"RTN","RCDPEX2",24,0)
 . S RCX1=$$SETSTR^VALM1($E($G(RCDPDATA(344.4,RCSUB,.06,"E")),1,25)_"/"_$E($G(RCDPDATA(344.4,RCSUB,.03,"E")),1,20),"",9,78)
"RTN","RCDPEX2",25,0)
 . S RCS=0 F  S RCS=$O(^RCY(344.4,"AEXC",RCER,RCMSG,RCS)) Q:'RCS  S RC0=$G(^RCY(344.4,RCMSG,1,RCS,0)) D
"RTN","RCDPEX2",26,0)
 .. S RCSEQ=RCSEQ+1
"RTN","RCDPEX2",27,0)
 .. S RCX=$$SETSTR^VALM1($E(RCSEQ_$J("",4),1,4)_"  "_$G(RCX("TRACE")),"",1,80)
"RTN","RCDPEX2",28,0)
 .. S RCX=$$SETSTR^VALM1("  "_$$FMTE^XLFDT($G(RCDPDATA(344.4,RCSUB,.04,"I")),2),RCX,70,10)
"RTN","RCDPEX2",29,0)
 .. D SET(RCX,RCSEQ,RCMSG,RCS)
"RTN","RCDPEX2",30,0)
 .. D SET(RCX1,RCSEQ,RCMSG,RCS)
"RTN","RCDPEX2",31,0)
 .. S DA(1)=RCMSG,DA=RCS,RCSUB=DA_","_DA(1)_","
"RTN","RCDPEX2",32,0)
 .. S DR=".01;.02;.03;.05;.07;.08;.1;.11;.12;.15",DA=RCS D DIQ3444(.DA,DR)
"RTN","RCDPEX2",33,0)
 .. S X=$$SETSTR^VALM1($J("",6)_"Seq #: "_$G(RCDPDATA(344.41,RCSUB,.01,"E")),"",1,17)
"RTN","RCDPEX2",34,0)
 .. S RCBILL=$S($G(RCDPDATA(344.41,RCSUB,.02,"E"))'="":RCDPDATA(344.41,RCSUB,.02,"E"),1:"*"_$G(RCDPDATA(344.41,RCSUB,.05,"E")))
"RTN","RCDPEX2",35,0)
 .. S X=$$SETSTR^VALM1(" Bill: "_RCBILL,X,18,20)
"RTN","RCDPEX2",36,0)
 .. S X=$$SETSTR^VALM1(" Pt: "_$G(RCDPDATA(344.41,RCSUB,.15,"E")),X,38,25)
"RTN","RCDPEX2",37,0)
 .. S X=$$SETSTR^VALM1(" Pd: "_$J(+$G(RCDPDATA(344.41,RCSUB,.03,"E")),"",2),X,63,17)
"RTN","RCDPEX2",38,0)
 .. D SET(X,RCSEQ,RCMSG,RCS)
"RTN","RCDPEX2",39,0)
 .. I $P(RC0,U,11) D
"RTN","RCDPEX2",40,0)
 ... S X=$J("",10)_"Transferred To: "_$G(RCDPDATA(344.41,RCSUB,.11,"E"))
"RTN","RCDPEX2",41,0)
 ... S X=$$SETSTR^VALM1("  On: "_$$FMTE^XLFDT($G(RCDPDATA(344.41,RCSUB,.12,"I")),2),X,$L(X)+1,25)
"RTN","RCDPEX2",42,0)
 ... D SET(X,RCSEQ,RCMSG,RCS)
"RTN","RCDPEX2",43,0)
 .. S RCEXC=$S($G(RCDPDATA(344.41,RCSUB,.07,"I"))=99:$S($G(RCDPDATA(344.41,RCSUB,.08,"E"))'="":RCDPDATA(344.41,RCSUB,.08,"E"),1:"UNKNOWN"),1:$G(RCDPDATA(344.41,RCSUB,.07,"E")))
"RTN","RCDPEX2",44,0)
 .. S X=$J("",10)_"**Exception: "_RCEXC_$S($P(RC0,U,7)=1:$S('$P(RC0,U,11):" (TRANSFER NEEDED IF NOT YOURS)",$P(RC0,U,10)=0:" (TRANSFER REJECTED)",$P(RC0,U,16):" (TRANSFER ACKNOWLEDGED)",1:" (TRANSFER NOT ACKNOWLEDGED)"),1:"")
"RTN","RCDPEX2",45,0)
 .. D SET(X,RCSEQ,RCMSG,RCS)
"RTN","RCDPEX2",46,0)
 ;
"RTN","RCDPEX2",47,0)
 I '$D(^TMP("RCDPEX_SUM-EOB",$J)) S VALMCNT=2,^TMP("RCDPEX_SUM-EOB",$J,1,0)=" ",^TMP("RCDPEX_SUM-EOB",$J,2,0)="   There Are No EEOB Detail Exceptions On File"
"RTN","RCDPEX2",48,0)
 Q
"RTN","RCDPEX2",49,0)
 ;
"RTN","RCDPEX2",50,0)
FNL ; -- Clean up list
"RTN","RCDPEX2",51,0)
 K ^TMP("RCDPEX_SUM-EOBDX",$J)
"RTN","RCDPEX2",52,0)
 D CLEAN^VALM10
"RTN","RCDPEX2",53,0)
 K RCFASTXT
"RTN","RCDPEX2",54,0)
 Q
"RTN","RCDPEX2",55,0)
 ;
"RTN","RCDPEX2",56,0)
SET(X,RCSEQ,RCMSG,RCS) ; -- set arrays for EOB exception records
"RTN","RCDPEX2",57,0)
 ; X = the data to set into the global
"RTN","RCDPEX2",58,0)
 S VALMCNT=VALMCNT+1,^TMP("RCDPEX_SUM-EOB",$J,VALMCNT,0)=X
"RTN","RCDPEX2",59,0)
 S ^TMP("RCDPEX_SUM-EOB",$J,"IDX",VALMCNT,RCSEQ)=""
"RTN","RCDPEX2",60,0)
 S ^TMP("RCDPEX_SUM-EOBDX",$J,RCSEQ)=VALMCNT_U_RCMSG_U_RCS
"RTN","RCDPEX2",61,0)
 Q
"RTN","RCDPEX2",62,0)
 ;
"RTN","RCDPEX2",63,0)
HDR ;
"RTN","RCDPEX2",64,0)
 S VALMHDR(1)=$J("",19)_"EEOB DETAIL DATA WITH EXCEPTION CONDITIONS"
"RTN","RCDPEX2",65,0)
 ;HIPPA 5010 - display of the following headers on a separate line due to the increased length of Trace # from 30 to 50 characters
"RTN","RCDPEX2",66,0)
 S VALMHDR(2)="  #   Trace #"_$J("",58)_"EOB Date"
"RTN","RCDPEX2",67,0)
 Q
"RTN","RCDPEX2",68,0)
 ;
"RTN","RCDPEX2",69,0)
DIQ3444(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.4/344.41
"RTN","RCDPEX2",70,0)
 N %I,D0,DIC,DIQ,DIQ2,YY,FILE
"RTN","RCDPEX2",71,0)
 S FILE=$S($D(DA(1)):344.41,1:344.4)
"RTN","RCDPEX2",72,0)
 K RCDPDATA(FILE)
"RTN","RCDPEX2",73,0)
 D GETS^DIQ(FILE,DA_","_$S($G(DA(1)):DA(1)_",",1:""),DR,"EI","RCDPDATA")
"RTN","RCDPEX2",74,0)
 Q
"RTN","RCDPEX2",75,0)
 ;
"RTN","RCDPEX3")
0^33^B75257587
"RTN","RCDPEX3",1,0)
RCDPEX3 ;ALB/TMK/PJH - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ; 3/30/11 7:19pm
"RTN","RCDPEX3",2,0)
 ;;4.5;Accounts Receivable;**173,208,258,269**;Mar 20, 1995;Build 113
"RTN","RCDPEX3",3,0)
 ;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCDPEX3",4,0)
 ; IA# 5286 for call to $$PRVPHONE^IBJPS3()
"RTN","RCDPEX3",5,0)
 Q
"RTN","RCDPEX3",6,0)
 ;
"RTN","RCDPEX3",7,0)
VP ; View/Print ERA Msgs - File 344.4
"RTN","RCDPEX3",8,0)
 N X,Y,RCDA,RCTDA,RCALL,DIR,POP
"RTN","RCDPEX3",9,0)
 D FULL^VALM1
"RTN","RCDPEX3",10,0)
 S DIR(0)="SA^A:ALL;S:SELECTED",DIR("A")="PRINT (A)LL or (S)ELECTED RECORDS?: "
"RTN","RCDPEX3",11,0)
 S DIR("B")="ALL"
"RTN","RCDPEX3",12,0)
 D ^DIR K DIR
"RTN","RCDPEX3",13,0)
 G:$D(DUOUT)!$D(DTOUT) VPQ
"RTN","RCDPEX3",14,0)
 S RCALL=(Y="A")
"RTN","RCDPEX3",15,0)
 ;
"RTN","RCDPEX3",16,0)
 I 'RCALL D  G:'$O(RCDA("")) VPQ
"RTN","RCDPEX3",17,0)
 . D SEL(.RCDA)
"RTN","RCDPEX3",18,0)
 ;
"RTN","RCDPEX3",19,0)
 ; device
"RTN","RCDPEX3",20,0)
 N %ZIS,ZTRTN,ZTSAVE,ZTDESC
"RTN","RCDPEX3",21,0)
 S %ZIS="QM" D ^%ZIS G:POP VPQ
"RTN","RCDPEX3",22,0)
 I $D(IO("Q")) D  G VPQ
"RTN","RCDPEX3",23,0)
 . S ZTRTN="VPOUT^RCDPEX3",ZTDESC="AR - Print ERA/EEOB Data With Exceptions"
"RTN","RCDPEX3",24,0)
 . S ZTSAVE("RCDA")="",ZTSAVE("RCALL")="",ZTSAVE("^TMP(""RCDPEX_SUM-EOBDX"",$J,")=""
"RTN","RCDPEX3",25,0)
 . D ^%ZTLOAD
"RTN","RCDPEX3",26,0)
 . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
"RTN","RCDPEX3",27,0)
 . K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEX3",28,0)
 U IO
"RTN","RCDPEX3",29,0)
 ;
"RTN","RCDPEX3",30,0)
VPOUT ; Entrypoint queued job
"RTN","RCDPEX3",31,0)
 ; RCDA, RCALL must be defined
"RTN","RCDPEX3",32,0)
 N Z,RCSTOP,RCZ,RCPG,RCDOT,RCTDA1
"RTN","RCDPEX3",33,0)
 K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT")
"RTN","RCDPEX3",34,0)
 S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)=""
"RTN","RCDPEX3",35,0)
 I RCALL D
"RTN","RCDPEX3",36,0)
 . S RCZ=0 F  S RCZ=$O(^TMP("RCDPEX_SUM-EOBDX",$J,RCZ)) Q:'RCZ  S RCTDA=$G(^(RCZ)),RCTDA1=+$P(RCTDA,U,3),RCTDA=+$P(RCTDA,U,2) D  Q:RCSTOP
"RTN","RCDPEX3",37,0)
 .. D PRT(RCTDA,RCTDA1,.RCPG,.RCSTOP)
"RTN","RCDPEX3",38,0)
 .. I $O(^TMP("RCDPEX_SUM-EOBDX",$J,RCZ)) D WRTSEP(RCDOT,RCPG)
"RTN","RCDPEX3",39,0)
 I 'RCALL D
"RTN","RCDPEX3",40,0)
 . S RCZ=0 F  S RCZ=$O(RCDA(RCZ)) Q:'RCZ  D
"RTN","RCDPEX3",41,0)
 .. S RCTDA1=+$P(RCDA(RCZ),U,2),RCTDA=+RCDA(RCZ) D PRT(RCTDA,RCTDA1,.RCPG,.RCSTOP) I $O(RCDA(RCZ)) D WRTSEP(RCDOT,RCPG)
"RTN","RCDPEX3",42,0)
 ;
"RTN","RCDPEX3",43,0)
 I '$D(ZTQUEUED),'RCSTOP,RCPG D ASK(.RCSTOP)
"RTN","RCDPEX3",44,0)
 ;
"RTN","RCDPEX3",45,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","RCDPEX3",46,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","RCDPEX3",47,0)
 ;
"RTN","RCDPEX3",48,0)
VPQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT")
"RTN","RCDPEX3",49,0)
 S VALMBCK="R"
"RTN","RCDPEX3",50,0)
 Q
"RTN","RCDPEX3",51,0)
 ;
"RTN","RCDPEX3",52,0)
WRTSEP(RCDOT,RCPG) ; Separating lines if more records to print
"RTN","RCDPEX3",53,0)
 W !,RCDOT,!,RCDOT
"RTN","RCDPEX3",54,0)
 I (($Y+5)>IOSL) D HDR(.RCPG) Q
"RTN","RCDPEX3",55,0)
 W !!
"RTN","RCDPEX3",56,0)
 Q
"RTN","RCDPEX3",57,0)
 ;
"RTN","RCDPEX3",58,0)
PRT(RCTDA,RCTDA1,RCPG,RCSTOP) ; Print data from file 344.4 and 344.41
"RTN","RCDPEX3",59,0)
 ; RCTDA = ien file 344.4
"RTN","RCDPEX3",60,0)
 ; RCTDA1 = ien file 344.41
"RTN","RCDPEX3",61,0)
 ; RCPG = last page extracted
"RTN","RCDPEX3",62,0)
 ; RCSTOP = returned 1 if passed by ref and process stopped
"RTN","RCDPEX3",63,0)
 ;
"RTN","RCDPEX3",64,0)
 N RCDIQ,RCDIQ1,RCDIQ2,RCXM1,RC,Z
"RTN","RCDPEX3",65,0)
 D GETS^DIQ(344.4,RCTDA_",","*","IEN","RCDIQ")
"RTN","RCDPEX3",66,0)
 D TXT0^RCDPEX31(RCTDA,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned fields
"RTN","RCDPEX3",67,0)
 ;
"RTN","RCDPEX3",68,0)
 I $O(^RCY(344.4,RCTDA,2,0)) S RC=RC+1,RCXM1(RC)="  **ERA LEVEL ADJUSTMENTS**"
"RTN","RCDPEX3",69,0)
 S Z=0 F  S Z=$O(^RCY(344.4,RCTDA,2,Z)) Q:'Z  D
"RTN","RCDPEX3",70,0)
 . D GETS^DIQ(344.42,Z_","_RCTDA_",","*","IEN","RCDIQ2")
"RTN","RCDPEX3",71,0)
 . D TXT2^RCDPEX31(RCTDA,Z,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs
"RTN","RCDPEX3",72,0)
 ;
"RTN","RCDPEX3",73,0)
 D GETS^DIQ(344.41,RCTDA1_","_RCTDA_",","*","IEN","RCDIQ1")
"RTN","RCDPEX3",74,0)
 D TXT00^RCDPEX31(RCTDA,RCTDA1,.RCDIQ1,.RCXM1,.RC)
"RTN","RCDPEX3",75,0)
 D DISP^RCDPESR0("^RCY(344.4,"_RCTDA_",1,"_RCTDA1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75) ; Get formatted 'raw' data
"RTN","RCDPEX3",76,0)
 ;
"RTN","RCDPEX3",77,0)
 I $D(RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2)) D
"RTN","RCDPEX3",78,0)
 . S RC=RC+1,RCXM1(RC)="  **RESOLUTION LOG DATA**"
"RTN","RCDPEX3",79,0)
 . S Z=0 F  S Z=$O(RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2,Z)) Q:'Z  S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2,Z)
"RTN","RCDPEX3",80,0)
 . S RC=RC+1,RCXM1(RC)=" "
"RTN","RCDPEX3",81,0)
 S (RCSTOP,Z)=0
"RTN","RCDPEX3",82,0)
 F  S Z=$O(RCXM1(Z)) Q:'Z  S ^TMP($J,"RC_SUMOUT",Z-999)=RCXM1(Z)
"RTN","RCDPEX3",83,0)
 S Z=""
"RTN","RCDPEX3",84,0)
 F  S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z  D  Q:RCSTOP
"RTN","RCDPEX3",85,0)
 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q
"RTN","RCDPEX3",86,0)
 . I 'RCPG!(($Y+5)>IOSL) D  I RCSTOP Q
"RTN","RCDPEX3",87,0)
 .. D:RCPG ASK(.RCSTOP) I RCSTOP Q
"RTN","RCDPEX3",88,0)
 .. D HDR(.RCPG)
"RTN","RCDPEX3",89,0)
 . W !,$G(^TMP($J,"RC_SUMOUT",Z))
"RTN","RCDPEX3",90,0)
 ;
"RTN","RCDPEX3",91,0)
 Q
"RTN","RCDPEX3",92,0)
 ;
"RTN","RCDPEX3",93,0)
XFR ; Transfer EOB(s) to other site
"RTN","RCDPEX3",94,0)
 N RC,RC0,RCCHG,RCOK,RCDOMAIN,RCDEF,RCDA,RCWHY,RCER,RCECT,RCXTO,RCALL,RCCONT,DIR,X,Y,DA,DIE,DR,POP,RCDA,RCXDA,RCXDA1,RCDUZ,XMBODY,XMTO
"RTN","RCDPEX3",95,0)
 D FULL^VALM1
"RTN","RCDPEX3",96,0)
 D SEL(.RCDA)
"RTN","RCDPEX3",97,0)
 ;
"RTN","RCDPEX3",98,0)
 G:'$O(RCDA(0)) XFRQ
"RTN","RCDPEX3",99,0)
 S DIR("S")="I +$G(^DIC(4,+Y,6))",DIR(0)="PA^4:AME",DIR("A")="TRANSFER TO WHICH SITE?: " D ^DIR K DIR
"RTN","RCDPEX3",100,0)
 I $D(DUOUT)!$D(DTOUT) G XFRQ
"RTN","RCDPEX3",101,0)
 S RCXTO=+Y,RCCHG=0
"RTN","RCDPEX3",102,0)
 ;
"RTN","RCDPEX3",103,0)
 S RCDOMAIN=$$EXTERNAL^DILFD(4,60,,+$G(^DIC(4,+RCXTO,6))),RCECT=0
"RTN","RCDPEX3",104,0)
 I RCDOMAIN="" D  G XFRQ
"RTN","RCDPEX3",105,0)
 . S DIR("A",1)="THERE IS NO VALID DOMAIN SET UP FOR THIS SITE. YOU MUST CHOOSE ANOTHER ONE.",DIR("A")="PRESS RETURN TO CONTINUE",DIR(0)="EA" W ! D ^DIR K DIR
"RTN","RCDPEX3",106,0)
 ;
"RTN","RCDPEX3",107,0)
 S RCDEF=$$PRVPHONE^IBJPS3()                  ; IA 5286
"RTN","RCDPEX3",108,0)
 I RCDEF'="" S RCDEF="AGENT CASHIER-"_RCDEF
"RTN","RCDPEX3",109,0)
 ;
"RTN","RCDPEX3",110,0)
 S DIR("A",1)="ENTER THE CONTACT INFORMATION FOR THE PERSON AT YOUR SITE"
"RTN","RCDPEX3",111,0)
 S DIR("A",2)="   WHO MAY BE CONTACTED BY THE OTHER SITE REGARDING THIS EEOB"
"RTN","RCDPEX3",112,0)
 S DIR("A")="   (1-45 CHARACTERS): "_$S(RCDEF'="":RCDEF_"// ",1:"")
"RTN","RCDPEX3",113,0)
 S DIR(0)="FA"_$S(RCDEF'="":"O",1:"")_"^1:45" W ! D ^DIR K DIR
"RTN","RCDPEX3",114,0)
 I $D(DUOUT)!$D(DTOUT) G XFRQ
"RTN","RCDPEX3",115,0)
 I Y="" S Y=RCDEF
"RTN","RCDPEX3",116,0)
 S RCCONT=Y
"RTN","RCDPEX3",117,0)
 ;
"RTN","RCDPEX3",118,0)
 S DIR(0)="YA",DIR("A")="DO YOU WANT TO PRINT THE EEOB(s)?: ",DIR("B")="Y"
"RTN","RCDPEX3",119,0)
 D ^DIR K DIR
"RTN","RCDPEX3",120,0)
 I $D(DUOUT)!$D(DTOUT) G XFRQ
"RTN","RCDPEX3",121,0)
 I Y=1 S RCER=0 D  I RCER G XFRQ
"RTN","RCDPEX3",122,0)
 . N %ZIS,ZTRTN,ZTSAVE,ZTDESC
"RTN","RCDPEX3",123,0)
 . S %ZIS="QM" D ^%ZIS I POP S RCER=1 Q
"RTN","RCDPEX3",124,0)
 . I $D(IO("Q")) D  Q
"RTN","RCDPEX3",125,0)
 .. S RCALL=0
"RTN","RCDPEX3",126,0)
 .. S ZTRTN="VPOUT^RCDPEX3",ZTDESC="AR - Print EEOB Data Before Transfer"
"RTN","RCDPEX3",127,0)
 .. S ZTSAVE("RCDA")="",ZTSAVE("RCALL")="",ZTSAVE("^TMP(""RCDPEX_SUM-EOBDX"",$J)")=""
"RTN","RCDPEX3",128,0)
 .. D ^%ZTLOAD
"RTN","RCDPEX3",129,0)
 .. I '$D(ZTSK) S RCER=1
"RTN","RCDPEX3",130,0)
 .. K ZTSK,IO("Q") D HOME^%ZIS
"RTN","RCDPEX3",131,0)
 . S RCALL=0
"RTN","RCDPEX3",132,0)
 . D VPOUT^RCDPEX3
"RTN","RCDPEX3",133,0)
 ;
"RTN","RCDPEX3",134,0)
 S RCWHY(1)="Transfer EEOB detail to another site"
"RTN","RCDPEX3",135,0)
 S RC=0 F  S RC=$O(RCDA(RC)) Q:'RC  D  L -^RCY(344.4,RCXDA,1,RCXDA1,0)
"RTN","RCDPEX3",136,0)
 . N RCBODY,RCAMT,RCBILL,RCX,XMZ
"RTN","RCDPEX3",137,0)
 . S RCXDA=+RCDA(RC),RCXDA1=+$P(RCDA(RC),U,2),RCWHY(2)=""
"RTN","RCDPEX3",138,0)
 . I '$$LOCK^RCDPEX31(RCXDA,RCXDA1,1) D  Q
"RTN","RCDPEX3",139,0)
 .. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" is being edited by another user - ... please try again later"
"RTN","RCDPEX3",140,0)
 . ;
"RTN","RCDPEX3",141,0)
 . S RC0=$G(^RCY(344.4,RCXDA,1,RCXDA1,0))
"RTN","RCDPEX3",142,0)
 . M RCBODY=^RCY(344.4,RCXDA,1,RCXDA1,1)
"RTN","RCDPEX3",143,0)
 . S RCAMT=$P(RC0,U,3)*100
"RTN","RCDPEX3",144,0)
 . S RCBILL=$P(RC0,U,5)
"RTN","RCDPEX3",145,0)
 . S DIR("A",1)="ONCE THIS EEOB HAS BEEN TRANSFERRED, ITS BILL # CANNOT BE EDITED",DIR("A")="ARE YOU SURE THIS IS NOT A CLAIM FOR YOUR SITE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
"RTN","RCDPEX3",146,0)
 . Q:Y'=1
"RTN","RCDPEX3",147,0)
 . I $P(RC0,U,11) D  Q:'RCOK
"RTN","RCDPEX3",148,0)
 .. S RCOK=1
"RTN","RCDPEX3",149,0)
 .. S DIR("A",1)="WARNING: EEOB FOR #"_RC_" ("_RCBILL_") HAS ALREADY BEEN TRANSFERRED",DIR("A",2)="   TO "_$P($G(^DIC(4,+$P(RC0,U,11),0)),U)_"   ON: "_$$FMTE^XLFDT($P(RC0,U,12),2)
"RTN","RCDPEX3",150,0)
 .. S DIR("A")="ARE YOU SURE YOU WANT TO TRANSFER IT AGAIN?: "
"RTN","RCDPEX3",151,0)
 .. S DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
"RTN","RCDPEX3",152,0)
 .. I Y=1 Q
"RTN","RCDPEX3",153,0)
 .. S RCOK=0
"RTN","RCDPEX3",154,0)
 .. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" already transferred - "_RCBILL_" NOT transferred again"
"RTN","RCDPEX3",155,0)
 . K RCBODY(0)
"RTN","RCDPEX3",156,0)
 . S RCX=$G(RCBODY(1,0))
"RTN","RCDPEX3",157,0)
 . ;
"RTN","RCDPEX3",158,0)
 . I $P($G(^RCY(344.4,RCXDA,1,RCXDA1,0)),U,7)'=1 D  Q
"RTN","RCDPEX3",159,0)
 .. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" is not available for transfer - "_RCBILL_" NOT transferred"
"RTN","RCDPEX3",160,0)
 . ;
"RTN","RCDPEX3",161,0)
 . I $P(RCX,U)'["835ERA"!'$O(RCBODY(1)) D  Q
"RTN","RCDPEX3",162,0)
 .. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" format is not valid for transfer - "_RCBILL_" NOT transferred"
"RTN","RCDPEX3",163,0)
 . ;
"RTN","RCDPEX3",164,0)
 . S $P(RCX,U)="835XFR",$P(RCX,U,10,15)=(RCAMT_"^^^^^")
"RTN","RCDPEX3",165,0)
 . S $P(RCX,U,19)=RCCONT
"RTN","RCDPEX3",166,0)
 . S RCBODY(1,0)=RCX
"RTN","RCDPEX3",167,0)
 . S RCBODY(+$O(RCBODY(""),-1)+1,0)="99^$"
"RTN","RCDPEX3",168,0)
 . S RCBODY(+$O(RCBODY(""),-1)+1,0)="NNNN"
"RTN","RCDPEX3",169,0)
 . S XMTO("S.RCDPE EDI LOCKBOX SERVER@"_RCDOMAIN)=""
"RTN","RCDPEX3",170,0)
 . S XMBODY="RCBODY",RCDUZ=$G(DUZ),DUZ=.5
"RTN","RCDPEX3",171,0)
 . D SENDMSG^XMXAPI(.5,"TRANSFER 3RD PARTY EEOB "_RCBILL_"(REF #"_RCXDA_";"_RCXDA1_"#)",XMBODY,.XMTO,,.XMZ)
"RTN","RCDPEX3",172,0)
 . ;
"RTN","RCDPEX3",173,0)
 . S DUZ=RCDUZ
"RTN","RCDPEX3",174,0)
 . I $G(XMZ) D  ; Report msg #
"RTN","RCDPEX3",175,0)
 .. S RCCHG=1
"RTN","RCDPEX3",176,0)
 .. S RCECT=RCECT+1,RCER(RCECT)="Entry #"_RC_" was successfully transferred - msg # is "_XMZ
"RTN","RCDPEX3",177,0)
 .. S DA(1)=RCXDA,DA=RCXDA1,DIE="^RCY(344.4,"_DA(1)_",1,",DR=".09////"_XMZ_";.11////"_RCXTO_";.12////"_$E($$NOW^XLFDT(),1,12) D ^DIE
"RTN","RCDPEX3",178,0)
 .. S RCWHY(2)=" Transfer to "_$P($G(^DIC(4,+RCXTO,0)),U)_" was successful"
"RTN","RCDPEX3",179,0)
 .. ;
"RTN","RCDPEX3",180,0)
 . E  D  ; error - transfer not done
"RTN","RCDPEX3",181,0)
 .. S RCECT=RCECT+1,RCER(RCECT)="**Entry #"_RC_" was NOT transferred due to a msg build error ("_RCBILL_")"
"RTN","RCDPEX3",182,0)
 .. S RCWHY(2)=" Transfer to "_$P($G(^DIC(4,+RCXTO,0)),U)_" was UNSUCCESSFUL"
"RTN","RCDPEX3",183,0)
 .. ;
"RTN","RCDPEX3",184,0)
 . D STORACT^RCDPEX31(RCXDA,RCXDA1,.RCWHY)
"RTN","RCDPEX3",185,0)
 ;
"RTN","RCDPEX3",186,0)
 I $O(RCER(0)) D
"RTN","RCDPEX3",187,0)
 . ; Write msgs
"RTN","RCDPEX3",188,0)
 . W !!,"TRANSFER OF EEOB TO "_$P($G(^DIC(4,RCXTO,0)),U)_" RESULTS: ",!
"RTN","RCDPEX3",189,0)
 . S RCECT=0 F  S RCECT=$O(RCER(RCECT)) Q:'RCECT  W !,"  ",RCER(RCECT)
"RTN","RCDPEX3",190,0)
 . W !
"RTN","RCDPEX3",191,0)
 ;
"RTN","RCDPEX3",192,0)
 D PAUSE^VALM1
"RTN","RCDPEX3",193,0)
 ;
"RTN","RCDPEX3",194,0)
XFRQ I $G(RCCHG) D BLD^RCDPEX2
"RTN","RCDPEX3",195,0)
 S VALMBCK="R"
"RTN","RCDPEX3",196,0)
 Q
"RTN","RCDPEX3",197,0)
 ;
"RTN","RCDPEX3",198,0)
SEL(RCDA,ONE) ; Select entry(s) from list
"RTN","RCDPEX3",199,0)
 ; RCDA = array returned if selections made
"RTN","RCDPEX3",200,0)
 ;    RCDA(n)=ien of bill selected file 344.4
"RTN","RCDPEX3",201,0)
 ; ONE = if set to 1, only one selection can be made at a time
"RTN","RCDPEX3",202,0)
 N RC
"RTN","RCDPEX3",203,0)
 K RCDA
"RTN","RCDPEX3",204,0)
 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
"RTN","RCDPEX3",205,0)
 S RCDA=0 F  S RCDA=$O(VALMY(RCDA)) Q:'RCDA  S RC=$G(^TMP("RCDPEX_SUM-EOBDX",$J,RCDA)),RCDA(RCDA)=+$P(RC,U,2)_U_+$P(RC,U,3)
"RTN","RCDPEX3",206,0)
 Q
"RTN","RCDPEX3",207,0)
 ;
"RTN","RCDPEX3",208,0)
HDR(RCPG) ;Print report hdr
"RTN","RCDPEX3",209,0)
 ; RCPG = last page #
"RTN","RCDPEX3",210,0)
 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
"RTN","RCDPEX3",211,0)
 S RCPG=$G(RCPG)+1
"RTN","RCDPEX3",212,0)
 W !,?5,"EDI LOCKBOX EEOB DATA EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=")
"RTN","RCDPEX3",213,0)
 Q
"RTN","RCDPEX3",214,0)
 ;
"RTN","RCDPEX3",215,0)
ASK(RCSTOP) ;
"RTN","RCDPEX3",216,0)
 I $E(IOST,1,2)'["C-" Q
"RTN","RCDPEX3",217,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","RCDPEX3",218,0)
 S DIR(0)="E" W ! D ^DIR
"RTN","RCDPEX3",219,0)
 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
"RTN","RCDPEX3",220,0)
 Q
"RTN","RCDPEX3",221,0)
 ; ***
"RTN","RCDPEX3",222,0)
 ; *** Entrypoints TXT* assume these variable definitions ***
"RTN","RCDPEX3",223,0)
 ; ***
"RTN","RCDPEX3",224,0)
 ; FUNCTIONs returns RCXM1 and RC if passed by reference
"RTN","RCDPEX3",225,0)
 ; RCTDA = ien, file 344.4
"RTN","RCDPEX3",226,0)
 ; RCXM1 = array returned with text, captioned
"RTN","RCDPEX3",227,0)
 ; RC = # of lines already in array (optional)
"RTN","RCDPEX3",228,0)
 ; RCDIQ and RCDIQ1 = arrays returned from GETS^DIQ
"RTN","RCDPEX3",229,0)
 ; ***
"RTN","RCDPEX3",230,0)
 ;
"RTN","RCDPEX3",231,0)
UPD ; Try to update the IB EOB file from exception in 344.41
"RTN","RCDPEX3",232,0)
 D UPD^RCDPEX31 ; Moved for space
"RTN","RCDPEX3",233,0)
 Q
"RTN","RCDPEX3",234,0)
 ;
"RTN","RCDPLPL1")
0^35^B25554080
"RTN","RCDPLPL1",1,0)
RCDPLPL1 ;WISC/RFJ/PJH - link payments listmanager options ; 5/25/11 2:53pm
"RTN","RCDPLPL1",2,0)
 ;;4.5;Accounts Receivable;**114,148,153,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPLPL1",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPLPL1",4,0)
 Q
"RTN","RCDPLPL1",5,0)
 ;
"RTN","RCDPLPL1",6,0)
 ;
"RTN","RCDPLPL1",7,0)
CHKTRACE ; Ask to search by chec # or trace #
"RTN","RCDPLPL1",8,0)
 N DIR,X,Y
"RTN","RCDPLPL1",9,0)
 D FULL^VALM1
"RTN","RCDPLPL1",10,0)
 S DIR("A")="SEARCH BY (C)HECK OR (T)RACE #?: ",DIR(0)="SA^C:CHECK;T:TRACE",DIR("B")="CHECK" W ! D ^DIR K DIR
"RTN","RCDPLPL1",11,0)
 Q:$D(DTOUT)!$D(DUOUT)
"RTN","RCDPLPL1",12,0)
 I Y="C" D  Q
"RTN","RCDPLPL1",13,0)
 . D FINDCHEK
"RTN","RCDPLPL1",14,0)
 I Y="T" D  Q
"RTN","RCDPLPL1",15,0)
 . D FINDTRAC
"RTN","RCDPLPL1",16,0)
 Q
"RTN","RCDPLPL1",17,0)
 ;
"RTN","RCDPLPL1",18,0)
FINDCHEK ;  find a specific check used for payments
"RTN","RCDPLPL1",19,0)
 D FULL^VALM1
"RTN","RCDPLPL1",20,0)
 S VALMBCK="R"
"RTN","RCDPLPL1",21,0)
 ;
"RTN","RCDPLPL1",22,0)
 N RCCHECK,RCTYPE
"RTN","RCDPLPL1",23,0)
 K RCFCHECK,RCFCREDT,RCFTRACE
"RTN","RCDPLPL1",24,0)
 W !
"RTN","RCDPLPL1",25,0)
 S RCCHECK=$$ASKCHEK I RCCHECK=-1 D INIT^RCDPLPLM Q
"RTN","RCDPLPL1",26,0)
 ;
"RTN","RCDPLPL1",27,0)
 S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
"RTN","RCDPLPL1",28,0)
 S RCFCHECK=RCCHECK_"^"_RCTYPE
"RTN","RCDPLPL1",29,0)
 D INIT^RCDPLPLM
"RTN","RCDPLPL1",30,0)
 Q
"RTN","RCDPLPL1",31,0)
 ;
"RTN","RCDPLPL1",32,0)
FINDTRAC ;  find a specific trace # used for EFT/ERA payments
"RTN","RCDPLPL1",33,0)
 D FULL^VALM1
"RTN","RCDPLPL1",34,0)
 S VALMBCK="R"
"RTN","RCDPLPL1",35,0)
 ;
"RTN","RCDPLPL1",36,0)
 N RCTRACE,RCTYPE
"RTN","RCDPLPL1",37,0)
 K RCFTRACE,RCFCREDT,RCFCHECK
"RTN","RCDPLPL1",38,0)
 W !
"RTN","RCDPLPL1",39,0)
 S RCTRACE=$$ASKTRACE I RCTRACE=-1 D INIT^RCDPLPLM Q
"RTN","RCDPLPL1",40,0)
 ;
"RTN","RCDPLPL1",41,0)
 S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
"RTN","RCDPLPL1",42,0)
 S RCFTRACE=RCTRACE_"^"_RCTYPE
"RTN","RCDPLPL1",43,0)
 D INIT^RCDPLPLM
"RTN","RCDPLPL1",44,0)
 Q
"RTN","RCDPLPL1",45,0)
 ;
"RTN","RCDPLPL1",46,0)
 ;
"RTN","RCDPLPL1",47,0)
FINDCRED ;  find a specific credit card used for payments
"RTN","RCDPLPL1",48,0)
 D FULL^VALM1
"RTN","RCDPLPL1",49,0)
 S VALMBCK="R"
"RTN","RCDPLPL1",50,0)
 ;
"RTN","RCDPLPL1",51,0)
 N RCCREDT,RCTYPE
"RTN","RCDPLPL1",52,0)
 K RCFCHECK,RCFCREDT,RCFTRACE
"RTN","RCDPLPL1",53,0)
 W !
"RTN","RCDPLPL1",54,0)
 S RCCREDT=$$ASKCRED I RCCREDT=-1 D INIT^RCDPLPLM Q
"RTN","RCDPLPL1",55,0)
 ;
"RTN","RCDPLPL1",56,0)
 S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
"RTN","RCDPLPL1",57,0)
 S RCFCREDT=RCCREDT_"^"_RCTYPE
"RTN","RCDPLPL1",58,0)
 D INIT^RCDPLPLM
"RTN","RCDPLPL1",59,0)
 Q
"RTN","RCDPLPL1",60,0)
 ;
"RTN","RCDPLPL1",61,0)
 ;
"RTN","RCDPLPL1",62,0)
ACCOUNT ;  account profile
"RTN","RCDPLPL1",63,0)
 D FULL^VALM1
"RTN","RCDPLPL1",64,0)
 D ACCTPROF^RCDPAPLM
"RTN","RCDPLPL1",65,0)
 D INIT^RCDPLPLM
"RTN","RCDPLPL1",66,0)
 S VALMBCK="R"
"RTN","RCDPLPL1",67,0)
 ;  fast exit
"RTN","RCDPLPL1",68,0)
 I $G(RCDPFXIT) S VALMBCK="Q"
"RTN","RCDPLPL1",69,0)
 Q
"RTN","RCDPLPL1",70,0)
 ;
"RTN","RCDPLPL1",71,0)
 ;
"RTN","RCDPLPL1",72,0)
RECEIPT ;  receipt profile
"RTN","RCDPLPL1",73,0)
 D FULL^VALM1
"RTN","RCDPLPL1",74,0)
 D RECTPROF^RCDPRPLM
"RTN","RCDPLPL1",75,0)
 D INIT^RCDPLPLM
"RTN","RCDPLPL1",76,0)
 S VALMBCK="R"
"RTN","RCDPLPL1",77,0)
 I $G(RCDPFXIT) S VALMBCK="Q"
"RTN","RCDPLPL1",78,0)
 Q
"RTN","RCDPLPL1",79,0)
 ;
"RTN","RCDPLPL1",80,0)
 ;
"RTN","RCDPLPL1",81,0)
CLEARSUS ;  flag a payment as being cleared from suspense
"RTN","RCDPLPL1",82,0)
 D FULL^VALM1
"RTN","RCDPLPL1",83,0)
 S VALMBCK="R"
"RTN","RCDPLPL1",84,0)
 ;
"RTN","RCDPLPL1",85,0)
 W !!,"This option will allow you to enter the FMS Document Number used"
"RTN","RCDPLPL1",86,0)
 W !,"to clear the payment from the suspense account in FMS.  Once an"
"RTN","RCDPLPL1",87,0)
 W !,"FMS Document Number is entered, the payment will no longer appear"
"RTN","RCDPLPL1",88,0)
 W !,"on the list as Unlinked.",!
"RTN","RCDPLPL1",89,0)
 N INDEX,RCPAY,RCRECTDA,RCTRANDA
"RTN","RCDPLPL1",90,0)
 S INDEX=$$SELPAY
"RTN","RCDPLPL1",91,0)
 I INDEX D
"RTN","RCDPLPL1",92,0)
 .   S RCPAY=$G(^TMP("RCDPLPLM",$J,"IDX",INDEX,INDEX))
"RTN","RCDPLPL1",93,0)
 .   S RCRECTDA=+$P(RCPAY,"^"),RCTRANDA=+$P(RCPAY,"^",2)
"RTN","RCDPLPL1",94,0)
 I 'INDEX D
"RTN","RCDPLPL1",95,0)
 .   W ! S RCRECTDA=+$$SELRECT^RCDPUREC(0,0) I RCRECTDA<1 Q
"RTN","RCDPLPL1",96,0)
 .   S RCTRANDA=+$$SELTRAN^RCDPURET(RCRECTDA) I RCTRANDA<1 S RCTRANDA=0
"RTN","RCDPLPL1",97,0)
 I '$G(RCRECTDA)!('$G(RCTRANDA)) S VALMBCK="R" Q
"RTN","RCDPLPL1",98,0)
 ;
"RTN","RCDPLPL1",99,0)
 W !!,"                   Receipt: ",$P(^RCY(344,RCRECTDA,0),"^")
"RTN","RCDPLPL1",100,0)
 W !,"               Transaction: ",RCTRANDA
"RTN","RCDPLPL1",101,0)
 W !,"  Unapplied Deposit Number: ",$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)
"RTN","RCDPLPL1",102,0)
 D EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"")
"RTN","RCDPLPL1",103,0)
 S VALMBCK="R"
"RTN","RCDPLPL1",104,0)
 D INIT^RCDPLPLM
"RTN","RCDPLPL1",105,0)
 Q
"RTN","RCDPLPL1",106,0)
 ;
"RTN","RCDPLPL1",107,0)
 ;
"RTN","RCDPLPL1",108,0)
 ;
"RTN","RCDPLPL1",109,0)
 ;
"RTN","RCDPLPL1",110,0)
SELPAY() ;  select a payment from the form list
"RTN","RCDPLPL1",111,0)
 N VALMBG,VALMLST
"RTN","RCDPLPL1",112,0)
 ;  if no payments, quit
"RTN","RCDPLPL1",113,0)
 I '$O(^TMP("RCDPLPLM",$J,"IDX",0)) S VALMSG="There are NO payments on the form to select." Q 0
"RTN","RCDPLPL1",114,0)
 ;
"RTN","RCDPLPL1",115,0)
 ;  if only one payment, select that one automatically
"RTN","RCDPLPL1",116,0)
 I '$O(^TMP("RCDPLPLM",$J,"IDX",1)) Q 1
"RTN","RCDPLPL1",117,0)
 ;
"RTN","RCDPLPL1",118,0)
 ;  select the entry from the list
"RTN","RCDPLPL1",119,0)
 ;  if not on first screen, make sure selection begins with 1
"RTN","RCDPLPL1",120,0)
 S VALMBG=1
"RTN","RCDPLPL1",121,0)
 ;  if not on last screen, make sure selection ends with last
"RTN","RCDPLPL1",122,0)
 S VALMLST=$O(^TMP("RCDPLPLM",$J,"IDX",999999999),-1)
"RTN","RCDPLPL1",123,0)
 D EN^VALM2($G(XQORNOD(0)),"OS")
"RTN","RCDPLPL1",124,0)
 Q $O(VALMY(0))
"RTN","RCDPLPL1",125,0)
 ;
"RTN","RCDPLPL1",126,0)
 ;
"RTN","RCDPLPL1",127,0)
ASKCHEK() ;  ask the check number
"RTN","RCDPLPL1",128,0)
 N DIR,X,Y
"RTN","RCDPLPL1",129,0)
 S DIR(0)="FAO^1:50"
"RTN","RCDPLPL1",130,0)
 S DIR("A")="Enter the Check Number to Search for: "
"RTN","RCDPLPL1",131,0)
 S DIR("?")="Enter the check number from 1 to 50 characters free text."
"RTN","RCDPLPL1",132,0)
 D ^DIR
"RTN","RCDPLPL1",133,0)
 I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCDPLPL1",134,0)
 Q $S(Y'="":Y,1:-1)
"RTN","RCDPLPL1",135,0)
 ;
"RTN","RCDPLPL1",136,0)
 ;
"RTN","RCDPLPL1",137,0)
ASKTRACE() ;  ask the e-payments trace number
"RTN","RCDPLPL1",138,0)
 N DIR,X,Y
"RTN","RCDPLPL1",139,0)
 S DIR(0)="FAO^1:50"
"RTN","RCDPLPL1",140,0)
 S DIR("A")="Enter the e-Payments Trace Number to Search for: "
"RTN","RCDPLPL1",141,0)
 S DIR("?")="Enter the trace number from 1 to 50 characters free text."
"RTN","RCDPLPL1",142,0)
 D ^DIR
"RTN","RCDPLPL1",143,0)
 I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCDPLPL1",144,0)
 Q $S(Y'="":Y,1:-1)
"RTN","RCDPLPL1",145,0)
 ;
"RTN","RCDPLPL1",146,0)
 ;
"RTN","RCDPLPL1",147,0)
ASKCRED() ;  ask the credit card number
"RTN","RCDPLPL1",148,0)
 N DIR,DIRUT,DTOUT,DUOUT,X,Y
"RTN","RCDPLPL1",149,0)
 S DIR(0)="NAO^0:9999999999999999"
"RTN","RCDPLPL1",150,0)
 S DIR("A")="Enter the Credit Card Number to Search for: "
"RTN","RCDPLPL1",151,0)
 S DIR("?")="Enter the check card number from 1 to 16 numbers."
"RTN","RCDPLPL1",152,0)
 D ^DIR
"RTN","RCDPLPL1",153,0)
 I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCDPLPL1",154,0)
 Q $S(Y'="":Y,1:-1)
"RTN","RCDPLPL1",155,0)
 ;
"RTN","RCDPLPL1",156,0)
 ;
"RTN","RCDPLPL1",157,0)
ASKTYPE() ;  ask the type of match
"RTN","RCDPLPL1",158,0)
 N DIR,DIRUT,DTOUT,DUOUT,X,Y
"RTN","RCDPLPL1",159,0)
 S DIR(0)="SAO^1:Exact Match;2:Contains;"
"RTN","RCDPLPL1",160,0)
 S DIR("A")="Type of Match: "
"RTN","RCDPLPL1",161,0)
 S DIR("B")="Contains"
"RTN","RCDPLPL1",162,0)
 D ^DIR
"RTN","RCDPLPL1",163,0)
 I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCDPLPL1",164,0)
 Q $S(Y=1:"EQUAL TO",Y=2:"CONTAINING",1:-1)
"RTN","RCDPRPL4")
0^36^B28923437
"RTN","RCDPRPL4",1,0)
RCDPRPL4 ;WISC/RFJ/PJH - receipt profile listmanager options ; 5/6/11 12:30pm
"RTN","RCDPRPL4",2,0)
 ;;4.5;Accounts Receivable;**169,172,173,269**;Mar 20, 1995;Build 113
"RTN","RCDPRPL4",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPRPL4",4,0)
 Q
"RTN","RCDPRPL4",5,0)
 ;
"RTN","RCDPRPL4",6,0)
 ;  this routine contains the entry points for receipt management
"RTN","RCDPRPL4",7,0)
 ;
"RTN","RCDPRPL4",8,0)
 ;
"RTN","RCDPRPL4",9,0)
ONLINE ;  allow the supervisor to mark the CR document as input on line
"RTN","RCDPRPL4",10,0)
 D FULL^VALM1
"RTN","RCDPRPL4",11,0)
 S VALMBCK="R"
"RTN","RCDPRPL4",12,0)
 ;
"RTN","RCDPRPL4",13,0)
 ;  get fms document and status
"RTN","RCDPRPL4",14,0)
 N %,FMSDOC,GECSDATA
"RTN","RCDPRPL4",15,0)
 S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
"RTN","RCDPRPL4",16,0)
 ;
"RTN","RCDPRPL4",17,0)
 W !!,"This option will allow you to mark a rejected Cash Receipt document as"
"RTN","RCDPRPL4",18,0)
 W !,"entered on line.  This will prevent the document from being listed on"
"RTN","RCDPRPL4",19,0)
 W !,"the nightly mailman message used to help manage the receipts and deposits."
"RTN","RCDPRPL4",20,0)
 ;
"RTN","RCDPRPL4",21,0)
 W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
"RTN","RCDPRPL4",22,0)
 ;
"RTN","RCDPRPL4",23,0)
 I '$D(^XUSEC("PRCAY PAYMENT SUP",DUZ)) W !!,"You are not an owner of the supervisor PRCAY PAYMENT SUP security key." D QUIT Q
"RTN","RCDPRPL4",24,0)
 ;
"RTN","RCDPRPL4",25,0)
 ;  cr accepted
"RTN","RCDPRPL4",26,0)
 I $E($P(FMSDOC,"^",2))="A" W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is ACCEPTED ??" D QUIT Q
"RTN","RCDPRPL4",27,0)
 ;
"RTN","RCDPRPL4",28,0)
 ;  not been transmitted for 2 days
"RTN","RCDPRPL4",29,0)
 I $E($P(FMSDOC,"^",2))="T",$$FMDIFF^XLFDT(DT,$P(^RCY(344,RCRECTDA,0),"^",8))'>2 W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document has NOT been TRANSMITTED for 2 days ??" D QUIT Q
"RTN","RCDPRPL4",30,0)
 ;
"RTN","RCDPRPL4",31,0)
 ;  cr queued for transmission
"RTN","RCDPRPL4",32,0)
 I $E($P(FMSDOC,"^",2))="Q"!($E($P(FMSDOC,"^",2))="M") W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is waiting to be TRANSMITTED ??" D QUIT Q
"RTN","RCDPRPL4",33,0)
 ;
"RTN","RCDPRPL4",34,0)
 ;  check to see if already marked as entered on line
"RTN","RCDPRPL4",35,0)
 I $E($P(FMSDOC,"^",2))="O" D  Q
"RTN","RCDPRPL4",36,0)
 .   I $$ASKSTAT("REMOVE")'=1 Q
"RTN","RCDPRPL4",37,0)
 .   W !,"... removing CR status as entered on line ..."
"RTN","RCDPRPL4",38,0)
 .   ;  remove the status on field 201
"RTN","RCDPRPL4",39,0)
 .   D EDITREC^RCDPUREC(RCRECTDA,"201////0;")
"RTN","RCDPRPL4",40,0)
 .   ;  show the new status
"RTN","RCDPRPL4",41,0)
 .   S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
"RTN","RCDPRPL4",42,0)
 .   W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
"RTN","RCDPRPL4",43,0)
 .   D QUIT
"RTN","RCDPRPL4",44,0)
 ;
"RTN","RCDPRPL4",45,0)
 ;  ask to change the status to entered on line
"RTN","RCDPRPL4",46,0)
 I $$ASKSTAT("ENTER")'=1 D QUIT Q
"RTN","RCDPRPL4",47,0)
 ;
"RTN","RCDPRPL4",48,0)
 ;  change the status to entered on line
"RTN","RCDPRPL4",49,0)
 W !,"... changing status to entered on line ..."
"RTN","RCDPRPL4",50,0)
 W !,"... changing the generic code sheet stack file status to ACCEPTED ..."
"RTN","RCDPRPL4",51,0)
 ;
"RTN","RCDPRPL4",52,0)
 ;  set the status to entered on line in field 201
"RTN","RCDPRPL4",53,0)
 D EDITREC^RCDPUREC(RCRECTDA,"201////1;")
"RTN","RCDPRPL4",54,0)
 ;
"RTN","RCDPRPL4",55,0)
 ;  set the generic code sheet status as accepted
"RTN","RCDPRPL4",56,0)
 ;  get the document ien
"RTN","RCDPRPL4",57,0)
 D DATA^GECSSGET($P(FMSDOC,"^"))
"RTN","RCDPRPL4",58,0)
 I $G(GECSDATA) D SETSTAT^GECSSTAA(GECSDATA,"A")
"RTN","RCDPRPL4",59,0)
 ;
"RTN","RCDPRPL4",60,0)
 ;  show the new status
"RTN","RCDPRPL4",61,0)
 S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
"RTN","RCDPRPL4",62,0)
 W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
"RTN","RCDPRPL4",63,0)
 ;
"RTN","RCDPRPL4",64,0)
QUIT ;  pause and rebuild the header
"RTN","RCDPRPL4",65,0)
 W !!,"press RETURN to continue: "
"RTN","RCDPRPL4",66,0)
 R %:DTIME
"RTN","RCDPRPL4",67,0)
 D HDR^RCDPRPLM
"RTN","RCDPRPL4",68,0)
 Q
"RTN","RCDPRPL4",69,0)
 ;
"RTN","RCDPRPL4",70,0)
 ;
"RTN","RCDPRPL4",71,0)
ASKSTAT(ACTION) ;  ask if its okay to remove or change the entered online status
"RTN","RCDPRPL4",72,0)
 ;  1 is yes, otherwise no
"RTN","RCDPRPL4",73,0)
 N DIR,DIQ2,DTOUT,DUOUT,X,Y
"RTN","RCDPRPL4",74,0)
 S DIR(0)="YO",DIR("B")="NO"
"RTN","RCDPRPL4",75,0)
 S DIR("A",1)="  Do you want to "_ACTION_" the status showing the Cash Receipt"
"RTN","RCDPRPL4",76,0)
 S DIR("A")="  document was entered ON LINE"
"RTN","RCDPRPL4",77,0)
 D ^DIR
"RTN","RCDPRPL4",78,0)
 I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCDPRPL4",79,0)
 Q Y
"RTN","RCDPRPL4",80,0)
 ;
"RTN","RCDPRPL4",81,0)
ERAWL(RCSCR) ; Generate automatic dec adj from ERA Worklist in RCSCR
"RTN","RCDPRPL4",82,0)
 ; RCADJ returned = 1 if passed by reference and adjustment successful
"RTN","RCDPRPL4",83,0)
 ;       returned = 2 if passed by ref and adjustments aborted
"RTN","RCDPRPL4",84,0)
 ;       returned = -1 if error
"RTN","RCDPRPL4",85,0)
 ;       returned = 0 if no WL adjustments found
"RTN","RCDPRPL4",86,0)
 N RCZ,RCZ0,Z00,V00,RCCOM,RC1,RCADJ,RCOK
"RTN","RCDPRPL4",87,0)
 S RC1=1,RCZ=0,RCADJ=0
"RTN","RCDPRPL4",88,0)
 F  S RCZ=$O(^RCY(344.49,RCSCR,1,RCZ)) Q:'RCZ!(RCADJ=2)  S V00=$G(^(RCZ,0)),RCZ0=0 F  S RCZ0=$O(^RCY(344.49,RCSCR,1,RCZ,1,RCZ0)) Q:'RCZ0!(RCADJ=2)  S Z00=$G(^(RCZ0,0)) Q:"12"'[+$P(Z00,U,5)  D
"RTN","RCDPRPL4",89,0)
 . S RCCOM(1)=$P(Z00,U,9)
"RTN","RCDPRPL4",90,0)
 . I RC1,$P(Z00,U,5)=1 D  Q:RCADJ=2
"RTN","RCDPRPL4",91,0)
 .. S RC1=0
"RTN","RCDPRPL4",92,0)
 .. S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="Generating automatic decrease adjustments from EDI Lbox Worklist ...",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
"RTN","RCDPRPL4",93,0)
 .. D ^DIR K DIR
"RTN","RCDPRPL4",94,0)
 .. I Y'=1 S RCADJ=2
"RTN","RCDPRPL4",95,0)
 . I $P(Z00,U,8)=1 D  Q  ; previously done
"RTN","RCDPRPL4",96,0)
 .. I $P(Z00,U,5)=1 W !,"  Automatic decrease adj from ERA Worklist for bill #"_$P($G(^PRCA(430,+$P(V00,U,7),0)),U),!,"    for amount of "_$J(+$P(Z00,U,3),"",2)_" was previously completed" S RCADJ=1
"RTN","RCDPRPL4",97,0)
 . I $P(Z00,U,5)=1 D  Q  ; Decrease adj
"RTN","RCDPRPL4",98,0)
 .. I '$$INCDEC^RCBEUTR1($P(V00,U,7),$P(Z00,U,3),.RCCOM,,,1) D
"RTN","RCDPRPL4",99,0)
 ... W !,"  Could not perform automatic decrease adj from ERA Worklist for ",!,"    bill # "_$P($G(^PRCA(430,+$P(V00,U,7),0)),U)_" for amount of "_$J(+$P(Z00,U,3),"",2)
"RTN","RCDPRPL4",100,0)
 ... S RCADJ=-1
"RTN","RCDPRPL4",101,0)
 .. E  D  ; success
"RTN","RCDPRPL4",102,0)
 ... D UPD(RCSCR,RCZ,RCZ0)
"RTN","RCDPRPL4",103,0)
 ... S RCADJ=1
"RTN","RCDPRPL4",104,0)
 ... W !,"  EDI Lbox Worklist automatic dec adjustment made to "_$P($G(^PRCA(430,+$P(V00,U,7),0)),U)_": "_$J(+$P(Z00,U,3),"",2)
"RTN","RCDPRPL4",105,0)
 . I $P(Z00,U,5)=2 D  Q  ; Bill comment
"RTN","RCDPRPL4",106,0)
 .. D ADDCOMM^RCBEUTRA($P(V00,U,7),.RCCOM),UPD(RCSCR,RCZ,RCZ0)
"RTN","RCDPRPL4",107,0)
 ;
"RTN","RCDPRPL4",108,0)
 Q $G(RCADJ)
"RTN","RCDPRPL4",109,0)
 ;
"RTN","RCDPRPL4",110,0)
UPD(RCSCR,Z,Z0) ; Mark as complete so it doesn't get done twice
"RTN","RCDPRPL4",111,0)
 N DA,DIE,DR
"RTN","RCDPRPL4",112,0)
 S DA(2)=RCSCR,DA(1)=Z,DA=Z0
"RTN","RCDPRPL4",113,0)
 S DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,",DR=".08////1" D ^DIE
"RTN","RCDPRPL4",114,0)
 Q
"RTN","RCDPRPL4",115,0)
 ;
"RTN","RCDPRSEA")
0^37^B21546260
"RTN","RCDPRSEA",1,0)
RCDPRSEA ;WISC/RFJ/PJH - extended search ; 5/25/11 3:07pm
"RTN","RCDPRSEA",2,0)
 ;;4.5;Accounts Receivable;**114,148,208,269**;Mar 20, 1995;Build 113
"RTN","RCDPRSEA",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPRSEA",4,0)
 ;
"RTN","RCDPRSEA",5,0)
 N DATEEND,DATESTRT,RCTRACE,RCCHECK,RCCREDIT,RCSEARCH,RCTYPE,%ZIS,ZTSAVE,ZTDESC,ZTQUEUED,ZTRTN,POP
"RTN","RCDPRSEA",6,0)
 ;  search check or credit card
"RTN","RCDPRSEA",7,0)
 W !
"RTN","RCDPRSEA",8,0)
 S RCSEARCH=$$ASKSEA
"RTN","RCDPRSEA",9,0)
 I RCSEARCH<1 Q
"RTN","RCDPRSEA",10,0)
 ;
"RTN","RCDPRSEA",11,0)
 ;  check to search for
"RTN","RCDPRSEA",12,0)
 I RCSEARCH=1 S RCCHECK=$$ASKCHEK^RCDPLPL1 I RCCHECK=-1 Q
"RTN","RCDPRSEA",13,0)
 ;  credit card to search for
"RTN","RCDPRSEA",14,0)
 I RCSEARCH=2 S RCCREDIT=$$ASKCRED^RCDPLPL1 I RCCREDIT=-1 Q
"RTN","RCDPRSEA",15,0)
 ;  ask contains or equals
"RTN","RCDPRSEA",16,0)
 S RCTYPE=$$ASKTYPE^RCDPLPL1 I RCTYPE=-1 Q
"RTN","RCDPRSEA",17,0)
 S RCTYPE=$E(RCTYPE)
"RTN","RCDPRSEA",18,0)
 ;
"RTN","RCDPRSEA",19,0)
 ;  trace # to search for
"RTN","RCDPRSEA",20,0)
 I RCSEARCH=3 S RCTRACE=$$ASKTRACE^RCDPLPL1 I RCTRACE=-1 Q
"RTN","RCDPRSEA",21,0)
 ;
"RTN","RCDPRSEA",22,0)
 ;  ask receipt open dates
"RTN","RCDPRSEA",23,0)
 W !
"RTN","RCDPRSEA",24,0)
 D DATESEL^RCRJRTRA("RECEIPT Opened")
"RTN","RCDPRSEA",25,0)
 I '$G(DATESTRT)!('$G(DATEEND)) Q
"RTN","RCDPRSEA",26,0)
 ;
"RTN","RCDPRSEA",27,0)
 ;  select device
"RTN","RCDPRSEA",28,0)
 W ! S %ZIS="Q" D ^%ZIS I POP Q
"RTN","RCDPRSEA",29,0)
 I $D(IO("Q")) D  D ^%ZTLOAD K IO("Q"),ZTSK Q
"RTN","RCDPRSEA",30,0)
 .   S ZTDESC="Extended Check/Trace#/Credit Card Search",ZTRTN="DQ^RCDPRSEA"
"RTN","RCDPRSEA",31,0)
 .   S ZTSAVE("RC*")="",ZTSAVE("DATE*")="",ZTSAVE("ZTREQ")="@"
"RTN","RCDPRSEA",32,0)
 W !!,"<*> please wait <*>"
"RTN","RCDPRSEA",33,0)
 ;
"RTN","RCDPRSEA",34,0)
DQ ;  queue starts here
"RTN","RCDPRSEA",35,0)
 N %,%I,DATA,DATEDIS1,DATEDIS2,NOW,PAGE,RCRECTDA,RCRJFLAG,RCRJLINE,RCTRANDA,SCREEN,X,Y
"RTN","RCDPRSEA",36,0)
 ;  print report
"RTN","RCDPRSEA",37,0)
 S Y=$P(DATESTRT,".") D DD^%DT S DATEDIS1=Y
"RTN","RCDPRSEA",38,0)
 S Y=$P(DATEEND,".") D DD^%DT S DATEDIS2=Y
"RTN","RCDPRSEA",39,0)
 D NOW^%DTC S Y=% D DD^%DT S NOW=Y
"RTN","RCDPRSEA",40,0)
 S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)=""
"RTN","RCDPRSEA",41,0)
 S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
"RTN","RCDPRSEA",42,0)
 U IO D H
"RTN","RCDPRSEA",43,0)
 S RCRECTDA=99999999999999
"RTN","RCDPRSEA",44,0)
 F  S RCRECTDA=$O(^RCY(344,RCRECTDA),-1) Q:'RCRECTDA!($G(RCRJFLAG))  D
"RTN","RCDPRSEA",45,0)
 .   S DATA=$G(^RCY(344,RCRECTDA,0))
"RTN","RCDPRSEA",46,0)
 .   I $P(DATA,"^",3)<DATESTRT Q
"RTN","RCDPRSEA",47,0)
 .   I $P($P(DATA,"^",3),".")>DATEEND Q
"RTN","RCDPRSEA",48,0)
 .   S RCTRANDA=0 F  S RCTRANDA=$O(^RCY(344,RCRECTDA,1,RCTRANDA)) Q:'RCTRANDA!($G(RCRJFLAG))  D
"RTN","RCDPRSEA",49,0)
 .   .   I SCREEN R X:0 I X["^" S RCRJFLAG=1 Q
"RTN","RCDPRSEA",50,0)
 .   .   S DATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
"RTN","RCDPRSEA",51,0)
 .   .   ;  check search
"RTN","RCDPRSEA",52,0)
 .   .   I RCSEARCH=1 D  Q
"RTN","RCDPRSEA",53,0)
 .   .   .   I RCTYPE="E",$P(DATA,"^",7)'=RCCHECK Q    ;equals
"RTN","RCDPRSEA",54,0)
 .   .   .   I $P(DATA,"^",7)'[RCCHECK Q               ;contains
"RTN","RCDPRSEA",55,0)
 .   .   .   D DISPLAY
"RTN","RCDPRSEA",56,0)
 .   .   ;  trace # search
"RTN","RCDPRSEA",57,0)
 .   .   I RCSEARCH=3 D  Q
"RTN","RCDPRSEA",58,0)
 .   .   .   N RCNUM
"RTN","RCDPRSEA",59,0)
 .   .   .   S RCNUM=$$TRACE(RCRECTDA)
"RTN","RCDPRSEA",60,0)
 .   .   .   I RCTYPE="E",RCNUM'=RCTRACE Q    ;equals
"RTN","RCDPRSEA",61,0)
 .   .   .   I RCNUM'[RCTRACE Q               ;contains
"RTN","RCDPRSEA",62,0)
 .   .   .   D DISPLAY
"RTN","RCDPRSEA",63,0)
 .   .   ;  credit card search
"RTN","RCDPRSEA",64,0)
 .   .   I RCTYPE="E",$P(DATA,"^",11)'=RCCREDIT Q    ;equals
"RTN","RCDPRSEA",65,0)
 .   .   I $P(DATA,"^",11)'[RCCREDIT Q               ;contains
"RTN","RCDPRSEA",66,0)
 .   .   D DISPLAY
"RTN","RCDPRSEA",67,0)
 ;
"RTN","RCDPRSEA",68,0)
 I '$G(RCRJFLAG),SCREEN U IO(0) R !,"Press RETURN to continue:",%:DTIME
"RTN","RCDPRSEA",69,0)
 D ^%ZISC
"RTN","RCDPRSEA",70,0)
 Q
"RTN","RCDPRSEA",71,0)
 ;
"RTN","RCDPRSEA",72,0)
 ;
"RTN","RCDPRSEA",73,0)
DISPLAY ;  display the payment
"RTN","RCDPRSEA",74,0)
 I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG)  W @IOF D H
"RTN","RCDPRSEA",75,0)
 ;
"RTN","RCDPRSEA",76,0)
 N ACCOUNT,DATA,DATA1
"RTN","RCDPRSEA",77,0)
 S DATA=$G(^RCY(344,RCRECTDA,0)),DATA1=DATA
"RTN","RCDPRSEA",78,0)
 ;  receipt
"RTN","RCDPRSEA",79,0)
 W !,$P(DATA,"^")
"RTN","RCDPRSEA",80,0)
 ;  date opened
"RTN","RCDPRSEA",81,0)
 W ?13,$E($P(DATA,"^",3),4,5),"/",$E($P(DATA,"^",3),6,7),"/",$E($P(DATA,"^",3),2,3)
"RTN","RCDPRSEA",82,0)
 ;  transaction number
"RTN","RCDPRSEA",83,0)
 W ?24,RCTRANDA
"RTN","RCDPRSEA",84,0)
 S DATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
"RTN","RCDPRSEA",85,0)
 ;  account
"RTN","RCDPRSEA",86,0)
 S ACCOUNT=$P(DATA,"^",3)
"RTN","RCDPRSEA",87,0)
 I ACCOUNT["PRCA(430," S ACCOUNT=$P($G(^PRCA(430,+$P(DATA,"^",3),0)),"^")
"RTN","RCDPRSEA",88,0)
 I ACCOUNT["DPT(" S ACCOUNT=$P($G(^DPT(+$P(DATA,"^",3),0)),"^")
"RTN","RCDPRSEA",89,0)
 W ?30,$E(ACCOUNT,1,24)
"RTN","RCDPRSEA",90,0)
 ;  amount
"RTN","RCDPRSEA",91,0)
 W ?54,$J($P(DATA,"^",4),8,2)
"RTN","RCDPRSEA",92,0)
 ;  check/trace/credit card number
"RTN","RCDPRSEA",93,0)
 W !,"   "
"RTN","RCDPRSEA",94,0)
 W $S(RCSEARCH=1:$P(DATA,"^",7),RCSEARCH=2:$P(DATA,"^",11),1:$$TRACE(RCRECTDA))
"RTN","RCDPRSEA",95,0)
 Q
"RTN","RCDPRSEA",96,0)
 ;
"RTN","RCDPRSEA",97,0)
 ;
"RTN","RCDPRSEA",98,0)
H ;  header
"RTN","RCDPRSEA",99,0)
 S %=NOW_"  PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
"RTN","RCDPRSEA",100,0)
 W $C(13),"EXTENDED CHECK/TRACE #/CREDIT CARD SEARCH",?(80-$L(%)),%
"RTN","RCDPRSEA",101,0)
 W !,"  FOR THE DATE RANGE: ",DATEDIS1,"  TO  ",DATEDIS2
"RTN","RCDPRSEA",102,0)
 W !,"       SEARCHING FOR: "
"RTN","RCDPRSEA",103,0)
 W $S(RCSEARCH=1:"CHECK ",RCSEARCH=2:"CREDIT CARD ",1:"TRACE # ")
"RTN","RCDPRSEA",104,0)
 W $S(RCTYPE="E":"EQUALS ",1:"CONTAINS ")
"RTN","RCDPRSEA",105,0)
 W $G(RCCHECK),$G(RCTRACE),$G(RCCREDIT)
"RTN","RCDPRSEA",106,0)
 W !,"RECEIPT",?13,"OPENDATE",?24,"TRANS",?30,"ACCOUNT",?54,$J("AMOUNT",8)
"RTN","RCDPRSEA",107,0)
 W !,"   "
"RTN","RCDPRSEA",108,0)
 W $S(RCSEARCH=1:"CHECK#",RCSEARCH=2:"CREDITCARD#",1:"TRACE#")
"RTN","RCDPRSEA",109,0)
 W !,RCRJLINE
"RTN","RCDPRSEA",110,0)
 I SCREEN W !!?10,"********** PRESS ^ at anytime to STOP search **********"
"RTN","RCDPRSEA",111,0)
 Q
"RTN","RCDPRSEA",112,0)
 ;
"RTN","RCDPRSEA",113,0)
 ;
"RTN","RCDPRSEA",114,0)
TRACE(RCRECTDA) ; Returns the trace # on a receipt
"RTN","RCDPRSEA",115,0)
 N DATA
"RTN","RCDPRSEA",116,0)
 S DATA=$G(^RCY(344,RCRECTDA,0))
"RTN","RCDPRSEA",117,0)
 Q $S($P(DATA,U,18):$P($G(^RCY(344.4,+$P(DATA,"^",18),0)),U,2),$P(DATA,U,17):$P($G(^RCY(344.31,+$P(DATA,U,17),0)),U,4),1:"")
"RTN","RCDPRSEA",118,0)
 ;
"RTN","RCDPRSEA",119,0)
ASKSEA() ;  ask search field
"RTN","RCDPRSEA",120,0)
 N DIR,DIRUT,DTOUT,DUOUT,X,Y
"RTN","RCDPRSEA",121,0)
 S DIR(0)="SAO^1:Check;2:Credit Card;3:Trace #;"
"RTN","RCDPRSEA",122,0)
 S DIR("A")="Search for Check, Trace #, or Credit Card: "
"RTN","RCDPRSEA",123,0)
 S DIR("B")="Check"
"RTN","RCDPRSEA",124,0)
 D ^DIR
"RTN","RCDPRSEA",125,0)
 I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCDPRSEA",126,0)
 Q Y
"RTN","RCDPUT")
0^3^B25168927
"RTN","RCDPUT",1,0)
RCDPUT ;WASH-ISC@ALTOONA,PA/RGY/KML - UTILITIES ; 5/6/11 12:29pm
"RTN","RCDPUT",2,0)
V ;;4.5;Accounts Receivable;**69,90,106,114,169,269**;Mar 20, 1995;Build 113
"RTN","RCDPUT",3,0)
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","RCDPUT",4,0)
 Q
"RTN","RCDPUT",5,0)
 ;
"RTN","RCDPUT",6,0)
 ;
"RTN","RCDPUT",7,0)
RECEIPTS ;  check receipts
"RTN","RCDPUT",8,0)
 N DATA,PAYDA,RCCOUNT,RCDATA0,RCDATE,RCRECTDA,STATUS,TOTAL,X,XCNP,XMDUZ,XMZ
"RTN","RCDPUT",9,0)
 K ^TMP("RCDPUT",$J)
"RTN","RCDPUT",10,0)
 ;  check receipts which are 4 days old
"RTN","RCDPUT",11,0)
 S RCDATE=$$FMADD^XLFDT(DT,-4)
"RTN","RCDPUT",12,0)
 S RCCOUNT=7
"RTN","RCDPUT",13,0)
 S RCRECTDA=0 F  S RCRECTDA=$O(^RCY(344,RCRECTDA)) Q:'RCRECTDA  D
"RTN","RCDPUT",14,0)
 .   ;  if no payments, quit
"RTN","RCDPUT",15,0)
 .   I '$O(^RCY(344,RCRECTDA,1,0)) Q
"RTN","RCDPUT",16,0)
 .   ;
"RTN","RCDPUT",17,0)
 .   S RCDATA0=$G(^RCY(344,RCRECTDA,0))
"RTN","RCDPUT",18,0)
 .   ;
"RTN","RCDPUT",19,0)
 .   ;  receipt is marked as processed
"RTN","RCDPUT",20,0)
 .   I $P(RCDATA0,"^",8) D  Q
"RTN","RCDPUT",21,0)
 .   .   ;  check the last payment and see if it was processed
"RTN","RCDPUT",22,0)
 .   .   ;  the last payment must have a paid amount and no processed
"RTN","RCDPUT",23,0)
 .   .   ;  amount AND the payment did not go to suspense.
"RTN","RCDPUT",24,0)
 .   .   S PAYDA=9999999,TOTAL=0
"RTN","RCDPUT",25,0)
 .   .   F  S PAYDA=$O(^RCY(344,RCRECTDA,1,PAYDA),-1) Q:'PAYDA  S DATA=$G(^RCY(344,RCRECTDA,1,PAYDA,0)),TOTAL=TOTAL+$P(DATA,"^",4) I $P(DATA,"^",4),$P(DATA,"^",3),$P($G(^RCY(344,RCRECTDA,1,PAYDA,2)),"^",5)="" Q
"RTN","RCDPUT",26,0)
 .   .   ;  no total paid on the receipt
"RTN","RCDPUT",27,0)
 .   .   I 'TOTAL Q
"RTN","RCDPUT",28,0)
 .   .   ;  found the last payment and it is not processed
"RTN","RCDPUT",29,0)
 .   .   I PAYDA,'$P(^RCY(344,RCRECTDA,1,PAYDA,0),"^",5) D BUILDLN(RCDATA0,"All payments NOT completely processed.") Q
"RTN","RCDPUT",30,0)
 .   .   ;
"RTN","RCDPUT",31,0)
 .   .   ;  if no deposit ticket, receipt is processed
"RTN","RCDPUT",32,0)
 .   .   I '$P(RCDATA0,"^",6) Q
"RTN","RCDPUT",33,0)
 .   .   ;
"RTN","RCDPUT",34,0)
 .   .   ;  receipts is marked as entered on line
"RTN","RCDPUT",35,0)
 .   .   I $P($G(^RCY(344,RCRECTDA,2)),"^",2)=1 Q
"RTN","RCDPUT",36,0)
 .   .   ;
"RTN","RCDPUT",37,0)
 .   .   ;  fms document has not been sent
"RTN","RCDPUT",38,0)
 .   .   I $P($G(^RCY(344,RCRECTDA,2)),"^")="" D BUILDLN(RCDATA0,"CR has NOT been sent to FMS.") Q
"RTN","RCDPUT",39,0)
 .   .   ;
"RTN","RCDPUT",40,0)
 .   .   ;  get the status of the fms code sheet and see if it is
"RTN","RCDPUT",41,0)
 .   .   ;  accepted
"RTN","RCDPUT",42,0)
 .   .   S STATUS=$$FMSSTAT^RCDPUREC(RCRECTDA)
"RTN","RCDPUT",43,0)
 .   .   ;  document is accepted or entered on line
"RTN","RCDPUT",44,0)
 .   .   I $E($P(STATUS,"^",2))="A" Q
"RTN","RCDPUT",45,0)
 .   .   I $E($P(STATUS,"^",2))="O" Q
"RTN","RCDPUT",46,0)
 .   .   ;  not been more than 4 days
"RTN","RCDPUT",47,0)
 .   .   I $$FMDIFF^XLFDT(DT,$P(RCDATA0,"^",8))<4 Q
"RTN","RCDPUT",48,0)
 .   .   D BUILDLN(RCDATA0,"CR NOT accepted in FMS ("_$P(STATUS," ")_").")
"RTN","RCDPUT",49,0)
 .   ;
"RTN","RCDPUT",50,0)
 .   ;  receipt not that old
"RTN","RCDPUT",51,0)
 .   I $P(RCDATA0,"^",3)>RCDATE Q
"RTN","RCDPUT",52,0)
 .   ;
"RTN","RCDPUT",53,0)
 .   ;  not processed in a timely manner
"RTN","RCDPUT",54,0)
 .   D BUILDLN(RCDATA0,"NOT processed in a timely manner.")
"RTN","RCDPUT",55,0)
 ;
"RTN","RCDPUT",56,0)
 I '$O(^TMP("RCDPUT",$J,0)) Q
"RTN","RCDPUT",57,0)
 ;
"RTN","RCDPUT",58,0)
 ;  send mail message
"RTN","RCDPUT",59,0)
 S ^TMP("RCDPUT",$J,1)="Sent to: PRCA ERROR mailgroup"
"RTN","RCDPUT",60,0)
 S ^TMP("RCDPUT",$J,2)="         RCDP PAYMENTS mailgroup"
"RTN","RCDPUT",61,0)
 S ^TMP("RCDPUT",$J,3)="         PRCAY PAYMENT SUP security key holders"
"RTN","RCDPUT",62,0)
 S ^TMP("RCDPUT",$J,4)=" "
"RTN","RCDPUT",63,0)
 S ^TMP("RCDPUT",$J,5)="RECEIPT        OPENED   PROCESS  WARNING"
"RTN","RCDPUT",64,0)
 S ^TMP("RCDPUT",$J,6)="------------------------------------------------------------------------------"
"RTN","RCDPUT",65,0)
 S XMY("G.PRCA ERROR")=""
"RTN","RCDPUT",66,0)
 S XMY("G.RCDP PAYMENTS")=""
"RTN","RCDPUT",67,0)
 F X=0:0 S X=$O(^XUSEC("PRCAY PAYMENT SUP",X)) Q:'X  S XMY(X)=""
"RTN","RCDPUT",68,0)
 S XMDUZ="Accounts Receivable Package"
"RTN","RCDPUT",69,0)
 S XMTEXT="^TMP(""RCDPUT"",$J,"
"RTN","RCDPUT",70,0)
 S XMSUB="Error in Agent Cashier Receipt(s)"
"RTN","RCDPUT",71,0)
 D ^XMD
"RTN","RCDPUT",72,0)
 K ^TMP("RCDPUT",$J)
"RTN","RCDPUT",73,0)
 Q
"RTN","RCDPUT",74,0)
 ;
"RTN","RCDPUT",75,0)
 ;
"RTN","RCDPUT",76,0)
BUILDLN(RCDATA0,WARNING) ;  build line in mail message with receipt data
"RTN","RCDPUT",77,0)
 N DATA,DATE
"RTN","RCDPUT",78,0)
 S RCCOUNT=RCCOUNT+1
"RTN","RCDPUT",79,0)
 S DATA=$E($P(RCDATA0,"^")_"           ",1,11)_"  "
"RTN","RCDPUT",80,0)
 S DATE=$P(RCDATA0,"^",3) I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
"RTN","RCDPUT",81,0)
 S DATA=DATA_$E(DATE_"        ",1,8)_"  "
"RTN","RCDPUT",82,0)
 S DATE=$P(RCDATA0,"^",8) I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
"RTN","RCDPUT",83,0)
 S DATA=DATA_$E(DATE_"        ",1,8)_"  "
"RTN","RCDPUT",84,0)
 S DATA=DATA_WARNING
"RTN","RCDPUT",85,0)
 S RCCOUNT=RCCOUNT+1
"RTN","RCDPUT",86,0)
 S ^TMP("RCDPUT",$J,RCCOUNT)=DATA
"RTN","RCDPUT",87,0)
 Q
"RTN","RCDPUT",88,0)
 ;
"RTN","RCDPUT",89,0)
 ;
"RTN","RCDPUT",90,0)
PURGE ;  purge receipts and deposits
"RTN","RCDPUT",91,0)
 N %,D0,D1,DA,DG,DIC,DICR,DIG,DIH,DIK,DIU,DIV,DIW,RCDATE,RCDEPDA,RCRECTDA,X,Y
"RTN","RCDPUT",92,0)
 ;
"RTN","RCDPUT",93,0)
 ;  purge receipts
"RTN","RCDPUT",94,0)
 ; HIPAA 5010 - retain receipts for 7 year (84 months)
"RTN","RCDPUT",95,0)
 S RCDATE=$$FPS^RCAMFN01(DT,-84)
"RTN","RCDPUT",96,0)
 S RCRECTDA=0 F  S RCRECTDA=$O(^RCY(344,RCRECTDA)) Q:'RCRECTDA  D
"RTN","RCDPUT",97,0)
 .   ;  receipt not processed, do not purge
"RTN","RCDPUT",98,0)
 .   I '$P(^RCY(344,RCRECTDA,0),"^",8) Q
"RTN","RCDPUT",99,0)
 .   ;  receipt processed less than 84 months ago, do not purge
"RTN","RCDPUT",100,0)
 .   I $P(^RCY(344,RCRECTDA,0),"^",8)>RCDATE Q
"RTN","RCDPUT",101,0)
 .   ;  purge receipt
"RTN","RCDPUT",102,0)
 .   L +^RCY(344,RCRECTDA,0)
"RTN","RCDPUT",103,0)
 .   S DIK="^RCY(344,",DA=RCRECTDA D ^DIK
"RTN","RCDPUT",104,0)
 .   L -^RCY(344,RCRECTDA,0)
"RTN","RCDPUT",105,0)
 ;
"RTN","RCDPUT",106,0)
 ;  purge deposits
"RTN","RCDPUT",107,0)
 ; ; HIPAA 5010 - retain deposits for 7 year (84 months)
"RTN","RCDPUT",108,0)
 S RCDATE=$$FPS^RCAMFN01(DT,-84)
"RTN","RCDPUT",109,0)
 S RCDEPDA=0 F  S RCDEPDA=$O(^RCY(344.1,RCDEPDA)) Q:'RCDEPDA  D
"RTN","RCDPUT",110,0)
 .   ;  if receipts are on deposit, do not purge
"RTN","RCDPUT",111,0)
 .   I $O(^RCY(344,"AD",RCDEPDA,0)) Q
"RTN","RCDPUT",112,0)
 .   ;  deposit not confirmed, do not purge
"RTN","RCDPUT",113,0)
 .   I '$P(^RCY(344.1,RCDEPDA,0),"^",11) Q
"RTN","RCDPUT",114,0)
 .   ;  deposit confirmed less than 84 months ago, do not purge
"RTN","RCDPUT",115,0)
 .   I $P(^RCY(344.1,RCDEPDA,0),"^",11)>RCDATE Q
"RTN","RCDPUT",116,0)
 .   ;  purge deposit
"RTN","RCDPUT",117,0)
 .   L +^RCY(344.1,RCDEPDA,0)
"RTN","RCDPUT",118,0)
 .   S DIK="^RCY(344.1,",DA=RCDEPDA D ^DIK
"RTN","RCDPUT",119,0)
 .   L -^RCY(344.1,RCDEPDA,0)
"RTN","RCDPUT",120,0)
 Q
"RTN","RCDPUT",121,0)
 ;
"RTN","RCDPUT",122,0)
 ;
"RTN","RCDPUT",123,0)
MAN ;  Entry point for nightly process for managing receipts and deposits
"RTN","RCDPUT",124,0)
 D PURGE
"RTN","RCDPUT",125,0)
 D RECEIPTS
"RTN","RCDPUT",126,0)
 Q
"UP",344,344.01,-1)
344^1
"UP",344,344.01,0)
344.01
"UP",344.4,344.41,-1)
344.4^1
"UP",344.4,344.41,0)
344.41
"UP",344.4,344.42,-1)
344.4^2
"UP",344.4,344.42,0)
344.42
"VER")
8.0^22.0
"^DD",344,344.01,.07,0)
CHECK #^F^^0;7^K:$L(X)>50!($L(X)<1) X
"^DD",344,344.01,.07,3)
Answer must be 1-50 characters in length.
"^DD",344,344.01,.07,21,0)
^^5^5^2920820^^^^
"^DD",344,344.01,.07,21,1,0)
If available the check # should be entered for check payments.  This
"^DD",344,344.01,.07,21,2,0)
information will be valuable for tracking 'lost' payments or to
"^DD",344,344.01,.07,21,3,0)
provide information for patient inquiries.  The check number will
"^DD",344,344.01,.07,21,4,0)
be logged with the payment transaction for each bill to which the
"^DD",344,344.01,.07,21,5,0)
payment is applied.
"^DD",344,344.01,.07,22)

"^DD",344,344.01,.07,"DT")
3110523
"^DD",344.31,344.31,.02,0)
PAYER NAME^F^^0;2^K:$L(X)>50!($L(X)<1) X
"^DD",344.31,344.31,.02,1,0)
^.1^^0
"^DD",344.31,344.31,.02,3)
Answer must be 1-50 characters in length.
"^DD",344.31,344.31,.02,21,0)
^.001^1^1^3100621^^^
"^DD",344.31,344.31,.02,21,1,0)
This is the insurance co name as reported for the payment on the EFT.
"^DD",344.31,344.31,.02,"DT")
3100709
"^DD",344.31,344.31,.04,0)
TRACE #^F^^0;4^K:$L(X)>50!($L(X)<3) X
"^DD",344.31,344.31,.04,1,0)
^.1^^0
"^DD",344.31,344.31,.04,3)
Answer must be 3-50 characters in length.
"^DD",344.31,344.31,.04,21,0)
^.001^2^2^3100621^^^
"^DD",344.31,344.31,.04,21,1,0)
This is the bank trace number assigned to the electronic funds transfer
"^DD",344.31,344.31,.04,21,2,0)
(EFT) by the payer's bank.
"^DD",344.31,344.31,.04,"DT")
3100623
"^DD",344.31,344.31,.15,0)
ACH TRACE#^F^^1;1^K:$L(X)>30!($L(X)<3) X
"^DD",344.31,344.31,.15,3)
Answer must be 1-30 characters in length.
"^DD",344.31,344.31,.15,21,0)
^.001^2^2^3100621^^
"^DD",344.31,344.31,.15,21,1,0)
This is the ACH trace # assigned by the Lockbox banking institution to
"^DD",344.31,344.31,.15,21,2,0)
this EFT detail record.
"^DD",344.31,344.31,.15,"DT")
3100621
"^DD",344.31,344.31,.16,0)
MANUAL TR DOCUMENT^F^^1;2^K:$L(X)>30!($L(X)<2)!'(X?1"TR".E) X
"^DD",344.31,344.31,.16,3)
Answer must be 2-30 characters in length.
"^DD",344.31,344.31,.16,21,0)
^.001^4^4^3100621^^^
"^DD",344.31,344.31,.16,21,1,0)
This is the TR document that was entered on-line to manually post the EFT
"^DD",344.31,344.31,.16,21,2,0)
detail to the correct accounts and remove them from FUND 5287.4, revenue
"^DD",344.31,344.31,.16,21,3,0)
source code 8NZZ. This is used when a RECEIPT was not used to
"^DD",344.31,344.31,.16,21,4,0)
automatically generate a TR document for the EFT detail record.
"^DD",344.31,344.31,.16,"DT")
3100621
"^DD",344.4,344.4,.02,0)
TRACE NUMBER^F^^0;2^K:$L(X)>50!($L(X)<3) X
"^DD",344.4,344.4,.02,1,0)
^.1^^0
"^DD",344.4,344.4,.02,3)
Answer must be 3-50 characters in length.
"^DD",344.4,344.4,.02,21,0)
^.001^2^2^3100621^^^^
"^DD",344.4,344.4,.02,21,1,0)
This is the bank trace number assigned to the ERA received.  If the ERA
"^DD",344.4,344.4,.02,21,2,0)
was paid by paper check, this should be the check #.
"^DD",344.4,344.4,.02,"DT")
3100622
"^DD",344.4,344.4,.13,0)
CHECK #^F^^5;2^K:$L(X)>50!($L(X)<1) X
"^DD",344.4,344.4,.13,3)
Answer must be 1-50 characters in length.
"^DD",344.4,344.4,.13,21,0)
^^2^2^3100621^
"^DD",344.4,344.4,.13,21,1,0)
This is the # of the paper check that was received for payment of this
"^DD",344.4,344.4,.13,21,2,0)
ERA.  
"^DD",344.4,344.4,.13,"DT")
3110523
"^DD",344.4,344.4,2,0)
ERA LEVEL ADJUSTMENTS^344.42A^^2;0
"^DD",344.4,344.4,2,21,0)
^^4^4^3021223^
"^DD",344.4,344.4,2,21,1,0)
This field holds the ERA level adjustments the payer has applied to the 
"^DD",344.4,344.4,2,21,2,0)
ERA.  These can be additional monies or less monies, depending on the   
"^DD",344.4,344.4,2,21,3,0)
type of adjustment (i.e. Takeback would be less money, interest would be
"^DD",344.4,344.4,2,21,4,0)
more money).
"^DD",344.4,344.4,3.02,0)
CONTACT NUMBER 1^F^^3;2^K:$L(X)>60!($L(X)<1) X
"^DD",344.4,344.4,3.02,3)
Answer must be 1-60 characters in length.
"^DD",344.4,344.4,3.02,21,0)
^.001^1^1^3100802^^
"^DD",344.4,344.4,3.02,21,1,0)
This is a phone #/telephone extension or email address for the contact.
"^DD",344.4,344.4,3.02,"DT")
3100802
"^DD",344.4,344.4,3.04,0)
CONTACT NUMBER 2^F^^3;4^K:$L(X)>60!($L(X)<1) X
"^DD",344.4,344.4,3.04,3)
Answer must be 1-60 characters in length.
"^DD",344.4,344.4,3.04,21,0)
^.001^1^1^3100802^^^^
"^DD",344.4,344.4,3.04,21,1,0)
This is a phone #/telephone extension or email address for the contact.
"^DD",344.4,344.4,3.04,"DT")
3100802
"^DD",344.4,344.4,3.06,0)
CONTACT NUMBER 3^F^^3;6^K:$L(X)>60!($L(X)<1) X
"^DD",344.4,344.4,3.06,3)
Answer must be 1-60 characters in length.
"^DD",344.4,344.4,3.06,21,0)
^.001^1^1^3100802^^^^
"^DD",344.4,344.4,3.06,21,1,0)
This is a phone #/telephone extension or email address for the contact.
"^DD",344.4,344.4,3.06,"DT")
3100802
"^DD",344.4,344.4,5.01,0)
PAYER WEB SITE ADDRESS^F^^5;1^K:$L(X)>115!($L(X)<1) X
"^DD",344.4,344.4,5.01,3)
Enter payer web site address (1-115 characters).
"^DD",344.4,344.4,5.01,21,0)
^.001^2^2^3100621^^
"^DD",344.4,344.4,5.01,21,1,0)
This is the web site for the payer. The source for this field is the 
"^DD",344.4,344.4,5.01,21,2,0)
contact data record (type '01') of the X12 835 received from FSC.
"^DD",344.4,344.4,5.01,23,0)
^.001^1^1^3100621^^
"^DD",344.4,344.4,5.01,23,1,0)
From 835 record 1000A PER04 where PER01 = "IC" and 1000A PER03 = "UR"
"^DD",344.4,344.4,5.01,"DT")
3100618
"^DD",344.4,344.41,.21,0)
RENDERING/SERVICING PROV NAME^F^^3;4^K:$L(X)>96!($L(X)<2) X
"^DD",344.4,344.41,.21,3)
Answer must be 2-96 characters in length.
"^DD",344.4,344.41,.21,21,0)
^.001^7^7^3100621^^
"^DD",344.4,344.41,.21,21,1,0)
This field holds the value of the "Rendering Provider Name" field 
"^DD",344.4,344.41,.21,21,2,0)
from the NM1 segment of the X12N 835.  It is last name (or servicing
"^DD",344.4,344.41,.21,21,3,0)
organization name) concatenated with a comma (if there is a first name)
"^DD",344.4,344.41,.21,21,4,0)
concatenated with the first name.  The last name is piece 18 of a line
"^DD",344.4,344.41,.21,21,5,0)
type of 10 in the 835ERA message and the first name is piece 19 of a line
"^DD",344.4,344.41,.21,21,6,0)
type of 10 in the 835ERA message transmitted from the Austin Information
"^DD",344.4,344.41,.21,21,7,0)
Technology Center.
"^DD",344.4,344.41,.21,"DT")
3100621
"^DD",344.4,344.41,.23,0)
REN PROV COMMENT^F^^4;1^K:$L(X)>80!($L(X)<3) X
"^DD",344.4,344.41,.23,3)
Answer must be 3-80 characters in length.
"^DD",344.4,344.41,.23,21,0)
^^2^2^3100621^
"^DD",344.4,344.41,.23,21,1,0)
This field is filled in with a comment if the Rendering/Servicing Provider
"^DD",344.4,344.41,.23,21,2,0)
NPI is not in correct format.
"^DD",344.4,344.41,.23,"DT")
3100621
"^DD",344.4,344.42,0)
ERA LEVEL ADJUSTMENTS SUB-FIELD^^.04^4
"^DD",344.4,344.42,0,"NM","ERA LEVEL ADJUSTMENTS")

"^DD",344.4,344.42,.01,0)
REFERENCE NUMBER^MF^^0;1^K:$L(X)>50!($L(X)<1) X
"^DD",344.4,344.42,.01,1,0)
^.1^^0
"^DD",344.4,344.42,.01,3)
Answer must be 1-50 characters in length.
"^DD",344.4,344.42,.01,"DT")
3100622
"^DD",344.4,344.42,.04,0)
ADJUSTMENT TEXT^F^^1;1^K:$L(X)>190!($L(X)<1) X
"^DD",344.4,344.42,.04,3)
Answer must be 1-190 characters in length.
"^DD",344.4,344.42,.04,21,0)
^^1^1^3100621^
"^DD",344.4,344.42,.04,21,1,0)
This is the text that describes the adjustment code.
"^DD",344.4,344.42,.04,"DT")
3100621
**END**
**END**