4. EPMO Open Source Coordination Office Redaction File Detail Report

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

4.1 Files compared

#	Location	File	Last Modified
1	PRCA_4.5_339_IB_2.568_Build 1_May_2018.zip	PRCA_45_339.KID	Thu May 24 14:49:30 2018 UTC
2	PRCA_4.5_339_IB_2.568_Build 1_May_2018.zip	PRCA_45_339.KID	Thu May 24 18:08:21 2018 UTC

4.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	3	12160
Changed	2	4
Inserted	0	0
Removed	0	0

4.3 Comparison options

Whitespace
Character case	Differences in character case are significant
Line endings	Differences in line endings (`CR` and `LF` characters) are ignored
CR/LF characters	Not shown in the comparison detail

4.4 Active regular expressions

No regular expressions were active.

4.5 Comparison detail

	1	Packman Ma il Message :
	2	========== ========== =
	3
	4	$END TXT
	5	$KID PRCA* 4.5*339
	6	INSTALL NAME
	7	PRCA4.53 39
	8	"BLD",1036 1,0)
	9	PRCA4.53 39^ACCOUNT S RECEIVAB LE^0^31804 23^y
	10	"BLD",1036 1,4,0)
	11	^9.64PA^^
	12	"BLD",1036 1,6.3)
	13	2
	14	"BLD",1036 1,"ABPKG")
	15	n
	16	"BLD",1036 1,"KRN",0)
	17	^9.67PA^77 9.2^20
	18	"BLD",1036 1,"KRN",.4 ,0)
	19	.4
	20	"BLD",1036 1,"KRN",.4 01,0)
	21	.401
	22	"BLD",1036 1,"KRN",.4 02,0)
	23	.402
	24	"BLD",1036 1,"KRN",.4 03,0)
	25	.403
	26	"BLD",1036 1,"KRN",.5 ,0)
	27	.5
	28	"BLD",1036 1,"KRN",.8 4,0)
	29	.84
	30	"BLD",1036 1,"KRN",3. 6,0)
	31	3.6
	32	"BLD",1036 1,"KRN",3. 8,0)
	33	3.8
	34	"BLD",1036 1,"KRN",9. 2,0)
	35	9.2
	36	"BLD",1036 1,"KRN",9. 8,0)
	37	9.8
	38	"BLD",1036 1,"KRN",9. 8,"NM",0)
	39	^9.68A^12^ 12
	40	"BLD",1036 1,"KRN",9. 8,"NM",1,0 )
	41	RCDPRTEX^^ 0^B6198793 1
	42	"BLD",1036 1,"KRN",9. 8,"NM",1,9 9999999)
	43	520824648^ 3180419.09 3048
	44	"BLD",1036 1,"KRN",9. 8,"NM",2,0 )
	45	RCDPRTP^^0 ^B14083064
	46	"BLD",1036 1,"KRN",9. 8,"NM",2,9 9999999)
	47	520824648^ 3180419.09 3048
	48	"BLD",1036 1,"KRN",9. 8,"NM",3,0 )
	49	RCDPRTP0^^ 0^B5415595 8
	50	"BLD",1036 1,"KRN",9. 8,"NM",3,9 9999999)
	51	520824648^ 3180419.09 3048
	52	"BLD",1036 1,"KRN",9. 8,"NM",4,0 )
	53	RCDPRTP1^^ 0^B4881542 5
	54	"BLD",1036 1,"KRN",9. 8,"NM",4,9 9999999)
	55	520824648^ 3180419.09 3048
	56	"BLD",1036 1,"KRN",9. 8,"NM",5,0 )
	57	RCTCSJR^^0 ^B12496018 8
	58	"BLD",1036 1,"KRN",9. 8,"NM",5,9 9999999)
	59	520824648^ 3180419.09 3048
	60	"BLD",1036 1,"KRN",9. 8,"NM",6,0 )
	61	RCTCSP1^^0 ^B17207287 5
	62	"BLD",1036 1,"KRN",9. 8,"NM",6,9 9999999)
	63	520824648^ 3180419.09 3048
	64	"BLD",1036 1,"KRN",9. 8,"NM",7,0 )
	65	RCTCSP2^^0 ^B13660604 6
	66	"BLD",1036 1,"KRN",9. 8,"NM",7,9 9999999)
	67	520824648^ 3180419.09 3048
	68	"BLD",1036 1,"KRN",9. 8,"NM",8,0 )
	69	RCTCSP4^^0 ^B22171697 1
	70	"BLD",1036 1,"KRN",9. 8,"NM",8,9 9999999)
	71	520824648^ 3180419.09 3048
	72	"BLD",1036 1,"KRN",9. 8,"NM",9,0 )
	73	RCTCSP5^^0 ^B10209552 6
	74	"BLD",1036 1,"KRN",9. 8,"NM",9,9 9999999)
	75	520824648^ 3180419.09 3048
	76	"BLD",1036 1,"KRN",9. 8,"NM",10, 0)
	77	RCTCSPD4^^ 0^B8889832 9
	78	"BLD",1036 1,"KRN",9. 8,"NM",10, 99999999)
	79	520824648^ 3180419.09 3048
	80	"BLD",1036 1,"KRN",9. 8,"NM",11, 0)
	81	RCTCSPD5^^ 0^B1994310 4
	82	"BLD",1036 1,"KRN",9. 8,"NM",11, 99999999)
	83	520824648^ 3180419.09 3048
	84	"BLD",1036 1,"KRN",9. 8,"NM",12, 0)
	85	RCTCSWL1^^ 0^B5406452 7
	86	"BLD",1036 1,"KRN",9. 8,"NM",12, 99999999)
	87	520824648^ 3180419.09 3048
	88	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCDPRTEX ",1)
	89
	90	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCDPRTP" ,2)
	91
	92	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCDPRTP0 ",3)
	93
	94	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCDPRTP1 ",4)
	95
	96	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCTCSJR" ,5)
	97
	98	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCTCSP1" ,6)
	99
	100	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCTCSP2" ,7)
	101
	102	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCTCSP4" ,8)
	103
	104	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCTCSP5" ,9)
	105
	106	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCTCSPD4 ",10)
	107
	108	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCTCSPD5 ",11)
	109
	110	"BLD",1036 1,"KRN",9. 8,"NM","B" ,"RCTCSWL1 ",12)
	111
	112	"BLD",1036 1,"KRN",19 ,0)
	113	19
	114	"BLD",1036 1,"KRN",19 .1,0)
	115	19.1
	116	"BLD",1036 1,"KRN",10 1,0)
	117	101
	118	"BLD",1036 1,"KRN",40 9.61,0)
	119	409.61
	120	"BLD",1036 1,"KRN",77 1,0)
	121	771
	122	"BLD",1036 1,"KRN",77 9.2,0)
	123	779.2
	124	"BLD",1036 1,"KRN",87 0,0)
	125	870
	126	"BLD",1036 1,"KRN",89 89.51,0)
	127	8989.51
	128	"BLD",1036 1,"KRN",89 89.52,0)
	129	8989.52
	130	"BLD",1036 1,"KRN",89 94,0)
	131	8994
	132	"BLD",1036 1,"KRN","B ",.4,.4)
	133
	134	"BLD",1036 1,"KRN","B ",.401,.40 1)
	135
	136	"BLD",1036 1,"KRN","B ",.402,.40 2)
	137
	138	"BLD",1036 1,"KRN","B ",.403,.40 3)
	139
	140	"BLD",1036 1,"KRN","B ",.5,.5)
	141
	142	"BLD",1036 1,"KRN","B ",.84,.84)
	143
	144	"BLD",1036 1,"KRN","B ",3.6,3.6)
	145
	146	"BLD",1036 1,"KRN","B ",3.8,3.8)
	147
	148	"BLD",1036 1,"KRN","B ",9.2,9.2)
	149
	150	"BLD",1036 1,"KRN","B ",9.8,9.8)
	151
	152	"BLD",1036 1,"KRN","B ",19,19)
	153
	154	"BLD",1036 1,"KRN","B ",19.1,19. 1)
	155
	156	"BLD",1036 1,"KRN","B ",101,101)
	157
	158	"BLD",1036 1,"KRN","B ",409.61,4 09.61)
	159
	160	"BLD",1036 1,"KRN","B ",771,771)
	161
	162	"BLD",1036 1,"KRN","B ",779.2,77 9.2)
	163
	164	"BLD",1036 1,"KRN","B ",870,870)
	165
	166	"BLD",1036 1,"KRN","B ",8989.51, 8989.51)
	167
	168	"BLD",1036 1,"KRN","B ",8989.52, 8989.52)
	169
	170	"BLD",1036 1,"KRN","B ",8994,899 4)
	171
	172	"BLD",1036 1,"QUES",0 )
	173	^9.62^^
	174	"BLD",1036 1,"REQB",0 )
	175	^9.611^1^1
	176	"BLD",1036 1,"REQB",1 ,0)
	177	PRCA4.53 15^2
	178	"BLD",1036 1,"REQB"," B","PRCA4 .5315",1)
	179
	180	"MBREQ")
	181	0
	182	"PKG",261, -1)
	183	1^1
	184	"PKG",261, 0)
	185	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	186	"PKG",261, 20,0)
	187	^9.402P^1^ 1
	188	"PKG",261, 20,1,0)
	189	2^^PRCAMRG
	190	"PKG",261, 20,1,1)
	191
	192	"PKG",261, 20,"B",2,1 )
	193
	194	"PKG",261, 22,0)
	195	^9.49I^1^1
	196	"PKG",261, 22,1,0)
	197	4.5^295032 0^2960503
	198	"PKG",261, 22,1,"PAH" ,1,0)
	199	339^318042 3
	200	"QUES","XP F1",0)
	201	Y
	202	"QUES","XP F1","??")
	203	^D REP^XPD H
	204	"QUES","XP F1","A")
	205	Shall I wr ite over y our \|FLAG\| File
	206	"QUES","XP F1","B")
	207	YES
	208	"QUES","XP F1","M")
	209	D XPF1^XPD IQ
	210	"QUES","XP F2",0)
	211	Y
	212	"QUES","XP F2","??")
	213	^D DTA^XPD H
	214	"QUES","XP F2","A")
	215	Want my da ta \|FLAG\| yours
	216	"QUES","XP F2","B")
	217	YES
	218	"QUES","XP F2","M")
	219	D XPF2^XPD IQ
	220	"QUES","XP I1",0)
	221	YO
	222	"QUES","XP I1","??")
	223	^D INHIBIT ^XPDH
	224	"QUES","XP I1","A")
	225	Want KIDS to INHIBIT LOGONs du ring the i nstall
	226	"QUES","XP I1","B")
	227	NO
	228	"QUES","XP I1","M")
	229	D XPI1^XPD IQ
	230	"QUES","XP M1",0)
	231	PO^VA(200, :EM
	232	"QUES","XP M1","??")
	233	^D MG^XPDH
	234	"QUES","XP M1","A")
	235	Enter the Coordinato r for Mail Group '\|F LAG\|'
	236	"QUES","XP M1","B")
	237
	238	"QUES","XP M1","M")
	239	D XPM1^XPD IQ
	240	"QUES","XP O1",0)
	241	Y
	242	"QUES","XP O1","??")
	243	^D MENU^XP DH
	244	"QUES","XP O1","A")
	245	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	246	"QUES","XP O1","B")
	247	NO
	248	"QUES","XP O1","M")
	249	D XPO1^XPD IQ
	250	"QUES","XP Z1",0)
	251	Y
	252	"QUES","XP Z1","??")
	253	^D OPT^XPD H
	254	"QUES","XP Z1","A")
	255	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	256	"QUES","XP Z1","B")
	257	NO
	258	"QUES","XP Z1","M")
	259	D XPZ1^XPD IQ
	260	"QUES","XP Z2",0)
	261	Y
	262	"QUES","XP Z2","??")
	263	^D RTN^XPD H
	264	"QUES","XP Z2","A")
	265	Want to MO VE routine s to other CPUs
	266	"QUES","XP Z2","B")
	267	NO
	268	"QUES","XP Z2","M")
	269	D XPZ2^XPD IQ
	270	"RTN")
	271	12
	272	"RTN","RCD PRTEX")
	273	0^1^B61987 931^n/a
	274	"RTN","RCD PRTEX",1,0 )
	275	RCDPRTEX ; ALB/LMH - Claims Mat ching Repo rt for Exc el ;30-SEP 2016
	276	"RTN","RCD PRTEX",2,0 )
	277	;;4.5;Acc ounts Rece ivable;3 15,339;M ar 20, 199 5;Build 2
	278	"RTN","RCD PRTEX",3,0 )
	279	;;Per VA Directive 6402, this routine s hould not be modifie d.
	280	"RTN","RCD PRTEX",4,0 )
	281	;
	282	"RTN","RCD PRTEX",5,0 )
	283	Q
	284	"RTN","RCD PRTEX",6,0 )
	285	;
	286	"RTN","RCD PRTEX",7,0 )
	287	PRINT ; En try point for printi ng the Exc el version of the re port (eith er in fore ground or background )
	288	"RTN","RCD PRTEX",8,0 )
	289	; Input:
	290	"RTN","RCD PRTEX",9,0 )
	291	; RCEX CEL=1 here
	292	"RTN","RCD PRTEX",10, 0)
	293	; Output:
	294	"RTN","RCD PRTEX",11, 0)
	295	; Repo rt is prin ted in tex t format f or Excel ( turn on lo gging)
	296	"RTN","RCD PRTEX",12, 0)
	297	;
	298	"RTN","RCD PRTEX",13, 0)
	299	U IO
	300	"RTN","RCD PRTEX",14, 0)
	301	K ^TMP("R CDPRTPB",$ J),^TMP("I BRBT",$J), ^TMP("IBRB F",$J)
	302	"RTN","RCD PRTEX",15, 0)
	303	N
	304	DAT,RCBIL, RCBIL0,RCN AM,RCPAY,R CPAY1,RCRE C,RCREC1,R CRECTDA,RC SSN,RCTYP, CRT,DIR,DI ROUT,DIR
	305	UT,DTOUT,D UOUT
	306	"RTN","RCD PRTEX",16, 0)
	307	N RCSTOP, PAGE,SEPLI NE,X,XX,Y, RCNO
	308	"RTN","RCD PRTEX",17, 0)
	309	S CRT=$S( IOST["C-": 1,1:0) ; 1 - Print t o Screen, 0 - Otherw ise
	310	"RTN","RCD PRTEX",18, 0)
	311	I '$D(ZTQ UEUED) U 0 W !!?5,"C ompiling C laims Matc hing Repor t for Exce l output. Please wai t ... " U IO
	312	"RTN","RCD PRTEX",19, 0)
	313	;
	314	"RTN","RCD PRTEX",20, 0)
	315	; build t he initial ^TMP("RCD PRTPB",$J) scratch g lobal
	316	"RTN","RCD PRTEX",21, 0)
	317	D
	318	@($S(RCSOR T=1:"PAT", RCSORT=2:" BILL",RCSO RT=3:"DATE ",RCSORT=4 :"REC",RCS ORT=5:"TYP E")_"^RCD
	319	PRTP0")
	320	"RTN","RCD PRTEX",22, 0)
	321	;
	322	"RTN","RCD PRTEX",23, 0)
	323	S IOSL=99 9999 ; Lon g screen l ength for Excel outp ut
	324	"RTN","RCD PRTEX",24, 0)
	325	S PAGE=0, RCSTOP=0,$ P(SEPLINE, "-",81)=""
	326	"RTN","RCD PRTEX",25, 0)
	327	;
	328	"RTN","RCD PRTEX",26, 0)
	329	I '$D(^TM P("RCDPRTP B",$J)) D Q
	330	"RTN","RCD PRTEX",27, 0)
	331	. W:CRT @ IOF W:'CRT $C(13) ; initial form feed or page r eset for n o data fou nd
	332	"RTN","RCD PRTEX",28, 0)
	333	. W !!?5, "No data f ound for t his report ."
	334	"RTN","RCD PRTEX",29, 0)
	335	. I CRT,' $D(ZTQUEUE D) S DIR(0 )="E" D ^D IR K DIR
	336	"RTN","RCD PRTEX",30, 0)
	337	. D ^%ZIS C
	338	"RTN","RCD PRTEX",31, 0)
	339	. Q
	340	"RTN","RCD PRTEX",32, 0)
	341	;
	342	"RTN","RCD PRTEX",33, 0)
	343	START ;
	344	"RTN","RCD PRTEX",34, 0)
	345	N RCPAT0, NAME,BILLN UM,BILLFRO M,BILLTO,R XCOV,RCIBF N,DOB,AMT, CHGTYP,STA TUS
	346	"RTN","RCD PRTEX",35, 0)
	347	N RCH,AMT 1,PAYOR,PS T,FILLFROM ,FILLTO,ON HOLD,RCAMT ,RCAMT1,RC IBDAT,STRI NG,RCBILL0
	348	"RTN","RCD PRTEX",36, 0)
	349	N
	350	RCQ,RCSSN, RCTP,RCEXN AM,ELIG,FP CBILL,POST DATE,RCDOB ,RCFLAG,BA L,DATE,DEB TOR,RCDATE ,RCDEB
	351	TOR,RCNAME
	352	"RTN","RCD PRTEX",37, 0)
	353	D EXCELHD
	354	"RTN","RCD PRTEX",38, 0)
	355	;
	356	"RTN","RCD PRTEX",39, 0)
	357	S RCNAM=" " F S RCN AM=$O(^TMP ("RCDPRTPB ",$J,RCNAM )) Q:RCNAM ="" D
	358	"RTN","RCD PRTEX",40, 0)
	359	.S RCBILL =0 F S RC BILL=$O(^T MP("RCDPRT PB",$J,RCN AM,RCBILL) ) Q:'RCBIL L D
	360	"RTN","RCD PRTEX",41, 0)
	361	..D DEMOG
	362	"RTN","RCD PRTEX",42, 0)
	363	..D PROC^ RCDPRTP1 ; Proces s each thi rd party b ill for a patient.
	364	"RTN","RCD PRTEX",43, 0)
	365	..K ^TMP( "IBRBT",$J ),^TMP("IB RBF",$J)
	366	"RTN","RCD PRTEX",44, 0)
	367	;
	368	"RTN","RCD PRTEX",45, 0)
	369	D ^%ZISC
	370	"RTN","RCD PRTEX",46, 0)
	371	K ^TMP("R CDPRTPB",$ J)
	372	"RTN","RCD PRTEX",47, 0)
	373	Q
	374	"RTN","RCD PRTEX",48, 0)
	375	;
	376	"RTN","RCD PRTEX",49, 0)
	377	DEMOG ; De mographic data for t hird party bills &
	378	"RTN","RCD PRTEX",50, 0)
	379	; first part y charges detail lin e header
	380	"RTN","RCD PRTEX",51, 0)
	381	;
	382	"RTN","RCD PRTEX",52, 0)
	383	S RCPAT0= $G(^TMP("R CDPRTPB",$ J,RCNAM))
	384	"RTN","RCD PRTEX",53, 0)
	385	S DATE=$G (^TMP("RCD PRTPB",$J, RCNAM,RCBI LL))
	386	"RTN","RCD PRTEX",54, 0)
	387	S RCNAME= $P(RCNAM," ^")
	388	"RTN","RCD PRTEX",55, 0)
	389	S RCBILL0 =$G(^PRCA( 430,RCBILL ,0))
	390	"RTN","RCD PRTEX",56, 0)
	391	S RCDFN=$ P($G(^PRCA (430,RCBIL L,0)),U,7)
	392	"RTN","RCD PRTEX",57, 0)
	393	S RCDOB=$ P($G(^DPT( RCDFN,0)), U,3)
	394	"RTN","RCD PRTEX",58, 0)
	395	S DOB=$$F MTE^XLFDT( RCDOB,"5Z" )
	396	"RTN","RCD PRTEX",59, 0)
	397	S DEBTOR= $P($G(RCBI LL0),U,9)
	398	"RTN","RCD PRTEX",60, 0)
	399	S RCDEBTO R=$O(^RCD( 340,"B",RC DFN_";DPT( ",0)) Q:'R CDEBTOR
	400	"RTN","RCD PRTEX",61, 0)
	401	S RCSSN=$ $SSN^RCFN0 1($G(RCDEB TOR))
	402	"RTN","RCD PRTEX",62, 0)
	403	S ELIG=$P ($G(RCPAT0 ),U,2)
	404	"RTN","RCD PRTEX",63, 0)
	405	Q
	406	"RTN","RCD PRTEX",64, 0)
	407	;
	408	"RTN","RCD PRTEX",65, 0)
	409	PRNTPAT ; setup & pr int third party bill s (called by PROC^RC DPRTP1 for Excel out put only)
	410	"RTN","RCD PRTEX",66, 0)
	411	S RCTP=RC BILL,RCIBD AT=$G(^TMP ("IBRBT",$ J,RCBILL,R CBILL))
	412	"RTN","RCD PRTEX",67, 0)
	413	S STATUS= $$STAT^RCD PRTP2(RCTP ) Q:STATUS ="CN"!(STA TUS="CB") ;Added a last minut e check fo r
	414	cancelled third part y bills
	415	"RTN","RCD PRTEX",68, 0)
	416	S RXCOV=$ S('$G(^TMP ("IBRBT",$ J,RCBILL)) :"NO",1:"Y ES")
	417	"RTN","RCD PRTEX",69, 0)
	418	S BILLNUM =$P(RCIBDA T,U,4) ; B ILL #
	419	"RTN","RCD PRTEX",70, 0)
	420	S PST=$P( RCIBDAT,U, 5) ; P/S/T
	421	"RTN","RCD PRTEX",71, 0)
	422	S BILLFRO M=$$DATE^R CDPRTP2($P (RCIBDAT,U )) ; bill date from
	423	"RTN","RCD PRTEX",72, 0)
	424	S BILLTO= $$DATE^RCD PRTP2($P(R CIBDAT,U,2 )) ; bill date to
	425	"RTN","RCD PRTEX",73, 0)
	426	S RCDATE= $S($G(RCTP (RCTP)):RC TP(RCTP),$ G(^TMP("RC DPRTPB",$J ,RCNAM,RCB ILL)):^(RC BILL),1:"" ) I
	427	RCTP=RCBIL L!($D(RCTP (RCTP))) S POSTDATE= $$DATE^RCD PRTP2(RCDA TE)
	428	"RTN","RCD PRTEX",74, 0)
	429	S RCIBFN= RCTP
	430	"RTN","RCD PRTEX",75, 0)
	431	S RCDATE= $P($G(^PRC A(430,+RCT P,0)),U,14 )
	432	"RTN","RCD PRTEX",76, 0)
	433	S POSTDAT E=$S(RCDAT E=DATE:$$D ATE^RCDPRT P2(RCDATE) ,RCDATE'=D ATE:"^")
	434	"RTN","RCD PRTEX",77, 0)
	435	S PAYOR=$ P(RCIBDAT, U,7) ; pay or
	436	"RTN","RCD PRTEX",78, 0)
	437	S RCAMT=$ P($G(^PRCA (430,+RCTP ,0)),"^",3 ) ; amt bi lled
	438	"RTN","RCD PRTEX",79, 0)
	439	S RCAMT1= $P($G(^PRC A(430,+RCT P,7)),"^", 7) ; amt p aid
	440	"RTN","RCD PRTEX",80, 0)
	441	S RCTYPE= $$TYP^IBRF N(RCTP) ;T hird party bill type of care
	442	"RTN","RCD PRTEX",81, 0)
	443	S RCTYPE= $S(RCTYPE= "":-1,RCTY PE="PR":"P ",RCTYPE=" PH":"R",1: RCTYPE)
	444	"RTN","RCD PRTEX",82, 0)
	445	S RCFLAG= RCTYPE
	446	"RTN","RCD PRTEX",83, 0)
	447	S RCTP=RC BILL
	448	"RTN","RCD PRTEX",84, 0)
	449	D EXCELPA T
	450	"RTN","RCD PRTEX",85, 0)
	451	;
	452	"RTN","RCD PRTEX",86, 0)
	453	EXCELTPB ; print oth er assoc. third part y bills
	454	"RTN","RCD PRTEX",87, 0)
	455	S RCTP=0 F S RCTP= $O(^TMP("I BRBT",$J,R CBILL,RCTP )) Q:'RCTP D
	456	"RTN","RCD PRTEX",88, 0)
	457	.S STATUS =$$STAT^RC DPRTP2(RCT P) Q:STATU S="CN"!(ST ATUS="CB") ;Added a last minu te check f or
	458	cancelled third part y bills
	459	"RTN","RCD PRTEX",89, 0)
	460	.I RCBILL =RCTP Q ; don't rep rint the b ill that w as paid.
	461	"RTN","RCD PRTEX",90, 0)
	462	.S RCIBDA T=$G(^TMP( "IBRBT",$J ,RCBILL,RC TP))
	463	"RTN","RCD PRTEX",91, 0)
	464	.I 'RCAN, ($P(RCIBDA T,"^",3)) Q ; exclu de cancell ed bills
	465	"RTN","RCD PRTEX",92, 0)
	466	.D DEMOG
	467	"RTN","RCD PRTEX",93, 0)
	468	.S RXCOV= $S('$G(^TM P("IBRBT", $J,RCBILL) ):"NO",1:" YES")
	469	"RTN","RCD PRTEX",94, 0)
	470	.S BILLNU M=$P(RCIBD AT,U,4) ; BILL #
	471	"RTN","RCD PRTEX",95, 0)
	472	.S PST=$P (RCIBDAT,U ,5) ; P/S/ T
	473	"RTN","RCD PRTEX",96, 0)
	474	.S BILLFR OM=$$DATE^ RCDPRTP2($ P(RCIBDAT, U)) ; bill date from
	475	"RTN","RCD PRTEX",97, 0)
	476	.S BILLTO =$$DATE^RC DPRTP2($P( RCIBDAT,U, 2)) ; bill date to
	477	"RTN","RCD PRTEX",98, 0)
	478	.S RCDATE =$P($G(^PR CA(430,+RC TP,0)),U,1 4)
	479	"RTN","RCD PRTEX",99, 0)
	480	.S POSTDA TE=$S(RCDA TE=DATE:$$ DATE^RCDPR TP2(RCDATE ),RCDATE'= DATE:"^")
	481	"RTN","RCD PRTEX",100 ,0)
	482	.S RCIBFN =RCTP
	483	"RTN","RCD PRTEX",101 ,0)
	484	.S PAYOR= $P(RCIBDAT ,U,7) ; pa yor
	485	"RTN","RCD PRTEX",102 ,0)
	486	.S RCAMT= $P($G(^PRC A(430,+RCT P,0)),"^", 3) ; amt b illed
	487	"RTN","RCD PRTEX",103 ,0)
	488	.S RCAMT1 =$P($G(^PR CA(430,+RC TP,7)),"^" ,7) ; amt paid
	489	"RTN","RCD PRTEX",104 ,0)
	490	.S RCTYPE =$$TYP^IBR FN(RCTP) ; Third part y bill typ e of care
	491	"RTN","RCD PRTEX",105 ,0)
	492	.S RCTYPE =$S(RCTYPE ="":-1,RCT YPE="PR":" P",RCTYPE= "PH":"R",1 :RCTYPE)
	493	"RTN","RCD PRTEX",106 ,0)
	494	.D EXCELP AT
	495	"RTN","RCD PRTEX",107 ,0)
	496	;
	497	"RTN","RCD PRTEX",108 ,0)
	498	PRNTFPC ; print asso ciated fir st party c harges
	499	"RTN","RCD PRTEX",109 ,0)
	500	; This co de screens entries f rom file 3 50.1 retur ned by API - RELBILL ^IBRFN
	501	"RTN","RCD PRTEX",110 ,0)
	502	N RCACTYP ,I,J ;D o the next section o f code onl y if Care Types were selected - Stored i n RCTYPE([ care
	503	type])
	504	"RTN","RCD PRTEX",111 ,0)
	505	; We must loop thro ugh all Bi lls and Fi rst party charges fo r this scr eening
	506	"RTN","RCD PRTEX",112 ,0)
	507	I $D(RCTY PE)>1 S I= 0 F S I=$ O(^TMP("IB RBF",$J,I) ) Q:'I S J=0 F S J =$O(^TMP(" IBRBF",$J, I,J)) Q:'J D
	508	"RTN","RCD PRTEX",113 ,0)
	509	. S RCACT YP=$P(^TMP ("IBRBF",$ J,I,J),U,6 ) Q:RCACTY P="" ;6th piece is Action Typ e
	510	"RTN","RCD PRTEX",114 ,0)
	511	. I RCACT YP["TRICAR E"!(RCACTY P["CHAMPA" ) Q ;Not needed for screening 1st party charges
	512	"RTN","RCD PRTEX",115 ,0)
	513	. I RCACT YP["RX" S RCTYP="R" D KILFPTY^ RCDPRTP1 Q
	514	"RTN","RCD PRTEX",116 ,0)
	515	. I RCACT YP["OPT"!( RCACTYP["O BSERV") S RCTYP="O" D KILFPTY^ RCDPRTP1 Q
	516	"RTN","RCD PRTEX",117 ,0)
	517	. I RCACT YP["INPT"! (RCACTYP[" NHCU")!(RC ACTYP["ADM IS")!(RCAC TYP["MEDIC ARE DECUCT IBLE") S
	518	RCTYP="I" D KILFPTY^ RCDPRTP1 Q
	519	"RTN","RCD PRTEX",118 ,0)
	520	. Q
	521	"RTN","RCD PRTEX",119 ,0)
	522	;
	523	"RTN","RCD PRTEX",120 ,0)
	524	S RCTP(0) =0 F S RC TP(0)=$O(^ TMP("IBRBF ",$J,RCTP( 0))) Q:'RC TP(0)!$G(R CQ) D
	525	"RTN","RCD PRTEX",121 ,0)
	526	.S RCTP=0 F S RCTP =$O(^TMP(" IBRBF",$J, RCTP(0),RC TP)) Q:'RC TP!$G(RCQ) D
	527	"RTN","RCD PRTEX",122 ,0)
	528	..S RCNO= 1
	529	"RTN","RCD PRTEX",123 ,0)
	530	..S RCIBD AT=$G(^TMP ("IBRBF",$ J,RCTP(0), RCTP))
	531	"RTN","RCD PRTEX",124 ,0)
	532	..S RCIBF N=$P(RCIBD AT,U,4) I RCIBFN S R CIBFN=$O(^ PRCA(430," B",RCIBFN, 0))
	533	"RTN","RCD PRTEX",125 ,0)
	534	..D DEMOG
	535	"RTN","RCD PRTEX",126 ,0)
	536	..S RXCOV =$S('$G(^T MP("IBRBT" ,$J,RCBILL )):"NO",1: "YES")
	537	"RTN","RCD PRTEX",127 ,0)
	538	..S FILLF ROM=$$DATE ^RCDPRTP2( +RCIBDAT) ; Bill fro m
	539	"RTN","RCD PRTEX",128 ,0)
	540	..S FILLT O=$$DATE^R CDPRTP2($P (RCIBDAT,U ,2)) ; Bil l to
	541	"RTN","RCD PRTEX",129 ,0)
	542	..S CHGTY P=$P(RCIBD AT,U,6)
	543	"RTN","RCD PRTEX",130 ,0)
	544	..S RCIBF N=$P(RCIBD AT,"^",4) I RCIBFN S RCIBFN=$O (^PRCA(430 ,"B",RCIBF N,0))
	545	"RTN","RCD PRTEX",131 ,0)
	546	..S FPCBI LL=$P(RCIB DAT,U,4)
	547	"RTN","RCD PRTEX",132 ,0)
	548	..S STATU S=$$STAT^R CDPRTP2(RC IBFN) ; St atus
	549	"RTN","RCD PRTEX",133 ,0)
	550	..S ONHOL D=$P(RCIBD AT,U,7) ; # Days On Hold
	551	"RTN","RCD PRTEX",134 ,0)
	552	..S AMT=$ P(RCIBDAT, U,5) ; Amo unt billed
	553	"RTN","RCD PRTEX",135 ,0)
	554	..S
	555	BAL=$S($G( ^PRCA(430, +RCIBFN,7) ):+($P(^(7 ),"^")+$P( ^(7),"^",2 )+$P(^(7), "^",3)+$P( ^(7),"^",4 )+$P(^(7), "
	556	^",4)),1:0 )
	557	"RTN","RCD PRTEX",136 ,0)
	558	..D EXCEL FPC
	559	"RTN","RCD PRTEX",137 ,0)
	560	.Q
	561	"RTN","RCD PRTEX",138 ,0)
	562	Q
	563	"RTN","RCD PRTEX",139 ,0)
	564	;
	565	"RTN","RCD PRTEX",140 ,0)
	566	EXCELHD ; Print an E xcel CSV h eader reco rd
	567	"RTN","RCD PRTEX",141 ,0)
	568	;
	569	"RTN","RCD PRTEX",142 ,0)
	570	; Input: None
	571	"RTN","RCD PRTEX",143 ,0)
	572	; Output: Header li ne printed for CSV f ormat (exc el)
	573	"RTN","RCD PRTEX",144 ,0)
	574	;
	575	"RTN","RCD PRTEX",145 ,0)
	576	W:CRT @IO F W:'CRT $ C(13) ; initial f orm feed o r page res et for Exc el header line
	577	"RTN","RCD PRTEX",146 ,0)
	578	N RCH
	579	"RTN","RCD PRTEX",147 ,0)
	580	S STRING= ""
	581	"RTN","RCD PRTEX",148 ,0)
	582	S RCH=$$C SV("","Pat ient")
	583	"RTN","RCD PRTEX",149 ,0)
	584	S RCH=$$C SV(RCH,"SS N")
	585	"RTN","RCD PRTEX",150 ,0)
	586	S RCH=$$C SV(RCH,"DO B")
	587	"RTN","RCD PRTEX",151 ,0)
	588	S RCH=$$C SV(RCH,"Pr im. Elig")
	589	"RTN","RCD PRTEX",152 ,0)
	590	S RCH=$$C SV(RCH,"RX Cvg")
	591	"RTN","RCD PRTEX",153 ,0)
	592	S RCH=$$C SV(RCH,"Bi ll Type")
	593	"RTN","RCD PRTEX",154 ,0)
	594	S RCH=$$C SV(RCH,"Bi ll#")
	595	"RTN","RCD PRTEX",155 ,0)
	596	S RCH=$$C SV(RCH,"P/ S/T")
	597	"RTN","RCD PRTEX",156 ,0)
	598	S RCH=$$C SV(RCH,"Ch g Type")
	599	"RTN","RCD PRTEX",157 ,0)
	600	S RCH=$$C SV(RCH,"St atus")
	601	"RTN","RCD PRTEX",158 ,0)
	602	S RCH=$$C SV(RCH,"Bi ll From")
	603	"RTN","RCD PRTEX",159 ,0)
	604	S RCH=$$C SV(RCH,"Bi ll To")
	605	"RTN","RCD PRTEX",160 ,0)
	606	S RCH=$$C SV(RCH,"Po sted")
	607	"RTN","RCD PRTEX",161 ,0)
	608	S RCH=$$C SV(RCH,"Am t Billed")
	609	"RTN","RCD PRTEX",162 ,0)
	610	S RCH=$$C SV(RCH,"Am t Pd")
	611	"RTN","RCD PRTEX",163 ,0)
	612	S RCH=$$C SV(RCH,"Ba l")
	613	"RTN","RCD PRTEX",164 ,0)
	614	S RCH=$$C SV(RCH,"Ca re Type")
	615	"RTN","RCD PRTEX",165 ,0)
	616	S RCH=$$C SV(RCH,"On Hold")
	617	"RTN","RCD PRTEX",166 ,0)
	618	S RCH=$$C SV(RCH,"Pa yor")
	619	"RTN","RCD PRTEX",167 ,0)
	620	W RCH
	621	"RTN","RCD PRTEX",168 ,0)
	622	Q
	623	"RTN","RCD PRTEX",169 ,0)
	624	;
	625	"RTN","RCD PRTEX",170 ,0)
	626	EXCELPAT ; Print pat ient third party bil ls
	627	"RTN","RCD PRTEX",171 ,0)
	628	;
	629	"RTN","RCD PRTEX",172 ,0)
	630	; Input: None
	631	"RTN","RCD PRTEX",173 ,0)
	632	; Output: Detail li ne printed for CSV f ormat (exc el)
	633	"RTN","RCD PRTEX",174 ,0)
	634	;
	635	"RTN","RCD PRTEX",175 ,0)
	636	N RCD
	637	"RTN","RCD PRTEX",176 ,0)
	638	S STRING= ""
	639	"RTN","RCD PRTEX",177 ,0)
	640	S RCD=$$C SV("",RCNA ME)_"^"_$E (RCNAME,1) _$E(RCSSN, 6,9)
	641	"RTN","RCD PRTEX",178 ,0)
	642	S RCD=$$C SV(RCD,DOB )
	643	"RTN","RCD PRTEX",179 ,0)
	644	S RCD=$$C SV(RCD,ELI G)
	645	"RTN","RCD PRTEX",180 ,0)
	646	S RCD=$$C SV(RCD,RXC OV)
	647	"RTN","RCD PRTEX",181 ,0)
	648	S RCD=$$C SV(RCD,"Th ird Party Bill")
	649	"RTN","RCD PRTEX",182 ,0)
	650	S RCD=$$C SV(RCD,BIL LNUM)
	651	"RTN","RCD PRTEX",183 ,0)
	652	S RCD=$$C SV(RCD,PST )
	653	"RTN","RCD PRTEX",184 ,0)
	654	S RCD=$$C SV(RCD,"^" )
	655	"RTN","RCD PRTEX",185 ,0)
	656	S RCD=$$C SV(RCD,STA TUS)
	657	"RTN","RCD PRTEX",186 ,0)
	658	S RCD=$$C SV(RCD,BIL LFROM)
	659	"RTN","RCD PRTEX",187 ,0)
	660	S RCD=$$C SV(RCD,BIL LTO)
	661	"RTN","RCD PRTEX",188 ,0)
	662	S RCD=$$C SV(RCD,POS TDATE)
	663	"RTN","RCD PRTEX",189 ,0)
	664	S RCD=$$C SV(RCD,RCA MT)
	665	"RTN","RCD PRTEX",190 ,0)
	666	S RCD=$$C SV(RCD,RCA MT1)
	667	"RTN","RCD PRTEX",191 ,0)
	668	S RCD=$$C SV(RCD,"^" )
	669	"RTN","RCD PRTEX",192 ,0)
	670	S RCD=$$C SV(RCD,RCT YPE)
	671	"RTN","RCD PRTEX",193 ,0)
	672	S RCD=$$C SV(RCD,"^" )
	673	"RTN","RCD PRTEX",194 ,0)
	674	S RCD=$$C SV(RCD,PAY OR)
	675	"RTN","RCD PRTEX",195 ,0)
	676	W !,RCD
	677	"RTN","RCD PRTEX",196 ,0)
	678	K RCTP(RC TP)
	679	"RTN","RCD PRTEX",197 ,0)
	680	Q
	681	"RTN","RCD PRTEX",198 ,0)
	682	;
	683	"RTN","RCD PRTEX",199 ,0)
	684	EXCELFPC ; Print pat ient first party cha rges
	685	"RTN","RCD PRTEX",200 ,0)
	686	;
	687	"RTN","RCD PRTEX",201 ,0)
	688	; Input: None
	689	"RTN","RCD PRTEX",202 ,0)
	690	; Output: Detail li ne printed for CSV f ormat (exc el)
	691	"RTN","RCD PRTEX",203 ,0)
	692	;
	693	"RTN","RCD PRTEX",204 ,0)
	694	N RCB
	695	"RTN","RCD PRTEX",205 ,0)
	696	S STRING= ""
	697	"RTN","RCD PRTEX",206 ,0)
	698	S RCB=$$C SV("",RCNA ME)_"^"_$E (RCNAME,1) _$E(RCSSN, 6,9)
	699	"RTN","RCD PRTEX",207 ,0)
	700	S RCB=$$C SV(RCB,DOB )
	701	"RTN","RCD PRTEX",208 ,0)
	702	S RCB=$$C SV(RCB,ELI G)
	703	"RTN","RCD PRTEX",209 ,0)
	704	S RCB=$$C SV(RCB,"^" )
	705	"RTN","RCD PRTEX",210 ,0)
	706	S RCB=$$C SV(RCB,"Fi rst Party Charge")
	707	"RTN","RCD PRTEX",211 ,0)
	708	S RCB=$$C SV(RCB,FPC BILL)
	709	"RTN","RCD PRTEX",212 ,0)
	710	S RCB=$$C SV(RCB,"^" )
	711	"RTN","RCD PRTEX",213 ,0)
	712	S RCB=$$C SV(RCB,CHG TYP)
	713	"RTN","RCD PRTEX",214 ,0)
	714	S RCB=$$C SV(RCB,STA TUS)
	715	"RTN","RCD PRTEX",215 ,0)
	716	S RCB=$$C SV(RCB,FIL LFROM)
	717	"RTN","RCD PRTEX",216 ,0)
	718	S RCB=$$C SV(RCB,FIL LTO)
	719	"RTN","RCD PRTEX",217 ,0)
	720	S RCB=$$C SV(RCB,"^" )
	721	"RTN","RCD PRTEX",218 ,0)
	722	S RCB=$$C SV(RCB,AMT )
	723	"RTN","RCD PRTEX",219 ,0)
	724	S RCB=$$C SV(RCB,"^" )
	725	"RTN","RCD PRTEX",220 ,0)
	726	S RCB=$$C SV(RCB,BAL )
	727	"RTN","RCD PRTEX",221 ,0)
	728	S RCB=$$C SV(RCB,"^" )
	729	"RTN","RCD PRTEX",222 ,0)
	730	S RCB=$$C SV(RCB,ONH OLD)
	731	"RTN","RCD PRTEX",223 ,0)
	732	W !,RCB
	733	"RTN","RCD PRTEX",224 ,0)
	734	Q
	735	"RTN","RCD PRTEX",225 ,0)
	736	;
	737	"RTN","RCD PRTEX",226 ,0)
	738	CSV(STRING ,DATA) ; B uild the E xcel data string for CSV forma t
	739	"RTN","RCD PRTEX",227 ,0)
	740	; Input: STRING - C urrent str ing being built or " "
	741	"RTN","RCD PRTEX",228 ,0)
	742	; DATA - New data t o be added to the st ring
	743	"RTN","RCD PRTEX",229 ,0)
	744	; Returns : STRING - Updated s tring with DATA adde d
	745	"RTN","RCD PRTEX",230 ,0)
	746	;
	747	"RTN","RCD PRTEX",231 ,0)
	748	S DATA="" _$TR(DATA, $C(94))
	749	"RTN","RCD PRTEX",232 ,0)
	750	S STRING= $S(STRING= "":DATA,1: STRING_"^" _DATA)
	751	"RTN","RCD PRTEX",233 ,0)
	752	Q STRING
	753	"RTN","RCD PRTEX",234 ,0)
	754	;
	755	"RTN","RCD PRTP")
	756	0^2^B14083 064^B83050 80
	757	"RTN","RCD PRTP",1,0)
	758	RCDPRTP ; ALB/LDB-CL AIMS MATCH ING REPORT ;1/11/01 2:03 PM
	759	"RTN","RCD PRTP",2,0)
	760	;;4.5;Acc ounts Rece ivable;1 51,186,315 ,339;Mar 20, 1995; Build 2
	761	"RTN","RCD PRTP",3,0)
	762	;;Per VA Directive 6402, this routine s hould not be modifie d.
	763	"RTN","RCD PRTP",4,0)
	764	;
	765	"RTN","RCD PRTP",5,0)
	766	EN ;
	767	"RTN","RCD PRTP",6,0)
	768	N
	769	DATEEND,DA TESTRT,DIC ,DIR,DIRUT ,POP,RCBIL L,RCDEBT,R CDFN,RCPT, RCSORT,RCQ UIT,%ZIS,Z TDESC,ZTS
	770	AVE,ZTRTN, Y,RCAN,DIO END,ZTIO,R CTYPE
	771	"RTN","RCD PRTP",7,0)
	772	W !
	773	"RTN","RCD PRTP",8,0)
	774	K DIRUT S DIR(0)="S ^1:Patient ;2:Bill Nu mber;3:Pay ment dates ;4:Receipt Number;5: Care
	775	Types",DIR ("A")="Sor t by" D ^D IR K DIR Q :$D(DIRUT)
	776	"RTN","RCD PRTP",9,0)
	777	S RCSORT= Y,RCQUIT=" "
	778	"RTN","RCD PRTP",10,0 )
	779	D @RCSORT Q:RCQUIT W !
	780	"RTN","RCD PRTP",11,0 )
	781	K DIRUT S DIR(0)="Y ",DIR("A") ="Include cancelled bills",DIR ("B")="NO" D ^DIR S RCAN=+Y Q: $D(DIRUT)
	782	"RTN","RCD PRTP",12,0 )
	783	;
	784	"RTN","RCD PRTP",13,0 )
	785	; if user wants Exc el output, then call the devic e question for Excel and then quit
	786	"RTN","RCD PRTP",14,0 )
	787	I $$FORMA T^RCDPRTP0 (.RCEXCEL) D DEVICE^ RCDPRTP0 Q ; exit point for Excel outp ut
	788	"RTN","RCD PRTP",15,0 )
	789	Q:RCQUIT
	790	"RTN","RCD PRTP",16,0 )
	791	;
	792	"RTN","RCD PRTP",17,0 )
	793	; At this point, th e user wan ts non-Exc el output. Ask devi ce questio n for non- Excel outp ut.
	794	"RTN","RCD PRTP",18,0 )
	795	W !!,"Thi s report r equires 13 2 columns. ",!!
	796	"RTN","RCD PRTP",19,0 )
	797	K IOP,IO( "Q") S %ZI S="MQ",%ZI S("B")="" D ^%ZIS Q: POP
	798	"RTN","RCD PRTP",20,0 )
	799	I $D(IO(" Q")) D Q
	800	"RTN","RCD PRTP",21,0 )
	801	.S ZTDESC ="Claims M atching Re port",ZTRT N="DQ^RCDP RTP"
	802	"RTN","RCD PRTP",22,0 )
	803	.S ZTSAVE ("RCSORT") =""
	804	"RTN","RCD PRTP",23,0 )
	805	. I RCSOR T=1 S ZTSA VE("RCDEBT ")="",ZTSA VE("RCDFN" )="",ZTSAV E("RCTYPE* ")=""
	806	"RTN","RCD PRTP",24,0 )
	807	. I RCSOR T=2 S ZTSA VE("RCBILL ")="",ZTSA VE("RCDFN" )="",ZTSAV E("RCDEBT" )=""
	808	"RTN","RCD PRTP",25,0 )
	809	. I RCSOR T=4 S ZTSA VE("RCPT") =""
	810	"RTN","RCD PRTP",26,0 )
	811	. I RCSOR T=5 S ZTSA VE("RCTYPE *")=""
	812	"RTN","RCD PRTP",27,0 )
	813	. S ZTSAV E("RCAN")= "",ZTSAVE( "ZTREQ")=" @",ZTSAVE( "^TMP(""RC DPRTPB"",$ J,")=""
	814	"RTN","RCD PRTP",28,0 )
	815	. S
	816	ZTSAVE("DA TEEND")="" ,ZTSAVE("D ATESTRT")= "",ZTSAVE( "RCQUIT")= "",ZTSAVE( "RCSORT")= "",ZTSAVE( "
	817	RCEXCEL")= ""
	818	"RTN","RCD PRTP",29,0 )
	819	. S ZTIO= ION_";"_IO ST_";"_IOM _";"_IOSL
	820	"RTN","RCD PRTP",30,0 )
	821	. S DIOEN D="K ^TMP( ""RCDPRTPB "",$J)"
	822	"RTN","RCD PRTP",31,0 )
	823	.D ^%ZTLO AD,HOME^%Z IS K IO("Q ") W !,"Ta sk# ",ZTSK
	824	"RTN","RCD PRTP",32,0 )
	825	W !!,?20, "<> pleas e wait <> "
	826	"RTN","RCD PRTP",33,0 )
	827	DQ ; queued rep ort starts here
	828	"RTN","RCD PRTP",34,0 )
	829	U IO
	830	"RTN","RCD PRTP",35,0 )
	831	K ^TMP("R CDPRTPB",$ J),^TMP("I BRBT",$J), ^TMP("IBRB F",$J)
	832	"RTN","RCD PRTP",36,0 )
	833	N DAT,RCB IL,RCBIL0, RCNAM,RCPA Y,RCPAY1,R CREC,RCREC 1,RCRECTDA ,RCSSN,RCT YP
	834	"RTN","RCD PRTP",37,0 )
	835	D
	836	@($S(RCSOR T=1:"PAT", RCSORT=2:" BILL",RCSO RT=3:"DATE ",RCSORT=4 :"REC",RCS ORT=5:"TYP E")_"^RCD
	837	PRTP0")
	838	"RTN","RCD PRTP",38,0 )
	839	Q:RCQUIT
	840	"RTN","RCD PRTP",39,0 )
	841	D EN^RCDP RTP1
	842	"RTN","RCD PRTP",40,0 )
	843	W !!,?20, "<End of r eport>",!
	844	"RTN","RCD PRTP",41,0 )
	845	K DATESTR T,DATEEND, ^TMP("RCDP RTPB",$J), RCTYPE
	846	"RTN","RCD PRTP",42,0 )
	847	D ^%ZISC
	848	"RTN","RCD PRTP",43,0 )
	849	Q
	850	"RTN","RCD PRTP",44,0 )
	851	;
	852	"RTN","RCD PRTP",45,0 )
	853	1 ;
	854	"RTN","RCD PRTP",46,0 )
	855	S DIC(0)= "QEAMZ",DI C=340,DIC( "S")="I ^R CD(340,+Y, 0)[""DPT"" ",DIC("A") ="Patient name: " D ^DIC I
	856	Y<0 S RCQU IT=1 Q
	857	"RTN","RCD PRTP",47,0 )
	858	S RCDEBT= +Y,RCDFN=+ $P(Y,"^",2 )
	859	"RTN","RCD PRTP",48,0 )
	860	D TYPEPIC ^RCDPRTP0( .RCTYPE) I '$D(RCTYP E) S RCQUI T=1 Q
	861	"RTN","RCD PRTP",49,0 )
	862	D DATESEL ^RCRJRTRA( "Payment")
	863	"RTN","RCD PRTP",50,0 )
	864	I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
	865	"RTN","RCD PRTP",51,0 )
	866	Q
	867	"RTN","RCD PRTP",52,0 )
	868	;
	869	"RTN","RCD PRTP",53,0 )
	870	3 ;
	871	"RTN","RCD PRTP",54,0 )
	872	D DATESEL ^RCRJRTRA( "Payment")
	873	"RTN","RCD PRTP",55,0 )
	874	I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
	875	"RTN","RCD PRTP",56,0 )
	876	Q
	877	"RTN","RCD PRTP",57,0 )
	878	;
	879	"RTN","RCD PRTP",58,0 )
	880	2 ;
	881	"RTN","RCD PRTP",59,0 )
	882	N DIC,DUO UT
	883	"RTN","RCD PRTP",60,0 )
	884	K ^TMP("I BRBF",$J)
	885	"RTN","RCD PRTP",61,0 )
	886	S DIC(0)= "QEAM",DIC =430,DIC(" S")="I $P( ^(0),U,2)= 9" D ^DIC I Y<0 S RC QUIT=1 Q
	887	"RTN","RCD PRTP",62,0 )
	888	S RCBILL= +Y,RCDFN=$ P($G(^PRCA (430,+RCBI LL,0)),"^" ,7) Q:'RCD FN
	889	"RTN","RCD PRTP",63,0 )
	890	S RCDEBT= $O(^RCD(34 0,"B",RCDF N_";DPT(", 0))
	891	"RTN","RCD PRTP",64,0 )
	892	I (RCDFN= "")!(RCDEB T="") W !, "This bill has no ma tching fir st party b ills." G 2
	893	"RTN","RCD PRTP",65,0 )
	894	D RELBILL ^IBRFN(RCB ILL)
	895	"RTN","RCD PRTP",66,0 )
	896	I '$O(^TM P("IBRBF", $J,RCBILL, 0)) W !,"T his bill h as no matc hing first party deb ts." K ^TM P("IBRBF", $J) G
	897	2
	898	"RTN","RCD PRTP",67,0 )
	899	K ^TMP("I BRBF",$J)
	900	"RTN","RCD PRTP",68,0 )
	901	Q
	902	"RTN","RCD PRTP",69,0 )
	903	;
	904	"RTN","RCD PRTP",70,0 )
	905	4 ;
	906	"RTN","RCD PRTP",71,0 )
	907	N DIC,X,Y
	908	"RTN","RCD PRTP",72,0 )
	909	S DIC(0)= "QEAM",DIC =344 D ^DI C I Y<0 S RCQUIT=1 Q
	910	"RTN","RCD PRTP",73,0 )
	911	S RCPT=$P (Y,"^",2)
	912	"RTN","RCD PRTP",74,0 )
	913	Q
	914	"RTN","RCD PRTP",75,0 )
	915	;
	916	"RTN","RCD PRTP",76,0 )
	917	5 ; Select care type - added i n patch 31 5
	918	"RTN","RCD PRTP",77,0 )
	919	D TYPEPIC ^RCDPRTP0( .RCTYPE) I '$D(RCTYP E) S RCQUI T=1 Q
	920	"RTN","RCD PRTP",78,0 )
	921	Q:RCQUIT
	922	"RTN","RCD PRTP",79,0 )
	923	D DATESEL ^RCRJRTRA( "Payment")
	924	"RTN","RCD PRTP",80,0 )
	925	I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
	926	"RTN","RCD PRTP",81,0 )
	927	Q
	928	"RTN","RCD PRTP",82,0 )
	929	;
	930	"RTN","RCD PRTP",83,0 )
	931	EXIT ;
	932	"RTN","RCD PRTP",84,0 )
	933	K DATESTR T,DATEEND, RCEXCEL,^T MP("RCDPRT PB",$J),^T MP("IBRBT" ,$J)
	934	"RTN","RCD PRTP",85,0 )
	935	K ^TMP("I BRBT1",$J) ,^TMP("IBR BF",$J),^T MP("IBRBF1 ",$J),RCTY PE
	936	"RTN","RCD PRTP",86,0 )
	937	Q
	938	"RTN","RCD PRTP",87,0 )
	939	;
	940	"RTN","RCD PRTP0")
	941	0^3^B54155 958^B10254 954
	942	"RTN","RCD PRTP0",1,0 )
	943	RCDPRTP0 ; ALB/LDB - CLAIMS MAT CHING REPO RT ;5/24/0 0 10:48 AM
	944	"RTN","RCD PRTP0",2,0 )
	945	;;4.5;Acc ounts Rece ivable;1 51,315,339 ;Mar 20, 1995;Buil d 2
	946	"RTN","RCD PRTP0",3,0 )
	947	;;Per VA Directive 6402, this routine s hould not be modifie d.
	948	"RTN","RCD PRTP0",4,0 )
	949	;
	950	"RTN","RCD PRTP0",5,0 )
	951	PAT ; find patie nt bills
	952	"RTN","RCD PRTP0",6,0 )
	953	S RCNAM=$ $NAM^RCFN0 1(RCDEBT)
	954	"RTN","RCD PRTP0",7,0 )
	955	S RCSSN=$ $SSN^RCFN0 1(RCDEBT)
	956	"RTN","RCD PRTP0",8,0 )
	957	S RCBIL=0 F S RCBI L=$O(^PRCA (430,"E",R CDFN,RCBIL )) Q:'RCBI L D
	958	"RTN","RCD PRTP0",9,0 )
	959	.I $P($G( ^PRCA(430, +RCBIL,0)) ,"^",2)'=9 Q
	960	"RTN","RCD PRTP0",10, 0)
	961	.S RCPAY= 0 F S RCP AY=$O(^PRC A(433,"C", RCBIL,RCPA Y)) Q:'RCP AY D
	962	"RTN","RCD PRTP0",11, 0)
	963	..S RCPAY 1=$G(^PRCA (433,+RCPA Y,1)) Q:RC PAY1=""
	964	"RTN","RCD PRTP0",12, 0)
	965	..I
	966	"^2^34^"[( "^"_$P(RCP AY1,"^",2) _"^"),($P( RCPAY1,"^" ,9)'<DATES TRT),($P(R CPAY1,"^", 9)<(DATEEN D_".9
	967	99999")) D
	968	"RTN","RCD PRTP0",13, 0)
	969	...S DFN= RCDFN D DE M^VADPT,EL IG^VADPT
	970	"RTN","RCD PRTP0",14, 0)
	971	...S RCTY PE=$$TYP^I BRFN(RCBIL ) ; added care type - 315
	972	"RTN","RCD PRTP0",15, 0)
	973	...S RCTY PE=$S(RCTY PE="":-1,R CTYPE="PR" :"P",RCTYP E="PH":"R" ,1:RCTYPE)
	974	"RTN","RCD PRTP0",16, 0)
	975	...I $D(R CTYPE(RCTY PE)) D Q: 'RCTYPE
	976	"RTN","RCD PRTP0",17, 0)
	977	....S ^TM P("RCDPRTP B",$J,RCNA M)=$P($G(V ADM(3)),"^ ",2)_"^"_$ P($G(VAEL( 1)),"^",2) _"^"_RCSSN
	978	"RTN","RCD PRTP0",18, 0)
	979	....S ^TM P("RCDPRTP B",$J,RCNA M,RCBIL)=$ P($P(RCPAY 1,"^",9)," .")
	980	"RTN","RCD PRTP0",19, 0)
	981	....K DFN ,VA,VADM,V AEL,VAERR
	982	"RTN","RCD PRTP0",20, 0)
	983	K RCDFN,R CDEBT
	984	"RTN","RCD PRTP0",21, 0)
	985	Q
	986	"RTN","RCD PRTP0",22, 0)
	987	;
	988	"RTN","RCD PRTP0",23, 0)
	989	DATE ; find third party bil ls by date of paymen ts
	990	"RTN","RCD PRTP0",24, 0)
	991	N RCDFN,R CDEBT
	992	"RTN","RCD PRTP0",25, 0)
	993	F RCTYP=2 ,34 S DAT= $$FMADD^XL FDT(DATEST RT,-1)_".9 99999" F S
	994	DAT=$O(^PR CA(433,"AT ",RCTYP,DA T)) Q:'DAT !(DAT>(DAT EEND_".999 999")) D
	995	"RTN","RCD PRTP0",26, 0)
	996	.S RCPAY= 0 F S RCP AY=$O(^PRC A(433,"AT" ,RCTYP,DAT ,RCPAY)) Q :'RCPAY D
	997	"RTN","RCD PRTP0",27, 0)
	998	..S RCBIL =$P($G(^PR CA(433,+RC PAY,0)),"^ ",2)
	999	"RTN","RCD PRTP0",28, 0)
	1000	..S RCBIL 0=$G(^PRCA (430,+RCBI L,0)) Q:RC BIL0=""
	1001	"RTN","RCD PRTP0",29, 0)
	1002	..Q:$P(RC BIL0,"^",2 )'=9
	1003	"RTN","RCD PRTP0",30, 0)
	1004	..S RCDFN =$P(RCBIL0 ,"^",7)
	1005	"RTN","RCD PRTP0",31, 0)
	1006	..S RCDEB T=$O(^RCD( 340,"B",RC DFN_";DPT( ",0)) Q:'R CDEBT
	1007	"RTN","RCD PRTP0",32, 0)
	1008	..S RCNAM =$$NAM^RCF N01(RCDEBT )
	1009	"RTN","RCD PRTP0",33, 0)
	1010	..S RCSSN =$$SSN^RCF N01(RCDEBT )
	1011	"RTN","RCD PRTP0",34, 0)
	1012	..S DFN=R CDFN D DEM ^VADPT,ELI G^VADPT
	1013	"RTN","RCD PRTP0",35, 0)
	1014	..S
	1015	^TMP("RCDP RTPB",$J,R CNAM_"^"_R CDEBT)=$P( $G(VADM(3) ),"^",2)_" ^"_$P($G(V AEL(1)),"^ ",2)_"^"_R C
	1016	SSN
	1017	"RTN","RCD PRTP0",36, 0)
	1018	..S ^TMP( "RCDPRTPB" ,$J,RCNAM_ "^"_RCDEBT ,RCBIL)=$P (DAT,".")
	1019	"RTN","RCD PRTP0",37, 0)
	1020	..K DFN,V A,VADM,VAE L,VAERR
	1021	"RTN","RCD PRTP0",38, 0)
	1022	Q
	1023	"RTN","RCD PRTP0",39, 0)
	1024	;
	1025	"RTN","RCD PRTP0",40, 0)
	1026	TYPE ; find third party bil ls by care type PRCA 4.5315
	1027	"RTN","RCD PRTP0",41, 0)
	1028	N RCDFN,R CDEBT,RCTY P
	1029	"RTN","RCD PRTP0",42, 0)
	1030	F RCTYP=2 ,34 S DAT= $$FMADD^XL FDT(DATEST RT,-1)_".9 99999" F S
	1031	DAT=$O(^PR CA(433,"AT ",RCTYP,DA T)) Q:'DAT !(DAT>(DAT EEND_".999 999")) D
	1032	"RTN","RCD PRTP0",43, 0)
	1033	.S RCPAY= 0 F S RCP AY=$O(^PRC A(433,"AT" ,RCTYP,DAT ,RCPAY)) Q :'RCPAY D
	1034	"RTN","RCD PRTP0",44, 0)
	1035	..S RCBIL =$P($G(^PR CA(433,+RC PAY,0)),"^ ",2)
	1036	"RTN","RCD PRTP0",45, 0)
	1037	..S RCBIL 0=$G(^PRCA (430,+RCBI L,0)) Q:RC BIL0=""
	1038	"RTN","RCD PRTP0",46, 0)
	1039	..Q:$P(RC BIL0,"^",2 )'=9
	1040	"RTN","RCD PRTP0",47, 0)
	1041	..S RCDFN =$P(RCBIL0 ,"^",7)
	1042	"RTN","RCD PRTP0",48, 0)
	1043	..S RCDEB T=$O(^RCD( 340,"B",RC DFN_";DPT( ",0)) Q:'R CDEBT
	1044	"RTN","RCD PRTP0",49, 0)
	1045	..S RCNAM =$$NAM^RCF N01(RCDEBT )
	1046	"RTN","RCD PRTP0",50, 0)
	1047	..S RCSSN =$$SSN^RCF N01(RCDEBT )
	1048	"RTN","RCD PRTP0",51, 0)
	1049	..S DFN=R CDFN D DEM ^VADPT,ELI G^VADPT
	1050	"RTN","RCD PRTP0",52, 0)
	1051	..S RCTYP E=$$TYP^IB RFN(RCBIL)
	1052	"RTN","RCD PRTP0",53, 0)
	1053	..S RCTYP E=$S(RCTYP E="":-1,RC TYPE="PR": "P",RCTYPE ="PH":"R", 1:RCTYPE)
	1054	"RTN","RCD PRTP0",54, 0)
	1055	..I $D(RC TYPE(RCTYP E)) D Q:' RCTYPE
	1056	"RTN","RCD PRTP0",55, 0)
	1057	...S
	1058	^TMP("RCDP RTPB",$J,R CNAM_"^"_R CDEBT)=$P( $G(VADM(3) ),"^",2)_" ^"_$P($G(V AEL(1)),"^ ",2)_"^"_R C
	1059	SSN
	1060	"RTN","RCD PRTP0",56, 0)
	1061	...S ^TMP ("RCDPRTPB ",$J,RCNAM _"^"_RCDEB T,RCBIL)=$ P(DAT,".")
	1062	"RTN","RCD PRTP0",57, 0)
	1063	...K DFN, VA,VADM,VA EL,VAERR
	1064	"RTN","RCD PRTP0",58, 0)
	1065	Q
	1066	"RTN","RCD PRTP0",59, 0)
	1067	BILL ; set TMP ar ray
	1068	"RTN","RCD PRTP0",60, 0)
	1069	S RCDEBT= $O(^RCD(34 0,"B",RCDF N_";DPT(", 0)) Q:'RCD EBT
	1070	"RTN","RCD PRTP0",61, 0)
	1071	S RCNAM=$ $NAM^RCFN0 1(RCDEBT)
	1072	"RTN","RCD PRTP0",62, 0)
	1073	S RCSSN=$ $SSN^RCFN0 1(RCDEBT)
	1074	"RTN","RCD PRTP0",63, 0)
	1075	S DFN=+$G (^RCD(340, RCDEBT,0))
	1076	"RTN","RCD PRTP0",64, 0)
	1077	D DEM^VAD PT,ELIG^VA DPT
	1078	"RTN","RCD PRTP0",65, 0)
	1079	S RCTP=0 F S RCTP= $O(^PRCA(4 33,"C",RCB ILL,RCTP)) Q:'RCTP I
	1080	"^2^34^"[( "^"_$P($G( ^PRCA(433, +RCTP,1)), "^",2)_"^" ) S
	1081	RCTP(0)=$P ($P($G(^PR CA(433,+RC TP,1)),"^" ,9),".")
	1082	"RTN","RCD PRTP0",66, 0)
	1083	S ^TMP("R CDPRTPB",$ J,RCNAM)=$ P($G(VADM( 3)),"^",2) _"^"_$P($G (VAEL(1)), "^",2)_"^" _RCSSN
	1084	"RTN","RCD PRTP0",67, 0)
	1085	S ^TMP("R CDPRTPB",$ J,RCNAM,RC BILL)=RCTP
	1086	"RTN","RCD PRTP0",68, 0)
	1087	K DFN,VA, VADM,VAEL, VAERR,RCBI LL,RCTP
	1088	"RTN","RCD PRTP0",69, 0)
	1089	Q
	1090	"RTN","RCD PRTP0",70, 0)
	1091	;
	1092	"RTN","RCD PRTP0",71, 0)
	1093	REC ; find recei pt payment s
	1094	"RTN","RCD PRTP0",72, 0)
	1095	N RCDEBT, RCDFN,RCRE C1,RCPAY1, RCBIL,RCBI L0,RCDFN,R CDEBT,RCSS N
	1096	"RTN","RCD PRTP0",73, 0)
	1097	S RCREC1= 0 F S RCR EC1=$O(^PR CA(433,"AF ",RCPT,RCR EC1)) Q:'R CREC1 D
	1098	"RTN","RCD PRTP0",74, 0)
	1099	.S RCPAY1 =$G(^PRCA( 433,+RCREC 1,1)) Q:RC PAY1=""
	1100	"RTN","RCD PRTP0",75, 0)
	1101	.S RCBIL= 0 I "^2^34 ^"[("^"_$P (RCPAY1,"^ ",2)_"^") S RCBIL=$P ($G(^PRCA( 433,+RCREC 1,0)),"^", 2)
	1102	"RTN","RCD PRTP0",76, 0)
	1103	.Q:'RCBIL
	1104	"RTN","RCD PRTP0",77, 0)
	1105	.S RCBIL0 =$G(^PRCA( 430,+RCBIL ,0))
	1106	"RTN","RCD PRTP0",78, 0)
	1107	.Q:$P(RCB IL0,"^",2) '=9
	1108	"RTN","RCD PRTP0",79, 0)
	1109	.S RCDFN= $P(RCBIL0, "^",7) Q:' RCDFN
	1110	"RTN","RCD PRTP0",80, 0)
	1111	.S RCDEBT =$O(^RCD(3 40,"B",RCD FN_";DPT(" ,0)) Q:'RC DEBT
	1112	"RTN","RCD PRTP0",81, 0)
	1113	.S RCSSN= $$SSN^RCFN 01(RCDEBT)
	1114	"RTN","RCD PRTP0",82, 0)
	1115	.S RCNAM= $$NAM^RCFN 01(RCDEBT)
	1116	"RTN","RCD PRTP0",83, 0)
	1117	.S DFN=RC DFN D DEM^ VADPT,ELIG ^VADPT
	1118	"RTN","RCD PRTP0",84, 0)
	1119	.S
	1120	^TMP("RCDP RTPB",$J,R CNAM_"^"_R CDEBT)=$P( $G(VADM(3) ),"^",2)_" ^"_$P($G(V AEL(1)),"^ ",2)_"^"_R C
	1121	SSN
	1122	"RTN","RCD PRTP0",85, 0)
	1123	.K DFN,VA ,VADM,VAEL ,VAERR
	1124	"RTN","RCD PRTP0",86, 0)
	1125	.S ^TMP(" RCDPRTPB", $J,RCNAM_" ^"_RCDEBT, RCBIL)=$P( $P($G(^PRC A(433,+RCR EC1,1)),"^ ",9),".")
	1126	"RTN","RCD PRTP0",87, 0)
	1127	Q
	1128	"RTN","RCD PRTP0",88, 0)
	1129	;
	1130	"RTN","RCD PRTP0",89, 0)
	1131	TYPEPIC(RC TYPE) ; fu nction for user sele ction of c are types PRCA4.53 15
	1132	"RTN","RCD PRTP0",90, 0)
	1133	; RCTYPE is an outp ut array, pass by re ference
	1134	"RTN","RCD PRTP0",91, 0)
	1135	; RCTYPE( type)="" w here type can be (I) npatient, (O)utpatie nt,(P)rost hetics or (R)x (Pres cription)
	1136	"RTN","RCD PRTP0",92, 0)
	1137	; Functio n value is 1 if at l east 1 car e type was selected, 0 otherwi se
	1138	"RTN","RCD PRTP0",93, 0)
	1139	; User ca n select o ne, all or a combina tion of ca re types.
	1140	"RTN","RCD PRTP0",94, 0)
	1141	;
	1142	"RTN","RCD PRTP0",95, 0)
	1143	N DIR,X,Y ,OK,DTOUT, DUOUT,DIRU T,DIROUT,R C
	1144	"RTN","RCD PRTP0",96, 0)
	1145	K RCTYPE
	1146	"RTN","RCD PRTP0",97, 0)
	1147	S OK=1 ; all OK def ault
	1148	"RTN","RCD PRTP0",98, 0)
	1149	S DIR(0)= "S"
	1150	"RTN","RCD PRTP0",99, 0)
	1151	S RC=";I: Inpatient"
	1152	"RTN","RCD PRTP0",100 ,0)
	1153	S RC=RC_" ;O:Outpati ent"
	1154	"RTN","RCD PRTP0",101 ,0)
	1155	S RC=RC_" ;P:Prosthe tic"
	1156	"RTN","RCD PRTP0",102 ,0)
	1157	S RC=RC_" ;R:Prescri ption"
	1158	"RTN","RCD PRTP0",103 ,0)
	1159	S RC=RC_" ;ALL:All"
	1160	"RTN","RCD PRTP0",104 ,0)
	1161	S $P(DIR( 0),U,2)=RC ,DIR("B")= "ALL"
	1162	"RTN","RCD PRTP0",105 ,0)
	1163	S DIR("A" )="Select a Care Typ e"
	1164	"RTN","RCD PRTP0",106 ,0)
	1165	W ! D ^DI R K DIR
	1166	"RTN","RCD PRTP0",107 ,0)
	1167	I (Y["A") D Q ; a ll types s elected so set & qui t
	1168	"RTN","RCD PRTP0",108 ,0)
	1169	. F X="I" ,"O","P"," R" S RCTYP E(X)=""
	1170	"RTN","RCD PRTP0",109 ,0)
	1171	. Q
	1172	"RTN","RCD PRTP0",110 ,0)
	1173	I $D(DIRU T)!(Y="") Q
	1174	"RTN","RCD PRTP0",111 ,0)
	1175	S X=$$UP^ XLFSTR(X)
	1176	"RTN","RCD PRTP0",112 ,0)
	1177	S RCTYPE( X)="" ; Toggle back on
	1178	"RTN","RCD PRTP0",113 ,0)
	1179	; Select another ty pe
	1180	"RTN","RCD PRTP0",114 ,0)
	1181	I (Y'["A" ) F D Q: X=""!(RCQU IT)
	1182	"RTN","RCD PRTP0",115 ,0)
	1183	. I ($G(D IRUT)'="") S OK=0,RC QUIT=1 Q
	1184	"RTN","RCD PRTP0",116 ,0)
	1185	. S DIR(0 )="SBO^I:I npatient;O :Outpatien t;P:Prosth etic;R:Pre scription"
	1186	"RTN","RCD PRTP0",117 ,0)
	1187	. S DIR(" A")="Selec t another Care Type" D ^DIR K DIR
	1188	"RTN","RCD PRTP0",118 ,0)
	1189	. I $G(DU OUT) W !!, "User exit ed with '^ ', quittin g",! S RCQ UIT=1 Q
	1190	"RTN","RCD PRTP0",119 ,0)
	1191	. I $D(DI RUT) S OK= 0 Q
	1192	"RTN","RCD PRTP0",120 ,0)
	1193	. I (X="" ) Q
	1194	"RTN","RCD PRTP0",121 ,0)
	1195	. S X=$$U P^XLFSTR(X )
	1196	"RTN","RCD PRTP0",122 ,0)
	1197	. S RCTYP E(X)=""
	1198	"RTN","RCD PRTP0",123 ,0)
	1199	. Q
	1200	"RTN","RCD PRTP0",124 ,0)
	1201	I $D(DUOU T)!$D(DTOU T) S OK=0 ; exit if "^" or tim e-out
	1202	"RTN","RCD PRTP0",125 ,0)
	1203	I '$D(RCT YPE) S OK= 0 W $C(7)
	1204	"RTN","RCD PRTP0",126 ,0)
	1205	Q OK
	1206	"RTN","RCD PRTP0",127 ,0)
	1207	;
	1208	"RTN","RCD PRTP0",128 ,0)
	1209	FORMAT(RCE XCEL) ; ca pture the report for mat from t he user (n ormal or C SV output) PRCA4.5 315
	1210	"RTN","RCD PRTP0",129 ,0)
	1211	; RCEXCEL =0 for nor mal output
	1212	"RTN","RCD PRTP0",130 ,0)
	1213	; RCEXCEL =1 (^ sepa rated valu es) for Ex cel output
	1214	"RTN","RCD PRTP0",131 ,0)
	1215	; pass pa rameter by reference
	1216	"RTN","RCD PRTP0",132 ,0)
	1217	;
	1218	"RTN","RCD PRTP0",133 ,0)
	1219	N DIR,X,Y ,DTOUT,DUO UT,DIRUT,D IROUT
	1220	"RTN","RCD PRTP0",134 ,0)
	1221	S RCEXCEL =0
	1222	"RTN","RCD PRTP0",135 ,0)
	1223	S DIR("A" )="Do you want to ca pture repo rt data fo r an Excel document"
	1224	"RTN","RCD PRTP0",136 ,0)
	1225	S DIR("B" )="NO"
	1226	"RTN","RCD PRTP0",137 ,0)
	1227	S DIR(0)= "Y"
	1228	"RTN","RCD PRTP0",138 ,0)
	1229	S DIR("?" ,1)="If yo u want to capture th e output f rom this r eport in a ^-separat ed"
	1230	"RTN","RCD PRTP0",139 ,0)
	1231	S DIR("?" ,2)="value s (Excel) format, th en answer YES here."
	1232	"RTN","RCD PRTP0",140 ,0)
	1233	S DIR("?" ,3)=" "
	1234	"RTN","RCD PRTP0",141 ,0)
	1235	S DIR("?" )="If you just want a normal r eport outp ut, then a nswer NO h ere."
	1236	"RTN","RCD PRTP0",142 ,0)
	1237	W ! D ^DI R K DIR
	1238	"RTN","RCD PRTP0",143 ,0)
	1239	I $D(DIRU T) S RCQUI T=1 Q 0 ; get ou t
	1240	"RTN","RCD PRTP0",144 ,0)
	1241	S RCEXCEL =Y
	1242	"RTN","RCD PRTP0",145 ,0)
	1243	Q RCEXCEL
	1244	"RTN","RCD PRTP0",146 ,0)
	1245	;
	1246	"RTN","RCD PRTP0",147 ,0)
	1247	DEVICE ; D evice Sele ction for Excel outp ut PRCA4. 5315
	1248	"RTN","RCD PRTP0",148 ,0)
	1249	; RCEXCEL =1 for Exc el ('^' se parated va lues) outp ut
	1250	"RTN","RCD PRTP0",149 ,0)
	1251	;
	1252	"RTN","RCD PRTP0",150 ,0)
	1253	N ZTRTN,Z TDESC,ZTSA VE,POP,ZTS K,DIR,X,Y, DIRUT,DTOU T,DUOUT,DI ROUT
	1254	"RTN","RCD PRTP0",151 ,0)
	1255	D EXMSG
	1256	"RTN","RCD PRTP0",152 ,0)
	1257	;
	1258	"RTN","RCD PRTP0",153 ,0)
	1259	S ZTRTN=" PRINT^RCDP RTEX"
	1260	"RTN","RCD PRTP0",154 ,0)
	1261	S ZTDESC= "Claims Ma tching Exc el Report"
	1262	"RTN","RCD PRTP0",155 ,0)
	1263	S
	1264	ZTSAVE("DA TEEND")="" ,ZTSAVE("D ATESTRT")= "",ZTSAVE( "RCQUIT")= "",ZTSAVE( "RCSORT")= "",ZTSAVE( "
	1265	RCEXCEL")= ""
	1266	"RTN","RCD PRTP0",156 ,0)
	1267	S ZTSAVE( "RCAN")="" ,ZTSAVE("Z TREQ")="@" ,ZTSAVE("^ TMP(""RCDP RTPB"",$J, ")=""
	1268	"RTN","RCD PRTP0",157 ,0)
	1269	I RCSORT= 1 S ZTSAVE ("RCDEBT") ="",ZTSAVE ("RCDFN")= "",ZTSAVE( "RCTYPE*") =""
	1270	"RTN","RCD PRTP0",158 ,0)
	1271	I RCSORT= 2 S ZTSAVE ("RCBILL") ="",ZTSAVE ("RCDFN")= "",ZTSAVE( "RCDEBT")= ""
	1272	"RTN","RCD PRTP0",159 ,0)
	1273	I RCSORT= 4 S ZTSAVE ("RCPT")=" "
	1274	"RTN","RCD PRTP0",160 ,0)
	1275	I RCSORT= 5 S ZTSAVE ("RCTYPE" )="",ZTSAV E("DATE") =""
	1276	"RTN","RCD PRTP0",161 ,0)
	1277	;
	1278	"RTN","RCD PRTP0",162 ,0)
	1279	D EN^XUTM DEVQ(ZTRTN ,ZTDESC,.Z TSAVE,"QM" ,1) Q:POP
	1280	"RTN","RCD PRTP0",163 ,0)
	1281	I $G(ZTSK ) W !!,"Re port compi lation has started w ith task# ",ZTSK,"." ,! S DIR(0 )="E" D ^D IR K DIR
	1282	"RTN","RCD PRTP0",164 ,0)
	1283	Q
	1284	"RTN","RCD PRTP0",165 ,0)
	1285	;
	1286	"RTN","RCD PRTP0",166 ,0)
	1287	EXMSG ; - Displays t he message about cap turing to an Excel f ile format
	1288	"RTN","RCD PRTP0",167 ,0)
	1289	;
	1290	"RTN","RCD PRTP0",168 ,0)
	1291	W !!?5,"T his report may take a while to run. It i s recommen ded that y ou Queue i t."
	1292	"RTN","RCD PRTP0",169 ,0)
	1293	W !!?5,"T o capture as an Exce l format, it is reco mmended th at you que ue this"
	1294	"RTN","RCD PRTP0",170 ,0)
	1295	W !?5,"re port to a spool devi ce with ma rgins of 2 56 and pag e length o f 99999"
	1296	"RTN","RCD PRTP0",171 ,0)
	1297	W !?5,"(e .g. spooln ame;256;99 999). This should he lp avoid w rapping pr oblems."
	1298	"RTN","RCD PRTP0",172 ,0)
	1299	W !!?5,"A nother met hod would be to set up your te rminal to capture th e detail"
	1300	"RTN","RCD PRTP0",173 ,0)
	1301	W !?5,"re port data. On some t erminals, this can b e done by clicking o n the"
	1302	"RTN","RCD PRTP0",174 ,0)
	1303	W !?5,"'T ools' menu above, th en click o n 'Capture Incoming Data' to s ave to"
	1304	"RTN","RCD PRTP0",175 ,0)
	1305	W !?5,"De sktop. To avoid und esired wra pping of t he data sa ved to the file,"
	1306	"RTN","RCD PRTP0",176 ,0)
	1307	W !?5,"pl ease enter '0;256;99 999' at th e 'DEVICE: ' prompt." ,!
	1308	"RTN","RCD PRTP0",177 ,0)
	1309	Q
	1310	"RTN","RCD PRTP0",178 ,0)
	1311	;
	1312	"RTN","RCD PRTP1")
	1313	0^4^B48815 425^B33480 590
	1314	"RTN","RCD PRTP1",1,0 )
	1315	RCDPRTP1 ;ALB/LDB - CLAIMS MA TCHING REP ORT (PRINT ) ;1/26/01 2:56 PM
	1316	"RTN","RCD PRTP1",2,0 )
	1317	;;4.5;Acc ounts Rece ivable;1 51,169,276 ,284,315,3 39;Mar 2 0, 1995;Bu ild 2
	1318	"RTN","RCD PRTP1",3,0 )
	1319	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1320	"RTN","RCD PRTP1",4,0 )
	1321	;
	1322	"RTN","RCD PRTP1",5,0 )
	1323	EN ; Entry poi nt to prin t the Clai ms Matchin g Report.
	1324	"RTN","RCD PRTP1",6,0 )
	1325	N
	1326	%,DATEDIS1 ,DATEDIS2, NOW,PG,RCB ILL,RCAMT, RCAMT1,RCI BDAT,RCIBF N,RCNAM,RC NAM1,RCNO, RCN
	1327	OW,RCDLINE ,RCLINE,RC PHIT
	1328	"RTN","RCD PRTP1",7,0 )
	1329	; PRCA4. 5284 - Re move RCPT 'new' as t his is the receipt # from user entry
	1330	"RTN","RCD PRTP1",8,0 )
	1331	N RCQ,RCS SN,RCSTAT, RCTP,X,Y
	1332	"RTN","RCD PRTP1",9,0 )
	1333	;
	1334	"RTN","RCD PRTP1",10, 0)
	1335	; - initi alize repo rt header variables
	1336	"RTN","RCD PRTP1",11, 0)
	1337	S PG=0
	1338	"RTN","RCD PRTP1",12, 0)
	1339	Q:RCQUIT
	1340	"RTN","RCD PRTP1",13, 0)
	1341	I RCSORT' =2,(RCSORT '=4) D
	1342	"RTN","RCD PRTP1",14, 0)
	1343	.S Y=$P(D ATESTRT,". ") D DD^%D T S DATEDI S1=Y
	1344	"RTN","RCD PRTP1",15, 0)
	1345	.S Y=$P(D ATEEND,"." ) D DD^%DT S DATEDIS 2=Y
	1346	"RTN","RCD PRTP1",16, 0)
	1347	D NOW^%DT C S Y=% D DD^%DT S R CNOW=$E(Y, 1,18)
	1348	"RTN","RCD PRTP1",17, 0)
	1349	S RCDLINE =$TR($J("" ,80)," "," -")
	1350	"RTN","RCD PRTP1",18, 0)
	1351	S RCLINE= $TR($J("", 80)," ","* ")
	1352	"RTN","RCD PRTP1",19, 0)
	1353	;
	1354	"RTN","RCD PRTP1",20, 0)
	1355	; - main report loo p
	1356	"RTN","RCD PRTP1",21, 0)
	1357	K ^TMP($J )
	1358	"RTN","RCD PRTP1",22, 0)
	1359	;
	1360	"RTN","RCD PRTP1",23, 0)
	1361	I 'RCEXCE L D HDR ; initial he ader
	1362	"RTN","RCD PRTP1",24, 0)
	1363	S RCNO=0 ; flag to indicate a t least on e matching claim
	1364	"RTN","RCD PRTP1",25, 0)
	1365	;
	1366	"RTN","RCD PRTP1",26, 0)
	1367	S RCNAM=" " F S RCN AM=$O(^TMP ("RCDPRTPB ",$J,RCNAM )) Q:RCNAM =""!$G(RCQ ) D
	1368	"RTN","RCD PRTP1",27, 0)
	1369	.S RCBILL =0 F S RC BILL=$O(^T MP("RCDPRT PB",$J,RCN AM,RCBILL) ) Q:'RCBIL L!$G(RCQ) D
	1370	"RTN","RCD PRTP1",28, 0)
	1371	..S RCPHI T=0 ; flag that requ ires patie nt info to print
	1372	"RTN","RCD PRTP1",29, 0)
	1373	..D PROC ; proc ess a sing le third p arty bill
	1374	"RTN","RCD PRTP1",30, 0)
	1375	..K ^TMP( "IBRBT",$J ),^TMP("IB RBF",$J)
	1376	"RTN","RCD PRTP1",31, 0)
	1377	;
	1378	"RTN","RCD PRTP1",32, 0)
	1379	I $G(RCQ) G ENQ
	1380	"RTN","RCD PRTP1",33, 0)
	1381	;
	1382	"RTN","RCD PRTP1",34, 0)
	1383	I $O(^TMP ("RCDPRTPB ",$J,0))=" " W !!,?18 ,"No match ing debts. " Q
	1384	"RTN","RCD PRTP1",35, 0)
	1385	;I 'RCNO W !!,?18," No matchin g debts."
	1386	"RTN","RCD PRTP1",36, 0)
	1387	ENQ ;
	1388	"RTN","RCD PRTP1",37, 0)
	1389	Q
	1390	"RTN","RCD PRTP1",38, 0)
	1391	;
	1392	"RTN","RCD PRTP1",39, 0)
	1393	;
	1394	"RTN","RCD PRTP1",40, 0)
	1395	PROC ; Process e ach third party bill for a pat ient.
	1396	"RTN","RCD PRTP1",41, 0)
	1397	D RELBILL ^IBRFN(RCB ILL)
	1398	"RTN","RCD PRTP1",42, 0)
	1399	S RCQUIT= 0 ;added for care t ype check
	1400	"RTN","RCD PRTP1",43, 0)
	1401	;Add code to check ^TMP("IBRB T",$J --- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ------for
	1402	third part y charges
	1403	"RTN","RCD PRTP1",44, 0)
	1404	I $D(RCTY PE)>1,$D(^ TMP("IBRBT ",$J)) N J S J=0 F S J=$O(^TM P("IBRBT", $J,RCBILL, J)) Q:'J D
	1405	"RTN","RCD PRTP1",45, 0)
	1406	. S RCTYP =$$TYP^IBR FN(J),RCTY P=$S(RCTYP ="":-1,RCT YP="PR":"P ",RCTYP="P H":"R",1:R CTYP)
	1407	"RTN","RCD PRTP1",46, 0)
	1408	. I '$D(R CTYPE(RCTY P)) K ^TMP ("IBRBT",$ J,RCBILL,J ) ; Ve rify that the type i s one of t he selecte d type,
	1409	if not del ete the ^T MP global node for t hat claim
	1410	"RTN","RCD PRTP1",47, 0)
	1411	; - quit if there a re no asso ciated fir st party b ills
	1412	"RTN","RCD PRTP1",48, 0)
	1413	I '$O(^TM P("IBRBF", $J,0)) K ^ TMP("RCDPR TPB",$J,RC NAM,RCBILL ) G PROCQ
	1414	"RTN","RCD PRTP1",49, 0)
	1415	;
	1416	"RTN","RCD PRTP1",50, 0)
	1417	S (RCAMT( 0),RCAMT(1 ))=0
	1418	"RTN","RCD PRTP1",51, 0)
	1419	S RCTP(0) =0 F S RC TP(0)=$O(^ TMP("IBRBF ",$J,RCTP( 0))) Q:'RC TP(0) S R CTP(1)=0 F S
	1420	RCTP(1)=$O (^TMP("IBR BF",$J,RCT P(0),RCTP( 1))) Q:'RC TP(1) S ^ TMP($J,"IB RBF",RCTP( 1),RCTP(0) )=""
	1421	"RTN","RCD PRTP1",52, 0)
	1422	; PRCA4. 5284 - Ch ange typo of RCPT(0) =0 to RCTP (0)=0
	1423	"RTN","RCD PRTP1",53, 0)
	1424	S RCTP(0) =0 F S RC TP(0)=$O(^ TMP($J,"IB RBF",RCTP( 0))) Q:'RC TP(0) S R CTP(1)=0 F S
	1425	RCTP(1)=$O (^TMP($J," IBRBF",RCT P(0),RCTP( 1))) Q:'RC TP(1) D
	1426	"RTN","RCD PRTP1",54, 0)
	1427	.I RCTP(1 )=RCBILL Q
	1428	"RTN","RCD PRTP1",55, 0)
	1429	.I $D(^TM P($J,"IBRB F",RCTP(0) ,RCBILL))! (RCTP(1)'= $O(^TMP($J ,"IBRBF",R CTP(0),0)) ) K
	1430	^TMP("IBRB F",$J,RCTP (1),RCTP(0 )),^TMP($J ,"IBRBF",R CTP(0),RCT P(1)) I '$ O(^TMP("IB RBF",$J,RC TP(1),0))
	1431	K ^TMP("IB RBF",$J,RC TP(1))
	1432	"RTN","RCD PRTP1",56, 0)
	1433	;
	1434	"RTN","RCD PRTP1",57, 0)
	1435	S RCTP(0) ="" F S R CTP(0)=$O( ^TMP("IBRB T",$J,RCBI LL,RCTP(0) )) Q:RCTP( 0)="" D
	1436	"RTN","RCD PRTP1",58, 0)
	1437	.;if asso ciated thi rd party h as had pay ment also do not lis t twice
	1438	"RTN","RCD PRTP1",59, 0)
	1439	.I $D(^TM P("RCDPRTP B",$J,RCNA M,RCTP(0)) ),(RCBILL' =RCTP(0)) S
	1440	RCTP(RCTP( 0))=^TMP(" RCDPRTPB", $J,RCNAM,R CTP(0)) K ^(RCTP(0))
	1441	"RTN","RCD PRTP1",60, 0)
	1442	.;if no p rescriptio n coverage exclude a ssociated rx co-pay charges
	1443	"RTN","RCD PRTP1",61, 0)
	1444	.I '$P(^T MP("IBRBT" ,$J,RCBILL ),"^") D
	1445	"RTN","RCD PRTP1",62, 0)
	1446	..S RCTP( 1)=0 F S RCTP(1)=$O (^TMP("IBR BF",$J,RCT P(0),RCTP( 1))) Q:RCT P(1)="" I
	1447	$G(^TMP("I BRBF",$J,R CTP(0),RCT P(1)))["RX " K ^TMP(" IBRBF",$J, RCTP(0),RC TP(1)) I
	1448	'$O(^TMP(" IBRBF",$J, RCTP(0),"" )) K ^TMP( "IBRBF",$J ,RCTP(0))
	1449	"RTN","RCD PRTP1",63, 0)
	1450	.;if dupl icate char ges exclud e them fro m report
	1451	"RTN","RCD PRTP1",64, 0)
	1452	S RCTP(0) =0 F S RC TP(0)=$O(^ TMP("IBRBF ",$J,RCTP( 0))) Q:RCT P(0)="" S RCTP(1)=0 F S
	1453	RCTP(1)=$O (^TMP("IBR BF",$J,RCT P(0),RCTP( 1))) Q:'RC TP(1) D
	1454	"RTN","RCD PRTP1",65, 0)
	1455	.I RCTP(0 )'=RCBILL, ($D(^TMP(" IBRBF",$J, RCBILL,RCT P(1)))) K ^TMP("IBRB F",$J,RCTP (0),RCTP(1 ))
	1456	K:'$O(^TMP ("IBRBF",$ J,RCTP(0), 0)) ^TMP(" IBRBF",$J, RCTP(0))
	1457	"RTN","RCD PRTP1",66, 0)
	1458	;
	1459	"RTN","RCD PRTP1",67, 0)
	1460	;exclude cancelled charges if not selec ted to be on report
	1461	"RTN","RCD PRTP1",68, 0)
	1462	I 'RCAN D
	1463	"RTN","RCD PRTP1",69, 0)
	1464	.S RCTP(0 )=0 F S R CTP(0)=$O( ^TMP("IBRB F",$J,RCTP (0))) Q:RC TP(0)="" S RCTP(1)= 0 F S
	1465	RCTP(1)=$O (^TMP("IBR BF",$J,RCT P(0),RCTP( 1))) Q:'RC TP(1) D
	1466	"RTN","RCD PRTP1",70, 0)
	1467	..I $P(^T MP("IBRBF" ,$J,RCTP(0 ),RCTP(1)) ,"^",3) K ^TMP("IBRB F",$J,RCTP (0),RCTP(1 )) Q
	1468	"RTN","RCD PRTP1",71, 0)
	1469	..S RCPT( 2)=$O(^PRC A(430,"B", +$P(^TMP(" IBRBF",$J, RCTP(0),RC TP(1)),"^" ,4),0)) I
	1470	($P($G(^PR CA(430,+RC PT(2),0)), "^",8)=39) !($P($G(^P RCA(430,+R CPT(2),0)) ,"^",8)=26 ) K
	1471	^TMP("IBRB F",$J,RCTP (0),RCTP(1 ))
	1472	"RTN","RCD PRTP1",72, 0)
	1473	..I '$O(^ TMP("IBRBF ",$J,RCTP( 0),"")) K ^TMP("IBRB F",$J,RCTP (0))
	1474	"RTN","RCD PRTP1",73, 0)
	1475	I '$O(^TM P("IBRBF", $J,RCBILL, 0)) K ^TMP ("RCDPRTPB ",$J,RCNAM ,RCBILL) G PROCQ
	1476	"RTN","RCD PRTP1",74, 0)
	1477	;
	1478	"RTN","RCD PRTP1",75, 0)
	1479	I RCEXCEL D PRNTPAT ^RCDPRTEX K ^TMP($J) Q ;Pri nt in clai ms in exce l format a nd quit
	1480	"RTN","RCD PRTP1",76, 0)
	1481	;
	1482	"RTN","RCD PRTP1",77, 0)
	1483	; - prin t patient detail lin e
	1484	"RTN","RCD PRTP1",78, 0)
	1485	I 'RCPHIT S RCPHIT= 1 D PRINT3 ^RCDPRTP2 G:$G(RCQ) PROCQ
	1486	"RTN","RCD PRTP1",79, 0)
	1487	;
	1488	"RTN","RCD PRTP1",80, 0)
	1489	; - print third par ty bills
	1490	"RTN","RCD PRTP1",81, 0)
	1491	; o p rint the h eader firs t; need ro om for the header an d
	1492	"RTN","RCD PRTP1",82, 0)
	1493	; t he bill th at was pai d.
	1494	"RTN","RCD PRTP1",83, 0)
	1495	; o p rint the b ill that w as paid.
	1496	"RTN","RCD PRTP1",84, 0)
	1497	S RCTP=RC BILL,RCIBD AT=$G(^TMP ("IBRBT",$ J,RCBILL,R CBILL))
	1498	"RTN","RCD PRTP1",85, 0)
	1499	I $Y>(IOS L-7) D PAU SE^RCDPRTP 2 G:$G(RCQ ) PROCQ D HDR
	1500	"RTN","RCD PRTP1",86, 0)
	1501	D HDR1^RC DPRTP2,PRI NT1^RCDPRT P2 G:$G(RC Q) PROCQ
	1502	"RTN","RCD PRTP1",87, 0)
	1503	;
	1504	"RTN","RCD PRTP1",88, 0)
	1505	; PRCA4. 5284, cor rected typ o of 'asso icated' to 'associat ed'
	1506	"RTN","RCD PRTP1",89, 0)
	1507	; - print the other associate d third pa rty bills
	1508	"RTN","RCD PRTP1",90, 0)
	1509	S RCTP=0 F S RCTP= $O(^TMP("I BRBT",$J,R CBILL,RCTP )) Q:'RCTP !$G(RCQ) D
	1510	"RTN","RCD PRTP1",91, 0)
	1511	.I RCBILL =RCTP Q ; don't rep rint the b ill that w as paid.
	1512	"RTN","RCD PRTP1",92, 0)
	1513	.S RCIBDA T=$G(^TMP( "IBRBT",$J ,RCBILL,RC TP))
	1514	"RTN","RCD PRTP1",93, 0)
	1515	.I 'RCAN, ($P(RCIBDA T,"^",3)) Q ; exclu de cancell ed claims
	1516	"RTN","RCD PRTP1",94, 0)
	1517	.D PRINT1 ^RCDPRTP2
	1518	"RTN","RCD PRTP1",95, 0)
	1519	G:$G(RCQ) PROCQ
	1520	"RTN","RCD PRTP1",96, 0)
	1521	;
	1522	"RTN","RCD PRTP1",97, 0)
	1523	; - print the third party tot als
	1524	"RTN","RCD PRTP1",98, 0)
	1525	; PRCA4. 5276 - ad justed hea der to mak e room for EEOB indi cator '%'
	1526	"RTN","RCD PRTP1",99, 0)
	1527	I $Y>(IOS L-2) D PAU SE^RCDPRTP 2 G:$G(RCQ ) PROCQ D HDR W !
	1528	"RTN","RCD PRTP1",100 ,0)
	1529	W !,?63," ---------- ",?75,"--- -------"
	1530	"RTN","RCD PRTP1",101 ,0)
	1531	W !,?64,$ J(RCAMT(0) ,9,2),?76, $J(RCAMT(1 ),9,2)
	1532	"RTN","RCD PRTP1",102 ,0)
	1533	;
	1534	"RTN","RCD PRTP1",103 ,0)
	1535	; - print the assoc iated firs t party ch arges
	1536	"RTN","RCD PRTP1",104 ,0)
	1537	;
	1538	"RTN","RCD PRTP1",105 ,0)
	1539	; PRCA4. 5315 new screen fo r first pa rty charge s by (CARE TYPES)
	1540	"RTN","RCD PRTP1",106 ,0)
	1541	; check g lobal node ^TMP("IBR BF",$J, al l bills, a ll charges ) --
	1542	"RTN","RCD PRTP1",107 ,0)
	1543	N RCACTYP ,I,J ;D o the next section o f code onl y if Care Types were selected - Stored i n RCTYPE([ care
	1544	type])
	1545	"RTN","RCD PRTP1",108 ,0)
	1546	; We must loop thro ugh all Bi lls and Fi rst party charges fo r this scr eening
	1547	"RTN","RCD PRTP1",109 ,0)
	1548	I $D(RCTY PE)>1 S I= 0 F S I=$ O(^TMP("IB RBF",$J,I) ) Q:'I S J=0 F S J =$O(^TMP(" IBRBF",$J, I,J)) Q:'J D
	1549	"RTN","RCD PRTP1",110 ,0)
	1550	. S RCACT YP=$P(^TMP ("IBRBF",$ J,I,J),U,6 ) Q:RCACTY P="" ;6th piece is Action Typ e
	1551	"RTN","RCD PRTP1",111 ,0)
	1552	. I RCACT YP["TRICAR E"!(RCACTY P["CHAMPA" ) Q ;Not needed for screening 1st party charges
	1553	"RTN","RCD PRTP1",112 ,0)
	1554	. I RCACT YP["RX" S RCTYP="R" D KILFPTY Q
	1555	"RTN","RCD PRTP1",113 ,0)
	1556	. I RCACT YP["OPT"!( RCACTYP["O BSERV") S RCTYP="O" D KILFPTY Q
	1557	"RTN","RCD PRTP1",114 ,0)
	1558	. I RCACT YP["INPT"! (RCACTYP[" NHCU")!(RC ACTYP["ADM IS")!(RCAC TYP["MEDIC ARE DECUCT IBLE") S
	1559	RCTYP="I" D KILFPTY Q
	1560	"RTN","RCD PRTP1",115 ,0)
	1561	. Q
	1562	"RTN","RCD PRTP1",116 ,0)
	1563	;
	1564	"RTN","RCD PRTP1",117 ,0)
	1565	S RCTP(0) =0 F S RC TP(0)=$O(^ TMP("IBRBF ",$J,RCTP( 0))) Q:'RC TP(0)!$G(R CQ) D
	1566	"RTN","RCD PRTP1",118 ,0)
	1567	.I RCTP(0 )=$O(^TMP( "IBRBF",$J ,0)) Q:$D( ^TMP("IBRB F",$J,RCTP (0)))<10 D ;New c ode - quit if
	1568	^TMP("IBRB F" has no sub nodes
	1569	"RTN","RCD PRTP1",119 ,0)
	1570	..I $Y>(I OSL-5) D P AUSE^RCDPR TP2 Q:$G(R CQ) D HDR
	1571	"RTN","RCD PRTP1",120 ,0)
	1572	..; - pri nt the hea der for th e first ch arge
	1573	"RTN","RCD PRTP1",121 ,0)
	1574	..D HDR2^ RCDPRTP2
	1575	"RTN","RCD PRTP1",122 ,0)
	1576	.S RCTP=0 F S RCTP =$O(^TMP(" IBRBF",$J, RCTP(0),RC TP)) Q:'RC TP!$G(RCQ) D
	1577	"RTN","RCD PRTP1",123 ,0)
	1578	..S RCNO= 1 ; set fl ag for at least one match
	1579	"RTN","RCD PRTP1",124 ,0)
	1580	..S RCIBD AT=$G(^TMP ("IBRBF",$ J,RCTP(0), RCTP))
	1581	"RTN","RCD PRTP1",125 ,0)
	1582	..; - pri nt the pat ient detai l line
	1583	"RTN","RCD PRTP1",126 ,0)
	1584	..I RCNO D PRINT2^R CDPRTP2
	1585	"RTN","RCD PRTP1",127 ,0)
	1586	;.
	1587	"RTN","RCD PRTP1",128 ,0)
	1588	; PRCA4. 5284, cle anup ^TMP( $J) only
	1589	"RTN","RCD PRTP1",129 ,0)
	1590	PROCQ ;
	1591	"RTN","RCD PRTP1",130 ,0)
	1592	K ^TMP($J ) Q
	1593	"RTN","RCD PRTP1",131 ,0)
	1594	;
	1595	"RTN","RCD PRTP1",132 ,0)
	1596	;
	1597	"RTN","RCD PRTP1",133 ,0)
	1598	HDR ; Print the main repo rt header.
	1599	"RTN","RCD PRTP1",134 ,0)
	1600	S PG=PG+1 I PG'=1!( $E(IOST,1, 2)="C-") W @IOF
	1601	"RTN","RCD PRTP1",135 ,0)
	1602	W !,?5,"T HIRD PARTY CLAIMS W/ MATCHING F IRST PARTY DEBTS ", RCNOW," PA GE ",PG
	1603	"RTN","RCD PRTP1",136 ,0)
	1604	I RCSORT' =2,(RCSORT '=4) W !,? 18,"FOR TH E PAYMENT DATES: ",D ATEDIS1," TO ",DAT EDIS2
	1605	"RTN","RCD PRTP1",137 ,0)
	1606	I RCSORT= 4 W !,?18, "RECEIPT N UMBER ",RC PT
	1607	"RTN","RCD PRTP1",138 ,0)
	1608	W !,RCDLI NE
	1609	"RTN","RCD PRTP1",139 ,0)
	1610	I PG=1 D
	1611	"RTN","RCD PRTP1",140 ,0)
	1612	.W !!,"Re member tha t any acti ons taken to decreas e the firs t party re ceivables must"
	1613	"RTN","RCD PRTP1",141 ,0)
	1614	.W !,"con sider any applicable deductibl es or coin surance am ounts spec ified on t he EOB."
	1615	"RTN","RCD PRTP1",142 ,0)
	1616	Q
	1617	"RTN","RCD PRTP1",143 ,0)
	1618	;
	1619	"RTN","RCD PRTP1",144 ,0)
	1620	;PRCA4.5 315
	1621	"RTN","RCD PRTP1",145 ,0)
	1622	KILFPTY ;K ILL 1st pa rty associ ated claim from ^TMP ("IBRBF", $J), used to screen out unwant ed 1st par ty
	1623	bills (wro ng Care Ty pe)
	1624	"RTN","RCD PRTP1",146 ,0)
	1625	;Verify t hat the ty pe is one of the sel ected care types, if not delet e the ^TMP global no de for tha t
	1626	charge
	1627	"RTN","RCD PRTP1",147 ,0)
	1628	I '$D(RCT YPE(RCTYP) ) K ^TMP(" IBRBF",$J, I,J)
	1629	"RTN","RCD PRTP1",148 ,0)
	1630	Q
	1631	"RTN","RCD PRTP1",149 ,0)
	1632	;
	1633	"RTN","RCT CSJR")
	1634	0^5^B12496 0188^B1133 25699
	1635	"RTN","RCT CSJR",1,0)
	1636	RCTCSJR ;A LBANY/LEG- CS DEBT RE FERRAL REJ ECT REPORT ING ;07/15 /14 3:34 P M
	1637	"RTN","RCT CSJR",2,0)
	1638	;;4.5;Acc ounts Rece ivable;3 01,315,339 ;Mar 20, 1995;Buil d 2
	1639	"RTN","RCT CSJR",3,0)
	1640	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1641	"RTN","RCT CSJR",4,0)
	1642	;
	1643	"RTN","RCT CSJR",5,0)
	1644	Q
	1645	"RTN","RCT CSJR",6,0)
	1646	ECLIST ; p rints IAI Error Code s List
	1647	"RTN","RCT CSJR",7,0)
	1648	S DIC="^R C(348.5,", BY=.01
	1649	"RTN","RCT CSJR",8,0)
	1650	S (FR,TO) =""
	1651	"RTN","RCT CSJR",9,0)
	1652	S FLDS="[ TCS IAI ER ROR CODES LIST]"
	1653	"RTN","RCT CSJR",10,0 )
	1654	S DHD="TC S IAI ERRO R CODES LI ST"
	1655	"RTN","RCT CSJR",11,0 )
	1656	S DIOBEG= "W !!"
	1657	"RTN","RCT CSJR",12,0 )
	1658	D EN1^DIP
	1659	"RTN","RCT CSJR",13,0 )
	1660	Q
	1661	"RTN","RCT CSJR",14,0 )
	1662	;
	1663	"RTN","RCT CSJR",15,0 )
	1664	RJRPT ; fo r CS REJEC T REPORT p rocessing
	1665	"RTN","RCT CSJR",16,0 )
	1666	D INIT S STOP=0
	1667	"RTN","RCT CSJR",17,0 )
	1668	D PROMPTS Q:POP
	1669	"RTN","RCT CSJR",18,0 )
	1670	Q:STOP
	1671	"RTN","RCT CSJR",19,0 )
	1672	D HEADING ,GETRECS,P RTRECS
	1673	"RTN","RCT CSJR",20,0 )
	1674	K
	1675	%ZIS,ACTN, ASCDES,BIL LID,BILLIE N,BLNKS,BY ,CD,CDIEN, CDREC,CDSH ,CHDR,CHDR S,CNTR,COL DASH,COLH
	1676	DRS,COLWID TH1,COLWID TH2,COLWID TH3,CWID,D ASH,DATA,D ATAITMS,DA TE,DEBTIDX ,DEBTIEN,D EBTO
	1677	R,DEBTREC, DEBTREF,DE FAULT,DESC ,DHD,DIOBE G
	1678	"RTN","RCT CSJR",21,0 )
	1679	K
	1680	DTFRM,DTFR MTO,DTFROM ,DTTO,ECDS ,EXCEL,FIE LD,FLDS,FR ,GROUPBD,H DTITLE,I,I NCLUDE,IND ATE,L,LE
	1681	V1,LEV2,LE V3,LEV4,LN ,OUTDATE,P AGE,POP,QU IT,RPTITEM S,RPTREC,S EQ,SRC,SSN ,STOP,STR, TO,TYP,UPD
	1682	N,RECW1,RE CW2,EXCOLH ,EXSSN,CDR EC1
	1683	"RTN","RCT CSJR",22,0 )
	1684	Q
	1685	"RTN","RCT CSJR",23,0 )
	1686	;
	1687	"RTN","RCT CSJR",24,0 )
	1688	INIT ;
	1689	"RTN","RCT CSJR",25,0 )
	1690	K ^TMP("R CTCSJR",$J ),REC
	1691	"RTN","RCT CSJR",26,0 )
	1692	S DASH="" ,$P(DASH," -",78)="" ; (as per PRCA4.5 315)
	1693	"RTN","RCT CSJR",27,0 )
	1694	S BLNKS=" ",$P(BLNKS ," ",71)=" "
	1695	"RTN","RCT CSJR",28,0 )
	1696	S
	1697	DATAITMS=" DATE^SRC^E CD(1)^ECD( 2)^ECD(3)^ ECD(4)^ECD (5)^ECD(6) ^ECD(7)^EC D(8)^ECD(9 )^TYP^AC
	1698	TN"
	1699	"RTN","RCT CSJR",29,0 )
	1700	S RPTITEM S="BILLID^ DEBTOR^SSN ^TYP^ACTN^ OUTDATE^SR C^ECDS"
	1701	"RTN","RCT CSJR",30,0 )
	1702	I $G(EXCE L) S RPTIT EMS="BILLI D^DEBTOR^E XSSN^TYP^A CTN^OUTDAT E^SRC^ECDS ^RECDET"
	1703	;PRCA4.5 315
	1704	"RTN","RCT CSJR",31,0 )
	1705	Q
	1706	"RTN","RCT CSJR",32,0 )
	1707	;
	1708	"RTN","RCT CSJR",33,0 )
	1709	GETRECS ;
	1710	"RTN","RCT CSJR",34,0 )
	1711	N PC,RECD ET
	1712	"RTN","RCT CSJR",35,0 )
	1713	K ^TMP("R CTCSJR",$J )
	1714	"RTN","RCT CSJR",36,0 )
	1715	S (DATE,D TFRM)=$$FM ADD^XLFDT( +$P(DTFRMT O,U,2),-1) ,DTTO=$P(D TFRMTO,U,3 )
	1716	"RTN","RCT CSJR",37,0 )
	1717	F S DATE =$O(^PRCA( 430,"AB",D ATE)),BILL IEN=0 Q:DA TE>DTTO!'D ATE D ;
	1718	"RTN","RCT CSJR",38,0 )
	1719	. S INDAT E=DATE,OUT DATE=$$FMT E^XLFDT(DA TE,"2Z") ;Standardi ze dates ( as per PRC A4.5315)
	1720	"RTN","RCT CSJR",39,0 )
	1721	. F S BI LLIEN=$O(^ PRCA(430," AB",DATE,B ILLIEN)),S EQ=0 Q:BIL LIEN="" D ;
	1722	"RTN","RCT CSJR",40,0 )
	1723	.. S BILL ID=$P(^PRC A(430,BILL IEN,0),U)
	1724	"RTN","RCT CSJR",41,0 )
	1725	.. S DEBT IEN=$P(^PR CA(430,BIL LIEN,0),U, 9) ;33460
	1726	"RTN","RCT CSJR",42,0 )
	1727	.. S DEBT IDX=$P($G( ^RCD(340,D EBTIEN,0)) ,U) ;77770 6050;DPT(
	1728	"RTN","RCT CSJR",43,0 )
	1729	.. Q:$G(D EBTIDX)=""
	1730	"RTN","RCT CSJR",44,0 )
	1731	.. S DEBT REF="^"_$P (DEBTIDX," ;",2)_$P(D EBTIDX,";" )_",0)"
	1732	"RTN","RCT CSJR",45,0 )
	1733	.. S DEBT REC=@(DEBT REF)
	1734	"RTN","RCT CSJR",46,0 )
	1735	.. S DEBT OR=$E($P(D EBTREC,U), 1,19),SSN= $E($$SSN^R CFN01($P($ G(^RCD(340 ,DEBTIEN,0 )),"^")),6 ,9)
	1736	;Last 4 of SSN only (as per PR CA4.5315 )
	1737	"RTN","RCT CSJR",47,0 )
	1738	.. S SSN= $E($$SSN^R CFN01($P($ G(^RCD(340 ,DEBTIEN,0 )),"^")),6 ,9) ;Last 4 of SSN if Excel
	1739	PRCA4.53 15
	1740	"RTN","RCT CSJR",48,0 )
	1741	.. S EXSS N=$E(DEBTO R)_$S(SSN' ="":SSN,1: " ") ; 1st init last name, last 4 of SSN if no t Excel
	1742	PRCA4.53 15
	1743	"RTN","RCT CSJR",49,0 )
	1744	.. F S S EQ=$O(^PRC A(430,"AB" ,DATE,BILL IEN,SEQ)) Q:SEQ="" D ;
	1745	"RTN","RCT CSJR",50,0 )
	1746	... S DAT A=$G(^PRCA (430,BILLI EN,18,SEQ, 0))
	1747	"RTN","RCT CSJR",51,0 )
	1748	... Q:'$L (DATA) ; in the eve nt the X-R EF is out of sync du e to test clearing
	1749	"RTN","RCT CSJR",52,0 )
	1750	... F PC= 2,12,13 S
	1751	CD=$P(DATA ,U,PC),X=$ P(DATAITMS ,U,PC)_"=" ""_$S(CD=" ":CD,PC=2: CD,PC=12:$ P($G(^RC(3 48.7,CD,0) ),
	1752	U),PC=13:$ P($G(^RC(3 48.6,CD,0) ),U),1:"") _"""",@X
	1753	"RTN","RCT CSJR",53,0 )
	1754	... K ECD
	1755	"RTN","RCT CSJR",54,0 )
	1756	... S ECD S=""
	1757	"RTN","RCT CSJR",55,0 )
	1758	... F PC= 3:1:11 S C D=$P(DATA, U,PC) Q:'$ L(CD) S
	1759	CD=$S('$D( ^RC(348.5, CD,0)):CD, 1:$P(^RC(3 48.5,CD,0) ,U)) S X=" S "_$P(DAT AITMS,U,PC )_"="""_CD _""""
	1760	D ;
	1761	"RTN","RCT CSJR",56,0 )
	1762	.... Q:'$ D(^RC(348. 5,$P(DATA, U,PC),0))! (CD="ZZ") ; quits j ust in cas e bad erro r code got thru
	1763	"RTN","RCT CSJR",57,0 )
	1764	.... X X
	1765	"RTN","RCT CSJR",58,0 )
	1766	.... S EC DS=ECDS_$S (PC>3:";", 1:"")_ECD( PC-2) ;Err or codes n ew delimit er ";"
	1767	"RTN","RCT CSJR",59,0 )
	1768	... ; ge ts record layout bas ed on RPTT YP and pla ces into R PTTYP sort ing sequen ce
	1769	"RTN","RCT CSJR",60,0 )
	1770	... D @RP TTYP ;1=BI LL NO. 2= DEBTOR 3= REJECT DAT E
	1771	"RTN","RCT CSJR",61,0 )
	1772	... Q ;
	1773	"RTN","RCT CSJR",62,0 )
	1774	... ;
	1775	"RTN","RCT CSJR",63,0 )
	1776	S LEV1="" ,CNTR=0
	1777	"RTN","RCT CSJR",64,0 )
	1778	K REC
	1779	"RTN","RCT CSJR",65,0 )
	1780	S UPDN=$S (ASCDES="D ":-1,1:1) ; determin es ASCendi ng or DeSC ending dir ection
	1781	"RTN","RCT CSJR",66,0 )
	1782	F S LEV1 =$O(^TMP(" RCTCSJR",$ J,"RPT",LE V1),UPDN), LEV2="" Q: LEV1="" D ;
	1783	"RTN","RCT CSJR",67,0 )
	1784	. F S LE V2=$O(^TMP ("RCTCSJR" ,$J,"RPT", LEV1,LEV2) ,UPDN),LEV 3="" Q:LEV 2="" D ;
	1785	"RTN","RCT CSJR",68,0 )
	1786	.. F S L EV3=$O(^TM P("RCTCSJR ",$J,"RPT" ,LEV1,LEV2 ,LEV3),UPD N),LEV4="" Q:LEV3="" D ;
	1787	"RTN","RCT CSJR",69,0 )
	1788	... F S LEV4=$O(^T MP("RCTCSJ R",$J,"RPT ",LEV1,LEV 2,LEV3,LEV 4),UPDN) Q :LEV4="" D ;
	1789	"RTN","RCT CSJR",70,0 )
	1790	.... S RP TREC=^TMP( "RCTCSJR", $J,"RPT",L EV1,LEV2,L EV3,LEV4)
	1791	"RTN","RCT CSJR",71,0 )
	1792	.... I 'E XCEL S SRC =$E(RPTREC ,65)
	1793	"RTN","RCT CSJR",72,0 )
	1794	.... I EX CEL S SRC= $P(RPTREC, U,7)
	1795	"RTN","RCT CSJR",73,0 )
	1796	.... I IN CLUDE'="AL L",INCLUDE '=SRC Q ; unwanted source
	1797	"RTN","RCT CSJR",74,0 )
	1798	.... S CN TR=CNTR+1
	1799	"RTN","RCT CSJR",75,0 )
	1800	.... S RE C(CNTR)=$P (RPTREC,"; ",1,$S(EXC EL:10,1:4) )
	1801	"RTN","RCT CSJR",76,0 )
	1802	.... I EX CEL S RECW 1=$E(REC(C NTR),1,70) ,RECW2=$TR ($E(REC(CN TR),71,999 ),"^","-
	1803	"),REC(CNT R)=RECW1_R ECW2
	1804	"RTN","RCT CSJR",77,0 )
	1805	.... ;Q:E XCEL ; only nee ds single line strin g if in Ex cel format
	1806	"RTN","RCT CSJR",78,0 )
	1807	.... I 'E XCEL S
	1808	RECW1=$E(R EC(CNTR),1 ,70),RECW2 =$TR($E(RE C(CNTR),71 ,999),"^", ";"),REC(C NTR)=RECW1 _RECW2
	1809	"RTN","RCT CSJR",79,0 )
	1810	.... I 'E XCEL,$L($P (RPTREC,"; ",5,8)) D
	1811	"RTN","RCT CSJR",80,0 )
	1812	..... S C NTR=CNTR+1 ,REC(CNTR) =$E(BLNKS, 1,67)_$P(R PTREC,";", 5,8)
	1813	"RTN","RCT CSJR",81,0 )
	1814	.... I 'E XCEL,$L($P (RPTREC,"; ",9)) D
	1815	"RTN","RCT CSJR",82,0 )
	1816	..... S C NTR=CNTR+1 ,REC(CNTR) =$E(BLNKS, 1,67)_$P(R PTREC,";", 9)
	1817	"RTN","RCT CSJR",83,0 )
	1818	.... I GR OUPBD="D" D ;
	1819	"RTN","RCT CSJR",84,0 )
	1820	..... K E CD
	1821	"RTN","RCT CSJR",85,0 )
	1822	..... S E CDS=$E(RPT REC,68,100 )
	1823	"RTN","RCT CSJR",86,0 )
	1824	..... F I =1:1:9 S E CD(I)=$P(E CDS,";",I) Q:'$L(ECD (I)) D
	1825	"RTN","RCT CSJR",87,0 )
	1826	...... S CD=$P(ECDS ,";",I),CD IEN=$O(^RC (348.5,"B" ,CD,0))
	1827	"RTN","RCT CSJR",88,0 )
	1828	...... S (CDREC,CDR EC1)="" I CDIEN,$D(^ RC(348.5,C DIEN)) S
	1829	CDREC=^RC( 348.5,CDIE N,0),CDREC 1=$G(^RC(3 48.5,CDIEN ,1))
	1830	"RTN","RCT CSJR",89,0 )
	1831	...... S (X,DESC,RE CDET)=" " _CD_" - "_ CDREC1
	1832	"RTN","RCT CSJR",90,0 )
	1833	...... I $L(DESC)<8 1 S CNTR=C NTR+1,REC( CNTR)=X
	1834	"RTN","RCT CSJR",91,0 )
	1835	...... ; splits li ne if > 80 chars
	1836	"RTN","RCT CSJR",92,0 )
	1837	...... I $L(DESC)>8 0 D ;
	1838	"RTN","RCT CSJR",93,0 )
	1839	....... F S STR=$E (X,1,80) D Q:'$L(X) ;
	1840	"RTN","RCT CSJR",94,0 )
	1841	........ I $L(X)<81 S CNTR=CN TR+1 S REC (CNTR)=X,X ="" Q
	1842	"RTN","RCT CSJR",95,0 )
	1843	........ F L=$L(STR ):-1:1 I $ F(STR," ", L) D Q ;
	1844	"RTN","RCT CSJR",96,0 )
	1845	......... S CNTR=CN TR+1
	1846	"RTN","RCT CSJR",97,0 )
	1847	......... S REC(CNT R)=$E(X,1, L),X=$E(X, L+1,999)
	1848	"RTN","RCT CSJR",98,0 )
	1849	......... I $L(X) S X=" " _X
	1850	"RTN","RCT CSJR",99,0 )
	1851	......... Q ;
	1852	"RTN","RCT CSJR",100, 0)
	1853	M ^TMP("R CTCSJR",$J ,"REC")=RE C
	1854	"RTN","RCT CSJR",101, 0)
	1855	Q
	1856	"RTN","RCT CSJR",102, 0)
	1857	;
	1858	"RTN","RCT CSJR",103, 0)
	1859	1 ; for re port by 1) Bill Numb er
	1860	"RTN","RCT CSJR",104, 0)
	1861	S QUIT=0
	1862	"RTN","RCT CSJR",105, 0)
	1863	I 'EXCEL D Q:QUIT ;
	1864	"RTN","RCT CSJR",106, 0)
	1865	. S RPTRE C=""
	1866	"RTN","RCT CSJR",107, 0)
	1867	. F PC=1: 1:7 D Q:Q UIT ;
	1868	"RTN","RCT CSJR",108, 0)
	1869	.. S FIEL D=$P(RPTIT EMS,U,PC)
	1870	"RTN","RCT CSJR",109, 0)
	1871	.. I PC=7 ,INCLUDE'= "ALL",@FIE LD'=INCLUD E S QUIT=1 Q ;
	1872	"RTN","RCT CSJR",110, 0)
	1873	.. S RPTR EC=RPTREC_ $E(@FIELD_ BLNKS,1,$P (COLWIDTH1 ,U,PC))
	1874	"RTN","RCT CSJR",111, 0)
	1875	. F PC=8 S RPTREC=R PTREC_@$P( RPTITEMS,U ,PC)
	1876	"RTN","RCT CSJR",112, 0)
	1877	I EXCEL S RPTREC=BI LLID_U_DEB TOR_U_EXSS N_U_TYP_U_ ACTN_U_OUT DATE_U_SRC _U_ECDS ;
	1878	PRCA4.53 15
	1879	"RTN","RCT CSJR",113, 0)
	1880	S ^TMP("R CTCSJR",$J ,"RPT",BIL LID,INDATE ,DEBTOR,SE Q)=RPTREC
	1881	"RTN","RCT CSJR",114, 0)
	1882	Q
	1883	"RTN","RCT CSJR",115, 0)
	1884	2 ; for re port by 2) Debtor Na me
	1885	"RTN","RCT CSJR",116, 0)
	1886	S QUIT=0
	1887	"RTN","RCT CSJR",117, 0)
	1888	I EXCEL S RPTREC=DE BTOR_U_BIL LID_U_EXSS N_U_TYP_U_ ACTN_U_OUT DATE_U_SRC _U_ECDS ;
	1889	PRCA4.53 15
	1890	"RTN","RCT CSJR",118, 0)
	1891	I 'EXCEL D Q:QUIT ;
	1892	"RTN","RCT CSJR",119, 0)
	1893	. S RPTRE C=""
	1894	"RTN","RCT CSJR",120, 0)
	1895	. F PC=2, 1,3:1:7 D Q:QUIT ;
	1896	"RTN","RCT CSJR",121, 0)
	1897	.. S FIEL D=$P(RPTIT EMS,U,PC)
	1898	"RTN","RCT CSJR",122, 0)
	1899	.. I PC=7 ,INCLUDE'= "ALL",@FIE LD'=INCLUD E S QUIT=1 Q ;
	1900	"RTN","RCT CSJR",123, 0)
	1901	.. S RPTR EC=RPTREC_ $E(@FIELD_ BLNKS,1,$P (COLWIDTH2 ,U,PC))
	1902	"RTN","RCT CSJR",124, 0)
	1903	. F PC=8 S RPTREC=R PTREC_@$P( RPTITEMS,U ,PC)
	1904	"RTN","RCT CSJR",125, 0)
	1905	S ^TMP("R CTCSJR",$J ,"RPT",DEB TOR,BILLID ,INDATE,SE Q)=RPTREC
	1906	"RTN","RCT CSJR",126, 0)
	1907	Q
	1908	"RTN","RCT CSJR",127, 0)
	1909	3 ; for re port by 3) CS Reject Date
	1910	"RTN","RCT CSJR",128, 0)
	1911	S QUIT=0
	1912	"RTN","RCT CSJR",129, 0)
	1913	I EXCEL S RPTREC=OU TDATE_U_BI LLID_U_DEB TOR_U_EXSS N_U_TYP_U_ ACTN_U_SRC _U_ECDS ;
	1914	PRCA4.53 15
	1915	"RTN","RCT CSJR",130, 0)
	1916	I 'EXCEL D Q:QUIT ;
	1917	"RTN","RCT CSJR",131, 0)
	1918	. S RPTRE C=""
	1919	"RTN","RCT CSJR",132, 0)
	1920	. F PC=6, 1:1:5,7 D Q:QUIT ;
	1921	"RTN","RCT CSJR",133, 0)
	1922	.. S FIEL D=$P(RPTIT EMS,U,PC)
	1923	"RTN","RCT CSJR",134, 0)
	1924	.. I PC=7 ,INCLUDE'= "ALL",@FIE LD'=INCLUD E S QUIT=1 Q ;
	1925	"RTN","RCT CSJR",135, 0)
	1926	.. S RPTR EC=RPTREC_ $E(@$P(RPT ITEMS,U,PC )_BLNKS,1, $P(COLWIDT H3,U,PC))
	1927	"RTN","RCT CSJR",136, 0)
	1928	. F PC=8 S RPTREC=R PTREC_@$P( RPTITEMS,U ,PC)
	1929	"RTN","RCT CSJR",137, 0)
	1930	S ^TMP("R CTCSJR",$J ,"RPT",IND ATE,BILLID ,DEBTOR,SE Q)=RPTREC
	1931	"RTN","RCT CSJR",138, 0)
	1932	Q
	1933	"RTN","RCT CSJR",139, 0)
	1934	QRPT ;if q ueued
	1935	"RTN","RCT CSJR",140, 0)
	1936	D HEADING ,GETRECS,P RTRECS
	1937	"RTN","RCT CSJR",141, 0)
	1938	Q
	1939	"RTN","RCT CSJR",142, 0)
	1940	;
	1941	"RTN","RCT CSJR",143, 0)
	1942	PRTRECS ; prints rep ort
	1943	"RTN","RCT CSJR",144, 0)
	1944	S PAGE=0
	1945	"RTN","RCT CSJR",145, 0)
	1946	K DIRUT,D UOUT,DTOUT
	1947	"RTN","RCT CSJR",146, 0)
	1948	D HEADING ,REJREPH
	1949	"RTN","RCT CSJR",147, 0)
	1950	S LN=0 F LN=1:1 Q:' $D(^TMP("R CTCSJR",$J ,"REC",LN) ) D Q:$D (DIRUT)!$D (DUOUT)!$D (DTOUT)
	1951	"RTN","RCT CSJR",148, 0)
	1952	. W ^TMP( "RCTCSJR", $J,"REC",L N),!
	1953	"RTN","RCT CSJR",149, 0)
	1954	. ; ch eck for en d of page here, if n ecessary f orm feed a nd print h eader
	1955	"RTN","RCT CSJR",150, 0)
	1956	. I $Y+3> IOSL D
	1957	"RTN","RCT CSJR",151, 0)
	1958	.. I $E(I OST,1,2)=" C-" S DIR( 0)="E" K D IRUT D ^DI R Q:$D(DIR UT)!$D(DUO UT)!$D(DTO UT)
	1959	"RTN","RCT CSJR",152, 0)
	1960	.. D REJR EPH
	1961	"RTN","RCT CSJR",153, 0)
	1962	. Q
	1963	"RTN","RCT CSJR",154, 0)
	1964	I $E(IOST ,1,2)="C-" R !!,"END OF REPORT ...PRESS R ETURN TO C ONTINUE",X :DTIME W @ IOF
	1965	"RTN","RCT CSJR",155, 0)
	1966	D ^%ZISC
	1967	"RTN","RCT CSJR",156, 0)
	1968	K ^TMP("R CTCSJR",$J )
	1969	"RTN","RCT CSJR",157, 0)
	1970	I $D(ZTQU EUED) S ZT REQ="@" ; purge t he task
	1971	"RTN","RCT CSJR",158, 0)
	1972	Q
	1973	"RTN","RCT CSJR",159, 0)
	1974	REJREPH ;
	1975	"RTN","RCT CSJR",160, 0)
	1976	U IO W @I OF S PAGE= PAGE+1
	1977	"RTN","RCT CSJR",161, 0)
	1978	W "PAGE " _PAGE,?10, HDTITLE,?6 8,$$FMTE^X LFDT(DT,"2 Z") ;Sta ndardize t he date
	1979	"RTN","RCT CSJR",162, 0)
	1980	I EXCEL W !,$TR(CHD R," ",""), ! Q
	1981	"RTN","RCT CSJR",163, 0)
	1982	W !,DASH, !,CHDR,!,C DSH,! Q
	1983	"RTN","RCT CSJR",164, 0)
	1984	Q
	1985	"RTN","RCT CSJR",165, 0)
	1986	COLHDR ; s ets report line base d on type of report
	1987	"RTN","RCT CSJR",166, 0)
	1988	S CHDR=CH DR_$P(COLH DRS,U,PC)_ $S(EXCEL:" ^",1:"")
	1989	"RTN","RCT CSJR",167, 0)
	1990	S CDSH=CD SH_$P(COLD ASH,U,PC)_ $S(EXCEL:" ^",1:"")
	1991	"RTN","RCT CSJR",168, 0)
	1992	Q
	1993	"RTN","RCT CSJR",169, 0)
	1994	HEADING ; compiles info for H eading and titles fo r cross-se rvicing re ject repor t
	1995	"RTN","RCT CSJR",170, 0)
	1996	S HDTITLE ="DEBT REF ERRAL REJE CT REPORT (SORTED BY "_$P("BIL L NO.^DEBT OR^REJ DAT E",U,RPTTY P)
	1997	"RTN","RCT CSJR",171, 0)
	1998	S HDTITLE =HDTITLE_" <"_$S(ASC DES="D":"D SC",1:"ASC ")_">)"
	1999	"RTN","RCT CSJR",172, 0)
	2000	;
	2001	"RTN","RCT CSJR",173, 0)
	2002	S COLWIDT H1="12^20^ 9^5^5^13^3 ^11" ;Cha nge SSN to last init ial last 4 only (as per PRCA4 .5315)
	2003	"RTN","RCT CSJR",174, 0)
	2004	S COLWIDT H2="12^20^ 9^5^5^13^3 ^8",COLWID TH3="12^20 ^9^5^6^12^ 3^11"
	2005	"RTN","RCT CSJR",175, 0)
	2006	S EXCOLH= "BILL NO.^ DEBTOR^Pt ID^TYP ^AC TNCD ^REJE CT DATE ^S RC ^ERR CO DES"
	2007	"RTN","RCT CSJR",176, 0)
	2008	S COLHDRS ="BILL NO. ^DEBTO R ^Pt I D ^TYP ^ ACTNCD ^RE JECT DATE ^SRC ^ERR CODES"
	2009	"RTN","RCT CSJR",177, 0)
	2010	S COLDASH ="-------- --- ^----- ---------- ---- ^---- - ^--- ^ ------ ^-- --------- ^--- ^---- -----"
	2011	"RTN","RCT CSJR",178, 0)
	2012	S (CHDR,C DSH,CWID)= ""
	2013	"RTN","RCT CSJR",179, 0)
	2014	I RPTTYP= 1 S
	2015	CWID=COLWI DTH1,CHDR= $S(EXCEL:C OLHDRS,1:$ TR(COLHDRS ,"^","")), CDSH=$S(EX CEL:COLDAS H,1:$TR(
	2016	COLDASH,"^ ",""))
	2017	"RTN","RCT CSJR",180, 0)
	2018	I RPTTYP= 2 F PC=2,1 ,3:1:8 D C OLHDR
	2019	"RTN","RCT CSJR",181, 0)
	2020	I RPTTYP= 3 F PC=6,1 :1:5,7,8 D COLHDR
	2021	"RTN","RCT CSJR",182, 0)
	2022	Q
	2023	"RTN","RCT CSJR",183, 0)
	2024	PROMPTS S U="^"
	2025	"RTN","RCT CSJR",184, 0)
	2026	S STOP=0, PROMPT="** * DEBT REF ERRAL REJE CT REPORT ***"
	2027	"RTN","RCT CSJR",185, 0)
	2028	S DTFRMTO =$$DTFRMTO (PROMPT) I 'DTFRMTO S (STOP,PO P)=1 Q
	2029	"RTN","RCT CSJR",186, 0)
	2030	;
	2031	"RTN","RCT CSJR",187, 0)
	2032	S PROMPT= "Group Err or Codes: Brief or Detail"
	2033	"RTN","RCT CSJR",188, 0)
	2034	S DIR(0)= "SB^B:Brie f;D:Detail "
	2035	"RTN","RCT CSJR",189, 0)
	2036	S GROUPBD =$$SELECT( PROMPT,"B" ) I "BD"'[ GROUPBD S (STOP,POP) =1 Q
	2037	"RTN","RCT CSJR",190, 0)
	2038	;
	2039	"RTN","RCT CSJR",191, 0)
	2040	S SET="S^ 1:Bill Num ber;2:Debt or Name;3: CS Reject Date"
	2041	"RTN","RCT CSJR",192, 0)
	2042	S RPTTYP= $$RPTTYP(" Select One of the Fo llowing:", SET) I 'RP TTYP S (ST OP,POP)=1 Q
	2043	"RTN","RCT CSJR",193, 0)
	2044	;
	2045	"RTN","RCT CSJR",194, 0)
	2046	S PROMPT= "Include O nly: AITC, DMC, TREA SURY or 'A LL'"
	2047	"RTN","RCT CSJR",195, 0)
	2048	S DIR(0)= "SB^A:AITC ;D:DMC;T:T REASURY;AL L:ALL",DIR ("L")=PROM PT
	2049	"RTN","RCT CSJR",196, 0)
	2050	S INCLUDE =$$SELECT( PROMPT,"AL L") I "ADT "'[$E(INCL UDE) S (ST OP,POP)=1 Q
	2051	"RTN","RCT CSJR",197, 0)
	2052	;
	2053	"RTN","RCT CSJR",198, 0)
	2054	S PROMPT= "Sort ASCE NDING or D ESCENDING" ,DIR(0)="S B^A:ASCEND ING;D:DESC ENDING"
	2055	"RTN","RCT CSJR",199, 0)
	2056	S DIR("L" )=PROMPT
	2057	"RTN","RCT CSJR",200, 0)
	2058	S ASCDES= $$SELECT(P ROMPT,"A") I "AD"'[A SCDES S (S TOP,POP)=1 Q
	2059	"RTN","RCT CSJR",201, 0)
	2060	;
	2061	"RTN","RCT CSJR",202, 0)
	2062	S EXCEL=0
	2063	"RTN","RCT CSJR",203, 0)
	2064	I GROUPBD ="B" D
	2065	"RTN","RCT CSJR",204, 0)
	2066	. S PROMP T="CAPTURE Report da ta to an E xcel Docum ent"
	2067	"RTN","RCT CSJR",205, 0)
	2068	. S DIR(0 )="Y",DIR( "?")="^D H EXC^RCTCSJ R"
	2069	"RTN","RCT CSJR",206, 0)
	2070	. S EXCEL =$$SELECT( PROMPT,"NO ") I "01"' [EXCEL S ( POP,STOP)= 1 Q
	2071	"RTN","RCT CSJR",207, 0)
	2072	I EXCEL=1 D EXCMSG^ RCTCSJR ; Display Ex cel displa y message
	2073	"RTN","RCT CSJR",208, 0)
	2074	;
	2075	"RTN","RCT CSJR",209, 0)
	2076	K IOP,IO( "Q") S %ZI S="MQ",%ZI S("B")="" D ^%ZIS I POP S STOP =1 Q
	2077	"RTN","RCT CSJR",210, 0)
	2078	I $D(IO(" Q")) D Q
	2079	"RTN","RCT CSJR",211, 0)
	2080	.S
	2081	ZTSAVE("DE BTOR")="", ZTSAVE("DT FRMTO")="" ,ZTSAVE("E XCEL")="", ZTSAVE("PR OMPT")="", ZTSAVE("DA
	2082	SH")="",ZT SAVE("BLNK S")="",ZTS AVE("DATAI TMS")="",Z TSAVE("RPT ITEMS")=""
	2083	"RTN","RCT CSJR",212, 0)
	2084	.S
	2085	ZTSAVE("GR OUPBD")="" ,ZTSAVE("R PTTYP")="" ,ZTSAVE("I NCLUDE")=" ",ZTSAVE(" ASCDES")=" ",ZTSAVE(" C
	2086	HDR")="",Z TSAVE("CDS H")="",ZTS AVE("ZTASK ")=""
	2087	"RTN","RCT CSJR",213, 0)
	2088	.S ZTRTN= "QRPT^RCTC SJR",ZTDES C="CROSS-S ERVICING B ILL REPORT "
	2089	"RTN","RCT CSJR",214, 0)
	2090	.D ^%ZTLO AD,^%ZISC S (STOP,PO P)=1
	2091	"RTN","RCT CSJR",215, 0)
	2092	.I $G(ZTS K) W !!,"R eport comp ilation ha s started with task# ",ZTSK,". ",! S DIR( 0)="E" D ^ DIR K DIR
	2093	"RTN","RCT CSJR",216, 0)
	2094	.Q
	2095	"RTN","RCT CSJR",217, 0)
	2096	Q ; PROM PTS
	2097	"RTN","RCT CSJR",218, 0)
	2098	;
	2099	"RTN","RCT CSJR",219, 0)
	2100	SELECT(PRO MPT,DEFAUL T) ; promp ts for a s election
	2101	"RTN","RCT CSJR",220, 0)
	2102	;INPUT:
	2103	"RTN","RCT CSJR",221, 0)
	2104	; PROMP T - Messag e to displ ay prior t o promptin g for date s
	2105	"RTN","RCT CSJR",222, 0)
	2106	;OUTPUT:
	2107	"RTN","RCT CSJR",223, 0)
	2108	; 1^BE GDT^ENDDT - Data fou nd
	2109	"RTN","RCT CSJR",224, 0)
	2110	; 0 - User up arrowed or timed out
	2111	"RTN","RCT CSJR",225, 0)
	2112	N Y,X,DTO UT,OUT,DIR UT,DUOUT,D IROUT
	2113	"RTN","RCT CSJR",226, 0)
	2114	S OUT=0
	2115	"RTN","RCT CSJR",227, 0)
	2116	W !
	2117	"RTN","RCT CSJR",228, 0)
	2118	S DIR("A" )=PROMPT,D IR("B")=DE FAULT
	2119	"RTN","RCT CSJR",229, 0)
	2120	D ^DIR K DIR
	2121	"RTN","RCT CSJR",230, 0)
	2122	;Quit if user time out or did n't enter valid date
	2123	"RTN","RCT CSJR",231, 0)
	2124	Q:Y<0 OUT
	2125	"RTN","RCT CSJR",232, 0)
	2126	Q Y
	2127	"RTN","RCT CSJR",233, 0)
	2128	;
	2129	"RTN","RCT CSJR",234, 0)
	2130	RPTTYP(PRO MPT,SET) ; PRINT CROS S-SERVICIN G REPORT; print cros s-servicin g report, prints sor ted
	2131	individual bills tha t make up a cross-se rvicing ac count
	2132	"RTN","RCT CSJR",235, 0)
	2133	N DIC,ZTS AVE,ZTDESC ,ZTRTN,RCS ORT
	2134	"RTN","RCT CSJR",236, 0)
	2135	S OUT=0
	2136	"RTN","RCT CSJR",237, 0)
	2137	W !
	2138	"RTN","RCT CSJR",238, 0)
	2139	S DIR(0)= SET ;"S^1: Bill Numbe r;2:Debtor Name;3:CS Reject Da te"
	2140	"RTN","RCT CSJR",239, 0)
	2141	S DIR("A" )="Sort by ",DIR("B") =1 D ^DIR K DIR
	2142	"RTN","RCT CSJR",240, 0)
	2143	Q:Y<0 OUT
	2144	"RTN","RCT CSJR",241, 0)
	2145	Q Y
	2146	"RTN","RCT CSJR",242, 0)
	2147	;
	2148	"RTN","RCT CSJR",243, 0)
	2149	DTFRMTO(PR OMPT) ;Get from and to dates
	2150	"RTN","RCT CSJR",244, 0)
	2151	;INPUT:
	2152	"RTN","RCT CSJR",245, 0)
	2153	; PROMP T - Messag e to displ ay prior t o promptin g for date s
	2154	"RTN","RCT CSJR",246, 0)
	2155	;OUTPUT:
	2156	"RTN","RCT CSJR",247, 0)
	2157	; 1^BE GDT^ENDDT - Data fou nd
	2158	"RTN","RCT CSJR",248, 0)
	2159	; 0 - User up arrowed or timed out
	2160	"RTN","RCT CSJR",249, 0)
	2161	;
	2162	"RTN","RCT CSJR",250, 0)
	2163	N %DT,Y,X ,BEGDT,END DT,DTOUT,O UT,DIRUT,D UOUT,DIROU T
	2164	"RTN","RCT CSJR",251, 0)
	2165	S OUT=0
	2166	"RTN","RCT CSJR",252, 0)
	2167	W !,$G(PR OMPT)
	2168	"RTN","RCT CSJR",253, 0)
	2169	S %DT="AE X",%DT("A" )="Date Ra nge: FROM: " ;Enter Beginning Date: "
	2170	"RTN","RCT CSJR",254, 0)
	2171	S %DT("B" )="T-7"
	2172	"RTN","RCT CSJR",255, 0)
	2173	W !
	2174	"RTN","RCT CSJR",256, 0)
	2175	D ^%DT K %DT
	2176	"RTN","RCT CSJR",257, 0)
	2177	Q:Y<0 OUT ;Quit if user time out or di dn't enter valid dat e
	2178	"RTN","RCT CSJR",258, 0)
	2179	S DTFROM= +Y
	2180	"RTN","RCT CSJR",259, 0)
	2181	S %DT="AE X"
	2182	"RTN","RCT CSJR",260, 0)
	2183	S %DT("A" )=" TO: ",%DT(" B")="T" ;" TODAY"
	2184	"RTN","RCT CSJR",261, 0)
	2185	D ^%DT K %DT
	2186	"RTN","RCT CSJR",262, 0)
	2187	;Quit if user time out or did n't enter valid date
	2188	"RTN","RCT CSJR",263, 0)
	2189	Q:Y<0 OUT
	2190	"RTN","RCT CSJR",264, 0)
	2191	S DTTO=+Y ,OUT=1_U_D TFROM_U_DT TO
	2192	"RTN","RCT CSJR",265, 0)
	2193	;Switch d ates if Be gin Date i s more rec ent than E nd Date
	2194	"RTN","RCT CSJR",266, 0)
	2195	S:DTFROM> DTTO OUT=1 _U_DTTO_U_ DTFROM
	2196	"RTN","RCT CSJR",267, 0)
	2197	Q OUT
	2198	"RTN","RCT CSJR",268, 0)
	2199	;
	2200	"RTN","RCT CSJR",269, 0)
	2201	HEXC ; - ' Do you wan t to captu re data to EXCEL' pr ompt
	2202	"RTN","RCT CSJR",270, 0)
	2203	W !!," Enter: 'Y' - To capture detail re port data to transfe r",!," to an Exce l document "
	2204	"RTN","RCT CSJR",271, 0)
	2205	W !," '<CR>' - To skip th is option" ,!," '^ ' - To quit this option"
	2206	"RTN","RCT CSJR",272, 0)
	2207	Q
	2208	"RTN","RCT CSJR",273, 0)
	2209	;
	2210	"RTN","RCT CSJR",274, 0)
	2211	EXCMSG ; - Displays the messag e about ca pturing to an Excel file forma t
	2212	"RTN","RCT CSJR",275, 0)
	2213	;
	2214	"RTN","RCT CSJR",276, 0)
	2215	W !!?5,"T o capture as an Exce l format, it is reco mmended th at you que ue this"
	2216	"RTN","RCT CSJR",277, 0)
	2217	W !?5,"re port to a spool devi ce with ma rgins of 2 56 and pag e length o f 99999"
	2218	"RTN","RCT CSJR",278, 0)
	2219	W !?5,"(e .g. 0;256; 99999). Th is should help avoid wrapping problems."
	2220	"RTN","RCT CSJR",279, 0)
	2221	W !!?5,"A nother met hod would be to set up your te rminal to capture th e detail"
	2222	"RTN","RCT CSJR",280, 0)
	2223	W !?5,"re port data. On some t erminals, this can b e done by invoking ' Logging'"
	2224	"RTN","RCT CSJR",281, 0)
	2225	W !?5,"or clicking on the 'To ols' menu above, the n click on 'Capture Incoming "
	2226	"RTN","RCT CSJR",282, 0)
	2227	W !?5,"Da ta' to sav e to Deskt op. To avo id undesir ed wrappin g of the d ata saved"
	2228	"RTN","RCT CSJR",283, 0)
	2229	W !?5,"to the file, change th e DISPLAY screen wid th size to 132 and y ou can"
	2230	"RTN","RCT CSJR",284, 0)
	2231	W !?5,"en ter '0;256 ;99999' at the 'DEVI CE:' promp t.",!
	2232	"RTN","RCT CSJR",285, 0)
	2233	Q
	2234	"RTN","RCT CSJR",286, 0)
	2235	; ======= ========== ========== ========== ========== ========== ========== =====
	2236	"RTN","RCT CSP1")
	2237	0^6^B17207 2875^B1742 26266
	2238	"RTN","RCT CSP1",1,0)
	2239	RCTCSP1 ;A LBANY/BDB- CROSS-SERV ICING TRAN SMISSION ; 03/15/14 3 :34 PM
	2240	"RTN","RCT CSP1",2,0)
	2241	;;4.5;Acc ounts Rece ivable;3 01,331,315 ,339;Mar 20, 1995; Build 2
	2242	"RTN","RCT CSP1",3,0)
	2243	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2244	"RTN","RCT CSP1",4,0)
	2245	;
	2246	"RTN","RCT CSP1",5,0)
	2247	;PRCA4.5 331 Modif y code to ensure tha t the debt or address info
	2248	"RTN","RCT CSP1",6,0)
	2249	; is co rrect on t ransmissio n of forei gn veteran s
	2250	"RTN","RCT CSP1",7,0)
	2251	; debto r/bills to Treasury.
	2252	"RTN","RCT CSP1",8,0)
	2253	Q
	2254	"RTN","RCT CSP1",9,0)
	2255	;
	2256	"RTN","RCT CSP1",10,0 )
	2257	BILLREP ;C ross-servi cing bill report, pr ints indiv idual bill s that mak e up a cro ss-servici ng account
	2258	"RTN","RCT CSP1",11,0 )
	2259	N DIC,DEB TOR,ZTSAVE ,ZTDESC,ZT RTN,POP,DT FRMTO,PROM PT,EXCEL
	2260	"RTN","RCT CSP1",12,0 )
	2261	K ^TMP("R CTCSP1",$J )
	2262	"RTN","RCT CSP1",13,0 )
	2263	S DIC=340 ,DIC(0)="A EQM",DIC(" S")="I $D( ^RCD(340," "TCSP"",+Y ))" D ^DIC
	2264	"RTN","RCT CSP1",14,0 )
	2265	Q:Y<1 S DEBTOR=+Y
	2266	"RTN","RCT CSP1",15,0 )
	2267	S DTFRMTO =$$DTFRMTO ^RCTCSP2 Q :'DTFRMTO ;Get date range as per PRCA4 .5315
	2268	"RTN","RCT CSP1",16,0 )
	2269	S EXCEL=0 ,PROMPT="C APTURE Rep ort data t o an Excel Document" ,DIR(0)="Y ",DIR("?") ="^D
	2270	HEXC^RCTCS JR"
	2271	"RTN","RCT CSP1",17,0 )
	2272	S EXCEL=$ $SELECT^RC TCSJR(PROM PT,"NO") I "01"'[EXC EL S STOP= 1 Q
	2273	"RTN","RCT CSP1",18,0 )
	2274	I EXCEL=1 D EXCMSG^ RCTCSJR ; Display Ex cel displa y message
	2275	"RTN","RCT CSP1",19,0 )
	2276	K IOP,IO( "Q") S %ZI S="MQ",%ZI S("B")="" D ^%ZIS G: POP BILLRE PQ S IOP=I ON_";"_IOM _";"_IOSL
	2277	"RTN","RCT CSP1",20,0 )
	2278	I $D(IO(" Q")) D G BILLREPQ
	2279	"RTN","RCT CSP1",21,0 )
	2280	.S ZTSAVE ("DEBTOR") ="",ZTSAVE ("DTFRMTO" )="",ZTSAV E("EXCEL") =""
	2281	"RTN","RCT CSP1",22,0 )
	2282	.S ZTRTN= "BILLREPP^ RCTCSP1",Z TDESC="CRO SS-SERVICI NG BILL RE PORT"
	2283	"RTN","RCT CSP1",23,0 )
	2284	.D ^%ZTLO AD,HOME^%Z IS
	2285	"RTN","RCT CSP1",24,0 )
	2286	.I $G(ZTS K) W !!,"R eport comp ilation ha s started with task# ",ZTSK,". ",! S DIR( 0)="E" D ^ DIR K DIR
	2287	"RTN","RCT CSP1",25,0 )
	2288	.Q
	2289	"RTN","RCT CSP1",26,0 )
	2290	;
	2291	"RTN","RCT CSP1",27,0 )
	2292	BILLREPP ; Call to bu ild array of bills r eferred
	2293	"RTN","RCT CSP1",28,0 )
	2294	U IO
	2295	"RTN","RCT CSP1",29,0 )
	2296	N
	2297	BILL,B7,B1 4,B15,B16, D4,FND,BAM T,TAMT,DIR UT,TNM,TID ,TDT,DASH, CSTAT,PAGE ,DASH,TMP, I,DATE,DT
	2298	FRM,DTTO,D ATDATE
	2299	"RTN","RCT CSP1",30,0 )
	2300	K ^TMP("R CTCSP1",$J )
	2301	"RTN","RCT CSP1",31,0 )
	2302	S DASH="" ,$P(DASH," -",78)="" ;(as per PRCA4.53 15)
	2303	"RTN","RCT CSP1",32,0 )
	2304	S (DATE,D TFRM)=$$FM ADD^XLFDT( +$P(DTFRMT O,U,2)),DT TO=$P(DTFR MTO,U,3)
	2305	"RTN","RCT CSP1",33,0 )
	2306	S (BAMT,T AMT,BILL,P AGE)=0
	2307	"RTN","RCT CSP1",34,0 )
	2308	; rewritt en to sort by "TCSP" (#151 dat e referred to TCSP) not the "A B" xref... PRCA4.5 315 (TV8)
	2309	"RTN","RCT CSP1",35,0 )
	2310	F S BILL =$O(^PRCA( 430,"TCSP" ,BILL)) Q: BILL=""!($ D(DIRUT)) D
	2311	"RTN","RCT CSP1",36,0 )
	2312	.Q:$P($G( ^PRCA(430, BILL,0)),U ,9)'=DEBTO R
	2313	"RTN","RCT CSP1",37,0 )
	2314	.Q:'+$G(^ PRCA(430,B ILL,15))
	2315	"RTN","RCT CSP1",38,0 )
	2316	.S DATDAT E=$P($G(^P RCA(430,BI LL,15)),U) Q:DATDATE <DTFRM!(DA TDATE>DTTO )
	2317	"RTN","RCT CSP1",39,0 )
	2318	.S B7=$G( ^PRCA(430, BILL,7))
	2319	"RTN","RCT CSP1",40,0 )
	2320	.S BAMT=0 F I=1:1:5 S BAMT=BA MT+$P(B7,U ,I)
	2321	"RTN","RCT CSP1",41,0 )
	2322	.S TAMT=T AMT+BAMT
	2323	"RTN","RCT CSP1",42,0 )
	2324	.S ^TMP(" RCTCSP1",$ J,DEBTOR,B ILL)=BAMT
	2325	"RTN","RCT CSP1",43,0 )
	2326	D BILLREP H
	2327	"RTN","RCT CSP1",44,0 )
	2328	S DEBTOR= "" F S DE BTOR=$O(^T MP("RCTCSP 1",$J,DEBT OR)) Q:'DE BTOR!($D(D IRUT)) D
	2329	"RTN","RCT CSP1",45,0 )
	2330	. S BILL= 0 F S BIL L=$O(^TMP( "RCTCSP1", $J,DEBTOR, BILL)) Q:' BILL D
	2331	"RTN","RCT CSP1",46,0 )
	2332	..Q:'+$G( ^PRCA(430, BILL,15))
	2333	"RTN","RCT CSP1",47,0 )
	2334	..S FND=1 W !,$P(^P RCA(430,BI LL,0),U) S CSTAT=$P( ^(0),U,8), B7=$G(^(7) ),B15=$G(^ (15)),B16= $G(^(16))
	2335	"RTN","RCT CSP1",48,0 )
	2336	..I 'EXCE L W ?12,$P (^PRCA(430 .3,CSTAT,0 ),U,2)
	2337	"RTN","RCT CSP1",49,0 )
	2338	..I EXCEL W U_$P(^P RCA(430.3, CSTAT,0),U ,2)
	2339	"RTN","RCT CSP1",50,0 )
	2340	..I 'EXCE L W ?15
	2341	"RTN","RCT CSP1",51,0 )
	2342	..I EXCEL W U
	2343	"RTN","RCT CSP1",52,0 )
	2344	..W $J($P (B16,U,9), 8,2)
	2345	"RTN","RCT CSP1",53,0 )
	2346	..S BAMT= ^TMP("RCTC SP1",$J,DE BTOR,BILL)
	2347	"RTN","RCT CSP1",54,0 )
	2348	..I 'EXCE L W ?25
	2349	"RTN","RCT CSP1",55,0 )
	2350	..I EXCEL W U
	2351	"RTN","RCT CSP1",56,0 )
	2352	..W $J(BA MT,8,2)
	2353	"RTN","RCT CSP1",57,0 )
	2354	..I 'EXCE L W $J($P( B7,U,1),9, 2),$J($P(B 7,U,2),7,2 ),$J($P(B7 ,U,3),8,2) ,$J($P(B7, U,4),8,2) ;(as per
	2355	PRCA4.53 15)
	2356	"RTN","RCT CSP1",58,0 )
	2357	..I EXCEL W $J($P(B 7,U,1),8,2 )_U_$J($P( B7,U,2),7, 2)_U_$J($P (B7,U,3),7 ,2)_U_$J($ P(B7,U,4), 8,2)
	2358	"RTN","RCT CSP1",59,0 )
	2359	..S TMP=$ $FMTE^XLFD T($P(B15,U ,1),"2Z") ;Format d ate to n/n /nn (as p er PRCA4. 5315)
	2360	"RTN","RCT CSP1",60,0 )
	2361	..I 'EXCE L W ?67,TM P ;$P(TMP ,", ",1)_" ,"_$P(TMP, ", ",2) ;
	2362	"RTN","RCT CSP1",61,0 )
	2363	..I EXCEL W U_TMP
	2364	"RTN","RCT CSP1",62,0 )
	2365	..;check for end of page here , if neces sary form feed and p rint heade r
	2366	"RTN","RCT CSP1",63,0 )
	2367	..I ($Y+3 )>IOSL D
	2368	"RTN","RCT CSP1",64,0 )
	2369	...I $E(I OST,1,2)=" C-" S DIR( 0)="E" K D IRUT D ^DI R Q:$D(DIR UT)
	2370	"RTN","RCT CSP1",65,0 )
	2371	...D BILL REPH
	2372	"RTN","RCT CSP1",66,0 )
	2373	I $E(IOST ,1,2)="C-" R !!,"END OF REPORT ...PRESS R ETURN TO C ONTINUE",X :DTIME W @ IOF
	2374	"RTN","RCT CSP1",67,0 )
	2375	D ^%ZISC
	2376	"RTN","RCT CSP1",68,0 )
	2377	S:$D(ZTQU EUED) ZTRE Q="@"
	2378	"RTN","RCT CSP1",69,0 )
	2379	K ^TMP("R CTCSP1",$J )
	2380	"RTN","RCT CSP1",70,0 )
	2381	K IOP,%ZI S,ZTQUEUED
	2382	"RTN","RCT CSP1",71,0 )
	2383	BILLREPQ Q
	2384	"RTN","RCT CSP1",72,0 )
	2385	;
	2386	"RTN","RCT CSP1",73,0 )
	2387	BILLREPH ; header for cross-ser vicing bil l report
	2388	"RTN","RCT CSP1",74,0 )
	2389	W @IOF
	2390	"RTN","RCT CSP1",75,0 )
	2391	S PAGE=PA GE+1
	2392	"RTN","RCT CSP1",76,0 )
	2393	I 'EXCEL W "PAGE "_ PAGE,?24," CROSS-SERV ICING BILL REPORT",? 60,$$FMTE^ XLFDT(DT," 2Z"),!,DAS H
	2394	"RTN","RCT CSP1",77,0 )
	2395	I EXCEL W "PAGE "_P AGE_U_"CRO SS-SERVICI NG BILL RE PORT"_U_U_ $$FMTE^XLF DT(DT,"2Z" )
	2396	"RTN","RCT CSP1",78,0 )
	2397	N RCHDR,R CSSN
	2398	"RTN","RCT CSP1",79,0 )
	2399	S
	2400	RCHDR=$$AC CNTHDR^RCD PAPLM(DEBT OR),RCSSN= $S($P(RCHD R,U,2)["P" :$E($P(RCH DR,U,2),7, 11),1:$E
	2401	($P(RCHDR, U,2),6,9)) ;Pseudo SSN should n't be all owed but w e allowed for it to print
	2402	"RTN","RCT CSP1",80,0 )
	2403	I 'EXCEL D Q
	2404	"RTN","RCT CSP1",81,0 )
	2405	. W !!,"D EBTOR: ",$ E($P(RCHDR ,U,1),1,18 ),?22,"SSN : ",RCSSN, ?45,"CURRE NT CS DEBT :
	2406	",$J(TAMT, 8,2),!,DAS H
	2407	"RTN","RCT CSP1",82,0 )
	2408	. W !,"BI LL NO.",?1 2,"ST",?15 ,"ORIG AMT ",?25,"CUR R
	2409	AMT",?38," PRIN",?46, "INT",?52, "ADMIN",?6 0,"COURT", ?67,"CS RE F DT" ;(as per PRCA* 4.5*315)
	2410	"RTN","RCT CSP1",83,0 )
	2411	. W !,"-- -- ---",?1 2,"--",?15 ,"---- --- ",?25,"--- - ---",?38 ,"----",?4 6,"---",?5 2,"-----", ?60,"----- ",?67,"-- -------"
	2412	"RTN","RCT CSP1",84,0 )
	2413	W !,"DEBT OR: "_$E($ P(RCHDR,U, 1),1,18)_U _U_"SSN: " _RCSSN_U_U _U_"CURREN T CS DEBT:
	2414	"_$J(TAMT, 8,2)
	2415	"RTN","RCT CSP1",85,0 )
	2416	W !,"BILL NO."_U_"S T"_U_"ORIG AMT"_U_"C URR
	2417	AMT"_U_"PR IN"_U_"INT "_U_"ADMIN "_U_"COURT "_U_"CS RE F DATE"
	2418	"RTN","RCT CSP1",86,0 )
	2419	Q
	2420	"RTN","RCT CSP1",87,0 )
	2421	;
	2422	"RTN","RCT CSP1",88,0 )
	2423	CSRPRT ;Pr int Cross- Servicing Report, pr ints sorte d individu al bills t hat make u p a cross- servicing
	2424	account
	2425	"RTN","RCT CSP1",89,0 )
	2426	;
	2427	"RTN","RCT CSP1",90,0 )
	2428	K ^TMP("R CTCSP1",$J )
	2429	"RTN","RCT CSP1",91,0 )
	2430	N
	2431	DIC,RCSORT ,PAGE,DASH ,DTOUT,DIR UT,DUOUT,D IROUT,RCIE N,RCDEBTOR ,RCREFDT,R CSSN,RCORI G,RCC
	2432	AMT,RCREFD T,RCBILL,I TEM,DBTR,S DT,SSN,NCI EN,TERMDIG
	2433	"RTN","RCT CSP1",92,0 )
	2434	S PAGE=0, DASH="",$P (DASH,"-", 81)=""
	2435	"RTN","RCT CSP1",93,0 )
	2436	W !
	2437	"RTN","RCT CSP1",94,0 )
	2438	S DIR(0)= "S^1:Bill Number;2:D ebtor Name ;3:CS Refe rred Date" ,DIR("A")= "Sort by" D ^DIR K D IR
	2439	"RTN","RCT CSP1",95,0 )
	2440	S RCSORT= Y Q:($D(DT OUT)!$D(DU OUT)!$D(DI ROUT))
	2441	"RTN","RCT CSP1",96,0 )
	2442	; The fol lowing sec tions were rewritten to elimin ate using ^DIP - (as per PRCA* 4.5*315 re format dat es
	2443	and SSN)
	2444	"RTN","RCT CSP1",97,0 )
	2445	S DTFRMTO =$$DTFRMTO ^RCTCSP2 Q :'DTFRMTO ;Get date range as per PRCA4 .5315
	2446	"RTN","RCT CSP1",98,0 )
	2447	S (DATE,D TFRM)=$$FM ADD^XLFDT( +$P(DTFRMT O,U,2)),DT TO=$P(DTFR MTO,U,3)
	2448	"RTN","RCT CSP1",99,0 )
	2449	S EXCEL=0 ,PROMPT="C APTURE Rep ort data t o an Excel Document" ,DIR(0)="Y ",DIR("?") ="^D
	2450	HEXC^RCTCS JR"
	2451	"RTN","RCT CSP1",100, 0)
	2452	S EXCEL=$ $SELECT^RC TCSJR(PROM PT,"NO") I "01"'[EXC EL S STOP= 1 Q
	2453	"RTN","RCT CSP1",101, 0)
	2454	I EXCEL=1 D EXCMSG^ RCTCSJR ; Display Ex cel displa y message
	2455	"RTN","RCT CSP1",102, 0)
	2456	K IOP,IO( "Q") S %ZI S="MQ",%ZI S("B")="" D ^%ZIS Q: POP S IOP =ION_";"_I OM_";"_IOS L
	2457	"RTN","RCT CSP1",103, 0)
	2458	I $D(IO(" Q")) D Q
	2459	"RTN","RCT CSP1",104, 0)
	2460	.S
	2461	ZTSAVE("RC SORT")="", ZTSAVE("DT FRMTO")="" ,ZTSAVE("E XCEL")="", ZTSAVE("PR OMPT")="", ZTSAVE("PA
	2462	GE")="",ZT SAVE("DASH ")=""
	2463	"RTN","RCT CSP1",105, 0)
	2464	.S ZTRTN= "CSRPRTR^R CTCSP1",ZT DESC="PRIN T CROSS-SE RVICING RE PORT"
	2465	"RTN","RCT CSP1",106, 0)
	2466	.D ^%ZTLO AD,HOME^%Z IS
	2467	"RTN","RCT CSP1",107, 0)
	2468	.I $G(ZTS K) W !!,"R eport comp ilation ha s started with task# ",ZTSK,". ",! S DIR( 0)="E" D ^ DIR K DIR
	2469	"RTN","RCT CSP1",108, 0)
	2470	.Q
	2471	"RTN","RCT CSP1",109, 0)
	2472	CSRPRTR ; compile/pr int job - either for eground or backgroun d
	2473	"RTN","RCT CSP1",110, 0)
	2474	U IO
	2475	"RTN","RCT CSP1",111, 0)
	2476	K ^TMP("R CTCSP1",$J )
	2477	"RTN","RCT CSP1",112, 0)
	2478	;
	2479	"RTN","RCT CSP1",113, 0)
	2480	I RCSORT= 1 D
	2481	"RTN","RCT CSP1",114, 0)
	2482	. D CSRPR TH1^RCTCSP 1A
	2483	"RTN","RCT CSP1",115, 0)
	2484	. S (DATE ,DTFRM)=$$ FMADD^XLFD T(+$P(DTFR MTO,U,2)), DTTO=$P(DT FRMTO,U,3)
	2485	"RTN","RCT CSP1",116, 0)
	2486	. S RCIEN ="" F S R CIEN=$O(^P RCA(430,"T CSP",RCIEN )) Q:RCIEN ="" D
	2487	"RTN","RCT CSP1",117, 0)
	2488	.. Q:'$D( ^PRCA(430, RCIEN,15)) ;cross servicing data field s
	2489	"RTN","RCT CSP1",118, 0)
	2490	..Q:$P($G (^PRCA(430 ,RCIEN,15) ),U)<DTFRM !($P($G(^P RCA(430,RC IEN,15)),U )>DTTO)
	2491	"RTN","RCT CSP1",119, 0)
	2492	..K LIST, MSG,RCLIST D GETS^DI Q(430,RCIE N_",",".01 ;9;121,141 ,161;169;1 51;11","IE ","LIST"," MSG") S
	2493	RCLIST=$NA (LIST(430, RCIEN_",") )
	2494	"RTN","RCT CSP1",120, 0)
	2495	..;Q:$G(@ RCLIST@(14 1,"E"))'=" " ;Date sent to TO P
	2496	"RTN","RCT CSP1",121, 0)
	2497	..S SSN=$ E($$SSN^RC FN01(@RCLI ST@(9,"I") ),6,9) S S SN=$S(SSN' ="":SSN,1: "
	2498	"),TERMDIG =$E(@RCLIS T@(9,"E"), 1)_SSN
	2499	"RTN","RCT CSP1",122, 0)
	2500	..I EXCEL D Q
	2501	"RTN","RCT CSP1",123, 0)
	2502	...S
	2503	^TMP("RCTC SP1",$J,RC IEN,@RCLIS T@(.01,"E" ))=@RCLIST @(.01,"E") _U_$E(@RCL IST@(9,"E" ),1,19)_U_ T
	2504	ERMDIG_U_$ J(@RCLIST@ (169,"E"), 8,2)_U_$$F MTE^XLFDT( @RCLIST@(1 51,"I"),"2 Z")
	2505	"RTN","RCT CSP1",124, 0)
	2506	...S
	2507	^TMP("RCTC SP1",$J,RC IEN,@RCLIS T@(.01,"E" ))=^TMP("R CTCSP1",$J ,RCIEN,@RC LIST@(.01, "E"))_U_$J (
	2508	@RCLIST@(1 1,"E"),8,2 )
	2509	"RTN","RCT CSP1",125, 0)
	2510	...Q
	2511	"RTN","RCT CSP1",126, 0)
	2512	..S
	2513	^TMP("RCTC SP1",$J,RC IEN,@RCLIS T@(.01,"E" ))=@RCLIST @(.01,"E") _U_$E(@RCL IST@(9,"E" ),1,19)_U_ S
	2514	SN_U_$J(@R CLIST@(169 ,"E"),8,2) _U_$$FMTE^ XLFDT(@RCL IST@(151," I"),"2Z")
	2515	"RTN","RCT CSP1",127, 0)
	2516	..S
	2517	^TMP("RCTC SP1",$J,RC IEN,@RCLIS T@(.01,"E" ))=^TMP("R CTCSP1",$J ,RCIEN,@RC LIST@(.01, "E"))_U_$J (
	2518	@RCLIST@(1 1,"E"),8,2 )
	2519	"RTN","RCT CSP1",128, 0)
	2520	.;
	2521	"RTN","RCT CSP1",129, 0)
	2522	.; print report for sort 1
	2523	"RTN","RCT CSP1",130, 0)
	2524	.S (NCIEN ,ITEM)="" F S NCIEN =$O(^TMP(" RCTCSP1",$ J,NCIEN)) Q:NCIEN="" !$D(DIRUT) F S
	2525	ITEM=$O(^T MP("RCTCSP 1",$J,NCIE N,ITEM)) Q :ITEM=""!$ D(DIRUT) D Q:$D(DI RUT)
	2526	"RTN","RCT CSP1",131, 0)
	2527	..I EXCEL W
	2528	!,$P(^TMP( "RCTCSP1", $J,NCIEN,I TEM),U)_U_ $P(^TMP("R CTCSP1",$J ,NCIEN,ITE M),U,2)_U_ $P(^TMP("R C
	2529	TCSP1",$J, NCIEN,ITEM ),U,3)
	2530	"RTN","RCT CSP1",132, 0)
	2531	..I EXCEL W
	2532	U_$P(^TMP( "RCTCSP1", $J,NCIEN,I TEM),U,4)_ U_$P(^TMP( "RCTCSP1", $J,NCIEN,I TEM),U,5)_ U_$P(^TMP( "
	2533	RCTCSP1",$ J,NCIEN,IT EM),U,6)
	2534	"RTN","RCT CSP1",133, 0)
	2535	..I EXCEL Q
	2536	"RTN","RCT CSP1",134, 0)
	2537	..; non-E xcel outpu t
	2538	"RTN","RCT CSP1",135, 0)
	2539	..W
	2540	!,$P(^TMP( "RCTCSP1", $J,NCIEN,I TEM),U),?1 4,$P(^TMP( "RCTCSP1", $J,NCIEN,I TEM),U,2), ?35,$P(^TM P("R
	2541	CTCSP1",$J ,NCIEN,ITE M),U,3),?4 3
	2542	"RTN","RCT CSP1",136, 0)
	2543	..W
	2544	$P(^TMP("R CTCSP1",$J ,NCIEN,ITE M),U,4),?5 8,$P(^TMP( "RCTCSP1", $J,NCIEN,I TEM),U,5), ?68,$P(^TM P("
	2545	RCTCSP1",$ J,NCIEN,IT EM),U,6)
	2546	"RTN","RCT CSP1",137, 0)
	2547	..; page break chec k
	2548	"RTN","RCT CSP1",138, 0)
	2549	..I ($Y+3 )>IOSL D
	2550	"RTN","RCT CSP1",139, 0)
	2551	...I $E(I OST,1,2)=" C-" S DIR( 0)="E" K D IRUT D ^DI R K DIR Q: $D(DIRUT)
	2552	"RTN","RCT CSP1",140, 0)
	2553	...D CSRP RTH1^RCTCS P1A
	2554	"RTN","RCT CSP1",141, 0)
	2555	...Q
	2556	"RTN","RCT CSP1",142, 0)
	2557	..Q
	2558	"RTN","RCT CSP1",143, 0)
	2559	.Q
	2560	"RTN","RCT CSP1",144, 0)
	2561	;
	2562	"RTN","RCT CSP1",145, 0)
	2563	I RCSORT= 2 D
	2564	"RTN","RCT CSP1",146, 0)
	2565	. D CSRPR TH2^RCTCSP 1A
	2566	"RTN","RCT CSP1",147, 0)
	2567	. S (DATE ,DTFRM)=$$ FMADD^XLFD T(+$P(DTFR MTO,U,2),- 1),DTTO=$P (DTFRMTO,U ,3)
	2568	"RTN","RCT CSP1",148, 0)
	2569	. S RCIEN ="" F S R CIEN=$O(^P RCA(430,"T CSP",RCIEN )) Q:RCIEN ="" D
	2570	"RTN","RCT CSP1",149, 0)
	2571	..Q:'$D(^ PRCA(430,R CIEN,15)) ;cross s ervicing d ata fields
	2572	"RTN","RCT CSP1",150, 0)
	2573	..Q:$P($G (^PRCA(430 ,RCIEN,15) ),U)<DTFRM !($P($G(^P RCA(430,RC IEN,15)),U )>DTTO)
	2574	"RTN","RCT CSP1",151, 0)
	2575	..K LIST, MSG,RCLIST D GETS^DI Q(430,RCIE N_",",".01 ;9;121,141 ,161;169;1 51;11","IE ","LIST"," MSG") S
	2576	RCLIST=$NA (LIST(430, RCIEN_",") )
	2577	"RTN","RCT CSP1",152, 0)
	2578	..;Q:$G(@ RCLIST@(12 1,"E"))'=" " ;Date sent to DM C
	2579	"RTN","RCT CSP1",153, 0)
	2580	..;Q:$G(@ RCLIST@(14 1,"E"))'=" " ;Date sent to TO P
	2581	"RTN","RCT CSP1",154, 0)
	2582	..S SSN=$ E($$SSN^RC FN01(@RCLI ST@(9,"I") ),6,9) S S SN=$S(SSN' ="":SSN,1: "
	2583	"),TERMDIG =$E(@RCLIS T@(9,"E"), 1)_SSN
	2584	"RTN","RCT CSP1",155, 0)
	2585	..I EXCEL D Q
	2586	"RTN","RCT CSP1",156, 0)
	2587	...S
	2588	^TMP("RCTC SP1",$J,@R CLIST@(9," E"),RCIEN) =$E(@RCLIS T@(9,"E"), 1,19)_U_@R CLIST@(.01 ,"E")_U_TE R
	2589	MDIG_U_$J( @RCLIST@(1 69,"E"),8, 2)_U_$$FMT E^XLFDT(@R CLIST@(151 ,"I"),"2Z" )_U_$J(@RC LIST@(11,
	2590	"E"),8,2) Q
	2591	"RTN","RCT CSP1",157, 0)
	2592	..S
	2593	^TMP("RCTC SP1",$J,@R CLIST@(9," E"),RCIEN) =$E(@RCLIS T@(9,"E"), 1,19)_U_@R CLIST@(.01 ,"E")_U_SS N
	2594	_U_$J(@RCL IST@(169," E"),8,2)_U _$$FMTE^XL FDT(@RCLIS T@(151,"I" ),"2Z")_U_ $J(@RCLIST @(11,"E"), 8
	2595	,2)
	2596	"RTN","RCT CSP1",158, 0)
	2597	.;
	2598	"RTN","RCT CSP1",159, 0)
	2599	.; print report for sort 2
	2600	"RTN","RCT CSP1",160, 0)
	2601	.S (DBTR, NCIEN)="" F S DBTR= $O(^TMP("R CTCSP1",$J ,DBTR)) Q: DBTR=""!$D (DIRUT) F S
	2602	NCIEN=$O(^ TMP("RCTCS P1",$J,DBT R,NCIEN)) Q:NCIEN="" !$D(DIRUT) D Q:$D( DIRUT)
	2603	"RTN","RCT CSP1",161, 0)
	2604	..I EXCEL W
	2605	!,$P(^TMP( "RCTCSP1", $J,DBTR,NC IEN),U,1,4 )_U_$P(^TM P("RCTCSP1 ",$J,DBTR, NCIEN),U,5 )_U_$P(^TM P(
	2606	"RCTCSP1", $J,DBTR,NC IEN),U,6)
	2607	"RTN","RCT CSP1",162, 0)
	2608	..I EXCEL Q
	2609	"RTN","RCT CSP1",163, 0)
	2610	..; non-E xcel outpu t
	2611	"RTN","RCT CSP1",164, 0)
	2612	..W
	2613	!,$P(^TMP( "RCTCSP1", $J,DBTR,NC IEN),U),?2 1,$P(^TMP( "RCTCSP1", $J,DBTR,NC IEN),U,2), ?35,$P(^TM P("
	2614	RCTCSP1",$ J,DBTR,NCI EN),U,3),? 43,$P(^TMP ("RCTCSP1" ,$J,DBTR,N CIEN),U,4)
	2615	"RTN","RCT CSP1",165, 0)
	2616	..W ?58,$ P(^TMP("RC TCSP1",$J, DBTR,NCIEN ),U,5),?68 ,$P(^TMP(" RCTCSP1",$ J,DBTR,NCI EN),U,6)
	2617	"RTN","RCT CSP1",166, 0)
	2618	..; page break chec k
	2619	"RTN","RCT CSP1",167, 0)
	2620	..I ($Y+3 )>IOSL D
	2621	"RTN","RCT CSP1",168, 0)
	2622	...I $E(I OST,1,2)=" C-" S DIR( 0)="E" K D IRUT D ^DI R K DIR Q: $D(DIRUT)
	2623	"RTN","RCT CSP1",169, 0)
	2624	...D CSRP RTH2^RCTCS P1A
	2625	"RTN","RCT CSP1",170, 0)
	2626	...Q
	2627	"RTN","RCT CSP1",171, 0)
	2628	..Q
	2629	"RTN","RCT CSP1",172, 0)
	2630	.Q
	2631	"RTN","RCT CSP1",173, 0)
	2632	;
	2633	"RTN","RCT CSP1",174, 0)
	2634	I RCSORT= 3 D
	2635	"RTN","RCT CSP1",175, 0)
	2636	.D CSRPRT H3^RCTCSP1 A
	2637	"RTN","RCT CSP1",176, 0)
	2638	.S (DATE, DTFRM)=$$F MADD^XLFDT (+$P(DTFRM TO,U,2),-1 ),DTTO=$P( DTFRMTO,U, 3)
	2639	"RTN","RCT CSP1",177, 0)
	2640	.S RCIEN= "" F S RC IEN=$O(^PR CA(430,"TC SP",RCIEN) ) Q:RCIEN= "" D
	2641	"RTN","RCT CSP1",178, 0)
	2642	..Q:'$D(^ PRCA(430,R CIEN,15)) ;cross s ervicing d ata fields
	2643	"RTN","RCT CSP1",179, 0)
	2644	..Q:$P(^P RCA(430,RC IEN,15),U) <DTFRM!($P (^PRCA(430 ,RCIEN,15) ,U)>DTTO)
	2645	"RTN","RCT CSP1",180, 0)
	2646	..K LIST, MSG,RCLIST D GETS^DI Q(430,RCIE N_",",".01 ;9;121,141 ,161;169;1 51;11","IE ","LIST"," MSG") S
	2647	RCLIST=$NA (LIST(430, RCIEN_",") )
	2648	"RTN","RCT CSP1",181, 0)
	2649	..;Q:$G(@ RCLIST@(12 1,"E"))'=" " ;Date sent to DM C
	2650	"RTN","RCT CSP1",182, 0)
	2651	..;Q:$G(@ RCLIST@(14 1,"E"))'=" " ;Date sent to TO P
	2652	"RTN","RCT CSP1",183, 0)
	2653	..S SSN=$ E($$SSN^RC FN01(@RCLI ST@(9,"I") ),6,9) S S SN=$S(SSN' ="":SSN,1: "
	2654	"),TERMDIG =$E(@RCLIS T@(9,"E"), 1)_SSN
	2655	"RTN","RCT CSP1",184, 0)
	2656	..I EXCEL S
	2657	^TMP("RCTC SP1",$J,@R CLIST@(151 ,"I"),RCIE N)=$$FMTE^ XLFDT(@RCL IST@(151," I"),"2Z")_ U_$E(@RCLI
	2658	ST@(9,"E") ,1,19)_U_@ RCLIST@(.0 1,"E")_U_T ERMDIG_U_$ J(@RCLIST@ (169,"E"), 8,2)_U_$J( @RCLIST@(
	2659	11,"E"),8, 2)
	2660	"RTN","RCT CSP1",185, 0)
	2661	..I 'EXCE L S
	2662	^TMP("RCTC SP1",$J,@R CLIST@(151 ,"I"),RCIE N)=$$FMTE^ XLFDT(@RCL IST@(151," I"),"2Z")_ U_$E(@RCLI
	2663	ST@(9,"E") ,1,19)_U_@ RCLIST@(.0 1,"E")_U_S SN_U_$J(@R CLIST@(169 ,"E"),8,2) _U_$J(@RCL IST@(11,"E "
	2664	),8,2)
	2665	"RTN","RCT CSP1",186, 0)
	2666	.;
	2667	"RTN","RCT CSP1",187, 0)
	2668	.; print report for sort 3
	2669	"RTN","RCT CSP1",188, 0)
	2670	.S (SDT,N CIEN)="" F S SDT=$O (^TMP("RCT CSP1",$J,S DT)) Q:SDT =""!$D(DIR UT) F S
	2671	NCIEN=$O(^ TMP("RCTCS P1",$J,SDT ,NCIEN)) Q :NCIEN=""! $D(DIRUT) D Q:$D(D IRUT)
	2672	"RTN","RCT CSP1",189, 0)
	2673	..I EXCEL W
	2674	!,$P(^TMP( "RCTCSP1", $J,SDT,NCI EN),U)_U_$ P(^TMP("RC TCSP1",$J, SDT,NCIEN) ,U,2)_U_$P (^TMP("RCT C
	2675	SP1",$J,SD T,NCIEN),U ,3)_U_$P(^ TMP("RCTCS P1",$J,SDT ,NCIEN),U, 4)
	2676	"RTN","RCT CSP1",190, 0)
	2677	..I EXCEL W U_$P(^T MP("RCTCSP 1",$J,SDT, NCIEN),U,5 )_U_$P(^TM P("RCTCSP1 ",$J,SDT,N CIEN),U,6)
	2678	"RTN","RCT CSP1",191, 0)
	2679	..I EXCEL Q
	2680	"RTN","RCT CSP1",192, 0)
	2681	..; non-E xcel outpu t
	2682	"RTN","RCT CSP1",193, 0)
	2683	..W
	2684	!,$P(^TMP( "RCTCSP1", $J,SDT,NCI EN),U),?12 ,$P(^TMP(" RCTCSP1",$ J,SDT,NCIE N),U,2),?3 4,$P(^TMP( "RCT
	2685	CSP1",$J,S DT,NCIEN), U,3),?49
	2686	"RTN","RCT CSP1",194, 0)
	2687	..W
	2688	$P(^TMP("R CTCSP1",$J ,SDT,NCIEN ),U,4),?58 ,$P(^TMP(" RCTCSP1",$ J,SDT,NCIE N),U,5),?6 8,$P(^TMP( "RC
	2689	TCSP1",$J, SDT,NCIEN) ,U,6)
	2690	"RTN","RCT CSP1",195, 0)
	2691	..; page break chec k
	2692	"RTN","RCT CSP1",196, 0)
	2693	..I ($Y+3 )>IOSL D
	2694	"RTN","RCT CSP1",197, 0)
	2695	...I $E(I OST,1,2)=" C-" S DIR( 0)="E" K D IRUT D ^DI R K DIR Q: $D(DIRUT)
	2696	"RTN","RCT CSP1",198, 0)
	2697	...D CSRP RTH3^RCTCS P1A
	2698	"RTN","RCT CSP1",199, 0)
	2699	...Q
	2700	"RTN","RCT CSP1",200, 0)
	2701	..Q
	2702	"RTN","RCT CSP1",201, 0)
	2703	.Q
	2704	"RTN","RCT CSP1",202, 0)
	2705	;
	2706	"RTN","RCT CSP1",203, 0)
	2707	;end of r eport
	2708	"RTN","RCT CSP1",204, 0)
	2709	I $E(IOST ,1,2)="C-" ,'$D(DIRUT ) R !!,"EN D OF REPOR T...PRESS RETURN TO CONTINUE", X:DTIME W @IOF
	2710	"RTN","RCT CSP1",205, 0)
	2711	;
	2712	"RTN","RCT CSP1",206, 0)
	2713	K ^TMP("R CTCSP1",$J ) ; kill sc ratch
	2714	"RTN","RCT CSP1",207, 0)
	2715	D ^%ZISC ; close d evice
	2716	"RTN","RCT CSP1",208, 0)
	2717	I $D(ZTQU EUED) S ZT REQ="@" ; purge t he task
	2718	"RTN","RCT CSP1",209, 0)
	2719	Q
	2720	"RTN","RCT CSP1",210, 0)
	2721	;
	2722	"RTN","RCT CSP1",211, 0)
	2723	REC5B ;Cre ate record 5B for Tr easury
	2724	"RTN","RCT CSP1",212, 0)
	2725	; trnnum trans action num ber file # 433 pass i n
	2726	"RTN","RCT CSP1",213, 0)
	2727	; trntyp trans action typ e pointer to 430.3
	2728	"RTN","RCT CSP1",214, 0)
	2729	; trntyp a aia t ransaction type (ai o: dmc age ncy intern al offset, abal: dec rease adju stment)
	2730	"RTN","RCT CSP1",215, 0)
	2731	N
	2732	REC,KNUM,D EBTNR,DEBT ORNB,TAMOU NT,TAMTPBA L,TAMTIBAL ,TAMTABAL, TAMTFBAL,T AMTCBAL,AM
	2733	TRFRRD,TRN TYP,TRNTYP A,TRANSNB
	2734	"RTN","RCT CSP1",216, 0)
	2735	N AMTPBAL ,AMTIBAL,A MTABAL,AMT FBAL,AMTCB AL,TRN3,TR NNUME
	2736	"RTN","RCT CSP1",217, 0)
	2737	S TRNTYPA ="AIO"
	2738	"RTN","RCT CSP1",218, 0)
	2739	S REC="C5 B"_ACTION_ "363600120 0"_"DM1D " _"L"
	2740	"RTN","RCT CSP1",219, 0)
	2741	S KNUM=$P ($P(B0,U,1 ),"-",2)
	2742	"RTN","RCT CSP1",220, 0)
	2743	S DEBTNR= $E(SITE,1, 3)_$$RJZF( KNUM,7)_$T R($J(BILL, 20)," ",0) ,REC=REC_D EBTNR
	2744	"RTN","RCT CSP1",221, 0)
	2745	S DEBTORN B=$E(SITE, 1,3)_$TR($ J(DEBTOR,1 2)," ",0)
	2746	"RTN","RCT CSP1",222, 0)
	2747	S REC=REC _DEBTORNB
	2748	"RTN","RCT CSP1",223, 0)
	2749	S TRNTYP= $P($G(^PRC A(433,TRNN UM,1)),U,2 ) I ",35,7 3,74,"[TRN TYP S TRNT YPA="ABAL"
	2750	"RTN","RCT CSP1",224, 0)
	2751	S REC=REC _$$LJSF(TR NTYPA,9)
	2752	"RTN","RCT CSP1",225, 0)
	2753	S TRNNUME =$$RJZF(TR NNUM,10)
	2754	"RTN","RCT CSP1",226, 0)
	2755	S TRNNUME =$E(TRNNUM E,5,10) ;m ax is 9999 99
	2756	"RTN","RCT CSP1",227, 0)
	2757	I TRNNUME ="000000" S TRNNUME= "000001" ; min is 1
	2758	"RTN","RCT CSP1",228, 0)
	2759	S REC=REC _$$RJZF(TR NNUME,10)
	2760	"RTN","RCT CSP1",229, 0)
	2761	S REC=REC _$$DATE8(D T)
	2762	"RTN","RCT CSP1",230, 0)
	2763	S TRANSNB =$E(SITE,1 ,3)_$TR($J (TRNNUM,12 )," ",0)
	2764	"RTN","RCT CSP1",231, 0)
	2765	S REC=REC _TRANSNB
	2766	"RTN","RCT CSP1",232, 0)
	2767	S REC=REC _$$BLANK(9 )
	2768	"RTN","RCT CSP1",233, 0)
	2769	S TRN3=$G (^PRCA(433 ,TRNNUM,3) )
	2770	"RTN","RCT CSP1",234, 0)
	2771	S TAMTPBA L=$P(TRN3, U,1) ;tran saction pr inciple ba lance
	2772	"RTN","RCT CSP1",235, 0)
	2773	S TAMTIBA L=$P(TRN3, U,2) ;tran saction in terest bal ance
	2774	"RTN","RCT CSP1",236, 0)
	2775	S TAMTABA L=$P(TRN3, U,3) ;tran saction ad ministrati ve balance
	2776	"RTN","RCT CSP1",237, 0)
	2777	S TAMTFBA L=$P(TRN3, U,4) ;tran saction ma rshal fee
	2778	"RTN","RCT CSP1",238, 0)
	2779	S TAMTCBA L=$P(TRN3, U,5) ;tran saction co urt cost
	2780	"RTN","RCT CSP1",239, 0)
	2781	I (TAMTPB AL+TAMTIBA L+TAMTABAL +TAMTFBAL+ TAMTCBAL)= 0 S TAMTPB AL=TRNAMT
	2782	"RTN","RCT CSP1",240, 0)
	2783	S TAMOUNT =$$AMOUNT( TAMTPBAL,T RNTYP)
	2784	"RTN","RCT CSP1",241, 0)
	2785	S TAMOUNT =TAMOUNT_$ $AMOUNT(TA MTIBAL,TRN TYP)
	2786	"RTN","RCT CSP1",242, 0)
	2787	S TAMOUNT =TAMOUNT_$ $AMOUNT(TA MTABAL,TRN TYP)
	2788	"RTN","RCT CSP1",243, 0)
	2789	S TAMOUNT =TAMOUNT_$ $AMOUNT(TA MTFBAL+TAM TCBAL,TRNT YP)
	2790	"RTN","RCT CSP1",244, 0)
	2791	S REC=REC _TAMOUNT
	2792	"RTN","RCT CSP1",245, 0)
	2793	S REC=REC _$$AMOUNT( TRNAMT,TRN TYP) ;315/ DRF Make m inus sign conditiona l on trans action
	2794	"RTN","RCT CSP1",246, 0)
	2795	S REC=REC _$$BLANK(4 50-$L(REC) )
	2796	"RTN","RCT CSP1",247, 0)
	2797	S AMTPBAL =$P(B7,U,1 ) ;princip le balance
	2798	"RTN","RCT CSP1",248, 0)
	2799	S AMTIBAL =$P(B7,U,2 ) ;interes t balance
	2800	"RTN","RCT CSP1",249, 0)
	2801	S AMTABAL =$P(B7,U,3 ) ;adminis trative ba lance
	2802	"RTN","RCT CSP1",250, 0)
	2803	S AMTFBAL =$P(B7,U,4 ) ;marshal fee
	2804	"RTN","RCT CSP1",251, 0)
	2805	S AMTCBAL =$P(B7,U,5 ) ;court c ost
	2806	"RTN","RCT CSP1",252, 0)
	2807	S AMTRFRR D=AMTPBAL+ AMTIBAL+AM TABAL+AMTF BAL+AMTCBA L
	2808	"RTN","RCT CSP1",253, 0)
	2809	I ACTION= "U" S $P(^ PRCA(430,B ILL,16),U, 10)=AMTRFR RD
	2810	"RTN","RCT CSP1",254, 0)
	2811	S ^XTMP(" RCTCSPD",$ J,BILL,ACT ION,"5B",T RNNUM)=REC
	2812	"RTN","RCT CSP1",255, 0)
	2813	S ^XTMP(" RCTCSPD",$ J,"BILL",A CTION,BILL )=$$TAXID( DEBTOR)_"^ "_$S(TRNTY P=35:"-
	2814	",1:"")_+$ E(REC,174, 184)_"."_$ E(REC,185, 186)
	2815	"RTN","RCT CSP1",256, 0)
	2816	Q
	2817	"RTN","RCT CSP1",257, 0)
	2818	;
	2819	"RTN","RCT CSP1",258, 0)
	2820	DATE8(X) ; changes fi leman date into 8 di git date y yyymmdd
	2821	"RTN","RCT CSP1",259, 0)
	2822	I +X S X= X+17000000
	2823	"RTN","RCT CSP1",260, 0)
	2824	S X=$E(X, 1,8)
	2825	"RTN","RCT CSP1",261, 0)
	2826	Q X
	2827	"RTN","RCT CSP1",262, 0)
	2828	;
	2829	"RTN","RCT CSP1",263, 0)
	2830	AMOUNT(X,T T) ;change s amount t o zero fil led, right justified
	2831	"RTN","RCT CSP1",264, 0)
	2832	N SIGN
	2833	"RTN","RCT CSP1",265, 0)
	2834	S X=$$SIG N(X,TT)
	2835	"RTN","RCT CSP1",266, 0)
	2836	S SIGN=$S (X<0:-1,1: 1)
	2837	"RTN","RCT CSP1",267, 0)
	2838	I X<0 S X =-X
	2839	"RTN","RCT CSP1",268, 0)
	2840	S X=$TR($ J(X,0,2)," .")
	2841	"RTN","RCT CSP1",269, 0)
	2842	S X=$E($S (SIGN<0:"- ",1:0)_"00 000000000" ,1,14-$L(X ))_X
	2843	"RTN","RCT CSP1",270, 0)
	2844	Q X
	2845	"RTN","RCT CSP1",271, 0)
	2846	;
	2847	"RTN","RCT CSP1",272, 0)
	2848	SIGN(X,TT) ;Sets sig n based on value and transacti on type
	2849	"RTN","RCT CSP1",273, 0)
	2850	I X=0 Q 0
	2851	"RTN","RCT CSP1",274, 0)
	2852	I X,TT=35 S X=-X
	2853	"RTN","RCT CSP1",275, 0)
	2854	Q X
	2855	"RTN","RCT CSP1",276, 0)
	2856	;
	2857	"RTN","RCT CSP1",277, 0)
	2858	BLANK(X) ; returns 'x ' blank sp aces
	2859	"RTN","RCT CSP1",278, 0)
	2860	N BLANK
	2861	"RTN","RCT CSP1",279, 0)
	2862	S BLANK=" ",$P(BLANK ," ",X+1)= ""
	2863	"RTN","RCT CSP1",280, 0)
	2864	Q BLANK
	2865	"RTN","RCT CSP1",281, 0)
	2866	;
	2867	"RTN","RCT CSP1",282, 0)
	2868	RJZF(X,Y) ;right jus tify zero fill width Y
	2869	"RTN","RCT CSP1",283, 0)
	2870	S X=$E("0 0000000000 0",1,Y-$L( X))_X
	2871	"RTN","RCT CSP1",284, 0)
	2872	Q X
	2873	"RTN","RCT CSP1",285, 0)
	2874	;
	2875	"RTN","RCT CSP1",286, 0)
	2876	LJSF(X,Y) ;left just ified spac e filled
	2877	"RTN","RCT CSP1",287, 0)
	2878	S X=$E(X, 1,Y)
	2879	"RTN","RCT CSP1",288, 0)
	2880	S X=X_$$B LANK(Y-$L( X))
	2881	"RTN","RCT CSP1",289, 0)
	2882	Q X
	2883	"RTN","RCT CSP1",290, 0)
	2884	;
	2885	"RTN","RCT CSP1",291, 0)
	2886	TAXID(DEBT OR) ;compu tes TAXID to place o n document s
	2887	"RTN","RCT CSP1",292, 0)
	2888	N TAXID,D IC,DA,DR,D IQ
	2889	"RTN","RCT CSP1",293, 0)
	2890	S TAXID=$ $SSN^RCFN0 1(DEBTOR)
	2891	"RTN","RCT CSP1",294, 0)
	2892	S TAXID=$ $LJSF(TAXI D,9)
	2893	"RTN","RCT CSP1",295, 0)
	2894	Q TAXID
	2895	"RTN","RCT CSP1",296, 0)
	2896	;
	2897	"RTN","RCT CSP1",297, 0)
	2898	ADDR(RCDFN ) ; return s patient file addre ss
	2899	"RTN","RCT CSP1",298, 0)
	2900	N DFN,ADD RCS,STATEI EN,STATEAB ,VAPA
	2901	"RTN","RCT CSP1",299, 0)
	2902	S DFN=RCD FN
	2903	"RTN","RCT CSP1",300, 0)
	2904	D ADD^VAD PT
	2905	"RTN","RCT CSP1",301, 0)
	2906	S STATEIE N=+VAPA(5) ,STATEAB=$ $GET1^DIQ( 5,STATEIEN ,1)
	2907	"RTN","RCT CSP1",302, 0)
	2908	S ADDRCS= VAPA(1)_U_ VAPA(2)_U_ VAPA(4)_U_ STATEAB_U_ VAPA(6)_U_ VAPA(8)_U_ +VAPA(25)
	2909	"RTN","RCT CSP1",303, 0)
	2910	I $L(DEBT OR1)>0 I $ P(DEBTOR1, U,1,5)'?1" ^"."^" D
	2911	"RTN","RCT CSP1",304, 0)
	2912	.N ADDR34 0
	2913	"RTN","RCT CSP1",305, 0)
	2914	.S ADDR34 0=$P($$DAD D^RCAMADD( DEBTOR),U, 1,8)
	2915	"RTN","RCT CSP1",306, 0)
	2916	.I $P(ADD RCS,U,7)>1 S $P(ADDR 340,U,6)=" " ;PRCA4.5 331
	2917	"RTN","RCT CSP1",307, 0)
	2918	.S
	2919	ADDR340=$P (ADDR340,U ,1,2)_"^"_ $P(ADDR340 ,U,4,7)_U_ $S($P(ADDR CS,U,7)'=" ":$P(ADDRC S,U,7),1:1 )
	2920	;PRCA4.5 331
	2921	"RTN","RCT CSP1",308, 0)
	2922	.I $P(ADD R340,U,7)= "" S $P(AD DR340,U,7) =$P(ADDRCS ,U,7) ;PRCA4.5 331
	2923	"RTN","RCT CSP1",309, 0)
	2924	.I $P(ADD R340,U,7)' =1 S $P(AD DR340,U,4) =" " ;PRCA4.5 331
	2925	"RTN","RCT CSP1",310, 0)
	2926	.S ADDRCS =ADDR340
	2927	"RTN","RCT CSP1",311, 0)
	2928	Q ADDRCS
	2929	"RTN","RCT CSP1",312, 0)
	2930	;
	2931	"RTN","RCT CSP1",313, 0)
	2932	DEM(RCDFN) ; returns patient f ile gender and dob
	2933	"RTN","RCT CSP1",314, 0)
	2934	N DFN,VAD M
	2935	"RTN","RCT CSP1",315, 0)
	2936	S DFN=RCD FN
	2937	"RTN","RCT CSP1",316, 0)
	2938	D DEM^VAD PT
	2939	"RTN","RCT CSP1",317, 0)
	2940	; return string s ex:m/f ^ d ob: yyyymm dd ^ ssn ^ deceased
	2941	"RTN","RCT CSP1",318, 0)
	2942	Q $P(VADM (5),U,1)_U _$P(VADM(3 ),U,1)_U_$ P(VADM(2), U,1)_U_VAD M(6)
	2943	"RTN","RCT CSP1",319, 0)
	2944	;
	2945	"RTN","RCT CSP2")
	2946	0^7^B13660 6046^B8786 1761
	2947	"RTN","RCT CSP2",1,0)
	2948	RCTCSP2 ;A LBANY/BDB- CROSS-SERV ICING TRAN SMISSION ; 03/15/14 3 :34 PM
	2949	"RTN","RCT CSP2",2,0)
	2950	;;4.5;Acc ounts Rece ivable;3 01,315,339 ;Mar 20, 1995;Buil d 2
	2951	"RTN","RCT CSP2",3,0)
	2952	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2953	"RTN","RCT CSP2",4,0)
	2954	;
	2955	"RTN","RCT CSP2",5,0)
	2956	Q
	2957	"RTN","RCT CSP2",6,0)
	2958	;
	2959	"RTN","RCT CSP2",7,0)
	2960	COMPILE ;
	2961	"RTN","RCT CSP2",8,0)
	2962	N RCMSG,B CNTR,REC,R ECC,AMOUNT ,RCNTR,ACT ION,SEQ
	2963	"RTN","RCT CSP2",9,0)
	2964	S BCNTR=0 ,REC=0,REC C=0,AMOUNT =0,SEQ=0
	2965	"RTN","RCT CSP2",10,0 )
	2966	F S BCNT R=$O(^XTMP ("RCTCSPD" ,$J,BCNTR) ) Q:+BCNTR '>0 D
	2967	"RTN","RCT CSP2",11,0 )
	2968	.I REC>50 D
	2969	"RTN","RCT CSP2",12,0 )
	2970	..D TRAIL ER^RCTCSP1 A
	2971	"RTN","RCT CSP2",13,0 )
	2972	..D AITCM SG
	2973	"RTN","RCT CSP2",14,0 )
	2974	..S REC=0 ,RECC=0
	2975	"RTN","RCT CSP2",15,0 )
	2976	..Q
	2977	"RTN","RCT CSP2",16,0 )
	2978	.S ACTION ="" F S A CTION=$O(^ XTMP("RCTC SPD",$J,BC NTR,ACTION )) Q:ACTIO N="" D
	2979	"RTN","RCT CSP2",17,0 )
	2980	..I REC=0 D HEADER^ RCTCSP1A
	2981	"RTN","RCT CSP2",18,0 )
	2982	..F RCNTR =1,2,"2A", "2C",3 I $ D(^XTMP("R CTCSPD",$J ,BCNTR,ACT ION,RCNTR) ) D
	2983	"RTN","RCT CSP2",19,0 )
	2984	...S REC= REC+1
	2985	"RTN","RCT CSP2",20,0 )
	2986	...S RECC =RECC+1 ;r ecord coun t for 'c' records on trailer r ecord
	2987	"RTN","RCT CSP2",21,0 )
	2988	...S
	2989	^XTMP("RCT CSPD",$J,S EQ,"BUILD" ,REC)=$E(^ XTMP("RCTC SPD",$J,BC NTR,ACTION ,RCNTR),1, 225)_$C(94 )
	2990	"RTN","RCT CSP2",22,0 )
	2991	...S REC= REC+1
	2992	"RTN","RCT CSP2",23,0 )
	2993	...S
	2994	^XTMP("RCT CSPD",$J,S EQ,"BUILD" ,REC)=$E(^ XTMP("RCTC SPD",$J,BC NTR,ACTION ,RCNTR),22 6,999)_$C(
	2995	126)
	2996	"RTN","RCT CSP2",24,0 )
	2997	...I $E(^ XTMP("RCTC SPD",$J,BC NTR,ACTION ,RCNTR),2) ="1" S AMO UNT=AMOUNT +$E(^(RCNT R),91,104)
	2998	"RTN","RCT CSP2",25,0 )
	2999	...Q
	3000	"RTN","RCT CSP2",26,0 )
	3001	..I $D(^X TMP("RCTCS PD",$J,BCN TR,ACTION, "5B")) D
	3002	"RTN","RCT CSP2",27,0 )
	3003	...N TRNN UM
	3004	"RTN","RCT CSP2",28,0 )
	3005	...S TRNN UM=0
	3006	"RTN","RCT CSP2",29,0 )
	3007	...F S T RNNUM=$O(^ XTMP("RCTC SPD",$J,BC NTR,ACTION ,"5B",TRNN UM)) Q:TRN NUM'?1N.N D
	3008	"RTN","RCT CSP2",30,0 )
	3009	....S REC =REC+1
	3010	"RTN","RCT CSP2",31,0 )
	3011	....S REC C=RECC+1 ; record cou nt for 'c' records o n trailer record
	3012	"RTN","RCT CSP2",32,0 )
	3013	....S
	3014	^XTMP("RCT CSPD",$J,S EQ,"BUILD" ,REC)=$E(^ XTMP("RCTC SPD",$J,BC NTR,ACTION ,"5B",TRNN UM),1,225)
	3015	_$C(94)
	3016	"RTN","RCT CSP2",33,0 )
	3017	....S REC =REC+1
	3018	"RTN","RCT CSP2",34,0 )
	3019	....S
	3020	^XTMP("RCT CSPD",$J,S EQ,"BUILD" ,REC)=$E(^ XTMP("RCTC SPD",$J,BC NTR,ACTION ,"5B",TRNN UM),226,9
	3021	99)_$C(126 )
	3022	"RTN","RCT CSP2",35,0 )
	3023	....S AMO UNT=AMOUNT +$TR($E(^X TMP("RCTCS PD",$J,BCN TR,ACTION, "5B",TRNNU M),173,186 ),"-")
	3024	"RTN","RCT CSP2",36,0 )
	3025	....Q
	3026	"RTN","RCT CSP2",37,0 )
	3027	...Q
	3028	"RTN","RCT CSP2",38,0 )
	3029	..Q
	3030	"RTN","RCT CSP2",39,0 )
	3031	.Q
	3032	"RTN","RCT CSP2",40,0 )
	3033	D TRAILER ^RCTCSP1A
	3034	"RTN","RCT CSP2",41,0 )
	3035	D AITCMSG
	3036	"RTN","RCT CSP2",42,0 )
	3037	D USRMSG
	3038	"RTN","RCT CSP2",43,0 )
	3039	Q
	3040	"RTN","RCT CSP2",44,0 )
	3041	;
	3042	"RTN","RCT CSP2",45,0 )
	3043	RCLLCHK(BI LL) ;
	3044	"RTN","RCT CSP2",46,0 )
	3045	N TOTAL
	3046	"RTN","RCT CSP2",47,0 )
	3047	I $P(B15, U,7) Q 0 ; check stop tcsp refe rral flag
	3048	"RTN","RCT CSP2",48,0 )
	3049	I $P(B15, U,2),'$P(B 15,U,3) D ;recall b ill
	3050	"RTN","RCT CSP2",49,0 )
	3051	.N ACTION ,BILLCSL
	3052	"RTN","RCT CSP2",50,0 )
	3053	.S ACTION ="L"
	3054	"RTN","RCT CSP2",51,0 )
	3055	.S $P(^PR CA(430,BIL L,15),U,1) ="" ;clear the date referred
	3056	"RTN","RCT CSP2",52,0 )
	3057	.S $P(^PR CA(430,BIL L,15),U,3) =DT ;set t he recall date
	3058	"RTN","RCT CSP2",53,0 )
	3059	.S $P(^PR CA(430,BIL L,15),U,5) =$$GET1^DI Q(430,BILL ,11) ;set the recall amount to the curre nt amount
	3060	"RTN","RCT CSP2",54,0 )
	3061	.S B15=^P RCA(430,BI LL,15)
	3062	"RTN","RCT CSP2",55,0 )
	3063	.S BILLCS L=BILL ;la st cs bill
	3064	"RTN","RCT CSP2",56,0 )
	3065	.D REC1^R CTCSPD
	3066	"RTN","RCT CSP2",57,0 )
	3067	.K ^PRCA( 430,"TCSP" ,BILL) ;se t the bill to not se nt to cros s-servicin g
	3068	"RTN","RCT CSP2",58,0 )
	3069	.D RCLL^R CTCSPD4 ; set bill r ecall non- financial transactio n PRCA4.5 315
	3070	"RTN","RCT CSP2",59,0 )
	3071	;
	3072	"RTN","RCT CSP2",60,0 )
	3073	;recall b ill if tot al <$25
	3074	"RTN","RCT CSP2",61,0 )
	3075	S TOTAL=$ P(B7,U)+$P (B7,U,2)+$ P(B7,U,3)+ $P(B7,U,4) +$P(B7,U,5 )
	3076	"RTN","RCT CSP2",62,0 )
	3077	I TOTAL<2 5 D Q 0
	3078	"RTN","RCT CSP2",63,0 )
	3079	.N X1,X2, P366DT,X,P RCAEN,I,RE CALL
	3080	"RTN","RCT CSP2",64,0 )
	3081	.S RECALL =0
	3082	"RTN","RCT CSP2",65,0 )
	3083	.S X1=DT, X2=-366 D C^%DTC S P 366DT=X
	3084	"RTN","RCT CSP2",66,0 )
	3085	.S PRCAEN =0 F I=0:0 S PRCAEN= $O(^PRCA(4 33,"C",BIL L,PRCAEN)) Q:'PRCAEN
	3086	S:$P($G(^P RCA(433,PR CAEN,1)),U ,1)>P366DT RECALL=1
	3087	"RTN","RCT CSP2",67,0 )
	3088	.I RECALL =0 D Q
	3089	"RTN","RCT CSP2",68,0 )
	3090	..S ACTIO N="L"
	3091	"RTN","RCT CSP2",69,0 )
	3092	..S $P(^P RCA(430,BI LL,15),U,1 )="" ;clea r the date referred
	3093	"RTN","RCT CSP2",70,0 )
	3094	..S $P(^P RCA(430,BI LL,15),U,2 )=1 ;set t he recall flag
	3095	"RTN","RCT CSP2",71,0 )
	3096	..S $P(^P RCA(430,BI LL,15),U,3 )=DT ;set the recall date
	3097	"RTN","RCT CSP2",72,0 )
	3098	..S $P(^P RCA(430,BI LL,15),U,4 )="07" ;se t the reca ll reason
	3099	"RTN","RCT CSP2",73,0 )
	3100	..S $P(^P RCA(430,BI LL,15),U,5 )=$P($G(^P RCA(430,BI LL,16)),U, 10) ;set t he recall amount to the curren t
	3101	tcsp amoun t
	3102	"RTN","RCT CSP2",74,0 )
	3103	..S $P(^P RCA(430,BI LL,15),U,7 )=1 ;set t he stop fl ag
	3104	"RTN","RCT CSP2",75,0 )
	3105	..S $P(^P RCA(430,BI LL,15),U,8 )=DT ;set the stop d ate
	3106	"RTN","RCT CSP2",76,0 )
	3107	..S $P(^P RCA(430,BI LL,15),U,9 )="O" ;set the stop date
	3108	"RTN","RCT CSP2",77,0 )
	3109	..S $P(^P RCA(430,BI LL,15),U,1 0)="AUTORE CALL <$25" ;set the stop reaso n
	3110	"RTN","RCT CSP2",78,0 )
	3111	..S B15=^ PRCA(430,B ILL,15)
	3112	"RTN","RCT CSP2",79,0 )
	3113	..D REC1^ RCTCSPD,RC LL^RCTCSPD 4 ; set CS Bill Reca ll transac tion PRCA* 4.5*315
	3114	"RTN","RCT CSP2",80,0 )
	3115	..K ^PRCA (430,"TCSP ",BILL) ;s et the bil l to not s ent to cro ss-servici ng
	3116	"RTN","RCT CSP2",81,0 )
	3117	..S $P(^P RCA(430,BI LL,19),U,1 0)=1 ;stop interest admin calc
	3118	"RTN","RCT CSP2",82,0 )
	3119	..S B19=$ G(^PRCA(43 0,BILL,19) )
	3120	"RTN","RCT CSP2",83,0 )
	3121	..Q
	3122	"RTN","RCT CSP2",84,0 )
	3123	.Q
	3124	"RTN","RCT CSP2",85,0 )
	3125	Q 0
	3126	"RTN","RCT CSP2",86,0 )
	3127	;
	3128	"RTN","RCT CSP2",87,0 )
	3129	RCRPRT ;Re conciliati on report
	3130	"RTN","RCT CSP2",88,0 )
	3131	N ZTDESC, ZTRTN,POP, %ZIS,DTFRM TO,DTFRM,D TTO,PROMPT ,EXCEL,DAT E
	3132	"RTN","RCT CSP2",89,0 )
	3133	S DTFRMTO =$$DTFRMTO Q:'DTFRMT O ;Get da te range a s per PRCA 4.5315
	3134	"RTN","RCT CSP2",90,0 )
	3135	S (DATE,D TFRM)=$$FM ADD^XLFDT( +$P(DTFRMT O,U,2),-1) ,DTTO=$P(D TFRMTO,U,3 ),CURDT=0
	3136	"RTN","RCT CSP2",91,0 )
	3137	S EXCEL=0 ,PROMPT="C APTURE Rep ort data t o an Excel Document" ,DIR(0)="Y ",DIR("?") ="^D
	3138	HEXC^RCTCS JR"
	3139	"RTN","RCT CSP2",92,0 )
	3140	S EXCEL=$ $SELECT^RC TCSJR(PROM PT,"NO") I "01"'[EXC EL S STOP= 1 Q
	3141	"RTN","RCT CSP2",93,0 )
	3142	I EXCEL=1 D EXCMSG^ RCTCSJR ; Display Ex cel displa y message
	3143	"RTN","RCT CSP2",94,0 )
	3144	K IOP,IO( "Q") S %ZI S="MQ",%ZI S("B")="" D ^%ZIS Q: POP S IOP =ION_";"_I OM_";"_IOS L
	3145	"RTN","RCT CSP2",95,0 )
	3146	I $D(IO(" Q")) D Q ;
	3147	"RTN","RCT CSP2",96,0 )
	3148	.S ZTSAVE ("DTFRMTO" )="",ZTSAV E("EXCEL") =""
	3149	"RTN","RCT CSP2",97,0 )
	3150	.S ZTRTN= "RCRPRTP^R CTCSP2",ZT DESC="RECO NCILIATION REPORT"
	3151	"RTN","RCT CSP2",98,0 )
	3152	.D ^%ZTLO AD,HOME^%Z IS
	3153	"RTN","RCT CSP2",99,0 )
	3154	.I $G(ZTS K) W !!,"R eport comp ilation ha s started with task# ",ZTSK,". ",! S DIR( 0)="E" D ^ DIR K DIR
	3155	"RTN","RCT CSP2",100, 0)
	3156	.Q
	3157	"RTN","RCT CSP2",101, 0)
	3158	;
	3159	"RTN","RCT CSP2",102, 0)
	3160	RCRPRTP ;p rint the - reconcili ation repo rt, call t o build ar ray of bil ls returne d
	3161	"RTN","RCT CSP2",103, 0)
	3162	U IO
	3163	"RTN","RCT CSP2",104, 0)
	3164	N DASH,PA GE,DBTR,DB TRN,RCOUT, CURDT,RC18 ,RCRTCD,BI LLIEN,DATE
	3165	"RTN","RCT CSP2",105, 0)
	3166	K ^TMP("R CTCSP2",$J )
	3167	"RTN","RCT CSP2",106, 0)
	3168	S (DATE,D TFRM)=$$FM ADD^XLFDT( +$P(DTFRMT O,U,2),-1) ,DTTO=$P(D TFRMTO,U,3 ),CURDT=0
	3169	"RTN","RCT CSP2",107, 0)
	3170	F S DATE =$O(^PRCA( 430,"AN",D ATE)),BILL IEN=0 Q:DA TE=""!(DAT E>DTTO) D ;Use new AN xref
	3171	PRCA4.53 15
	3172	"RTN","RCT CSP2",108, 0)
	3173	. F S BI LLIEN=$O(^ PRCA(430," AN",DATE,B ILLIEN)) Q :BILLIEN=" " D
	3174	"RTN","RCT CSP2",109, 0)
	3175	..I +$P($ G(^PRCA(43 0,BILLIEN, 30)),U,1)= 0 Q ;Ret urned date is NULL
	3176	"RTN","RCT CSP2",110, 0)
	3177	..S DBTR= $P($G(^PRC A(430,BILL IEN,0)),U, 9),DBTRN=$ $GET1^DIQ( 430,BILLIE N,9)
	3178	"RTN","RCT CSP2",111, 0)
	3179	..Q:DBTRN ']""
	3180	"RTN","RCT CSP2",112, 0)
	3181	..S ^TMP( "RCTCSP2", $J,DBTRN,D BTR)="" ; store sc ratch by D ebtor Name , Debtor I EN
	3182	"RTN","RCT CSP2",113, 0)
	3183	S PAGE=0, RCOUT=0
	3184	"RTN","RCT CSP2",114, 0)
	3185	S DASH="" ,$P(DASH," -",78)=""
	3186	"RTN","RCT CSP2",115, 0)
	3187	D RCRPRTH 2
	3188	"RTN","RCT CSP2",116, 0)
	3189	;
	3190	"RTN","RCT CSP2",117, 0)
	3191	;New fiel ds added i n PRCA4.5 315:
	3192	"RTN","RCT CSP2",118, 0)
	3193	;AMTREF:( #310) REC ORIGINAL T CSP AMOUNT stored in ^PRCA(430 ,BILL,30), piece 10
	3194	"RTN","RCT CSP2",119, 0)
	3195	;AMTPD:AM TREF - (#3 11) REC CU RRENT TCSP AMOUNT st ored in ^P RCA(430,BI LL,30), pi ece 11
	3196	"RTN","RCT CSP2",120, 0)
	3197	;AMTFEE:( #74) MARSH AL FEE
	3198	"RTN","RCT CSP2",121, 0)
	3199	;CORDT:(# 312) REC T CSP RECALL EFF. DATE stored in ^PRCA(430 ,BILL,30), piece 12
	3200	"RTN","RCT CSP2",122, 0)
	3201	;DTREJ: ( #172) REJE CT DATE (m ultiple)
	3202	"RTN","RCT CSP2",123, 0)
	3203	;See RCTC SPRS for m ore inform ation on t hese field s
	3204	"RTN","RCT CSP2",124, 0)
	3205	;
	3206	"RTN","RCT CSP2",125, 0)
	3207	S DBTRN=0
	3208	"RTN","RCT CSP2",126, 0)
	3209	F S DBTR N=$O(^TMP( "RCTCSP2", $J,DBTRN)) Q:DBTRN=" "!RCOUT S DBTR=0 F S
	3210	DBTR=$O(^T MP("RCTCSP 2",$J,DBTR N,DBTR)) Q :'DBTR!RCO UT D Q:R COUT
	3211	"RTN","RCT CSP2",127, 0)
	3212	.S BILL=0
	3213	"RTN","RCT CSP2",128, 0)
	3214	.F S BIL L=$O(^PRCA (430,"C",D BTR,BILL)) Q:BILL'?1 N.N D Q: RCOUT
	3215	"RTN","RCT CSP2",129, 0)
	3216	..N B0,B3 0,AMTREF,A MTPD,AMTFE E,DTRET,CO RDT,SSN
	3217	"RTN","RCT CSP2",130, 0)
	3218	..S B0=$G (^PRCA(430 ,BILL,0)), B30=$G(^PR CA(430,BIL L,30))
	3219	"RTN","RCT CSP2",131, 0)
	3220	..S AMTRE F=$P(B30,U ,10),AMTPD =AMTREF-$P (B30,U,11)
	3221	"RTN","RCT CSP2",132, 0)
	3222	..I 'EXCE L S AMTFEE =$J($P($G( ^PRCA(430, BILL,7)),U ,4),8,2)
	3223	"RTN","RCT CSP2",133, 0)
	3224	..I EXCEL S AMTFEE= $J($P($G(^ PRCA(430,B ILL,7)),U, 4),5,2)
	3225	"RTN","RCT CSP2",134, 0)
	3226	..I 'EXCE L S AMTREF =$J(AMTREF ,8,2),AMTP D=$J(AMTPD ,8,2)
	3227	"RTN","RCT CSP2",135, 0)
	3228	..I EXCEL S AMTREF= $J(AMTREF, 7,2),AMTPD =$J(AMTPD, 7,2)
	3229	"RTN","RCT CSP2",136, 0)
	3230	..S DEBTO R=$P(B0,U, 9),SSN=$$S SN^RCFN01( $P(^RCD(34 0,DEBTOR,0 ),"^")),SS N=$E(SSN,6 ,9)
	3231	"RTN","RCT CSP2",137, 0)
	3232	..S CORDT =$$FMTE^XL FDT($P(B30 ,U,12),"2Z "),DTRET=" "
	3233	"RTN","RCT CSP2",138, 0)
	3234	..S DTRET =$P(B30,U) I DTRET S DTRET=$$F MTE^XLFDT( DTRET,"2Z" )
	3235	"RTN","RCT CSP2",139, 0)
	3236	..I +$P(B 30,U,1)=0 Q
	3237	"RTN","RCT CSP2",140, 0)
	3238	..I 'EXCE L W $E($$G ET1^DIQ(43 0,BILL,9), 1,16)
	3239	"RTN","RCT CSP2",141, 0)
	3240	..I EXCEL W !,$E($$ GET1^DIQ(4 30,BILL,9) ,1,14)
	3241	"RTN","RCT CSP2",142, 0)
	3242	..I 'EXCE L W ?17,$P (B0,U,1),? 29,SSN,?33 ,AMTREF,?4 1,AMTPD,?4 7,AMTFEE,? 59,CORDT,? 69,DTRET,!
	3243	"RTN","RCT CSP2",143, 0)
	3244	..I EXCEL W U_$P($P (B0,U,1)," -",2)_U_SS N_U_AMTREF _U_AMTPD_U _AMTFEE_U_ CORDT_U_DT RET
	3245	"RTN","RCT CSP2",144, 0)
	3246	..S RCRTC D=$P(B30,U ,2)
	3247	"RTN","RCT CSP2",145, 0)
	3248	..I 'EXCE L D
	3249	"RTN","RCT CSP2",146, 0)
	3250	...D ;Di splay retu rn reason code
	3251	"RTN","RCT CSP2",147, 0)
	3252	....I RCR TCD="" W ? 6,"NO RETU RN REASON CODE",! Q
	3253	"RTN","RCT CSP2",148, 0)
	3254	....W:$D( ^PRCA(430. 5,RCRTCD,0 )) ?6,$P(^ PRCA(430.5 ,RCRTCD,0) ,U,2),!
	3255	"RTN","RCT CSP2",149, 0)
	3256	....W:'$D (^PRCA(430 .5,RCRTCD, 0)) ?6,"UN KNOWN RETU RN REASON CODE: ",RC RTCD,!
	3257	"RTN","RCT CSP2",150, 0)
	3258	....W:RCR TCD=14 ?7, "Compromis e, Please write this bill off by the man ual proces s",!,?8,"A mount (not
	3259	collected) : "_$J($P( B30,U,4),9 ,2),! ;Ad ded PRCA4 .5315
	3260	"RTN","RCT CSP2",151, 0)
	3261	....W:RCR TCD=2 ?8," Date of De ath: "_$$ FMTE^XLFDT ($P(B30,U, 7),"2Z"),! ;date ty pe (as per
	3262	PRCA4.53 15)
	3263	"RTN","RCT CSP2",152, 0)
	3264	....W:RCR TCD=3 ?8," Bankruptcy Date: "_ $$FMTE^XLF DT($P(B30, U,6),"2Z") ,!
	3265	"RTN","RCT CSP2",153, 0)
	3266	...W:+$P( B30,U,8) ? 6,"Date of Dissoluti on: "_$$F MTE^XLFDT( $P(B30,U,8 ),"2Z"),!
	3267	"RTN","RCT CSP2",154, 0)
	3268	..I EXCEL D
	3269	"RTN","RCT CSP2",155, 0)
	3270	...I RCRT CD=14 W U_ $P(^PRCA(4 30.5,RCRTC D,0),U,2)_ U_"AMT NOT COLL"_U_$ P(B30,U,4)
	3271	"RTN","RCT CSP2",156, 0)
	3272	...I $P(B 30,U,3)="Y " W U_"CP" _U_$J($P(B 30,U,4),4, 2) Q
	3273	"RTN","RCT CSP2",157, 0)
	3274	...I RCRT CD=2 W U_$ P(^PRCA(43 0.5,RCRTCD ,0),U,2)_" "_$$FMTE^ XLFDT($P(B 30,U,7),"2 Z") Q
	3275	"RTN","RCT CSP2",158, 0)
	3276	...I RCRT CD=3 W U_$ P(^PRCA(43 0.5,RCRTCD ,0),U,2)_" "_$$FMTE^ XLFDT($P(B 30,U,6),"2 Z") Q
	3277	"RTN","RCT CSP2",159, 0)
	3278	...I RCRT CD]"" W U_ $S($D(^PRC A(430.5,RC RTCD,0)):$ $GET1^DIQ( 430.5,RCRT CD,1),1:RC RTCD) Q
	3279	"RTN","RCT CSP2",160, 0)
	3280	..;check for end of page here , if neces sary form feed and p rint heade r
	3281	"RTN","RCT CSP2",161, 0)
	3282	..I 'EXCE L W ! I ($ Y+5)>IOSL D
	3283	"RTN","RCT CSP2",162, 0)
	3284	...I $E(I OST,1,2)=" C-" S DIR( 0)="E" K D IRUT D ^DI R K DIR I $D(DTOUT)! ($D(DUOUT) ) S RCOUT= 1 K
	3285	X,Y,DIRUT, DTOUT,DUOU T,DIROUT Q
	3286	"RTN","RCT CSP2",163, 0)
	3287	...D RCRP RTH2
	3288	"RTN","RCT CSP2",164, 0)
	3289	I $E(IOST ,1,2)="C-" R !!,"END OF REPORT ...PRESS R ETURN TO C ONTINUE",X :DTIME W @ IOF
	3290	"RTN","RCT CSP2",165, 0)
	3291	D ^%ZISC
	3292	"RTN","RCT CSP2",166, 0)
	3293	S:$D(ZTQU EUED) ZTRE Q="@"
	3294	"RTN","RCT CSP2",167, 0)
	3295	K IOP,%ZI S,ZTQUEUED
	3296	"RTN","RCT CSP2",168, 0)
	3297	K ^TMP("R CTCSP2",$J )
	3298	"RTN","RCT CSP2",169, 0)
	3299	Q
	3300	"RTN","RCT CSP2",170, 0)
	3301	;
	3302	"RTN","RCT CSP2",171, 0)
	3303	RCRPRTH2 ; header for reconcili ation repo rt print r eport 2
	3304	"RTN","RCT CSP2",172, 0)
	3305	W @IOF
	3306	"RTN","RCT CSP2",173, 0)
	3307	S PAGE=PA GE+1
	3308	"RTN","RCT CSP2",174, 0)
	3309	I 'EXCEL W "PAGE "_ PAGE,?12," RECONCILIA TION REPOR T ",?65,$$ FMTE^XLFDT (DT,"2Z")
	3310	"RTN","RCT CSP2",175, 0)
	3311	I 'EXCEL D Q
	3312	"RTN","RCT CSP2",176, 0)
	3313	.W !,DASH
	3314	"RTN","RCT CSP2",177, 0)
	3315	.W !,"DEB TOR",?17," BILL
	3316	NO.",?29," SSN",?34," Amount",?4 2,"Amount" ,?51,"Amou nt",?59,"R ecall",?69 ,"Date",!
	3317	"RTN","RCT CSP2",178, 0)
	3318	.W ?34,"R efer",?42, "Paid",?51 ,"of Fee", ?59,"Eff. Dt",?69,"R eturn"
	3319	"RTN","RCT CSP2",179, 0)
	3320	.W !,"--- ---------- ---",?17," ---------- -",?29,"-- --",?34,"- ------",?4 2,"------- ",?51,"--- ---",?59," --------", ?69,"----- ---
	3321	",!
	3322	"RTN","RCT CSP2",180, 0)
	3323	;EXCEL FO RMAT
	3324	"RTN","RCT CSP2",181, 0)
	3325	W "PAGE " _PAGE_U_"R ECONCILIAT ION REPORT "_U_$$FMT E^XLFDT(DT ,"2Z")
	3326	"RTN","RCT CSP2",182, 0)
	3327	W !,"DEBT OR"_U_"BIL L #"_U_"Pt ID"_U_"AM T REF"_U_" AMT PD"_U_ "AMT FEE"_ U_"DT RPT" _U_"DT
	3328	RET"_U_"CO MMENT"
	3329	"RTN","RCT CSP2",183, 0)
	3330	Q
	3331	"RTN","RCT CSP2",184, 0)
	3332	;
	3333	"RTN","RCT CSP2",185, 0)
	3334	AITCMSG ;
	3335	"RTN","RCT CSP2",186, 0)
	3336	N XMY,XMD UZ,XMSUB,X MTEXT,CNTL ID,SYSTYP
	3337	"RTN","RCT CSP2",187, 0)
	3338	S SYSTYP= $$PROD^XUP ROD(1)
	3339	"RTN","RCT CSP2",188, 0)
	3340	S CNTLID= $$JD^RCTCS P1A()_$$RJ ZF^RCTCSP1 (SEQ,4)
	3341	"RTN","RCT CSP2",189, 0)
	3342	S XMDUZ=" AR PACKAGE "
	3343	"RTN","RCT CSP2",190, 0)
	3344	I SYSTYP S XMY("XXX @Q- URL ")=""
	3345	"RTN","RCT CSP2",191, 0)
	3346	I 'SYSTYP S XMY("XX X@Q- URL ")=""
	3347	"RTN","RCT CSP2",192, 0)
	3348	S XMY("G. TCSP")=""
	3349	"RTN","RCT CSP2",193, 0)
	3350	S XMSUB=S ITE_"/CS T RANSMISSIO N/BATCH#: "_CNTLID
	3351	"RTN","RCT CSP2",194, 0)
	3352	S XMTEXT= "^XTMP(""R CTCSPD""," _$J_","""_ SEQ_""","" BUILD"","
	3353	"RTN","RCT CSP2",195, 0)
	3354	D ^XMD
	3355	"RTN","RCT CSP2",196, 0)
	3356	Q
	3357	"RTN","RCT CSP2",197, 0)
	3358	;
	3359	"RTN","RCT CSP2",198, 0)
	3360	USRMSG ;se nds mailma n message of documen ts sent to user
	3361	"RTN","RCT CSP2",199, 0)
	3362	N XMY,XMD UZ,XMSUB,X MTEXT,X,RC NT,RCDAT1, RCDAT2
	3363	"RTN","RCT CSP2",200, 0)
	3364	S ACTION= "" F S AC TION=$O(^X TMP("RCTCS PD",$J,"BI LL",ACTION )) Q:ACTIO N="" D
	3365	"RTN","RCT CSP2",201, 0)
	3366	.K ^XTMP( "RCTCSPD", $J,"BILL", "MSG")
	3367	"RTN","RCT CSP2",202, 0)
	3368	.S XMDUZ= "AR PACKAG E"
	3369	"RTN","RCT CSP2",203, 0)
	3370	.S XMY("G .TCSP")=""
	3371	"RTN","RCT CSP2",204, 0)
	3372	.S XMSUB= "CS "_$S(A CTION="A": "ADD
	3373	REFERRAL", ACTION="U" :"UPDATES" ,ACTION="L ":"RECALLS ",ACTION=" B":"EXISTI NG
	3374	DEBTOR",1: "UNKNOWN") _" SENT ON "_$E(DT,4 ,5)_"/"_$E (DT,6,7)_" /"_$E(DT,2 ,3)_" BATC H ID:
	3375	"_CNTLID
	3376	"RTN","RCT CSP2",205, 0)
	3377	.S ^XTMP( "RCTCSPD", $J,"BILL", "MSG",1)=" Bill# TIN TYPE AMOU NT"
	3378	"RTN","RCT CSP2",206, 0)
	3379	.S ^XTMP( "RCTCSPD", $J,"BILL", "MSG",2)=" ----- --- ---- ---- --"
	3380	"RTN","RCT CSP2",207, 0)
	3381	.S X=0,RC NT=2 F S X=$O(^XTMP ("RCTCSPD" ,$J,"BILL" ,ACTION,X) ) Q:X="" D
	3382	"RTN","RCT CSP2",208, 0)
	3383	..S RCNT= RCNT+1
	3384	"RTN","RCT CSP2",209, 0)
	3385	..S RCDAT 1=$P(^XTMP ("RCTCSPD" ,$J,"BILL" ,ACTION,X) ,U,1)
	3386	"RTN","RCT CSP2",210, 0)
	3387	..S RCDAT 2=$P(^XTMP ("RCTCSPD" ,$J,"BILL" ,ACTION,X) ,U,2)
	3388	"RTN","RCT CSP2",211, 0)
	3389	..S
	3390	^XTMP("RCT CSPD",$J," BILL","MSG ",RCNT)=$$ RJZF($P($G (^PRCA(430 ,X,0)),U,1 ),7)_$$BLA NK(22)_RCD AT
	3391	1_" "_ ACTION_" "_$S (RCDAT2]"" :RCDAT2,1: "")
	3392	"RTN","RCT CSP2",212, 0)
	3393	..Q
	3394	"RTN","RCT CSP2",213, 0)
	3395	.S ^XTMP( "RCTCSPD", $J,"BILL", "MSG",RCNT +1)="Total Bills: "_ (RCNT-2)
	3396	"RTN","RCT CSP2",214, 0)
	3397	.S XMTEXT ="^XTMP("" RCTCSPD"", "_$J_",""B ILL"",""MS G"","
	3398	"RTN","RCT CSP2",215, 0)
	3399	.D ^XMD
	3400	"RTN","RCT CSP2",216, 0)
	3401	.K ^XTMP( "RCTCSPD", $J,"BILL", "MSG")
	3402	"RTN","RCT CSP2",217, 0)
	3403	Q
	3404	"RTN","RCT CSP2",218, 0)
	3405	;
	3406	"RTN","RCT CSP2",219, 0)
	3407	THIRD ;sen ds mailman message t o user if no third l etter foun d
	3408	"RTN","RCT CSP2",220, 0)
	3409	Q:'$D(^XT MP("RCTCSP D",$J,"THI RD"))
	3410	"RTN","RCT CSP2",221, 0)
	3411	N XMY,XMD UZ,XMSUB,X MTEXT
	3412	"RTN","RCT CSP2",222, 0)
	3413	S XMDUZ=" AR PACKAGE "
	3414	"RTN","RCT CSP2",223, 0)
	3415	S XMY("G. TCSP")=""
	3416	"RTN","RCT CSP2",224, 0)
	3417	N TCT,TDE B,TDEB0,TB IL,TSP,FST
	3418	"RTN","RCT CSP2",225, 0)
	3419	S XMSUB=" TCSP QUALI FIED/NO 3R D LETTER S ENT ON "_$ E(DT,4,5)_ "/"_$E(DT, 6,7)_"/"_$ E(DT,2,3)
	3420	"RTN","RCT CSP2",226, 0)
	3421	S ^XTMP(" RCTCSPD",$ J,"THIRD", 1)="The fo llowing li st of debt or bills w ere not se nt to TCSP ."
	3422	"RTN","RCT CSP2",227, 0)
	3423	S ^XTMP(" RCTCSPD",$ J,"THIRD", 2)="Please review de btor's acc ount to de termine wh y the thir d"
	3424	"RTN","RCT CSP2",228, 0)
	3425	S ^XTMP(" RCTCSPD",$ J,"THIRD", 3)="notice letter ha s not been sent:"
	3426	"RTN","RCT CSP2",229, 0)
	3427	S ^XTMP(" RCTCSPD",$ J,"THIRD", 4)="Name B ill #"
	3428	"RTN","RCT CSP2",230, 0)
	3429	S ^XTMP(" RCTCSPD",$ J,"THIRD", 5)="---- - -----"
	3430	"RTN","RCT CSP2",231, 0)
	3431	S TCT=6,T SP=0,TDEB= ""
	3432	"RTN","RCT CSP2",232, 0)
	3433	F S TDEB =$O(^XTMP( "RCTCSPD", $J,"THIRD" ,TDEB)) Q: TDEB="" D
	3434	"RTN","RCT CSP2",233, 0)
	3435	.S FST=1, TBIL=""
	3436	"RTN","RCT CSP2",234, 0)
	3437	.I FST,TC T'=6 S ^XT MP("RCTCSP D",$J,"THI RD",TCT)=" ",TCT=TCT+ 1,TSP=TSP+ 1
	3438	"RTN","RCT CSP2",235, 0)
	3439	.F S TBI L=$O(^XTMP ("RCTCSPD" ,$J,"THIRD ",TDEB,TBI L)) Q:TBIL ="" D
	3440	"RTN","RCT CSP2",236, 0)
	3441	..S TDEB0 =$S(FST:TD EB,1:"")
	3442	"RTN","RCT CSP2",237, 0)
	3443	..S ^XTMP ("RCTCSPD" ,$J,"THIRD ",TCT)=TDE B0_$J(" ", 35-$L(TDEB 0))_TBIL
	3444	"RTN","RCT CSP2",238, 0)
	3445	..S TCT=T CT+1,FST=0
	3446	"RTN","RCT CSP2",239, 0)
	3447	S ^XTMP(" RCTCSPD",$ J,"THIRD", TCT)="Tota l records: "_(TCT-(6 +TSP))
	3448	"RTN","RCT CSP2",240, 0)
	3449	S XMTEXT= "^XTMP(""R CTCSPD""," _$J_",""TH IRD"","
	3450	"RTN","RCT CSP2",241, 0)
	3451	D ^XMD
	3452	"RTN","RCT CSP2",242, 0)
	3453	K ^XTMP(" RCTCSPD",$ J,"THIRD")
	3454	"RTN","RCT CSP2",243, 0)
	3455	THIRDQ Q
	3456	"RTN","RCT CSP2",244, 0)
	3457	;
	3458	"RTN","RCT CSP2",245, 0)
	3459	REC3 ;
	3460	"RTN","RCT CSP2",246, 0)
	3461	N REC,KNU M,DEBTNR,D EBTORNB
	3462	"RTN","RCT CSP2",247, 0)
	3463	S REC="C3 "_ACTION_ "363600120 0"_"DM1D "
	3464	"RTN","RCT CSP2",248, 0)
	3465	S KNUM=$P ($P(B0,U,1 ),"-",2)
	3466	"RTN","RCT CSP2",249, 0)
	3467	S DEBTNR= $E(SITE,1, 3)_$$LJZF( KNUM,7)_$T R($J(BILL, 20)," ",0) ,REC=REC_D EBTNR
	3468	"RTN","RCT CSP2",250, 0)
	3469	S DEBTORN B=$E(SITE, 1,3)_$TR($ J(DEBTOR,1 2)," ",0)
	3470	"RTN","RCT CSP2",251, 0)
	3471	S REC=REC _DEBTORNB
	3472	"RTN","RCT CSP2",252, 0)
	3473	S REC=REC _$S(ACTION ="L":"15", 1:" ")
	3474	"RTN","RCT CSP2",253, 0)
	3475	S REC=REC _"SLF"
	3476	"RTN","RCT CSP2",254, 0)
	3477	S REC=REC _$$BLANK(8 )
	3478	"RTN","RCT CSP2",255, 0)
	3479	S REC=REC _$$AMOUNT( 0)
	3480	"RTN","RCT CSP2",256, 0)
	3481	S REC=REC _$$BLANK(1 6)
	3482	"RTN","RCT CSP2",257, 0)
	3483	S REC=REC _"SLFIND"
	3484	"RTN","RCT CSP2",258, 0)
	3485	S REC=REC _$$BLANK(4 50-$L(REC) )
	3486	"RTN","RCT CSP2",259, 0)
	3487	S ^XTMP(" RCTCSPD",$ J,BILL,ACT ION,3)=REC
	3488	"RTN","RCT CSP2",260, 0)
	3489	S $P(^XTM P("RCTCSPD ",$J,"BILL ",ACTION,B ILL),U,1)= $$TAXID(DE BTOR)
	3490	"RTN","RCT CSP2",261, 0)
	3491	Q
	3492	"RTN","RCT CSP2",262, 0)
	3493	;
	3494	"RTN","RCT CSP2",263, 0)
	3495	DATE8(X) ; changes fi leman date into 8 di git date y yyymmdd
	3496	"RTN","RCT CSP2",264, 0)
	3497	I +X S X= X+17000000
	3498	"RTN","RCT CSP2",265, 0)
	3499	S X=$E(X, 1,8)
	3500	"RTN","RCT CSP2",266, 0)
	3501	Q X
	3502	"RTN","RCT CSP2",267, 0)
	3503	;
	3504	"RTN","RCT CSP2",268, 0)
	3505	AMOUNT(X) ;changes a mount to z ero filled , right ju stified
	3506	"RTN","RCT CSP2",269, 0)
	3507	S:X<0 X=- X
	3508	"RTN","RCT CSP2",270, 0)
	3509	S X=$TR($ J(X,0,2)," .")
	3510	"RTN","RCT CSP2",271, 0)
	3511	S X=$E("0 0000000000 0",1,14-$L (X))_X
	3512	"RTN","RCT CSP2",272, 0)
	3513	Q X
	3514	"RTN","RCT CSP2",273, 0)
	3515	;
	3516	"RTN","RCT CSP2",274, 0)
	3517	BLANK(X) ; returns 'x ' blank sp aces
	3518	"RTN","RCT CSP2",275, 0)
	3519	N BLANK
	3520	"RTN","RCT CSP2",276, 0)
	3521	S BLANK=" ",$P(BLANK ," ",X+1)= ""
	3522	"RTN","RCT CSP2",277, 0)
	3523	Q BLANK
	3524	"RTN","RCT CSP2",278, 0)
	3525	;
	3526	"RTN","RCT CSP2",279, 0)
	3527	RJZF(X,Y) ;right jus tify zero fill width Y
	3528	"RTN","RCT CSP2",280, 0)
	3529	S X=$E("0 0000000000 0",1,Y-$L( X))_X
	3530	"RTN","RCT CSP2",281, 0)
	3531	Q X
	3532	"RTN","RCT CSP2",282, 0)
	3533	;
	3534	"RTN","RCT CSP2",283, 0)
	3535	LJSF(X,Y) ;left just ified spac e filled
	3536	"RTN","RCT CSP2",284, 0)
	3537	S X=$E(X, 1,Y)
	3538	"RTN","RCT CSP2",285, 0)
	3539	S X=X_$$B LANK(Y-$L( X))
	3540	"RTN","RCT CSP2",286, 0)
	3541	Q X
	3542	"RTN","RCT CSP2",287, 0)
	3543	;
	3544	"RTN","RCT CSP2",288, 0)
	3545	LJZF(X,Y) ;x left ju stified, y zero fill ed
	3546	"RTN","RCT CSP2",289, 0)
	3547	S X=X_"00 00000000"
	3548	"RTN","RCT CSP2",290, 0)
	3549	S X=$E(X, X,Y)
	3550	"RTN","RCT CSP2",291, 0)
	3551	Q X
	3552	"RTN","RCT CSP2",292, 0)
	3553	;
	3554	"RTN","RCT CSP2",293, 0)
	3555	TAXID(DEBT OR) ;compu tes TAXID to place o n document s
	3556	"RTN","RCT CSP2",294, 0)
	3557	N TAXID,D IC,DA,DR,D IQ
	3558	"RTN","RCT CSP2",295, 0)
	3559	S TAXID=$ $SSN^RCFN0 1(DEBTOR)
	3560	"RTN","RCT CSP2",296, 0)
	3561	S TAXID=$ $LJSF(TAXI D,9)
	3562	"RTN","RCT CSP2",297, 0)
	3563	Q TAXID
	3564	"RTN","RCT CSP2",298, 0)
	3565	;
	3566	"RTN","RCT CSP2",299, 0)
	3567	DTFRMTO(PR OMPT) ;Get from and to dates (added as per PRCA4 .5315 to be able to sort by d ates for
	3568	reports)
	3569	"RTN","RCT CSP2",300, 0)
	3570	;INPUT:
	3571	"RTN","RCT CSP2",301, 0)
	3572	; PROMP T - Messag e to displ ay prior t o promptin g for date s
	3573	"RTN","RCT CSP2",302, 0)
	3574	;OUTPUT:
	3575	"RTN","RCT CSP2",303, 0)
	3576	; 1^BE GDT^ENDDT - Data fou nd
	3577	"RTN","RCT CSP2",304, 0)
	3578	; 0 - User up arrowed or timed out
	3579	"RTN","RCT CSP2",305, 0)
	3580	;
	3581	"RTN","RCT CSP2",306, 0)
	3582	N %DT,Y,X ,BEGDT,END DT,DTOUT,O UT,DIRUT,D UOUT,DIROU T,DTFROM,D TTO
	3583	"RTN","RCT CSP2",307, 0)
	3584	S OUT=0
	3585	"RTN","RCT CSP2",308, 0)
	3586	W !,$G(PR OMPT)
	3587	"RTN","RCT CSP2",309, 0)
	3588	S %DT="AE X"
	3589	"RTN","RCT CSP2",310, 0)
	3590	S %DT("A" )="Date Ra nge: FROM: " ;Enter Beginning Date: "
	3591	"RTN","RCT CSP2",311, 0)
	3592	S %DT("B" )="T-30"
	3593	"RTN","RCT CSP2",312, 0)
	3594	W !
	3595	"RTN","RCT CSP2",313, 0)
	3596	D ^%DT
	3597	"RTN","RCT CSP2",314, 0)
	3598	K %DT
	3599	"RTN","RCT CSP2",315, 0)
	3600	Q:Y<0 OUT ;Quit if user time out or di dn't enter valid dat e
	3601	"RTN","RCT CSP2",316, 0)
	3602	S DTFROM= +Y
	3603	"RTN","RCT CSP2",317, 0)
	3604	S %DT="AE X"
	3605	"RTN","RCT CSP2",318, 0)
	3606	S %DT("A" )=" TO: ",%DT(" B")="T" ;" TODAY"
	3607	"RTN","RCT CSP2",319, 0)
	3608	D ^%DT
	3609	"RTN","RCT CSP2",320, 0)
	3610	K %DT
	3611	"RTN","RCT CSP2",321, 0)
	3612	;Quit if user time out or did n't enter valid date
	3613	"RTN","RCT CSP2",322, 0)
	3614	Q:Y<0 OUT
	3615	"RTN","RCT CSP2",323, 0)
	3616	S DTTO=+Y
	3617	"RTN","RCT CSP2",324, 0)
	3618	S OUT=1_U _DTFROM_U_ DTTO
	3619	"RTN","RCT CSP2",325, 0)
	3620	;Switch d ates if Be gin Date i s more rec ent than E nd Date
	3621	"RTN","RCT CSP2",326, 0)
	3622	S:DTFROM> DTTO OUT=1 _U_DTTO_U_ DTFROM
	3623	"RTN","RCT CSP2",327, 0)
	3624	Q OUT
	3625	"RTN","RCT CSP2",328, 0)
	3626	;
	3627	"RTN","RCT CSP4")
	3628	0^8^B22171 6971^n/a
	3629	"RTN","RCT CSP4",1,0)
	3630	RCTCSP4 ;A LB/ESG - C S Debt Ref erral Stop Reactivat e Report ; 6/1/2017
	3631	"RTN","RCT CSP4",2,0)
	3632	;;4.5;Acc ounts Rece ivable;3 15,339;M ar 20, 199 5;Build 2
	3633	"RTN","RCT CSP4",3,0)
	3634	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3635	"RTN","RCT CSP4",4,0)
	3636	;
	3637	"RTN","RCT CSP4",5,0)
	3638	Q
	3639	"RTN","RCT CSP4",6,0)
	3640	;
	3641	"RTN","RCT CSP4",7,0)
	3642	EN ; main report ent ry point
	3643	"RTN","RCT CSP4",8,0)
	3644	;
	3645	"RTN","RCT CSP4",9,0)
	3646	N RCTCFLG ,RCTCDEBT1 ,RCTCDEBT2 ,RCTCDATE, RCTCEXCEL
	3647	"RTN","RCT CSP4",10,0 )
	3648	;
	3649	"RTN","RCT CSP4",11,0 )
	3650	P1 I '$$FL AGGED(.RCT CFLG) G EX ; cu rrently fl agged/reac tivated/bo th
	3651	"RTN","RCT CSP4",12,0 )
	3652	P2 I '$$DE BTFR(.RCTC DEBT1) G E X:$$STOP,P 1 ; st art with d ebtor
	3653	"RTN","RCT CSP4",13,0 )
	3654	P3 I '$$DE BTTO(.RCTC DEBT2) G E X:$$STOP,P 2 ; go to debtor
	3655	"RTN","RCT CSP4",14,0 )
	3656	P4 I '$$DA TES(.RCTCD ATE) G EX: $$STOP,P3 ; al l dates or a date ra nge; from and thru d ates
	3657	"RTN","RCT CSP4",15,0 )
	3658	P5 I '$$FO RMAT(.RCTC EXCEL) G E X:$$STOP,P 4 ; ou tput forma t (standar d or Excel )
	3659	"RTN","RCT CSP4",16,0 )
	3660	P6 I '$$DE VICE() G E X:$$STOP,P 5 ; ou tput devic e/queueing
	3661	"RTN","RCT CSP4",17,0 )
	3662	;
	3663	"RTN","RCT CSP4",18,0 )
	3664	EX ; main report exi t point
	3665	"RTN","RCT CSP4",19,0 )
	3666	Q
	3667	"RTN","RCT CSP4",20,0 )
	3668	;
	3669	"RTN","RCT CSP4",21,0 )
	3670	STOP() ; D etermine i f user wan ts to exit out of th e option e ntirely
	3671	"RTN","RCT CSP4",22,0 )
	3672	; 1=yes, get out en tirely
	3673	"RTN","RCT CSP4",23,0 )
	3674	; 0=no, j ust go bac k to the p revious qu estion
	3675	"RTN","RCT CSP4",24,0 )
	3676	;
	3677	"RTN","RCT CSP4",25,0 )
	3678	N DIR,X,Y ,DTOUT,DUO UT,DIRUT,D IROUT
	3679	"RTN","RCT CSP4",26,0 )
	3680	;
	3681	"RTN","RCT CSP4",27,0 )
	3682	S DIR(0)= "Y"
	3683	"RTN","RCT CSP4",28,0 )
	3684	S DIR("A" )="Do you want to ex it out of this optio n entirely "
	3685	"RTN","RCT CSP4",29,0 )
	3686	S DIR("B" )="YES"
	3687	"RTN","RCT CSP4",30,0 )
	3688	S DIR("?" ,1)=" Ent er YES to immediatel y exit out of this o ption."
	3689	"RTN","RCT CSP4",31,0 )
	3690	S DIR("?" )=" Enter NO to ret urn to the previous question."
	3691	"RTN","RCT CSP4",32,0 )
	3692	W ! D ^DI R K DIR
	3693	"RTN","RCT CSP4",33,0 )
	3694	I $D(DIRU T) S Y=1
	3695	"RTN","RCT CSP4",34,0 )
	3696	Q Y
	3697	"RTN","RCT CSP4",35,0 )
	3698	;
	3699	"RTN","RCT CSP4",36,0 )
	3700	FLAGGED(RC TCFLG) ; c apture if the user w ants bills with a cu rrent flag , reactiva ted, or bo th
	3701	"RTN","RCT CSP4",37,0 )
	3702	; RCTCFLG =C meaning data is c urrently p resent in the STOP T CSP REFERR AL FLAG fi eld (430,1 57)
	3703	"RTN","RCT CSP4",38,0 )
	3704	; RCTCFLG =R meaning data is c urrently b lank in th e STOP TCS P REFERRAL FLAG fiel d (430,157 )
	3705	"RTN","RCT CSP4",39,0 )
	3706	; RCTCFLG =B meaning either is wanted
	3707	"RTN","RCT CSP4",40,0 )
	3708	; pass pa rameter by reference
	3709	"RTN","RCT CSP4",41,0 )
	3710	;
	3711	"RTN","RCT CSP4",42,0 )
	3712	N RET,DIR ,X,Y,DTOUT ,DUOUT,DIR UT,DIROUT
	3713	"RTN","RCT CSP4",43,0 )
	3714	S RCTCFLG ="",RET=1
	3715	"RTN","RCT CSP4",44,0 )
	3716	S DIR(0)= "S"
	3717	"RTN","RCT CSP4",45,0 )
	3718	S $P(DIR( 0),U,2)="C :Currently Flagged;R :Reactivat ed;B:Both"
	3719	"RTN","RCT CSP4",46,0 )
	3720	S DIR("A" )="Run the Report fo r"
	3721	"RTN","RCT CSP4",47,0 )
	3722	S DIR("B" )="B"
	3723	"RTN","RCT CSP4",48,0 )
	3724	S DIR("?" ,1)="Selec t 'Current ly Flagged ' to see b ills which currently have the Cross-"
	3725	"RTN","RCT CSP4",49,0 )
	3726	S DIR("?" ,2)="Servi cing activ ity stop f lag set."
	3727	"RTN","RCT CSP4",50,0 )
	3728	S DIR("?" ,3)="Selec t 'Reactiv ated' to s ee bills i n which th e stop fla g is not c urrently"
	3729	"RTN","RCT CSP4",51,0 )
	3730	S DIR("?" ,4)="set, but was on ce set in the past."
	3731	"RTN","RCT CSP4",52,0 )
	3732	S DIR("?" )="Select 'Both' to see bills of both ty pes."
	3733	"RTN","RCT CSP4",53,0 )
	3734	W ! D ^DI R K DIR
	3735	"RTN","RCT CSP4",54,0 )
	3736	I $D(DIRU T)!(Y="") S RET=0 W $C(7) G FL X
	3737	"RTN","RCT CSP4",55,0 )
	3738	S RCTCFLG =Y
	3739	"RTN","RCT CSP4",56,0 )
	3740	FLX ;
	3741	"RTN","RCT CSP4",57,0 )
	3742	Q RET
	3743	"RTN","RCT CSP4",58,0 )
	3744	;
	3745	"RTN","RCT CSP4",59,0 )
	3746	DEBTFR(RCT CDEBT1) ; start with debtor
	3747	"RTN","RCT CSP4",60,0 )
	3748	N RET,DIR ,X,Y,DTOUT ,DUOUT,DIR UT,DIROUT
	3749	"RTN","RCT CSP4",61,0 )
	3750	S RCTCDEB T1="",RET= 1
	3751	"RTN","RCT CSP4",62,0 )
	3752	S DIR(0)= "F^1:75"
	3753	"RTN","RCT CSP4",63,0 )
	3754	S DIR("A" )="Start w ith Debtor "
	3755	"RTN","RCT CSP4",64,0 )
	3756	S DIR("B" )="FIRST"
	3757	"RTN","RCT CSP4",65,0 )
	3758	S DIR("?" ,1)="If yo u want to specify a range of A R debtor n ames, ente r the begi nning"
	3759	"RTN","RCT CSP4",66,0 )
	3760	S DIR("?" ,2)="debto r name her e. If you want to in clude all debtors, a ccept the default"
	3761	"RTN","RCT CSP4",67,0 )
	3762	S DIR("?" )="value o f FIRST he re."
	3763	"RTN","RCT CSP4",68,0 )
	3764	W ! D ^DI R K DIR
	3765	"RTN","RCT CSP4",69,0 )
	3766	I $D(DIRU T)!(Y="") S RET=0 W $C(7) G DF X
	3767	"RTN","RCT CSP4",70,0 )
	3768	S RCTCDEB T1=Y
	3769	"RTN","RCT CSP4",71,0 )
	3770	DFX ;
	3771	"RTN","RCT CSP4",72,0 )
	3772	Q RET
	3773	"RTN","RCT CSP4",73,0 )
	3774	;
	3775	"RTN","RCT CSP4",74,0 )
	3776	DEBTTO(RCT CDEBT2) ; go to debt or
	3777	"RTN","RCT CSP4",75,0 )
	3778	N RET,DIR ,X,Y,DTOUT ,DUOUT,DIR UT,DIROUT
	3779	"RTN","RCT CSP4",76,0 )
	3780	DBT1 S RCT CDEBT2="", RET=1
	3781	"RTN","RCT CSP4",77,0 )
	3782	S DIR(0)= "F^1:75"
	3783	"RTN","RCT CSP4",78,0 )
	3784	S DIR("A" )=" Go to Debtor "
	3785	"RTN","RCT CSP4",79,0 )
	3786	S DIR("B" )="LAST"
	3787	"RTN","RCT CSP4",80,0 )
	3788	S DIR("?" ,1)="If yo u want to specify a range of A R debtor n ames, ente r the endi ng debtor"
	3789	"RTN","RCT CSP4",81,0 )
	3790	S DIR("?" ,2)="name here. If y ou want to include a ll debtors , accept t he default value of"
	3791	"RTN","RCT CSP4",82,0 )
	3792	S DIR("?" )="LAST he re."
	3793	"RTN","RCT CSP4",83,0 )
	3794	D ^DIR K DIR
	3795	"RTN","RCT CSP4",84,0 )
	3796	I $D(DIRU T)!(Y="") S RET=0 W $C(7) G DT X
	3797	"RTN","RCT CSP4",85,0 )
	3798	S RCTCDEB T2=Y
	3799	"RTN","RCT CSP4",86,0 )
	3800	I RCTCDEB T1'="FIRST ",RCTCDEBT 2'="LAST", RCTCDEBT1] RCTCDEBT2 W $C(7),!! ,"You must enter
	3801	something after '",R CTCDEBT1," '!",! G DB T1
	3802	"RTN","RCT CSP4",87,0 )
	3803	DTX ;
	3804	"RTN","RCT CSP4",88,0 )
	3805	Q RET
	3806	"RTN","RCT CSP4",89,0 )
	3807	;
	3808	"RTN","RCT CSP4",90,0 )
	3809	DATES(RCTC DATE) ; al l dates or a date ra nge - also capture f rom and th ru dates
	3810	"RTN","RCT CSP4",91,0 )
	3811	; RCTCDAT E="A" or " R" if user wants All Dates or to select a Date Ran ge
	3812	"RTN","RCT CSP4",92,0 )
	3813	; RCTCDAT E("BEGIN") =starting FM date
	3814	"RTN","RCT CSP4",93,0 )
	3815	; RCTCDAT E("END")=e nding FM d ate
	3816	"RTN","RCT CSP4",94,0 )
	3817	;
	3818	"RTN","RCT CSP4",95,0 )
	3819	N RET,DIR ,X,Y,DTOUT ,DUOUT,DIR UT,DIROUT
	3820	"RTN","RCT CSP4",96,0 )
	3821	K RCTCDAT E
	3822	"RTN","RCT CSP4",97,0 )
	3823	S RET=1
	3824	"RTN","RCT CSP4",98,0 )
	3825	S DIR(0)= "S^A:All D ates;R:Dat e Range"
	3826	"RTN","RCT CSP4",99,0 )
	3827	S DIR("A" )="Include All Dates or Select by Date R ange"
	3828	"RTN","RCT CSP4",100, 0)
	3829	S DIR("B" )="Date Ra nge"
	3830	"RTN","RCT CSP4",101, 0)
	3831	S DIR("?" ,1)="If yo u want to include al l transact ion entere d dates, p lease sele ct 'A' -"
	3832	"RTN","RCT CSP4",102, 0)
	3833	S DIR("?" ,2)="All D ates here. But if y ou want to specify a date rang e for the"
	3834	"RTN","RCT CSP4",103, 0)
	3835	S DIR("?" ,3)="trans action ent ered dates , then ent er 'R' her e and then choose th e from and "
	3836	"RTN","RCT CSP4",104, 0)
	3837	S DIR("?" )="through dates."
	3838	"RTN","RCT CSP4",105, 0)
	3839	W ! D ^DI R K DIR
	3840	"RTN","RCT CSP4",106, 0)
	3841	I $D(DIRU T)!(Y="") S RET=0 W $C(7) G DA TESX
	3842	"RTN","RCT CSP4",107, 0)
	3843	S RCTCDAT E=Y
	3844	"RTN","RCT CSP4",108, 0)
	3845	I RCTCDAT E="A" G DA TESX
	3846	"RTN","RCT CSP4",109, 0)
	3847	;
	3848	"RTN","RCT CSP4",110, 0)
	3849	S DIR(0)= "DA^:DT:EX "
	3850	"RTN","RCT CSP4",111, 0)
	3851	S DIR("A" )="Date En tered From : "
	3852	"RTN","RCT CSP4",112, 0)
	3853	S DIR("?" ,1)="The F rom and To dates for this repo rt refer t o the date that the AR"
	3854	"RTN","RCT CSP4",113, 0)
	3855	S DIR("?" )="transac tion was e ntered."
	3856	"RTN","RCT CSP4",114, 0)
	3857	W ! D ^DI R K DIR
	3858	"RTN","RCT CSP4",115, 0)
	3859	I $D(DIRU T)!'Y S RE T=0 W $C(7 ) K RCTCDA TE G DATES X
	3860	"RTN","RCT CSP4",116, 0)
	3861	S RCTCDAT E("BEGIN") =Y
	3862	"RTN","RCT CSP4",117, 0)
	3863	;
	3864	"RTN","RCT CSP4",118, 0)
	3865	S DIR(0)= "DA^"_RCTC DATE("BEGI N")_":DT:E X"
	3866	"RTN","RCT CSP4",119, 0)
	3867	S DIR("A" )=" Date Entered To : "
	3868	"RTN","RCT CSP4",120, 0)
	3869	S DIR("B" )="T"
	3870	"RTN","RCT CSP4",121, 0)
	3871	S DIR("?" ,1)="The F rom and To dates for this repo rt refer t o the date that the AR"
	3872	"RTN","RCT CSP4",122, 0)
	3873	S DIR("?" )="transac tion was e ntered."
	3874	"RTN","RCT CSP4",123, 0)
	3875	D ^DIR K DIR
	3876	"RTN","RCT CSP4",124, 0)
	3877	I $D(DIRU T)!'Y S RE T=0 W $C(7 ) K RCTCDA TE G DATES X
	3878	"RTN","RCT CSP4",125, 0)
	3879	S RCTCDAT E("END")=Y
	3880	"RTN","RCT CSP4",126, 0)
	3881	DATESX ;
	3882	"RTN","RCT CSP4",127, 0)
	3883	Q RET
	3884	"RTN","RCT CSP4",128, 0)
	3885	;
	3886	"RTN","RCT CSP4",129, 0)
	3887	FORMAT(RCT CEXCEL) ; output for mat is Exc el format or normal report out put
	3888	"RTN","RCT CSP4",130, 0)
	3889	; RCTCEXC EL=0 for n ormal repo rt output
	3890	"RTN","RCT CSP4",131, 0)
	3891	; RCTCEXC EL=1 for E xcel outpu t
	3892	"RTN","RCT CSP4",132, 0)
	3893	; pass pa rameter by reference
	3894	"RTN","RCT CSP4",133, 0)
	3895	;
	3896	"RTN","RCT CSP4",134, 0)
	3897	N RET,DIR ,X,Y,DTOUT ,DUOUT,DIR UT,DIROUT
	3898	"RTN","RCT CSP4",135, 0)
	3899	S RCTCEXC EL=0,RET=1
	3900	"RTN","RCT CSP4",136, 0)
	3901	S DIR(0)= "Y"
	3902	"RTN","RCT CSP4",137, 0)
	3903	S DIR("A" )="Do you want to ca pture the output in Excel form at"
	3904	"RTN","RCT CSP4",138, 0)
	3905	S DIR("B" )="NO"
	3906	"RTN","RCT CSP4",139, 0)
	3907	S DIR("?" ,1)="If yo u want to capture th e output f rom this r eport in a format wh ich can"
	3908	"RTN","RCT CSP4",140, 0)
	3909	S DIR("?" ,2)="easil y be impor ted into E xcel, then answer YE S here."
	3910	"RTN","RCT CSP4",141, 0)
	3911	S DIR("?" ,3)=" "
	3912	"RTN","RCT CSP4",142, 0)
	3913	S DIR("?" )="If you just want a normal r eport outp ut, then a nswer NO h ere."
	3914	"RTN","RCT CSP4",143, 0)
	3915	W ! D ^DI R K DIR
	3916	"RTN","RCT CSP4",144, 0)
	3917	I $D(DIRU T) S RET=0 W $C(7) G FMX
	3918	"RTN","RCT CSP4",145, 0)
	3919	S RCTCEXC EL=Y
	3920	"RTN","RCT CSP4",146, 0)
	3921	FMX ;
	3922	"RTN","RCT CSP4",147, 0)
	3923	Q RET
	3924	"RTN","RCT CSP4",148, 0)
	3925	;
	3926	"RTN","RCT CSP4",149, 0)
	3927	DEVICE() ; Device Se lection
	3928	"RTN","RCT CSP4",150, 0)
	3929	N ZTRTN,Z TDESC,ZTSA VE,POP,RET ,ZTSK,DIR, X,Y
	3930	"RTN","RCT CSP4",151, 0)
	3931	S RET=1
	3932	"RTN","RCT CSP4",152, 0)
	3933	I 'RCTCEX CEL W !!," This repor t is 132 c haracters wide. Ple ase choose an approp riate devi ce.",!
	3934	"RTN","RCT CSP4",153, 0)
	3935	I RCTCEXC EL D
	3936	"RTN","RCT CSP4",154, 0)
	3937	. W !!,"F or Excel o utput, tur n logging or capture on now."
	3938	"RTN","RCT CSP4",155, 0)
	3939	. W !,"To avoid und esired wra pping of t he data sa ved to the file,"
	3940	"RTN","RCT CSP4",156, 0)
	3941	. W !,"pl ease enter ""0;256;9 9999"" at the ""DEVI CE:"" prom pt.",!
	3942	"RTN","RCT CSP4",157, 0)
	3943	;
	3944	"RTN","RCT CSP4",158, 0)
	3945	S ZTRTN=" COMPILE^RC TCSP4"
	3946	"RTN","RCT CSP4",159, 0)
	3947	S ZTDESC= "RCTC AR C ross-Servi cing Stop Reactivate Report"
	3948	"RTN","RCT CSP4",160, 0)
	3949	S ZTSAVE( "RCTCFLG") =""
	3950	"RTN","RCT CSP4",161, 0)
	3951	S ZTSAVE( "RCTCDEBT1 ")=""
	3952	"RTN","RCT CSP4",162, 0)
	3953	S ZTSAVE( "RCTCDEBT2 ")=""
	3954	"RTN","RCT CSP4",163, 0)
	3955	S ZTSAVE( "RCTCDATE" )=""
	3956	"RTN","RCT CSP4",164, 0)
	3957	S ZTSAVE( "RCTCDATE( ")=""
	3958	"RTN","RCT CSP4",165, 0)
	3959	S ZTSAVE( "RCTCEXCEL ")=""
	3960	"RTN","RCT CSP4",166, 0)
	3961	D EN^XUTM DEVQ(ZTRTN ,ZTDESC,.Z TSAVE,"QM" ,1)
	3962	"RTN","RCT CSP4",167, 0)
	3963	I POP S R ET=0
	3964	"RTN","RCT CSP4",168, 0)
	3965	I $G(ZTSK ) W !!,"Re port compi lation has started w ith task# ",ZTSK,"." ,! S DIR(0 )="E" D ^D IR K DIR
	3966	"RTN","RCT CSP4",169, 0)
	3967	Q RET
	3968	"RTN","RCT CSP4",170, 0)
	3969	;
	3970	"RTN","RCT CSP4",171, 0)
	3971	;
	3972	"RTN","RCT CSP4",172, 0)
	3973	COMPILE ; entry poin t for the report com pile to bu ild the sc ratch glob al
	3974	"RTN","RCT CSP4",173, 0)
	3975	; may be a backgrou nd task if job queue d
	3976	"RTN","RCT CSP4",174, 0)
	3977	;
	3978	"RTN","RCT CSP4",175, 0)
	3979	K ^TMP("R CTCSP4",$J ) ; kill scratch a t start
	3980	"RTN","RCT CSP4",176, 0)
	3981	I '$D(ZTQ UEUED) W ! !,"Compili ng Cross-S ervicing S top Reacti vate Repor t. Please wait ... "
	3982	"RTN","RCT CSP4",177, 0)
	3983	;
	3984	"RTN","RCT CSP4",178, 0)
	3985	D COMP ; buil d scratch global
	3986	"RTN","RCT CSP4",179, 0)
	3987	D PRINT ; prin t the repo rt
	3988	"RTN","RCT CSP4",180, 0)
	3989	D ^%ZISC ; clos e the devi ce
	3990	"RTN","RCT CSP4",181, 0)
	3991	K ^TMP("R CTCSP4",$J ) ; kill scratch g lobal at e nd
	3992	"RTN","RCT CSP4",182, 0)
	3993	I $D(ZTQU EUED) S ZT REQ="@" ; purg e the task
	3994	"RTN","RCT CSP4",183, 0)
	3995	COMIPLX ;
	3996	"RTN","RCT CSP4",184, 0)
	3997	Q
	3998	"RTN","RCT CSP4",185, 0)
	3999	;
	4000	"RTN","RCT CSP4",186, 0)
	4001	COMP ; com pile data into scrat ch global
	4002	"RTN","RCT CSP4",187, 0)
	4003	N
	4004	ARTTIEN,RC TCTT,RCTCD TENT,RC433 ,P0,RCIBN, USER,RCTTN AME,RC340, DEBTNAME,F LAG,RCDEBT OR,RC
	4005	BILLNUM
	4006	"RTN","RCT CSP4",188, 0)
	4007	;
	4008	"RTN","RCT CSP4",189, 0)
	4009	; first i dentify th e AR Trans action typ es eligibl e for this report (C S STOP PLA CED or CS STOP DELET ED)
	4010	"RTN","RCT CSP4",190, 0)
	4011	; load in to the RCT CTT local array
	4012	"RTN","RCT CSP4",191, 0)
	4013	S ARTTIEN =0 F S AR TTIEN=$O(^ PRCA(430.3 ,ARTTIEN)) Q:'ARTTIE N I
	4014	$P($G(^PRC A(430.3,AR TTIEN,0)), U,1)["CS S TOP" S RCT CTT(ARTTIE N)=""
	4015	"RTN","RCT CSP4",192, 0)
	4016	;
	4017	"RTN","RCT CSP4",193, 0)
	4018	; if no e nd date sp ecified th en assume all dates are OK
	4019	"RTN","RCT CSP4",194, 0)
	4020	I '$G(RCT CDATE("END ")) S RCTC DATE("END" )=9999999
	4021	"RTN","RCT CSP4",195, 0)
	4022	;
	4023	"RTN","RCT CSP4",196, 0)
	4024	; start l oop
	4025	"RTN","RCT CSP4",197, 0)
	4026	S ARTTIEN =0 F S AR TTIEN=$O(R CTCTT(ARTT IEN)) Q:'A RTTIEN D
	4027	"RTN","RCT CSP4",198, 0)
	4028	. ;
	4029	"RTN","RCT CSP4",199, 0)
	4030	. ; deter mine date to start l ooping bas ed on if t he user sp ecified a start date or not
	4031	"RTN","RCT CSP4",200, 0)
	4032	. S RCTCD TENT=0
	4033	"RTN","RCT CSP4",201, 0)
	4034	. I $G(RC TCDATE("BE GIN")) S R CTCDTENT=$ O(^PRCA(43 3,"AT",ART TIEN,RCTCD ATE("BEGIN ")),-1) ; get
	4035	one day ea rlier to s tart
	4036	"RTN","RCT CSP4",202, 0)
	4037	. ;
	4038	"RTN","RCT CSP4",203, 0)
	4039	. F S RC TCDTENT=$O (^PRCA(433 ,"AT",ARTT IEN,RCTCDT ENT))
	4040	Q:'RCTCDTE NT!(RCTCDT ENT>RCTCDA TE("END")) D
	4041	"RTN","RCT CSP4",204, 0)
	4042	.. S RC43 3=0 F S R C433=$O(^P RCA(433,"A T",ARTTIEN ,RCTCDTENT ,RC433)) Q :'RC433 D
	4043	"RTN","RCT CSP4",205, 0)
	4044	... S P0= $G(^PRCA(4 33,RC433,0 ))
	4045	"RTN","RCT CSP4",206, 0)
	4046	... S RCI BN=+$P(P0, U,2) Q:'RC IBN ; bill# ie n
	4047	"RTN","RCT CSP4",207, 0)
	4048	... S USE R=$P($G(^V A(200,+$P( P0,U,9),0) ),U,1) ; processe d by user
	4049	"RTN","RCT CSP4",208, 0)
	4050	... S RCT TNAME=$$GE T1^DIQ(433 ,RC433,12) ; trans ty pe name
	4051	"RTN","RCT CSP4",209, 0)
	4052	... ;
	4053	"RTN","RCT CSP4",210, 0)
	4054	... ; now get some bill data from 430
	4055	"RTN","RCT CSP4",211, 0)
	4056	... S RC3 40=+$P($G( ^PRCA(430, RCIBN,0)), U,9) ; ar debto r ien
	4057	"RTN","RCT CSP4",212, 0)
	4058	... Q:'RC 340
	4059	"RTN","RCT CSP4",213, 0)
	4060	... S DEB TNAME=$$GE T1^DIQ(340 ,RC340,.01 ) ; external ar debtor name
	4061	"RTN","RCT CSP4",214, 0)
	4062	... Q:DEB TNAME=""
	4063	"RTN","RCT CSP4",215, 0)
	4064	... ;
	4065	"RTN","RCT CSP4",216, 0)
	4066	... ; che ck report filter on debtor nam e
	4067	"RTN","RCT CSP4",217, 0)
	4068	... I RCT CDEBT1'="F IRST",RCTC DEBT1'=DEB TNAME,RCTC DEBT1]DEBT NAME Q ; before n ame range
	4069	"RTN","RCT CSP4",218, 0)
	4070	... I RCT CDEBT2'="L AST",RCTCD EBT2'=DEBT NAME,DEBTN AME]RCTCDE BT2 Q ; after na me range
	4071	"RTN","RCT CSP4",219, 0)
	4072	... ;
	4073	"RTN","RCT CSP4",220, 0)
	4074	... ; get the curre nt flag va lue and ch eck report filter
	4075	"RTN","RCT CSP4",221, 0)
	4076	... S FLA G=+$P($G(^ PRCA(430,R CIBN,15)), U,7) ; stop tcs p referral flag fiel d (430,157 ) 1:flag set
	4077	"RTN","RCT CSP4",222, 0)
	4078	... I RCT CFLG="R",F LAG Q ; user wan ts only Re activated bills and this one i s still fl agged
	4079	"RTN","RCT CSP4",223, 0)
	4080	... I RCT CFLG="C",' FLAG Q ; user wan ts only cu rrently fl agged bill s and this flag is c lear
	4081	"RTN","RCT CSP4",224, 0)
	4082	... ;
	4083	"RTN","RCT CSP4",225, 0)
	4084	... S RCD EBTOR=DEBT NAME_U_RC3 40 ; debtor n ame^debtor ien (used in subscr ipt)
	4085	"RTN","RCT CSP4",226, 0)
	4086	... S RCB ILLNUM=$$G ET1^DIQ(43 0,RCIBN,.0 1) ; bill#
	4087	"RTN","RCT CSP4",227, 0)
	4088	... Q:RCB ILLNUM=""
	4089	"RTN","RCT CSP4",228, 0)
	4090	... ;
	4091	"RTN","RCT CSP4",229, 0)
	4092	... ; sto re data at the debto r level if not alrea dy there
	4093	"RTN","RCT CSP4",230, 0)
	4094	... I '$D (^TMP("RCT CSP4",$J,R CDEBTOR)) D
	4095	"RTN","RCT CSP4",231, 0)
	4096	.... N RC DV,SSN,PTI D
	4097	"RTN","RCT CSP4",232, 0)
	4098	.... S (S SN,PTID)=" "
	4099	"RTN","RCT CSP4",233, 0)
	4100	.... S SS N=$$SSN^RC FN01(RC340 )
	4101	"RTN","RCT CSP4",234, 0)
	4102	.... S PT ID=$E(DEBT NAME,1)_$S (SSN'="":$ E(SSN,6,9) ,1:"0000") ; patien t id
	4103	"RTN","RCT CSP4",235, 0)
	4104	.... S ^T MP("RCTCSP 4",$J,RCDE BTOR)=PTID _U_DEBTNAM E ; save in to scratch
	4105	"RTN","RCT CSP4",236, 0)
	4106	.... Q
	4107	"RTN","RCT CSP4",237, 0)
	4108	... ;
	4109	"RTN","RCT CSP4",238, 0)
	4110	... ; sto re data at the bill# level if not alread y there
	4111	"RTN","RCT CSP4",239, 0)
	4112	... I '$D (^TMP("RCT CSP4",$J,R CDEBTOR,RC BILLNUM)) D
	4113	"RTN","RCT CSP4",240, 0)
	4114	.... N RC X,CAT
	4115	"RTN","RCT CSP4",241, 0)
	4116	.... S RC X=RCBILLNU M ; bill#
	4117	"RTN","RCT CSP4",242, 0)
	4118	.... S $P (RCX,U,2)= $$GET1^DIQ (430,RCIBN ,11) ; current balance
	4119	"RTN","RCT CSP4",243, 0)
	4120	.... S $P (RCX,U,3)= $$GET1^DIQ (430,RCIBN ,8) ; current ar status name
	4121	"RTN","RCT CSP4",244, 0)
	4122	.... S $P (RCX,U,4)= $$GET1^DIQ (430,RCIBN ,2) ; ar cate gory name
	4123	"RTN","RCT CSP4",245, 0)
	4124	.... S $P (RCX,U,5)= $$GET1^DIQ (430,RCIBN ,61,"I") ; letter1 date FM f ormat
	4125	"RTN","RCT CSP4",246, 0)
	4126	.... S $P (RCX,U,6)= $$GET1^DIQ (430,RCIBN ,158,"I") ; stop tc sp referra l eff. dat e FM forma t
	4127	"RTN","RCT CSP4",247, 0)
	4128	.... S $P (RCX,U,7)= $$GET1^DIQ (430,RCIBN ,159) ; stop tc sp referra l reason d esc
	4129	"RTN","RCT CSP4",248, 0)
	4130	.... S CA T=+$P($G(^ PRCA(430,R CIBN,0)),U ,2) ; ar cate gory ien
	4131	"RTN","RCT CSP4",249, 0)
	4132	.... S $P (RCX,U,8)= $$GET1^DIQ (430.2,CAT ,1) ; ar cate gory abbre viation
	4133	"RTN","RCT CSP4",250, 0)
	4134	.... S ^T MP("RCTCSP 4",$J,RCDE BTOR,RCBIL LNUM)=RCX
	4135	"RTN","RCT CSP4",251, 0)
	4136	... ;
	4137	"RTN","RCT CSP4",252, 0)
	4138	... ; now we can st ore the AR transacti on data
	4139	"RTN","RCT CSP4",253, 0)
	4140	... S ^TM P("RCTCSP4 ",$J,RCDEB TOR,RCBILL NUM,RC433) =RCTTNAME_ U_RCTCDTEN T_U_USER
	4141	"RTN","RCT CSP4",254, 0)
	4142	. Q
	4143	"RTN","RCT CSP4",255, 0)
	4144	;
	4145	"RTN","RCT CSP4",256, 0)
	4146	;
	4147	"RTN","RCT CSP4",257, 0)
	4148	COMPX ;
	4149	"RTN","RCT CSP4",258, 0)
	4150	Q
	4151	"RTN","RCT CSP4",259, 0)
	4152	;
	4153	"RTN","RCT CSP4",260, 0)
	4154	;
	4155	"RTN","RCT CSP4",261, 0)
	4156	PRINT ; en try point for printi ng the rep ort
	4157	"RTN","RCT CSP4",262, 0)
	4158	N
	4159	CRT,PAGE,R CTCSTOP,SE PLINE,DIR, DIROUT,DIR UT,DTOUT,D UOUT,X,Y,R CD,DEBTDAT A,BILL,BIL LDATA,RC4
	4160	33,TRANDAT A
	4161	"RTN","RCT CSP4",263, 0)
	4162	S CRT=$S( IOST["C-": 1,1:0)
	4163	"RTN","RCT CSP4",264, 0)
	4164	I RCTCEXC EL S IOSL= 999999 ; long screen le ngth for E xcel outpu t
	4165	"RTN","RCT CSP4",265, 0)
	4166	S PAGE=0, RCTCSTOP=0 ,$P(SEPLIN E,"-",133) =""
	4167	"RTN","RCT CSP4",266, 0)
	4168	;
	4169	"RTN","RCT CSP4",267, 0)
	4170	I '$D(^TM P("RCTCSP4 ",$J)) D H DR W !!?5, "No data f ound for t his report ." G PX
	4171	"RTN","RCT CSP4",268, 0)
	4172	I $G(ZTST OP) D HDR W !!?5,"Th is report was halted during co mpilation by TaskMan ager Reque st." G PX
	4173	"RTN","RCT CSP4",269, 0)
	4174	;
	4175	"RTN","RCT CSP4",270, 0)
	4176	D HDR I R CTCSTOP G PX ; display headers fi rst for bo th types o f output
	4177	"RTN","RCT CSP4",271, 0)
	4178	;
	4179	"RTN","RCT CSP4",272, 0)
	4180	; loop th ru scratch , check fo r RCTCSTOP as we go
	4181	"RTN","RCT CSP4",273, 0)
	4182	S RCD="" F S RCD=$ O(^TMP("RC TCSP4",$J, RCD)) Q:RC D=""!RCTCS TOP D
	4183	"RTN","RCT CSP4",274, 0)
	4184	. S DEBTD ATA=$G(^TM P("RCTCSP4 ",$J,RCD))
	4185	"RTN","RCT CSP4",275, 0)
	4186	. S BILL= "" F S BI LL=$O(^TMP ("RCTCSP4" ,$J,RCD,BI LL)) Q:BIL L=""!RCTCS TOP D
	4187	"RTN","RCT CSP4",276, 0)
	4188	.. S BILL DATA=$G(^T MP("RCTCSP 4",$J,RCD, BILL))
	4189	"RTN","RCT CSP4",277, 0)
	4190	.. S RC43 3=0 F S R C433=$O(^T MP("RCTCSP 4",$J,RCD, BILL,RC433 )) Q:'RC43 3!RCTCSTOP D
	4191	"RTN","RCT CSP4",278, 0)
	4192	... S TRA NDATA=$G(^ TMP("RCTCS P4",$J,RCD ,BILL,RC43 3))
	4193	"RTN","RCT CSP4",279, 0)
	4194	... D RPT LN
	4195	"RTN","RCT CSP4",280, 0)
	4196	... Q
	4197	"RTN","RCT CSP4",281, 0)
	4198	.. Q
	4199	"RTN","RCT CSP4",282, 0)
	4200	. Q
	4201	"RTN","RCT CSP4",283, 0)
	4202	;
	4203	"RTN","RCT CSP4",284, 0)
	4204	I RCTCSTO P G PRINTX ; g et out rig ht away if stop flag is set
	4205	"RTN","RCT CSP4",285, 0)
	4206	;
	4207	"RTN","RCT CSP4",286, 0)
	4208	I $Y+3>IO SL D HDR I RCTCSTOP G PRINTX
	4209	"RTN","RCT CSP4",287, 0)
	4210	W !!?5,"* End of Report * "
	4211	"RTN","RCT CSP4",288, 0)
	4212	;
	4213	"RTN","RCT CSP4",289, 0)
	4214	PX ;
	4215	"RTN","RCT CSP4",290, 0)
	4216	I CRT,'$D (ZTQUEUED) S DIR(0)= "E" D ^DIR K DIR
	4217	"RTN","RCT CSP4",291, 0)
	4218	PRINTX ;
	4219	"RTN","RCT CSP4",292, 0)
	4220	Q
	4221	"RTN","RCT CSP4",293, 0)
	4222	;
	4223	"RTN","RCT CSP4",294, 0)
	4224	RPTLN ; di splay one line on th e report - either no rmal or Ex cel
	4225	"RTN","RCT CSP4",295, 0)
	4226	N TT
	4227	"RTN","RCT CSP4",296, 0)
	4228	;
	4229	"RTN","RCT CSP4",297, 0)
	4230	; for Exc el output, print a l ine and ge t out
	4231	"RTN","RCT CSP4",298, 0)
	4232	I RCTCEXC EL D EXCEL N G RPTLNX
	4233	"RTN","RCT CSP4",299, 0)
	4234	;
	4235	"RTN","RCT CSP4",300, 0)
	4236	; page br eak check
	4237	"RTN","RCT CSP4",301, 0)
	4238	I $Y+3>IO SL D HDR I RCTCSTOP G RPTLNX
	4239	"RTN","RCT CSP4",302, 0)
	4240	;
	4241	"RTN","RCT CSP4",303, 0)
	4242	; write a line of r eport data
	4243	"RTN","RCT CSP4",304, 0)
	4244	W !,$E($P (DEBTDATA, U,2),1,18) ; debtor name
	4245	"RTN","RCT CSP4",305, 0)
	4246	W ?20,$P( DEBTDATA,U ,1) ; Pt ID
	4247	"RTN","RCT CSP4",306, 0)
	4248	W ?27,$P( $P(BILLDAT A,U,1),"-" ,2) ; bill#
	4249	"RTN","RCT CSP4",307, 0)
	4250	W ?34,$$R J^XLFSTR($ FN($P(BILL DATA,U,2), "",2),10) ; current balance
	4251	"RTN","RCT CSP4",308, 0)
	4252	W ?46,$E( $P(BILLDAT A,U,3),1,1 6) ; current status
	4253	"RTN","RCT CSP4",309, 0)
	4254	W ?64,$P( BILLDATA,U ,8) ; categor y abbr
	4255	"RTN","RCT CSP4",310, 0)
	4256	W ?68,$$F MTE^XLFDT( $P(BILLDAT A,U,5),"2Z ") ; letter 1 date
	4257	"RTN","RCT CSP4",311, 0)
	4258	W ?78,$$F MTE^XLFDT( $P(BILLDAT A,U,6),"2Z ") ; stop da te
	4259	"RTN","RCT CSP4",312, 0)
	4260	W ?88,$E( $P(BILLDAT A,U,7),1,1 0) ; stop re ason
	4261	"RTN","RCT CSP4",313, 0)
	4262	S TT=$P(T RANDATA,U, 1)
	4263	"RTN","RCT CSP4",314, 0)
	4264	W ?100,$S (TT["DELET ED":"DEL", TT["PLACED ":"ADD",1: "UNK") ; transac tion type
	4265	"RTN","RCT CSP4",315, 0)
	4266	W ?105,$$ FMTE^XLFDT ($P(TRANDA TA,U,2),"2 Z") ; date en tered
	4267	"RTN","RCT CSP4",316, 0)
	4268	W ?115,$E ($P(TRANDA TA,U,3),1, 17) ; user
	4269	"RTN","RCT CSP4",317, 0)
	4270	;
	4271	"RTN","RCT CSP4",318, 0)
	4272	RPTLNX ;
	4273	"RTN","RCT CSP4",319, 0)
	4274	Q
	4275	"RTN","RCT CSP4",320, 0)
	4276	;
	4277	"RTN","RCT CSP4",321, 0)
	4278	HDR ; repo rt header
	4279	"RTN","RCT CSP4",322, 0)
	4280	;
	4281	"RTN","RCT CSP4",323, 0)
	4282	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
	4283	"RTN","RCT CSP4",324, 0)
	4284	;
	4285	"RTN","RCT CSP4",325, 0)
	4286	; Do an e nd of page reader ca ll if page # exists a nd device is the scr een
	4287	"RTN","RCT CSP4",326, 0)
	4288	I PAGE,CR T S DIR(0) ="E" D ^DI R K DIR I 'Y S RCTCS TOP=1 G HD RX
	4289	"RTN","RCT CSP4",327, 0)
	4290	;
	4291	"RTN","RCT CSP4",328, 0)
	4292	; If scre en output or page# e xists, do a form fee d
	4293	"RTN","RCT CSP4",329, 0)
	4294	I PAGE!CR T W @IOF
	4295	"RTN","RCT CSP4",330, 0)
	4296	;
	4297	"RTN","RCT CSP4",331, 0)
	4298	; First p rinter/fil e page - d o a left m argin rese t
	4299	"RTN","RCT CSP4",332, 0)
	4300	I 'PAGE,' CRT W $C(1 3)
	4301	"RTN","RCT CSP4",333, 0)
	4302	;
	4303	"RTN","RCT CSP4",334, 0)
	4304	S PAGE=PA GE+1 ; increment page#
	4305	"RTN","RCT CSP4",335, 0)
	4306	;
	4307	"RTN","RCT CSP4",336, 0)
	4308	; For Exc el format, display t he column headers on ly
	4309	"RTN","RCT CSP4",337, 0)
	4310	I RCTCEXC EL D EXCEL HD G HDRX
	4311	"RTN","RCT CSP4",338, 0)
	4312	;
	4313	"RTN","RCT CSP4",339, 0)
	4314	; Display the repor t headers
	4315	"RTN","RCT CSP4",340, 0)
	4316	W "Debtor Range: "
	4317	"RTN","RCT CSP4",341, 0)
	4318	I RCTCDEB T1="FIRST" ,RCTCDEBT2 ="LAST" W "ALL"
	4319	"RTN","RCT CSP4",342, 0)
	4320	E D
	4321	"RTN","RCT CSP4",343, 0)
	4322	. W $S(RC TCDEBT1="F IRST":"FIR ST",1:($C( 34)_$E(RCT CDEBT1,1,1 0)_$C(34)) )," - "
	4323	"RTN","RCT CSP4",344, 0)
	4324	. W $S(RC TCDEBT2="L AST":"LAST ",1:($C(34 )_$E(RCTCD EBT2,1,10) _$C(34)))
	4325	"RTN","RCT CSP4",345, 0)
	4326	. Q
	4327	"RTN","RCT CSP4",346, 0)
	4328	;
	4329	"RTN","RCT CSP4",347, 0)
	4330	W ?47,"Cr oss-Servic ing Stop R eactivate Report",?1 22,"Page: ",PAGE
	4331	"RTN","RCT CSP4",348, 0)
	4332	;
	4333	"RTN","RCT CSP4",349, 0)
	4334	W !?2,"Da te Range: "
	4335	"RTN","RCT CSP4",350, 0)
	4336	I RCTCDAT E="A" W "A LL"
	4337	"RTN","RCT CSP4",351, 0)
	4338	E D
	4339	"RTN","RCT CSP4",352, 0)
	4340	. W $$FMT E^XLFDT($G (RCTCDATE( "BEGIN")), "2Z")," - "
	4341	"RTN","RCT CSP4",353, 0)
	4342	. W $$FMT E^XLFDT($G (RCTCDATE( "END")),"2 Z")
	4343	"RTN","RCT CSP4",354, 0)
	4344	. Q
	4345	"RTN","RCT CSP4",355, 0)
	4346	;
	4347	"RTN","RCT CSP4",356, 0)
	4348	W ?44,"Cu rrently Fl agged, Rea ctivated, or Both: "
	4349	"RTN","RCT CSP4",357, 0)
	4350	W $S(RCTC FLG="C":"C urrently F lagged",RC TCFLG="R": "Reactivat ed",1:"Bot h")
	4351	"RTN","RCT CSP4",358, 0)
	4352	W ?111,$$ FMTE^XLFDT ($$NOW^XLF DT)
	4353	"RTN","RCT CSP4",359, 0)
	4354	;
	4355	"RTN","RCT CSP4",360, 0)
	4356	W !,SEPLI NE
	4357	"RTN","RCT CSP4",361, 0)
	4358	W !,"Debt or Name",? 20,"Pt
	4359	ID",?27,"B ill#",?37, "Balance", ?46,"Statu s",?63,"Ca t",?68,"Le tter1",?78 ,"StopDate "
	4360	"RTN","RCT CSP4",362, 0)
	4361	W ?88,"Re ason",?97, "CS STOP", ?106,"Ente red",?115, "User"
	4362	"RTN","RCT CSP4",363, 0)
	4363	W !,SEPLI NE
	4364	"RTN","RCT CSP4",364, 0)
	4365	;
	4366	"RTN","RCT CSP4",365, 0)
	4367	; check f or a TaskM anager sto p request
	4368	"RTN","RCT CSP4",366, 0)
	4369	I $D(ZTQU EUED),$$S^ %ZTLOAD() D G HDRX
	4370	"RTN","RCT CSP4",367, 0)
	4371	. S (ZTST OP,RCTCSTO P)=1
	4372	"RTN","RCT CSP4",368, 0)
	4373	. W !!!?5 ,"* Repo rt Halted by TaskMan ager Reque st *"
	4374	"RTN","RCT CSP4",369, 0)
	4375	. Q
	4376	"RTN","RCT CSP4",370, 0)
	4377	;
	4378	"RTN","RCT CSP4",371, 0)
	4379	HDRX ;
	4380	"RTN","RCT CSP4",372, 0)
	4381	Q
	4382	"RTN","RCT CSP4",373, 0)
	4383	;
	4384	"RTN","RCT CSP4",374, 0)
	4385	EXCELHD ; print an E xcel heade r record ( only 1 Exc el header should pri nt for the whole rep ort)
	4386	"RTN","RCT CSP4",375, 0)
	4387	N RCH
	4388	"RTN","RCT CSP4",376, 0)
	4389	S RCH=$$C SV("","Deb tor Name")
	4390	"RTN","RCT CSP4",377, 0)
	4391	S RCH=$$C SV(RCH,"Pa tient ID")
	4392	"RTN","RCT CSP4",378, 0)
	4393	S RCH=$$C SV(RCH,"Bi ll Number" )
	4394	"RTN","RCT CSP4",379, 0)
	4395	S RCH=$$C SV(RCH,"Cu rrent Bala nce")
	4396	"RTN","RCT CSP4",380, 0)
	4397	S RCH=$$C SV(RCH,"Cu rrent Stat us")
	4398	"RTN","RCT CSP4",381, 0)
	4399	S RCH=$$C SV(RCH,"Ca tegory Nam e")
	4400	"RTN","RCT CSP4",382, 0)
	4401	S RCH=$$C SV(RCH,"Ca tegory Abb r")
	4402	"RTN","RCT CSP4",383, 0)
	4403	S RCH=$$C SV(RCH,"Le tter1 Date ")
	4404	"RTN","RCT CSP4",384, 0)
	4405	S RCH=$$C SV(RCH,"St op Date")
	4406	"RTN","RCT CSP4",385, 0)
	4407	S RCH=$$C SV(RCH,"St op Reason" )
	4408	"RTN","RCT CSP4",386, 0)
	4409	S RCH=$$C SV(RCH,"Tr ansaction Type")
	4410	"RTN","RCT CSP4",387, 0)
	4411	S RCH=$$C SV(RCH,"Tr ansaction Date Enter ed")
	4412	"RTN","RCT CSP4",388, 0)
	4413	S RCH=$$C SV(RCH,"Tr ansaction Processed By")
	4414	"RTN","RCT CSP4",389, 0)
	4415	W RCH
	4416	"RTN","RCT CSP4",390, 0)
	4417	Q
	4418	"RTN","RCT CSP4",391, 0)
	4419	;
	4420	"RTN","RCT CSP4",392, 0)
	4421	EXCELN ; w rite a lin e of Excel data
	4422	"RTN","RCT CSP4",393, 0)
	4423	N RCZ
	4424	"RTN","RCT CSP4",394, 0)
	4425	S RCZ=$$C SV("",$P(D EBTDATA,U, 2)) ; AR Debtor Name
	4426	"RTN","RCT CSP4",395, 0)
	4427	S RCZ=$$C SV(RCZ,$P( DEBTDATA,U ,1)) ; patient ID
	4428	"RTN","RCT CSP4",396, 0)
	4429	S RCZ=$$C SV(RCZ,$P( BILLDATA,U ,1)) ; bill#
	4430	"RTN","RCT CSP4",397, 0)
	4431	S RCZ=$$C SV(RCZ,+$P (BILLDATA, U,2)) ; current ba lance
	4432	"RTN","RCT CSP4",398, 0)
	4433	S RCZ=$$C SV(RCZ,$P( BILLDATA,U ,3)) ; AR status name
	4434	"RTN","RCT CSP4",399, 0)
	4435	S RCZ=$$C SV(RCZ,$P( BILLDATA,U ,4)) ; AR categor y name
	4436	"RTN","RCT CSP4",400, 0)
	4437	S RCZ=$$C SV(RCZ,$P( BILLDATA,U ,8)) ; AR categor y abbr
	4438	"RTN","RCT CSP4",401, 0)
	4439	S RCZ=$$C SV(RCZ,$$F MTE^XLFDT( $P(BILLDAT A,U,5),"2Z ")) ; letter1 da te
	4440	"RTN","RCT CSP4",402, 0)
	4441	S RCZ=$$C SV(RCZ,$$F MTE^XLFDT( $P(BILLDAT A,U,6),"2Z ")) ; stop flag effective date
	4442	"RTN","RCT CSP4",403, 0)
	4443	S RCZ=$$C SV(RCZ,$P( BILLDATA,U ,7)) ; stop flag reason
	4444	"RTN","RCT CSP4",404, 0)
	4445	S RCZ=$$C SV(RCZ,$P( TRANDATA,U ,1)) ; ar transac tion type desc
	4446	"RTN","RCT CSP4",405, 0)
	4447	S RCZ=$$C SV(RCZ,$$F MTE^XLFDT( $P(TRANDAT A,U,2),"2Z ")) ; transactio n date ent ered
	4448	"RTN","RCT CSP4",406, 0)
	4449	S RCZ=$$C SV(RCZ,$P( TRANDATA,U ,3)) ; trans user
	4450	"RTN","RCT CSP4",407, 0)
	4451	W !,RCZ
	4452	"RTN","RCT CSP4",408, 0)
	4453	Q
	4454	"RTN","RCT CSP4",409, 0)
	4455	;
	4456	"RTN","RCT CSP4",410, 0)
	4457	CSV(STRING ,DATA) ; b uild the E xcel data string for mat
	4458	"RTN","RCT CSP4",411, 0)
	4459	S STRING= $S(STRING= "":DATA,1: STRING_U_D ATA)
	4460	"RTN","RCT CSP4",412, 0)
	4461	Q STRING
	4462	"RTN","RCT CSP4",413, 0)
	4463	;
	4464	"RTN","RCT CSP5")
	4465	0^9^B10209 5526^n/a
	4466	"RTN","RCT CSP5",1,0)
	4467	RCTCSP5 ;A LBANY/PAW- CROSS-SERV ICING RECA LL REPORT ;03/15/14 3:34 PM
	4468	"RTN","RCT CSP5",2,0)
	4469	;;4.5;Acc ounts Rece ivable;3 15,339;M ar 20, 199 5;Build 2
	4470	"RTN","RCT CSP5",3,0)
	4471	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4472	"RTN","RCT CSP5",4,0)
	4473	;
	4474	"RTN","RCT CSP5",5,0)
	4475	Q
	4476	"RTN","RCT CSP5",6,0)
	4477	;
	4478	"RTN","RCT CSP5",7,0)
	4479	CSRCLRT ;c ross-servi cing recal l report, prints sor ted indivi dual bills that make up a cros s-servicin g
	4480	account
	4481	"RTN","RCT CSP5",8,0)
	4482	N
	4483	RCSORT,PAG E,DASH,DTO UT,DUOUT,D IROUT,VALU E,SSN,PROM PT,EXCEL,R CIEN,BILLN ,RCDTV,RCU SER,RC
	4484	TRAN,RCDAT E,TERMDIG, CURDT,DATE ,DBTR
	4485	"RTN","RCT CSP5",9,0)
	4486	N DTFRM,D TTO,DTFRMT O,POP,ZTDE SC,ZTREQ,Z TSAVE,ZTRT N,ZTSK,X,Y ,DIRUT,STO P,FLAG,TRA NTYP
	4487	"RTN","RCT CSP5",10,0 )
	4488	S PAGE=0, DASH="",$P (DASH,"-", 78)="",SSN =0000
	4489	"RTN","RCT CSP5",11,0 )
	4490	W !
	4491	"RTN","RCT CSP5",12,0 )
	4492	K ^TMP("R CTCSP5",$J )
	4493	"RTN","RCT CSP5",13,0 )
	4494	S DIR(0)= "S^1:Bill Number;2:D ebtor Name ",DIR("A") ="Sort by" ,DIR("B")= 2 D ^DIR K DIR
	4495	"RTN","RCT CSP5",14,0 )
	4496	S RCSORT= Y Q:($D(DT OUT)!$D(DU OUT)!$D(DI ROUT))
	4497	"RTN","RCT CSP5",15,0 )
	4498	S DTFRMTO =$$DTFRMTO ^RCTCSP2 Q :'DTFRMTO ;Get date range as per PRCA4 .5315
	4499	"RTN","RCT CSP5",16,0 )
	4500	S (DATE,D TFRM)=$$FM ADD^XLFDT( +$P(DTFRMT O,U,2)),DT TO=$P(DTFR MTO,U,3),C URDT=0
	4501	"RTN","RCT CSP5",17,0 )
	4502	S EXCEL=0 ,PROMPT="C APTURE Rep ort data t o an Excel Document" ,DIR(0)="Y ",DIR("?") ="^D
	4503	HEXC^RCTCS JR"
	4504	"RTN","RCT CSP5",18,0 )
	4505	S EXCEL=$ $SELECT^RC TCSJR(PROM PT,"NO") I "01"'[EXC EL S STOP= 1 Q
	4506	"RTN","RCT CSP5",19,0 )
	4507	I EXCEL=1 D EXCMSG^ RCTCSJR ; Display Ex cel displa y message
	4508	"RTN","RCT CSP5",20,0 )
	4509	K IOP,IO( "Q") S %ZI S="MQ",%ZI S("B")="" D ^%ZIS Q: POP
	4510	"RTN","RCT CSP5",21,0 )
	4511	I $D(IO(" Q")) D Q
	4512	"RTN","RCT CSP5",22,0 )
	4513	.S ZTSAVE ("RCSORT") ="",ZTSAVE ("EXCEL")= "",ZTSAVE( "DTFRM")=" ",ZTSAVE(" DTTO")=""
	4514	"RTN","RCT CSP5",23,0 )
	4515	.S ZTSAVE ("PAGE")=" ",ZTSAVE(" SSN")="",Z TSAVE("DAS H")=""
	4516	"RTN","RCT CSP5",24,0 )
	4517	.S ZTRTN= "PRTSORT^R CTCSP5",ZT DESC="CROS S-SERVICIN G RECALL R EPORT"
	4518	"RTN","RCT CSP5",25,0 )
	4519	.D ^%ZTLO AD,^%ZISC
	4520	"RTN","RCT CSP5",26,0 )
	4521	.I $G(ZTS K) W !!,"R eport comp ilation ha s started with task# ",ZTSK,". ",! S DIR( 0)="E" D ^ DIR K DIR
	4522	"RTN","RCT CSP5",27,0 )
	4523	.Q
	4524	"RTN","RCT CSP5",28,0 )
	4525	;
	4526	"RTN","RCT CSP5",29,0 )
	4527	I $E(IOST ,1,2)="C-" W !!,"Com piling Cro ss-Servici ng Recall Report. P lease wait ... ",!
	4528	"RTN","RCT CSP5",30,0 )
	4529	;
	4530	"RTN","RCT CSP5",31,0 )
	4531	PRTSORT ;l oop throug h all bill s, find re call bills and corrs ponding tr anactions
	4532	"RTN","RCT CSP5",32,0 )
	4533	K ^TMP("R CTCSP5",$J )
	4534	"RTN","RCT CSP5",33,0 )
	4535	S (RCIEN) =0 F S RC IEN=$O(^PR CA(430,RCI EN)) Q:'RC IEN D
	4536	"RTN","RCT CSP5",34,0 )
	4537	.S FLAG=0
	4538	"RTN","RCT CSP5",35,0 )
	4539	.Q:('+$P( $G(^PRCA(4 30,RCIEN,1 5)),U,2)) ;QUIT if 'TCSP RECA LL FLAG' i s Null
	4540	"RTN","RCT CSP5",36,0 )
	4541	.I $P($G( ^PRCA(430, RCIEN,15)) ,U,3)'=""
	4542	Q:$P($G(^P RCA(430,RC IEN,15)),U ,3)<DTFRM! ($P($G(^PR CA(430,RCI EN,15)),U, 3)>DTTO) ;If using "recall
	4543	effective date" to s creen
	4544	"RTN","RCT CSP5",37,0 )
	4545	.K RCLIST ,LIST,MSG D GETS^DIQ (430,RCIEN _",",".01; 9;155;151; 153;154"," IE","LIST" ,"MSG")
	4546	Q:$D(LIST) <10 S RCL IST=$NA(LI ST(430,RCI EN_","))
	4547	"RTN","RCT CSP5",38,0 )
	4548	.S DEBTOR =$P($G(^PR CA(430,RCI EN,0)),U,9 )
	4549	"RTN","RCT CSP5",39,0 )
	4550	.I '$D(^R CD(340,DEB TOR,0)) S SSN=" " ;set SSN to blank if not VA employee o r Patient
	4551	"RTN","RCT CSP5",40,0 )
	4552	.I $D(^RC D(340,DEBT OR,0)) S S SN=$E($$SS N^RCFN01($ P($G(^RCD( 340,DEBTOR ,0)),"^")) ,6,9) S
	4553	TERMDIG=$E (@RCLIST@( 9,"E"),1)_ $S(SSN'="" :SSN,1:" ")
	4554	"RTN","RCT CSP5",41,0 )
	4555	.;
	4556	"RTN","RCT CSP5",42,0 )
	4557	.;locate recall tra nsaction - loop thru backwards , getting the most r ecent tran saction. s top when w e find
	4558	one.
	4559	"RTN","RCT CSP5",43,0 )
	4560	.S RCUSER ="",RCTRAN =""
	4561	"RTN","RCT CSP5",44,0 )
	4562	.;
	4563	"RTN","RCT CSP5",45,0 )
	4564	.; TCSP R ECALL EFFE CTIVE DATE is not th ere
	4565	"RTN","RCT CSP5",46,0 )
	4566	.I $P(^PR CA(430,RCI EN,15),U,3 )="" D
	4567	"RTN","RCT CSP5",47,0 )
	4568	..F S RC TRAN=$O(^P RCA(433,"C ",RCIEN,RC TRAN),-1) Q:RCTRAN=" " D Q:FL AG
	4569	"RTN","RCT CSP5",48,0 )
	4570	...S TRAN TYP=$$GET1 ^DIQ(433,R CTRAN,12) ; transa ction type descripti on
	4571	"RTN","RCT CSP5",49,0 )
	4572	...I $F(" .CS BILL R ECALL.CS C ASE RECALL .CS DEBTOR RECALL.CS RECALL PL ACED.","." _TRANTYP_" .") D
	4573	"RTN","RCT CSP5",50,0 )
	4574	....S RCU SER=$E($$G ET1^DIQ(43 3,RCTRAN,4 2),1,10),F LAG=1
	4575	"RTN","RCT CSP5",51,0 )
	4576	.;
	4577	"RTN","RCT CSP5",52,0 )
	4578	.; TCSP R ECALL EFFE CTIVE DATE exists
	4579	"RTN","RCT CSP5",53,0 )
	4580	.I $P(^PR CA(430,RCI EN,15),U,3 )'="" D
	4581	"RTN","RCT CSP5",54,0 )
	4582	..F S RC TRAN=$O(^P RCA(433,"C ",RCIEN,RC TRAN),-1) Q:RCTRAN=" " D Q:FL AG
	4583	"RTN","RCT CSP5",55,0 )
	4584	...S TRAN TYP=$$GET1 ^DIQ(433,R CTRAN,12) ; transa ction type descripti on
	4585	"RTN","RCT CSP5",56,0 )
	4586	...I $F(" .CS BILL R ECALL.CS C ASE RECALL .CS DEBTOR RECALL.", "."_TRANTY P_".") D
	4587	"RTN","RCT CSP5",57,0 )
	4588	....S RCU SER=$E($$G ET1^DIQ(43 3,RCTRAN,4 2),1,10),F LAG=1
	4589	"RTN","RCT CSP5",58,0 )
	4590	.;
	4591	"RTN","RCT CSP5",59,0 )
	4592	.;We want to sort b y date, bu t when the date is N ULL we nee d to use a lternate
	4593	"RTN","RCT CSP5",60,0 )
	4594	.;data fi eld, so if a date is present u se negativ e value ot herwise us e RCIEN
	4595	"RTN","RCT CSP5",61,0 )
	4596	.;that al lows us to sort by d ate (newes t first). When we p rint if th e number
	4597	"RTN","RCT CSP5",62,0 )
	4598	.;is long er than 8 (negative date) char print "Pe nding".
	4599	"RTN","RCT CSP5",63,0 )
	4600	.S RCDTV= @RCLIST@(1 53,"I"),RC DTV=$S(RCD TV'="":-RC DTV,1:RCIE N)
	4601	"RTN","RCT CSP5",64,0 )
	4602	.I RCDTV> 0 S RCDTV= -RCDTV D
	4603	"RTN","RCT CSP5",65,0 )
	4604	..I $L(RC DTV)<10 S RCDTV=$E(- 99999999,1 ,(11-$L(RC DTV)))_$E( RCDTV,2,9) Q ;Ensur e that ent ries that
	4605	use IEN ar e 9 charac ters, this makes emp ty dates f loat to th e top
	4606	"RTN","RCT CSP5",66,0 )
	4607	..I $E(RC DTV,2)<3 S $E(RCDTV, 1,4)=-999 ;If IEN i s long we need to as sure that the first 4 characte rs are -
	4608	999 , so t hat null d ates float to the to p
	4609	"RTN","RCT CSP5",67,0 )
	4610	.;
	4611	"RTN","RCT CSP5",68,0 )
	4612	.;write r ecords to ^TMP
	4613	"RTN","RCT CSP5",69,0 )
	4614	.I RCSORT =1 D
	4615	"RTN","RCT CSP5",70,0 )
	4616	..S
	4617	^TMP("RCTC SP5",$J,@R CLIST@(.01 ,"E"),RCDT V)=@RCLIST @(.01,"E") _U_$E(@RCL IST@(9,"E" ),1,17)_U_ T
	4618	ERMDIG
	4619	"RTN","RCT CSP5",71,0 )
	4620	..S
	4621	^TMP("RCTC SP5",$J,@R CLIST@(.01 ,"E"),RCDT V)=^TMP("R CTCSP5",$J ,@RCLIST@( .01,"E"),R CDTV)_U_$J (
	4622	@RCLIST@(1 55,"E"),9, 2)_U_$S($L (RCDTV)=8: $$FMTE^XLF DT(-
	4623	RCDTV,"2Z" ),1:"Pendi ng")_U_@RC LIST@(154, "I")_"-"_$ E(@RCLIST@ (154,"E"), 1,7)_U_RCU SER
	4624	"RTN","RCT CSP5",72,0 )
	4625	.I RCSORT =2 D ; re write for EXCEL and faster pro cessing, a dded User ID (as per PRCA4.5 315)
	4626	"RTN","RCT CSP5",73,0 )
	4627	.. I EXCE L D Q
	4628	"RTN","RCT CSP5",74,0 )
	4629	...S
	4630	^TMP("RCTC SP5",$J,@R CLIST@(9," E"),RCIEN, RCDTV)=$E( @RCLIST@(9 ,"E"),1,16 )_U_@RCLIS T@(.01,"E" )
	4631	_U_TERMDIG _U_$J(@RCL IST@(155," E"),9,2)_U
	4632	"RTN","RCT CSP5",75,0 )
	4633	...S
	4634	^TMP("RCTC SP5",$J,@R CLIST@(9," E"),RCIEN, RCDTV)=^TM P("RCTCSP5 ",$J,@RCLI ST@(9,"E") ,RCIEN,RCD
	4635	TV)_$S($L( RCDTV)=8:$ $FMTE^XLFD T(-RCDTV," 2Z"),1:"Pe nding")_U_ @RCLIST@(1 54,"I")_"-
	4636	"_$E(@RCLI ST@(154,"E "),1,7)_U_ RCUSER Q
	4637	"RTN","RCT CSP5",76,0 )
	4638	..I 'EXCE L D Q
	4639	"RTN","RCT CSP5",77,0 )
	4640	...S
	4641	^TMP("RCTC SP5",$J,@R CLIST@(9," E"),RCIEN, RCDTV)=$E( @RCLIST@(9 ,"E"),1,16 )_U_@RCLIS T@(.01,"E" )
	4642	_U_SSN_U_$ J(@RCLIST@ (155,"E"), 9,2)_U_$S( $L(RCDTV)= 8:$$FMTE^X LFDT(-RCDT V,"2Z"),1: "Pending")
	4643	"RTN","RCT CSP5",78,0 )
	4644	...S
	4645	^TMP("RCTC SP5",$J,@R CLIST@(9," E"),RCIEN, RCDTV)=^TM P("RCTCSP5 ",$J,@RCLI ST@(9,"E") ,RCIEN,RCD
	4646	TV)_U_@RCL IST@(154," I")_"-"_$E (@RCLIST@( 154,"E"),1 ,7)_U_RCUS ER
	4647	"RTN","RCT CSP5",79,0 )
	4648	;
	4649	"RTN","RCT CSP5",80,0 )
	4650	;^TMP glo bal loaded , now prin t report
	4651	"RTN","RCT CSP5",81,0 )
	4652	U IO
	4653	"RTN","RCT CSP5",82,0 )
	4654	I RCSORT= 1 D ;Prin t bill num ber sort
	4655	"RTN","RCT CSP5",83,0 )
	4656	.D CSRCLH 1
	4657	"RTN","RCT CSP5",84,0 )
	4658	.S (BILLN ,RCDTV)="" F S BILL N=$O(^TMP( "RCTCSP5", $J,BILLN)) Q:BILLN=" "!$D(DIRUT ) F S
	4659	RCDTV=$O(^ TMP("RCTCS P5",$J,BIL LN,RCDTV)) Q:RCDTV=" "!$D(DIRUT ) D Q:$D (DIRUT)
	4660	"RTN","RCT CSP5",85,0 )
	4661	..I EXCEL W !,$P(^T MP("RCTCSP 5",$J,BILL N,RCDTV),U ,1,4)_U_$S ($L(RCDTV) =8:$$FMTE^ XLFDT(-
	4662	RCDTV,"2Z" ),1:"Pendi ng")_U_$P( ^TMP("RCTC SP5",$J,BI LLN,RCDTV) ,U,6,10) Q
	4663	"RTN","RCT CSP5",86,0 )
	4664	.. ; non- Excel outp ut
	4665	"RTN","RCT CSP5",87,0 )
	4666	..W
	4667	!,$P(^TMP( "RCTCSP5", $J,BILLN,R CDTV),U),? 13,$P(^TMP ("RCTCSP5" ,$J,BILLN, RCDTV),U,2 ),?31,$P(^ TMP(
	4668	"RCTCSP5", $J,BILLN,R CDTV),U,3)
	4669	"RTN","RCT CSP5",88,0 )
	4670	..W ?33,$ P(^TMP("RC TCSP5",$J, BILLN,RCDT V),U,4),?4 7,$P(^TMP( "RCTCSP5", $J,BILLN,R CDTV),U,5)
	4671	"RTN","RCT CSP5",89,0 )
	4672	..W ?56,$ P(^TMP("RC TCSP5",$J, BILLN,RCDT V),U,6),?6 7,$P(^TMP( "RCTCSP5", $J,BILLN,R CDTV),U,7)
	4673	"RTN","RCT CSP5",90,0 )
	4674	.. ; chec k for page breaks
	4675	"RTN","RCT CSP5",91,0 )
	4676	.. I ($Y+ 3)>IOSL D
	4677	"RTN","RCT CSP5",92,0 )
	4678	... I $E( IOST,1,2)= "C-" S DIR (0)="E" K DIRUT D ^D IR K DIR Q :$D(DIRUT)
	4679	"RTN","RCT CSP5",93,0 )
	4680	... D CSR CLH1
	4681	"RTN","RCT CSP5",94,0 )
	4682	;
	4683	"RTN","RCT CSP5",95,0 )
	4684	I RCSORT= 2 D ;Prin t debtor s ort
	4685	"RTN","RCT CSP5",96,0 )
	4686	.D CSRCLH 2
	4687	"RTN","RCT CSP5",97,0 )
	4688	.S (DBTR, RCDTV,RCIE N)="" F S DBTR=$O(^ TMP("RCTCS P5",$J,DBT R)) Q:DBTR =""!$D(DIR UT) F S
	4689	RCIEN=$O(^ TMP("RCTCS P5",$J,DBT R,RCIEN)) Q:RCIEN="" !$D(DIRUT) F S
	4690	RCDTV=$O(^ TMP("RCTCS P5",$J,DBT R,RCIEN,RC DTV)) Q:RC DTV=""!$D( DIRUT) D Q:$D(DIRU T)
	4691	"RTN","RCT CSP5",98,0 )
	4692	..I EXCEL W !,^TMP( "RCTCSP5", $J,DBTR,RC IEN,RCDTV) Q
	4693	"RTN","RCT CSP5",99,0 )
	4694	.. ; non- Excel outp ut
	4695	"RTN","RCT CSP5",100, 0)
	4696	..W
	4697	!,$P(^TMP( "RCTCSP5", $J,DBTR,RC IEN,RCDTV) ,U),?18,$P (^TMP("RCT CSP5",$J,D BTR,RCIEN, RCDTV),U,2 )
	4698	"RTN","RCT CSP5",101, 0)
	4699	..W
	4700	?31,$P(^TM P("RCTCSP5 ",$J,DBTR, RCIEN,RCDT V),U,3),?3 6,$P(^TMP( "RCTCSP5", $J,DBTR,RC IEN,RCDTV) ,U
	4701	,4)
	4702	"RTN","RCT CSP5",102, 0)
	4703	..W
	4704	?47,$P(^TM P("RCTCSP5 ",$J,DBTR, RCIEN,RCDT V),U,5),?5 6,$P(^TMP( "RCTCSP5", $J,DBTR,RC IEN,RCDTV) ,U
	4705	,6)
	4706	"RTN","RCT CSP5",103, 0)
	4707	..W ?67,$ P(^TMP("RC TCSP5",$J, DBTR,RCIEN ,RCDTV),U, 7)
	4708	"RTN","RCT CSP5",104, 0)
	4709	.. ; chec k for page breaks
	4710	"RTN","RCT CSP5",105, 0)
	4711	.. I ($Y+ 3)>IOSL D
	4712	"RTN","RCT CSP5",106, 0)
	4713	... I $E( IOST,1,2)= "C-" S DIR (0)="E" K DIRUT D ^D IR K DIR Q :$D(DIRUT)
	4714	"RTN","RCT CSP5",107, 0)
	4715	... D CSR CLH2
	4716	"RTN","RCT CSP5",108, 0)
	4717	;
	4718	"RTN","RCT CSP5",109, 0)
	4719	;Finish u p report
	4720	"RTN","RCT CSP5",110, 0)
	4721	I '$D(^TM P("RCTCSP5 ",$J)) W ! ,"No recor ds found", !!
	4722	"RTN","RCT CSP5",111, 0)
	4723	K ^TMP("R CTCSP5",$J )
	4724	"RTN","RCT CSP5",112, 0)
	4725	I $E(IOST ,1,2)="C-" ,'$D(DIRUT ) R !!,"EN D OF REPOR T...PRESS RETURN TO CONTINUE", X:DTIME W @IOF
	4726	"RTN","RCT CSP5",113, 0)
	4727	D ^%ZISC
	4728	"RTN","RCT CSP5",114, 0)
	4729	S:$D(ZTQU EUED) ZTRE Q="@"
	4730	"RTN","RCT CSP5",115, 0)
	4731	K IOP,%ZI S,ZTQUEUED
	4732	"RTN","RCT CSP5",116, 0)
	4733	Q
	4734	"RTN","RCT CSP5",117, 0)
	4735	;
	4736	"RTN","RCT CSP5",118, 0)
	4737	CSRCLH1 ;h eader for cross-serv icing reca ll report 1
	4738	"RTN","RCT CSP5",119, 0)
	4739	S PAGE=PA GE+1
	4740	"RTN","RCT CSP5",120, 0)
	4741	I 'EXCEL D Q
	4742	"RTN","RCT CSP5",121, 0)
	4743	.W @IOF
	4744	"RTN","RCT CSP5",122, 0)
	4745	.W !,"PAG E "_PAGE,? 12,"CROSS- SERVICING RECALL REP ORT (SORTE D BY BILL
	4746	NUMBER)",? 68,$$FMTE^ XLFDT(DT," 2Z")
	4747	"RTN","RCT CSP5",123, 0)
	4748	.W !,DASH
	4749	"RTN","RCT CSP5",124, 0)
	4750	.W !,"BIL L NO.",?13 ,"DEBTOR", ?31,"Pt ID ",?37,"REC L AMT",?47 ,"RECL DT" ,?56,"RECA LL RSN",?6 7,"USER
	4751	ID"
	4752	"RTN","RCT CSP5",125, 0)
	4753	.W !,"--- -----",?13 ,"------", ?31,"----- ",?37,"--- -----",?47 ,"-------" ,?56,"---- ------",?6 7,"------- "
	4754	"RTN","RCT CSP5",126, 0)
	4755	;EXCEL FO RM
	4756	"RTN","RCT CSP5",127, 0)
	4757	W !,"PAGE "_PAGE_U_ U_"CS RECA LL RPT (BI LL)"_U_U_$ $FMTE^XLFD T(DT,"2Z")
	4758	"RTN","RCT CSP5",128, 0)
	4759	W !,"BILL NO."_U_"D EBTOR"_U_" Pt ID"_U_" RECL AMT"_ U_"RECALL DT"_U_"REC ALL RSN"_U _"USER
	4760	ID"
	4761	"RTN","RCT CSP5",129, 0)
	4762	Q
	4763	"RTN","RCT CSP5",130, 0)
	4764	;
	4765	"RTN","RCT CSP5",131, 0)
	4766	CSRCLH2 ;h eader for cross-serv icing reca ll report 2
	4767	"RTN","RCT CSP5",132, 0)
	4768	S PAGE=PA GE+1
	4769	"RTN","RCT CSP5",133, 0)
	4770	I 'EXCEL D Q
	4771	"RTN","RCT CSP5",134, 0)
	4772	.W @IOF
	4773	"RTN","RCT CSP5",135, 0)
	4774	.W !,"PAG E "_PAGE,? 14,"CROSS- SERVICING RECALL REP ORT (SORTE D BY
	4775	DEBTOR)",? 68,$$FMTE^ XLFDT(DT," 2Z")
	4776	"RTN","RCT CSP5",136, 0)
	4777	.W !,DASH
	4778	"RTN","RCT CSP5",137, 0)
	4779	.W !,"DEB TOR",?18," BILL NO.", ?31,"Pt ID ",?37,"REC L AMT",?47 ,"RECL DT" ,?56,"RECA LL RSN",?6 7,"USER
	4780	ID"
	4781	"RTN","RCT CSP5",138, 0)
	4782	.W !,"--- ---",?18," --------", ?31,"----- ",?37,"--- -----",?47 ,"-------" ,?56,"---- ------",?6 7,"------- "
	4783	"RTN","RCT CSP5",139, 0)
	4784	;EXCEL FO RMAT
	4785	"RTN","RCT CSP5",140, 0)
	4786	W !,"PAGE "_PAGE_U_ U_"CS RECA LL RPT (DE BTOR)"_U_U _$$FMTE^XL FDT(DT,"2Z ")
	4787	"RTN","RCT CSP5",141, 0)
	4788	W !,"DEBT OR"_U_"BIL L NO."_U_" Pt ID"_U_" RECL AMT"_ U_"RECALL DT"_U_"REC ALL RSN"_U _"USER
	4789	ID"
	4790	"RTN","RCT CSP5",142, 0)
	4791	Q
	4792	"RTN","RCT CSP5",143, 0)
	4793	;
	4794	"RTN","RCT CSP5",144, 0)
	4795	IAIRPT ;Tr easury Cro ss-Servici ng IAI Rep ort
	4796	"RTN","RCT CSP5",145, 0)
	4797	;This rep ort displa ys a recor d of curre nt VHA bil ls at Trea sury. It i s a tool t hat can be used to i dentify
	4798	bills erro neously
	4799	"RTN","RCT CSP5",146, 0)
	4800	;listed i n a referr al status in VistA w hen reconc iled with the Print Cross-Serv icing Repo rt.
	4801	"RTN","RCT CSP5",147, 0)
	4802	;
	4803	"RTN","RCT CSP5",148, 0)
	4804	N
	4805	RDATES,RDG BL,NODE,PA GE,DASH,EX CEL,DEBTOR ,BILLDA,RC BILL,CNT,C URDT,POP,R CNAME,ZTDE SC,ZTRE
	4806	Q,ZTSAVE,Z TSK,ZTRTN, X,Y,STOP,D IRUT
	4807	"RTN","RCT CSP5",149, 0)
	4808	S PAGE=0, DASH="",$P (DASH,"-", 78)=""
	4809	"RTN","RCT CSP5",150, 0)
	4810	;Get avai lable repo rt dates
	4811	"RTN","RCT CSP5",151, 0)
	4812	S RDGBL=" RCTCSP6",C NT=1 F S RDGBL=$O(^ XTMP(RDGBL ),-1) Q:RD GBL=""!($E (RDGBL,1)= "Q") I
	4813	RDGBL["RCT CSP5" D
	4814	"RTN","RCT CSP5",152, 0)
	4815	. I $P(RD GBL," - ", 2)="" S VA LUE="No re port data to print" Q
	4816	"RTN","RCT CSP5",153, 0)
	4817	. S RDATE S(CNT)=$P( RDGBL," - ",2)_U_$$F MTE^XLFDT( $P(RDGBL," -
	4818	",2),"2Z") ,RDGBL(CNT )=RDGBL,CN T=CNT+1
	4819	"RTN","RCT CSP5",154, 0)
	4820	. Q
	4821	"RTN","RCT CSP5",155, 0)
	4822	I '$D(RDA TES(1)) W !,?5,"Ther e is no da ta availab le for the report, q uitting.", ! Q
	4823	"RTN","RCT CSP5",156, 0)
	4824	; Show da tes sorted by newest first and only show the last two report dates if they exist
	4825	"RTN","RCT CSP5",157, 0)
	4826	I '$D(RDA TES(2)) S DIR(0)="S^ 1:"_$P(RDA TES(1),U,2 ),DIR("A") ="Print da te?",DIR(" B")=1 D ^D IR K DIR
	4827	"RTN","RCT CSP5",158, 0)
	4828	I $D(RDAT ES(2)) S D IR(0)="S^1 :"_$P(RDAT ES(1),U,2) _";2:"_$P( RDATES(2), U,2),DIR(" A")=" Print IAI
	4829	report dat e?",DIR("B ")=1 D ^DI R K DIR
	4830	"RTN","RCT CSP5",159, 0)
	4831	Q:$G(DUOU T)
	4832	"RTN","RCT CSP5",160, 0)
	4833	S NODE=RD GBL(Y),RDA TES=+RDATE S(Y)
	4834	"RTN","RCT CSP5",161, 0)
	4835	S EXCEL=0 ,PROMPT="C APTURE Rep ort data t o an Excel Document" ,DIR(0)="Y ",DIR("?") ="^D
	4836	HEXC^RCTCS JR"
	4837	"RTN","RCT CSP5",162, 0)
	4838	S EXCEL=$ $SELECT^RC TCSJR(PROM PT,"NO") I "01"'[EXC EL S STOP= 1 Q
	4839	"RTN","RCT CSP5",163, 0)
	4840	I EXCEL=1 D EXCMSG^ RCTCSJR ; Display Ex cel displa y message
	4841	"RTN","RCT CSP5",164, 0)
	4842	;
	4843	"RTN","RCT CSP5",165, 0)
	4844	K IOP,IO( "Q") S %ZI S="MQ",%ZI S("B")="" D ^%ZIS Q: POP
	4845	"RTN","RCT CSP5",166, 0)
	4846	I $D(IO(" Q")) D Q
	4847	"RTN","RCT CSP5",167, 0)
	4848	.S ZTSAVE ("NODE")=" ",ZTSAVE(" EXCEL")="" ,ZTSAVE("R DATES")=""
	4849	"RTN","RCT CSP5",168, 0)
	4850	.S ZTRTN= "IAIPRNT^R CTCSP5",ZT DESC="CROS S-SERVICIN G IAI REPO RT"
	4851	"RTN","RCT CSP5",169, 0)
	4852	.D ^%ZTLO AD,^%ZISC
	4853	"RTN","RCT CSP5",170, 0)
	4854	.I $G(ZTS K) W !!,"R eport comp ilation ha s started with task# ",ZTSK,". ",!
	4855	"RTN","RCT CSP5",171, 0)
	4856	.Q
	4857	"RTN","RCT CSP5",172, 0)
	4858	.;
	4859	"RTN","RCT CSP5",173, 0)
	4860	IAIPRNT ;
	4861	"RTN","RCT CSP5",174, 0)
	4862	N GETNM,G ETBL,GLO
	4863	"RTN","RCT CSP5",175, 0)
	4864	S PAGE=0
	4865	"RTN","RCT CSP5",176, 0)
	4866	S GLO=$NA (^TMP("RCT CSP5",$J)) K @GLO
	4867	"RTN","RCT CSP5",177, 0)
	4868	U IO
	4869	"RTN","RCT CSP5",178, 0)
	4870	D IAIHDR
	4871	"RTN","RCT CSP5",179, 0)
	4872	;
	4873	"RTN","RCT CSP5",180, 0)
	4874	; report compile
	4875	"RTN","RCT CSP5",181, 0)
	4876	S DEBTOR= 0 F S DEB TOR=$O(^XT MP(NODE,DE BTOR)) Q:' DEBTOR D
	4877	"RTN","RCT CSP5",182, 0)
	4878	. S BILLD A="" F S BILLDA=$O( ^XTMP(NODE ,DEBTOR,BI LLDA)) Q:' BILLDA D
	4879	"RTN","RCT CSP5",183, 0)
	4880	..S RCBIL L=$P($G(^P RCA(430,BI LLDA,0)),U ),RCNAME=$ E($$GET1^D IQ(430,BIL LDA,9),1,2 0)
	4881	"RTN","RCT CSP5",184, 0)
	4882	..S SSN=$ S($P($G(^R CD(340,DEB TOR,0)),U) '="":$$SSN ^RCFN01($P (^RCD(340, DEBTOR,0), "^")),1:"N one")
	4883	"RTN","RCT CSP5",185, 0)
	4884	..I SSN<1 S SSN="No ne"
	4885	"RTN","RCT CSP5",186, 0)
	4886	..S @GLO@ (RCNAME,RC BILL)=RCBI LL_U_RCNAM E_U_SSN Q
	4887	"RTN","RCT CSP5",187, 0)
	4888	;
	4889	"RTN","RCT CSP5",188, 0)
	4890	; report print
	4891	"RTN","RCT CSP5",189, 0)
	4892	S GETNM=" " F S GET NM=$O(@GLO @(GETNM)) Q:GETNM="" !$D(DIRUT) S GETBL= "" F S
	4893	GETBL=$O(@ GLO@(GETNM ,GETBL)) Q :GETBL=""! $D(DIRUT) D Q:$D(D IRUT)
	4894	"RTN","RCT CSP5",190, 0)
	4895	.I 'EXCEL W
	4896	$P(@GLO@(G ETNM,GETBL ),U),?15,$ P(@GLO@(GE TNM,GETBL) ,U,2),?40, $P(@GLO@(G ETNM,GETBL ),U,
	4897	3),!
	4898	"RTN","RCT CSP5",191, 0)
	4899	.I EXCEL W @GLO@(GE TNM,GETBL) ,!
	4900	"RTN","RCT CSP5",192, 0)
	4901	.;check f or end of page here, if necess ary form f eed and pr int header
	4902	"RTN","RCT CSP5",193, 0)
	4903	.I 'EXCEL ,($Y+3)>IO SL D
	4904	"RTN","RCT CSP5",194, 0)
	4905	..I $E(IO ST,1,2)="C -" S DIR(0 )="E" K DI RUT D ^DIR Q:$D(DIRU T)
	4906	"RTN","RCT CSP5",195, 0)
	4907	..D IAIHD R
	4908	"RTN","RCT CSP5",196, 0)
	4909	I 'EXCEL, '$D(DIRUT) ,$E(IOST,1 ,2)="C-" R !!,"END O F REPORT.. .PRESS RET URN TO CON TINUE",X:D TIME W
	4910	@IOF
	4911	"RTN","RCT CSP5",197, 0)
	4912	K @GLO
	4913	"RTN","RCT CSP5",198, 0)
	4914	D ^%ZISC
	4915	"RTN","RCT CSP5",199, 0)
	4916	S:$D(ZTQU EUED) ZTRE Q="@"
	4917	"RTN","RCT CSP5",200, 0)
	4918	Q
	4919	"RTN","RCT CSP5",201, 0)
	4920	;
	4921	"RTN","RCT CSP5",202, 0)
	4922	IAIHDR ;
	4923	"RTN","RCT CSP5",203, 0)
	4924	S PAGE=PA GE+1
	4925	"RTN","RCT CSP5",204, 0)
	4926	I 'EXCEL D Q
	4927	"RTN","RCT CSP5",205, 0)
	4928	.W @IOF
	4929	"RTN","RCT CSP5",206, 0)
	4930	.W ?10,"T reasury Cr oss-Servic ing IAI Re port",!!," IAI data c ompiled da te:
	4931	",$$FMTE^X LFDT(RDATE S,"2Z"),?5 0,"Page ", PAGE
	4932	"RTN","RCT CSP5",207, 0)
	4933	.W !!,"Bi ll Number" ,?20,"Debt or",?43,"S SN"
	4934	"RTN","RCT CSP5",208, 0)
	4935	.W !,"--- --------", ?15,"----- ---------- --------", ?40,"----- ----",!
	4936	"RTN","RCT CSP5",209, 0)
	4937	;EXCEL FO RMAT
	4938	"RTN","RCT CSP5",210, 0)
	4939	W !,"PAGE "_PAGE_U_ U_"Treasur y Cross-Se rvicing IA I Report"_ U_U_$$FMTE ^XLFDT(RDA TES,"2Z")
	4940	"RTN","RCT CSP5",211, 0)
	4941	W !,"Bill Number"_U _"Debtor"_ U_"SSN",!
	4942	"RTN","RCT CSP5",212, 0)
	4943	Q
	4944	"RTN","RCT CSPD4")
	4945	0^10^B8889 8329^n/a
	4946	"RTN","RCT CSPD4",1,0 )
	4947	RCTCSPD4 ; ALB/LMH-CR OSS-SERVIC ING NON-FI NANCIAL TR ANSACTIONS ;03/15/14 3:34 PM
	4948	"RTN","RCT CSPD4",2,0 )
	4949	;;4.5;Acc ounts Rece ivable;3 15,339;M ar 20, 199 5;Build 2
	4950	"RTN","RCT CSPD4",3,0 )
	4951	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4952	"RTN","RCT CSPD4",4,0 )
	4953	;
	4954	"RTN","RCT CSPD4",5,0 )
	4955	Q
	4956	"RTN","RCT CSPD4",6,0 )
	4957	;
	4958	"RTN","RCT CSPD4",7,0 )
	4959	STOP ; CS stop place d non-fina ncial tx
	4960	"RTN","RCT CSPD4",8,0 )
	4961	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	4962	"RTN","RCT CSPD4",9,0 )
	4963	S PRCABN= BILL
	4964	"RTN","RCT CSPD4",10, 0)
	4965	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	4966	"RTN","RCT CSPD4",11, 0)
	4967	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	4968	"RTN","RCT CSPD4",12, 0)
	4969	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	4970	"RTN","RCT CSPD4",13, 0)
	4971	S DIE="^P RCA(433,", DA=PRCAEN
	4972	"RTN","RCT CSPD4",14, 0)
	4973	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	4974	"RTN","RCT CSPD4",15, 0)
	4975	S DR=DR_" ;3///0" ;C alm Code D one
	4976	"RTN","RCT CSPD4",16, 0)
	4977	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",33 ,0)) ;Tran saction Ty pe
	4978	"RTN","RCT CSPD4",17, 0)
	4979	S DR=DR_" ;15///0" ; Transactio n Amount
	4980	"RTN","RCT CSPD4",18, 0)
	4981	S DR=DR_" ;42///"_DU Z ;Process ed by user
	4982	"RTN","RCT CSPD4",19, 0)
	4983	S DR=DR_" ;11///"_DT ;Transact ion date
	4984	"RTN","RCT CSPD4",20, 0)
	4985	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	4986	"RTN","RCT CSPD4",21, 0)
	4987	S DR=DR_" ;5.02///CS STOP PLAC ED" D ^DIE
	4988	"RTN","RCT CSPD4",22, 0)
	4989	Q
	4990	"RTN","RCT CSPD4",23, 0)
	4991	;
	4992	"RTN","RCT CSPD4",24, 0)
	4993	DELSTOP ; CS delete stop non-f inancial t x
	4994	"RTN","RCT CSPD4",25, 0)
	4995	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	4996	"RTN","RCT CSPD4",26, 0)
	4997	S PRCABN= BILL
	4998	"RTN","RCT CSPD4",27, 0)
	4999	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5000	"RTN","RCT CSPD4",28, 0)
	5001	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5002	"RTN","RCT CSPD4",29, 0)
	5003	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5004	"RTN","RCT CSPD4",30, 0)
	5005	S DIE="^P RCA(433,", DA=PRCAEN
	5006	"RTN","RCT CSPD4",31, 0)
	5007	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5008	"RTN","RCT CSPD4",32, 0)
	5009	S DR=DR_" ;3///0" ;C alm Code D one
	5010	"RTN","RCT CSPD4",33, 0)
	5011	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",36 ,0)) ;Tran saction Ty pe
	5012	"RTN","RCT CSPD4",34, 0)
	5013	S DR=DR_" ;15///0" ; Transactio n Amount
	5014	"RTN","RCT CSPD4",35, 0)
	5015	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5016	"RTN","RCT CSPD4",36, 0)
	5017	S DR=DR_" ;11///"_DT ;Transact ion date
	5018	"RTN","RCT CSPD4",37, 0)
	5019	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5020	"RTN","RCT CSPD4",38, 0)
	5021	S DR=DR_" ;5.02///CS STOP DELE TED" D ^DI E
	5022	"RTN","RCT CSPD4",39, 0)
	5023	Q
	5024	"RTN","RCT CSPD4",40, 0)
	5025	;
	5026	"RTN","RCT CSPD4",41, 0)
	5027	RCLL ; Rec all from C ross-Servi cing non-f inancial t x
	5028	"RTN","RCT CSPD4",42, 0)
	5029	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,DU Z
	5030	"RTN","RCT CSPD4",43, 0)
	5031	;DUZ is r eserved, b ut in this case DUZ may be und efined due to batch background job
	5032	"RTN","RCT CSPD4",44, 0)
	5033	S PRCABN= BILL,DUZ=. 5,DUZ(0)=" @",DUZ(2)= 1 ; Server has no DU Z, use Pos tmaster
	5034	"RTN","RCT CSPD4",45, 0)
	5035	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5036	"RTN","RCT CSPD4",46, 0)
	5037	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5038	"RTN","RCT CSPD4",47, 0)
	5039	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5040	"RTN","RCT CSPD4",48, 0)
	5041	S DIE="^P RCA(433,", DA=PRCAEN
	5042	"RTN","RCT CSPD4",49, 0)
	5043	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5044	"RTN","RCT CSPD4",50, 0)
	5045	S DR=DR_" ;3///0" ;C alm Code D one
	5046	"RTN","RCT CSPD4",51, 0)
	5047	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",34 ,0)) ;Tran saction Ty pe
	5048	"RTN","RCT CSPD4",52, 0)
	5049	S DR=DR_" ;15///0" ; Transactio n Amount
	5050	"RTN","RCT CSPD4",53, 0)
	5051	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5052	"RTN","RCT CSPD4",54, 0)
	5053	S DR=DR_" ;11///"_DT ;Transact ion date
	5054	"RTN","RCT CSPD4",55, 0)
	5055	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5056	"RTN","RCT CSPD4",56, 0)
	5057	S DR=DR_" ;5.02///CS BILL RECA LL" D ^DIE
	5058	"RTN","RCT CSPD4",57, 0)
	5059	Q
	5060	"RTN","RCT CSPD4",58, 0)
	5061	;
	5062	"RTN","RCT CSPD4",59, 0)
	5063	DELRCLL ; Cross-Serv icing Dele te Bill Re call non-f inancial t x
	5064	"RTN","RCT CSPD4",60, 0)
	5065	;
	5066	"RTN","RCT CSPD4",61, 0)
	5067	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	5068	"RTN","RCT CSPD4",62, 0)
	5069	S PRCABN= BILL
	5070	"RTN","RCT CSPD4",63, 0)
	5071	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5072	"RTN","RCT CSPD4",64, 0)
	5073	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5074	"RTN","RCT CSPD4",65, 0)
	5075	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5076	"RTN","RCT CSPD4",66, 0)
	5077	S DIE="^P RCA(433,", DA=PRCAEN
	5078	"RTN","RCT CSPD4",67, 0)
	5079	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5080	"RTN","RCT CSPD4",68, 0)
	5081	S DR=DR_" ;3///0" ;C alm Code D one
	5082	"RTN","RCT CSPD4",69, 0)
	5083	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",37 ,0)) ;Tran saction Ty pe
	5084	"RTN","RCT CSPD4",70, 0)
	5085	S DR=DR_" ;15///0" ; Transactio n Amount
	5086	"RTN","RCT CSPD4",71, 0)
	5087	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5088	"RTN","RCT CSPD4",72, 0)
	5089	S DR=DR_" ;11///"_DT ;Transact ion date
	5090	"RTN","RCT CSPD4",73, 0)
	5091	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5092	"RTN","RCT CSPD4",74, 0)
	5093	S DR=DR_" ;5.02///CS DEL BILL RECALL" D ^DIE
	5094	"RTN","RCT CSPD4",75, 0)
	5095	Q
	5096	"RTN","RCT CSPD4",76, 0)
	5097	;
	5098	"RTN","RCT CSPD4",77, 0)
	5099	NEWDEBTR ; CS add ne w debtor n on-financi al tx
	5100	"RTN","RCT CSPD4",78, 0)
	5101	; Called by RCTCSPD
	5102	"RTN","RCT CSPD4",79, 0)
	5103	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,X, PRCABN
	5104	"RTN","RCT CSPD4",80, 0)
	5105	S PRCABN= BILL,DUZ=. 5,DUZ(0)=" @",DUZ(2)= 1 ; Server has no DU Z, use Pos tmaster
	5106	"RTN","RCT CSPD4",81, 0)
	5107	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5108	"RTN","RCT CSPD4",82, 0)
	5109	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5110	"RTN","RCT CSPD4",83, 0)
	5111	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5112	"RTN","RCT CSPD4",84, 0)
	5113	S DIE="^P RCA(433,", DA=PRCAEN
	5114	"RTN","RCT CSPD4",85, 0)
	5115	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5116	"RTN","RCT CSPD4",86, 0)
	5117	S DR=DR_" ;3///0" ;C alm Code D one
	5118	"RTN","RCT CSPD4",87, 0)
	5119	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",48 ,0)) ;Tran saction Ty pe
	5120	"RTN","RCT CSPD4",88, 0)
	5121	S DR=DR_" ;15///0" ; Transactio n Amount
	5122	"RTN","RCT CSPD4",89, 0)
	5123	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5124	"RTN","RCT CSPD4",90, 0)
	5125	S DR=DR_" ;11///"_DT ;Transact ion date
	5126	"RTN","RCT CSPD4",91, 0)
	5127	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5128	"RTN","RCT CSPD4",92, 0)
	5129	S DR=DR_" ;5.02///CS NEW DBTR NEW BILL" D ^DIE
	5130	"RTN","RCT CSPD4",93, 0)
	5131	Q
	5132	"RTN","RCT CSPD4",94, 0)
	5133	;
	5134	"RTN","RCT CSPD4",95, 0)
	5135	RCRSD ; CS Debtor Re call non-f inancial t x
	5136	"RTN","RCT CSPD4",96, 0)
	5137	; Set thi s debtor f or Recall from Cross -Servicing
	5138	"RTN","RCT CSPD4",97, 0)
	5139	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,X
	5140	"RTN","RCT CSPD4",98, 0)
	5141	;DUZ is r eserved, b ut in this case DUZ may be und efined due to batch background job
	5142	"RTN","RCT CSPD4",99, 0)
	5143	S PRCABN= BILL,DUZ=. 5,DUZ(0)=" @",DUZ(2)= 1 ; Server has no DU Z, use Pos tmaster
	5144	"RTN","RCT CSPD4",100 ,0)
	5145	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5146	"RTN","RCT CSPD4",101 ,0)
	5147	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5148	"RTN","RCT CSPD4",102 ,0)
	5149	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5150	"RTN","RCT CSPD4",103 ,0)
	5151	S DIE="^P RCA(433,", DA=PRCAEN
	5152	"RTN","RCT CSPD4",104 ,0)
	5153	S DR=".03 ///"_PRCAB N ; BILL N UMBER
	5154	"RTN","RCT CSPD4",105 ,0)
	5155	S DR=DR_" ;3///0" ;C alm Code D one
	5156	"RTN","RCT CSPD4",106 ,0)
	5157	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",35 ,0)) ;Tran saction Ty pe
	5158	"RTN","RCT CSPD4",107 ,0)
	5159	S DR=DR_" ;15///0" ; Transactio n Amount
	5160	"RTN","RCT CSPD4",108 ,0)
	5161	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5162	"RTN","RCT CSPD4",109 ,0)
	5163	S DR=DR_" ;11///"_DT ;Transact ion date
	5164	"RTN","RCT CSPD4",110 ,0)
	5165	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5166	"RTN","RCT CSPD4",111 ,0)
	5167	S DR=DR_" ;5.02///CS DEBTOR RE CALL" D ^D IE
	5168	"RTN","RCT CSPD4",112 ,0)
	5169	Q
	5170	"RTN","RCT CSPD4",113 ,0)
	5171	;
	5172	"RTN","RCT CSPD4",114 ,0)
	5173	DELSETD(BI LL) ; CS D elete Debt or Recall non-financ ial tx
	5174	"RTN","RCT CSPD4",115 ,0)
	5175	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSERX
	5176	"RTN","RCT CSPD4",116 ,0)
	5177	S PRCABN= BILL
	5178	"RTN","RCT CSPD4",117 ,0)
	5179	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5180	"RTN","RCT CSPD4",118 ,0)
	5181	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5182	"RTN","RCT CSPD4",119 ,0)
	5183	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5184	"RTN","RCT CSPD4",120 ,0)
	5185	S DIE="^P RCA(433,", DA=PRCAEN
	5186	"RTN","RCT CSPD4",121 ,0)
	5187	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5188	"RTN","RCT CSPD4",122 ,0)
	5189	S DR=DR_" ;3///0" ;C alm Code D one
	5190	"RTN","RCT CSPD4",123 ,0)
	5191	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",38 ,0)) ;Tran saction Ty pe
	5192	"RTN","RCT CSPD4",124 ,0)
	5193	S DR=DR_" ;15///0" ; Transactio n Amount
	5194	"RTN","RCT CSPD4",125 ,0)
	5195	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5196	"RTN","RCT CSPD4",126 ,0)
	5197	S DR=DR_" ;11///"_DT ;Transact ion date
	5198	"RTN","RCT CSPD4",127 ,0)
	5199	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5200	"RTN","RCT CSPD4",128 ,0)
	5201	S DR=DR_" ;5.02///CS DEL DEBTO R RECALL" D ^DIE
	5202	"RTN","RCT CSPD4",129 ,0)
	5203	Q
	5204	"RTN","RCT CSPD4",130 ,0)
	5205	;
	5206	"RTN","RCT CSPD4",131 ,0)
	5207	DEBTOR ; C S New Bill Existing Debtor non -financial tx
	5208	"RTN","RCT CSPD4",132 ,0)
	5209	;
	5210	"RTN","RCT CSPD4",133 ,0)
	5211	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,PR CABN
	5212	"RTN","RCT CSPD4",134 ,0)
	5213	S PRCABN= BILL,DUZ=. 5,DUZ(0)=" @",DUZ(2)= 1 ; Server has no DU Z, use Pos tmaster
	5214	"RTN","RCT CSPD4",135 ,0)
	5215	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5216	"RTN","RCT CSPD4",136 ,0)
	5217	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5218	"RTN","RCT CSPD4",137 ,0)
	5219	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5220	"RTN","RCT CSPD4",138 ,0)
	5221	S DIE="^P RCA(433,", DA=PRCAEN
	5222	"RTN","RCT CSPD4",139 ,0)
	5223	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5224	"RTN","RCT CSPD4",140 ,0)
	5225	S DR=DR_" ;3///0" ;C alm Code D one
	5226	"RTN","RCT CSPD4",141 ,0)
	5227	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",39 ,0)) ;Tran saction Ty pe
	5228	"RTN","RCT CSPD4",142 ,0)
	5229	S DR=DR_" ;15///0" ; Transactio n Amount
	5230	"RTN","RCT CSPD4",143 ,0)
	5231	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5232	"RTN","RCT CSPD4",144 ,0)
	5233	S DR=DR_" ;11///"_DT ;Transact ion date
	5234	"RTN","RCT CSPD4",145 ,0)
	5235	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5236	"RTN","RCT CSPD4",146 ,0)
	5237	S DR=DR_" ;5.02///CS DEBTOR NE W BILL" D ^DIE ; Rev ised as re quested
	5238	"RTN","RCT CSPD4",147 ,0)
	5239	Q
	5240	"RTN","RCT CSPD4",148 ,0)
	5241	;
	5242	"RTN","RCT CSPD4",149 ,0)
	5243	CSCASE ; Add Case I nfo non-fi nancial tx
	5244	"RTN","RCT CSPD4",150 ,0)
	5245	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	5246	"RTN","RCT CSPD4",151 ,0)
	5247	S PRCABN= BILL,DUZ=. 5,DUZ(0)=" @",DUZ(2)= 1 ; Server has no DU Z, use Pos tmaster
	5248	"RTN","RCT CSPD4",152 ,0)
	5249	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5250	"RTN","RCT CSPD4",153 ,0)
	5251	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5252	"RTN","RCT CSPD4",154 ,0)
	5253	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5254	"RTN","RCT CSPD4",155 ,0)
	5255	S DIE="^P RCA(433,", DA=PRCAEN
	5256	"RTN","RCT CSPD4",156 ,0)
	5257	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5258	"RTN","RCT CSPD4",157 ,0)
	5259	S DR=DR_" ;3///0" ;C alm Code D one
	5260	"RTN","RCT CSPD4",158 ,0)
	5261	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",47 ,0)) ;Tran saction Ty pe
	5262	"RTN","RCT CSPD4",159 ,0)
	5263	S DR=DR_" ;15///0" ; Transactio n Amount
	5264	"RTN","RCT CSPD4",160 ,0)
	5265	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5266	"RTN","RCT CSPD4",161 ,0)
	5267	S DR=DR_" ;11///"_DT ;Transact ion date
	5268	"RTN","RCT CSPD4",162 ,0)
	5269	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5270	"RTN","RCT CSPD4",163 ,0)
	5271	S DR=DR_" ;5.02///CS ADD CASE INFO" D ^D IE
	5272	"RTN","RCT CSPD4",164 ,0)
	5273	Q
	5274	"RTN","RCT CSPD4",165 ,0)
	5275	;
	5276	"RTN","RCT CSPD4",166 ,0)
	5277	DELSETC ; Cross-Serv icing dele te case re call non-f inancial t x
	5278	"RTN","RCT CSPD4",167 ,0)
	5279	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	5280	"RTN","RCT CSPD4",168 ,0)
	5281	S PRCABN= BILL
	5282	"RTN","RCT CSPD4",169 ,0)
	5283	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5284	"RTN","RCT CSPD4",170 ,0)
	5285	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5286	"RTN","RCT CSPD4",171 ,0)
	5287	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5288	"RTN","RCT CSPD4",172 ,0)
	5289	S DIE="^P RCA(433,", DA=PRCAEN
	5290	"RTN","RCT CSPD4",173 ,0)
	5291	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5292	"RTN","RCT CSPD4",174 ,0)
	5293	S DR=DR_" ;3///0" ;C alm Code D one
	5294	"RTN","RCT CSPD4",175 ,0)
	5295	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",46 ,0)) ;Tran saction Ty pe
	5296	"RTN","RCT CSPD4",176 ,0)
	5297	S DR=DR_" ;15///0" ; Transactio n Amount
	5298	"RTN","RCT CSPD4",177 ,0)
	5299	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5300	"RTN","RCT CSPD4",178 ,0)
	5301	S DR=DR_" ;11///"_DT ;Transact ion date
	5302	"RTN","RCT CSPD4",179 ,0)
	5303	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5304	"RTN","RCT CSPD4",180 ,0)
	5305	S DR=DR_" ;5.02///CS DEL CASE RECALL" D ^DIE
	5306	"RTN","RCT CSPD4",181 ,0)
	5307	Q
	5308	"RTN","RCT CSPD4",182 ,0)
	5309	;
	5310	"RTN","RCT CSPD4",183 ,0)
	5311	DECADJ ; n on-financi al decreas e adjustme nt transac tion for 5 b cross-se rvicing re cord
	5312	"RTN","RCT CSPD4",184 ,0)
	5313	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	5314	"RTN","RCT CSPD4",185 ,0)
	5315	S PRCABN= BILL
	5316	"RTN","RCT CSPD4",186 ,0)
	5317	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5318	"RTN","RCT CSPD4",187 ,0)
	5319	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5320	"RTN","RCT CSPD4",188 ,0)
	5321	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5322	"RTN","RCT CSPD4",189 ,0)
	5323	S DIE="^P RCA(433,", DA=PRCAEN
	5324	"RTN","RCT CSPD4",190 ,0)
	5325	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5326	"RTN","RCT CSPD4",191 ,0)
	5327	S DR=DR_" ;3///0" ;C alm Code D one
	5328	"RTN","RCT CSPD4",192 ,0)
	5329	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",49 ,0)) ;Tran saction Ty pe
	5330	"RTN","RCT CSPD4",193 ,0)
	5331	S DR=DR_" ;15///0" ; Transactio n Amount
	5332	"RTN","RCT CSPD4",194 ,0)
	5333	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5334	"RTN","RCT CSPD4",195 ,0)
	5335	S DR=DR_" ;11///"_DT ;Transact ion date
	5336	"RTN","RCT CSPD4",196 ,0)
	5337	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5338	"RTN","RCT CSPD4",197 ,0)
	5339	S DR=DR_" ;5.02///CS DECREASE ADJ" D ^DI E
	5340	"RTN","RCT CSPD4",198 ,0)
	5341	Q
	5342	"RTN","RCT CSPD4",199 ,0)
	5343	;
	5344	"RTN","RCT CSPD4",200 ,0)
	5345	DECADJ0 ; decrease a djustment transactio n deletes cs date
	5346	"RTN","RCT CSPD4",201 ,0)
	5347	; 5B tx t akes bal. of bill to 0
	5348	"RTN","RCT CSPD4",202 ,0)
	5349	; if node 7 balance s = 0. Ca lled by RC TCSPD
	5350	"RTN","RCT CSPD4",203 ,0)
	5351	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	5352	"RTN","RCT CSPD4",204 ,0)
	5353	S PRCABN= BILL
	5354	"RTN","RCT CSPD4",205 ,0)
	5355	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5356	"RTN","RCT CSPD4",206 ,0)
	5357	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5358	"RTN","RCT CSPD4",207 ,0)
	5359	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5360	"RTN","RCT CSPD4",208 ,0)
	5361	S DIE="^P RCA(433,", DA=PRCAEN
	5362	"RTN","RCT CSPD4",209 ,0)
	5363	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5364	"RTN","RCT CSPD4",210 ,0)
	5365	S DR=DR_" ;3///0" ;C alm Code D one
	5366	"RTN","RCT CSPD4",211 ,0)
	5367	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",40 ,0)) ;Tran saction Ty pe
	5368	"RTN","RCT CSPD4",212 ,0)
	5369	S DR=DR_" ;15///0" ; Transactio n Amount
	5370	"RTN","RCT CSPD4",213 ,0)
	5371	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5372	"RTN","RCT CSPD4",214 ,0)
	5373	S DR=DR_" ;11///"_DT ;Transact ion date
	5374	"RTN","RCT CSPD4",215 ,0)
	5375	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5376	"RTN","RCT CSPD4",216 ,0)
	5377	S DR=DR_" ;5.02///CS DECR ADJ NOT APP" D ^DIE
	5378	"RTN","RCT CSPD4",217 ,0)
	5379	D CHKS
	5380	"RTN","RCT CSPD4",218 ,0)
	5381	Q
	5382	"RTN","RCT CSPD4",219 ,0)
	5383	;
	5384	"RTN","RCT CSPD4",220 ,0)
	5385	RCRSC ; Cr oss-Servic ing case r ecall non- financial tx
	5386	"RTN","RCT CSPD4",221 ,0)
	5387	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	5388	"RTN","RCT CSPD4",222 ,0)
	5389	;DUZ is r eserved, b ut in this case DUZ may be und efined due to batch background job
	5390	"RTN","RCT CSPD4",223 ,0)
	5391	S PRCABN= BILL,DUZ=. 5,DUZ(0)=" @",DUZ(2)= 1 ; Server has no DU Z, use Pos tmaster
	5392	"RTN","RCT CSPD4",224 ,0)
	5393	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5394	"RTN","RCT CSPD4",225 ,0)
	5395	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5396	"RTN","RCT CSPD4",226 ,0)
	5397	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5398	"RTN","RCT CSPD4",227 ,0)
	5399	S DIE="^P RCA(433,", DA=PRCAEN
	5400	"RTN","RCT CSPD4",228 ,0)
	5401	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5402	"RTN","RCT CSPD4",229 ,0)
	5403	S DR=DR_" ;3///0" ;C alm Code D one
	5404	"RTN","RCT CSPD4",230 ,0)
	5405	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",45 ,0)) ;Tran saction Ty pe
	5406	"RTN","RCT CSPD4",231 ,0)
	5407	S DR=DR_" ;15///0" ; Transactio n Amount
	5408	"RTN","RCT CSPD4",232 ,0)
	5409	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5410	"RTN","RCT CSPD4",233 ,0)
	5411	S DR=DR_" ;11///"_DT ;Transact ion date
	5412	"RTN","RCT CSPD4",234 ,0)
	5413	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5414	"RTN","RCT CSPD4",235 ,0)
	5415	S DR=DR_" ;5.02///CS CASE RECA LL" D ^DIE
	5416	"RTN","RCT CSPD4",236 ,0)
	5417	Q
	5418	"RTN","RCT CSPD4",237 ,0)
	5419	;
	5420	"RTN","RCT CSPD4",238 ,0)
	5421	CHKS ;Leav e validati on checks in place
	5422	"RTN","RCT CSPD4",239 ,0)
	5423	I $P($G(^ PRCA(433,P RCAEN,5)), "^",2)=""! '$P(^PRCA( 433,PRCAEN ,1),"^") S PRCACOMM= "TRANSACTI ON
	5424	INCOMPLETE " D DELETE ^PRCAWO1 K PRCACOMM Q
	5425	"RTN","RCT CSPD4",240 ,0)
	5426	I '$D(PRC AD("DELETE ")) S RCAS K=1 D TRAN UP^PRCAUTL ,UPPRIN^PR CADJ
	5427	"RTN","RCT CSPD4",241 ,0)
	5428	I $P($G(^ RCD(340,+$ P(^PRCA(43 0,PRCABN,0 ),"^",9),0 )),"^")["; DPT(" D
	5429	"RTN","RCT CSPD4",242 ,0)
	5430	.;Ensure comment do es not app ear on pat ient state ment
	5431	"RTN","RCT CSPD4",243 ,0)
	5432	.S $P(^PR CA(433,PRC AEN,0),"^" ,10)=1
	5433	"RTN","RCT CSPD4",244 ,0)
	5434	Q
	5435	"RTN","RCT CSPD4",245 ,0)
	5436	; End of RCTCSPD4
	5437	"RTN","RCT CSPD5")
	5438	0^11^B1994 3104^n/a
	5439	"RTN","RCT CSPD5",1,0 )
	5440	RCTCSPD5 ; ALB/LMH-CR OSS-SERVIC ING NON-FI NANCIAL TR ANSACTIONS ;03/15/14 3:34 PM
	5441	"RTN","RCT CSPD5",2,0 )
	5442	;;4.5;Acc ounts Rece ivable;3 15,339;M ar 20, 199 5;Build 2
	5443	"RTN","RCT CSPD5",3,0 )
	5444	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5445	"RTN","RCT CSPD5",4,0 )
	5446	;
	5447	"RTN","RCT CSPD5",5,0 )
	5448	Q
	5449	"RTN","RCT CSPD5",6,0 )
	5450	;
	5451	"RTN","RCT CSPD5",7,0 )
	5452	CSATRY ; C ross-Servi cing Admin Adj Treas ury Rev? Y es non-fin ancial tx
	5453	"RTN","RCT CSPD5",8,0 )
	5454	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,X
	5455	"RTN","RCT CSPD5",9,0 )
	5456	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5457	"RTN","RCT CSPD5",10, 0)
	5458	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5459	"RTN","RCT CSPD5",11, 0)
	5460	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5461	"RTN","RCT CSPD5",12, 0)
	5462	S DIE="^P RCA(433,", DA=PRCAEN
	5463	"RTN","RCT CSPD5",13, 0)
	5464	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5465	"RTN","RCT CSPD5",14, 0)
	5466	S DR=DR_" ;3///0" ;C alm Code D one
	5467	"RTN","RCT CSPD5",15, 0)
	5468	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",53 ,0)) ;Tran saction Ty pe
	5469	"RTN","RCT CSPD5",16, 0)
	5470	S DR=DR_" ;15///0" ; Transactio n Amount
	5471	"RTN","RCT CSPD5",17, 0)
	5472	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5473	"RTN","RCT CSPD5",18, 0)
	5474	S DR=DR_" ;11///"_DT ;Transact ion date
	5475	"RTN","RCT CSPD5",19, 0)
	5476	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5477	"RTN","RCT CSPD5",20, 0)
	5478	S DR=DR_" ;5.02///CS ADMIN ADJ TR REV?Y" D ^DIE
	5479	"RTN","RCT CSPD5",21, 0)
	5480	Q
	5481	"RTN","RCT CSPD5",22, 0)
	5482	;
	5483	"RTN","RCT CSPD5",23, 0)
	5484	CSATRN ; C ross-Servi cing Admin Adj Treas ury Rev? N o non-fina ncial tx
	5485	"RTN","RCT CSPD5",24, 0)
	5486	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,X
	5487	"RTN","RCT CSPD5",25, 0)
	5488	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5489	"RTN","RCT CSPD5",26, 0)
	5490	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5491	"RTN","RCT CSPD5",27, 0)
	5492	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5493	"RTN","RCT CSPD5",28, 0)
	5494	S DIE="^P RCA(433,", DA=PRCAEN
	5495	"RTN","RCT CSPD5",29, 0)
	5496	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5497	"RTN","RCT CSPD5",30, 0)
	5498	S DR=DR_" ;3///0" ;C alm Code D one
	5499	"RTN","RCT CSPD5",31, 0)
	5500	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",54 ,0)) ;Tran saction Ty pe
	5501	"RTN","RCT CSPD5",32, 0)
	5502	S DR=DR_" ;15///0" ; Transactio n Amount
	5503	"RTN","RCT CSPD5",33, 0)
	5504	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5505	"RTN","RCT CSPD5",34, 0)
	5506	S DR=DR_" ;11///"_DT ;Transact ion date
	5507	"RTN","RCT CSPD5",35, 0)
	5508	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5509	"RTN","RCT CSPD5",36, 0)
	5510	S DR=DR_" ;5.02///CS ADMIN ADJ TR REV?N" D ^DIE
	5511	"RTN","RCT CSPD5",37, 0)
	5512	Q
	5513	"RTN","RCT CSPD5",38, 0)
	5514	;
	5515	"RTN","RCT CSPD5",39, 0)
	5516	CSITRY ; C ross-Servi cing Incr Adj Treasu ry Rev? Ye s non-fina ncial tx
	5517	"RTN","RCT CSPD5",40, 0)
	5518	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,X
	5519	"RTN","RCT CSPD5",41, 0)
	5520	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5521	"RTN","RCT CSPD5",42, 0)
	5522	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5523	"RTN","RCT CSPD5",43, 0)
	5524	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5525	"RTN","RCT CSPD5",44, 0)
	5526	S DIE="^P RCA(433,", DA=PRCAEN
	5527	"RTN","RCT CSPD5",45, 0)
	5528	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5529	"RTN","RCT CSPD5",46, 0)
	5530	S DR=DR_" ;3///0" ;C alm Code D one
	5531	"RTN","RCT CSPD5",47, 0)
	5532	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",57 ,0)) ;Tran saction Ty pe
	5533	"RTN","RCT CSPD5",48, 0)
	5534	S DR=DR_" ;15///0" ; Transactio n Amount
	5535	"RTN","RCT CSPD5",49, 0)
	5536	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5537	"RTN","RCT CSPD5",50, 0)
	5538	S DR=DR_" ;11///"_DT ;Transact ion date
	5539	"RTN","RCT CSPD5",51, 0)
	5540	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5541	"RTN","RCT CSPD5",52, 0)
	5542	S DR=DR_" ;5.02///CS INC ADJ T R REV?Y" D ^DIE
	5543	"RTN","RCT CSPD5",53, 0)
	5544	Q
	5545	"RTN","RCT CSPD5",54, 0)
	5546	;
	5547	"RTN","RCT CSPD5",55, 0)
	5548	CSITRN ; C ross-Servi cing Incr Adj Treasu ry Rev? No non-finan cial tx
	5549	"RTN","RCT CSPD5",56, 0)
	5550	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,X
	5551	"RTN","RCT CSPD5",57, 0)
	5552	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5553	"RTN","RCT CSPD5",58, 0)
	5554	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5555	"RTN","RCT CSPD5",59, 0)
	5556	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5557	"RTN","RCT CSPD5",60, 0)
	5558	S DIE="^P RCA(433,", DA=PRCAEN
	5559	"RTN","RCT CSPD5",61, 0)
	5560	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5561	"RTN","RCT CSPD5",62, 0)
	5562	S DR=DR_" ;3///0" ;C alm Code D one
	5563	"RTN","RCT CSPD5",63, 0)
	5564	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",58 ,0)) ;Tran saction Ty pe
	5565	"RTN","RCT CSPD5",64, 0)
	5566	S DR=DR_" ;15///0" ; Transactio n Amount
	5567	"RTN","RCT CSPD5",65, 0)
	5568	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5569	"RTN","RCT CSPD5",66, 0)
	5570	S DR=DR_" ;11///"_DT ;Transact ion date
	5571	"RTN","RCT CSPD5",67, 0)
	5572	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5573	"RTN","RCT CSPD5",68, 0)
	5574	S DR=DR_" ;5.02///CS INC ADJ T R REV?N" D ^DIE
	5575	"RTN","RCT CSPD5",69, 0)
	5576	Q
	5577	"RTN","RCT CSPD5",70, 0)
	5578	;
	5579	"RTN","RCT CSPD5",71, 0)
	5580	CSPRTR ; C ross-Servi cing PENDI NG RECONCI LIATION no n-financia l tx
	5581	"RTN","RCT CSPD5",72, 0)
	5582	; C alled by R 1^RCTCSPRS
	5583	"RTN","RCT CSPD5",73, 0)
	5584	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER,DU Z
	5585	"RTN","RCT CSPD5",74, 0)
	5586	; DUZ is reserved, but in thi s case DUZ may be un defined du e to a ser ver backgr ound job, but we don 't
	5587	want to ov erwrite DU Z if it ex ists
	5588	"RTN","RCT CSPD5",75, 0)
	5589	S PRCABN= BILL,DUZ=. 5,DUZ(0)=" @",DUZ(2)= 1 ; Server has no DU Z, use Pos tmaster
	5590	"RTN","RCT CSPD5",76, 0)
	5591	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5592	"RTN","RCT CSPD5",77, 0)
	5593	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5594	"RTN","RCT CSPD5",78, 0)
	5595	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5596	"RTN","RCT CSPD5",79, 0)
	5597	S DIE="^P RCA(433,", DA=PRCAEN
	5598	"RTN","RCT CSPD5",80, 0)
	5599	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5600	"RTN","RCT CSPD5",81, 0)
	5601	S DR=DR_" ;3///0" ;C alm Code D one
	5602	"RTN","RCT CSPD5",82, 0)
	5603	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",61 ,0)) ;Tran saction Ty pe
	5604	"RTN","RCT CSPD5",83, 0)
	5605	S DR=DR_" ;15///0" ; Transactio n Amount
	5606	"RTN","RCT CSPD5",84, 0)
	5607	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5608	"RTN","RCT CSPD5",85, 0)
	5609	S DR=DR_" ;11///"_DT ;Transact ion date
	5610	"RTN","RCT CSPD5",86, 0)
	5611	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5612	"RTN","RCT CSPD5",87, 0)
	5613	S DR=DR_" ;5.02///CS PEND RECO N" D ^DIE
	5614	"RTN","RCT CSPD5",88, 0)
	5615	Q
	5616	"RTN","RCT CSPD5",89, 0)
	5617	;
	5618	"RTN","RCT CSPD5",90, 0)
	5619	CSRCLPL ; CS RECALL placed non -financial tx
	5620	"RTN","RCT CSPD5",91, 0)
	5621	N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY ,RCUSER
	5622	"RTN","RCT CSPD5",92, 0)
	5623	S PRCABN= BILL
	5624	"RTN","RCT CSPD5",93, 0)
	5625	D SETTR^P RCAUTL,PAT TR^PRCAUTL Q:'$D(PRC AEN)
	5626	"RTN","RCT CSPD5",94, 0)
	5627	S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
	5628	"RTN","RCT CSPD5",95, 0)
	5629	Q:PRCAA1' >0 S PRCA A2=$P(^(0) ,U,3)
	5630	"RTN","RCT CSPD5",96, 0)
	5631	S DIE="^P RCA(433,", DA=PRCAEN
	5632	"RTN","RCT CSPD5",97, 0)
	5633	S DR=".03 ///"_PRCAB N ;Bill Nu mber
	5634	"RTN","RCT CSPD5",98, 0)
	5635	S DR=DR_" ;3///0" ;C alm Code D one
	5636	"RTN","RCT CSPD5",99, 0)
	5637	S DR=DR_" ;12///"_$O (^PRCA(430 .3,"AC",62 ,0)) ;Tran saction Ty pe
	5638	"RTN","RCT CSPD5",100 ,0)
	5639	S DR=DR_" ;15///0" ; Transactio n Amount
	5640	"RTN","RCT CSPD5",101 ,0)
	5641	S DR=DR_" ;42///"_DU Z ;Process ed by user
	5642	"RTN","RCT CSPD5",102 ,0)
	5643	S DR=DR_" ;11///"_DT ;Transact ion date
	5644	"RTN","RCT CSPD5",103 ,0)
	5645	S DR=DR_" ;4///2" ;T ransaction status (c omplete)
	5646	"RTN","RCT CSPD5",104 ,0)
	5647	S DR=DR_" ;5.02///CS RECALL PL ACED" D ^D IE
	5648	"RTN","RCT CSPD5",105 ,0)
	5649	Q
	5650	"RTN","RCT CSPD5",106 ,0)
	5651	; End of RCTCSPD5
	5652	"RTN","RCT CSWL1")
	5653	0^12^B5406 4527^n/a
	5654	"RTN","RCT CSWL1",1,0 )
	5655	RCTCSWL1 ; ALB/PAW-Cr oss Servic ing Workli st ;30-SEP -2015
	5656	"RTN","RCT CSWL1",2,0 )
	5657	;;4.5;ACC OUNTS RECE IVABLE;3 15,339;M ar 20, 199 5;Build 2
	5658	"RTN","RCT CSWL1",3,0 )
	5659	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5660	"RTN","RCT CSWL1",4,0 )
	5661	;
	5662	"RTN","RCT CSWL1",5,0 )
	5663	GETRPT(RCR PT) ; Crea te patient report ba sed upon r eport sele ction
	5664	"RTN","RCT CSWL1",6,0 )
	5665	; require d input RC RPT (see c omments be low for nu mber/repor t correlat ion)
	5666	"RTN","RCT CSWL1",7,0 )
	5667	; output ^TMP("RCTC SWL",$J), containing auths for group que ue
	5668	"RTN","RCT CSWL1",8,0 )
	5669	N
	5670	RCBILLEX,R CDATE,RCDE BTOR,RCDFN ,RCBILL,RC DBTRN,RCDF N,RCFND1,R CTRAN,RCRT CD,RCRTCDX ,RCUN
	5671	C,RCPIF,RC SPA,RCDIV, RCDIVX
	5672	"RTN","RCT CSWL1",9,0 )
	5673	; Loop th rough ACCO UNTS RECEI VABLE File (#430) Cr oss-Servic ing Index
	5674	"RTN","RCT CSWL1",10, 0)
	5675	S RCDATE= "" F S RC DATE=$O(^P RCA(430,"A N",RCDATE) ) Q:RCDATE ="" D
	5676	"RTN","RCT CSWL1",11, 0)
	5677	.S RCBILL ="" F S R CBILL=$O(^ PRCA(430," AN",RCDATE ,RCBILL)) Q:RCBILL=" " D
	5678	"RTN","RCT CSWL1",12, 0)
	5679	..I +$P($ G(^PRCA(43 0,RCBILL,3 0)),U,9) Q ;Bill ha s been rem oved from CS Reconci liation Wo rklist
	5680	"RTN","RCT CSWL1",13, 0)
	5681	..S RCDEB TOR=$P($G( ^PRCA(430, RCBILL,0)) ,U,9) ;De btor in Fi le 340
	5682	"RTN","RCT CSWL1",14, 0)
	5683	..I $P($G (^RCD(340, RCDEBTOR,0 )),U,1)["D PT" S RCDF N=+$P($G(^ RCD(340,RC DEBTOR,0)) ,U,1)
	5684	"RTN","RCT CSWL1",15, 0)
	5685	..S RCRTC D=$P($G(^P RCA(430,RC BILL,30)), U,2)
	5686	"RTN","RCT CSWL1",16, 0)
	5687	..I RCRTC D="" Q
	5688	"RTN","RCT CSWL1",17, 0)
	5689	..S RCRTC DX=$P(^PRC A(430.5,RC RTCD,0),U)
	5690	"RTN","RCT CSWL1",18, 0)
	5691	..S RCBIL LEX=$P(^PR CA(430,RCB ILL,0),U)
	5692	"RTN","RCT CSWL1",19, 0)
	5693	..; Check if runnin g for spec ific Divis ion - MEDI CAL CENTER DIVISION File #40.8
	5694	"RTN","RCT CSWL1",20, 0)
	5695	..S RCDIV =$P(RCBILL EX,"-")
	5696	"RTN","RCT CSWL1",21, 0)
	5697	..S RCDIV X="" I VAU TD=0 I '$D (VAUTD(RCD IV)) Q
	5698	"RTN","RCT CSWL1",22, 0)
	5699	..; Check if runnin g for spec ific Patie nt
	5700	"RTN","RCT CSWL1",23, 0)
	5701	..I $P(FI LTERS(0),U ,3)=1 I '$ D(RCDFN) Q
	5702	"RTN","RCT CSWL1",24, 0)
	5703	..I $P(FI LTERS(0),U ,3)=1 I '$ D(FILTERS( 2,RCDFN)) Q
	5704	"RTN","RCT CSWL1",25, 0)
	5705	..; Speci fic checks for each type of re port
	5706	"RTN","RCT CSWL1",26, 0)
	5707	..I RCRPT =1 I RCRTC DX'="B" Q ;Bankrupt cy Return Reason cod e B
	5708	"RTN","RCT CSWL1",27, 0)
	5709	..I RCRPT =2 I RCRTC DX'="D" Q ;Death Re turn Reaso n Code D
	5710	"RTN","RCT CSWL1",28, 0)
	5711	..I RCRPT =3 I RCRTC DX'="Z" Q ;Uncollec table Retu rn Reason Code Z
	5712	"RTN","RCT CSWL1",29, 0)
	5713	..I RCRPT =4 I RCRTC DX'="F" Q ;Payment in Full - Return Rea son Code = F
	5714	"RTN","RCT CSWL1",30, 0)
	5715	..I RCRPT =5 I RCRTC DX'="P" Q ;Satisfie d PA - Ret urn Reason Code = P, but nothi ng in Comp romise Fie ld
	5716	"RTN","RCT CSWL1",31, 0)
	5717	..I RCRPT =6 I RCRTC DX'="S" Q ;Compromi se Field s et to Y
	5718	"RTN","RCT CSWL1",32, 0)
	5719	..I RCRPT =7 I RCRTC DX="" Q ; Any Return Reason Co de
	5720	"RTN","RCT CSWL1",33, 0)
	5721	..D BLDTM P
	5722	"RTN","RCT CSWL1",34, 0)
	5723	Q
	5724	"RTN","RCT CSWL1",35, 0)
	5725	;
	5726	"RTN","RCT CSWL1",36, 0)
	5727	BLDTMP ; B uild ^TMP( "RCTCSWL", $J) for th e main lis t screen
	5728	"RTN","RCT CSWL1",37, 0)
	5729	N
	5730	A1,A2,PRCA 3,DFN,RCBA L,RCBILLEX ,RCNAME,RC PTID,RCRTR SN,RCLINE, VA,VADM,VA ERR,TRTYP, RCBIND
	5731	"RTN","RCT CSWL1",38, 0)
	5732	I $D(RCDF N) D
	5733	"RTN","RCT CSWL1",39, 0)
	5734	. S DFN=R CDFN
	5735	"RTN","RCT CSWL1",40, 0)
	5736	. D DEM^V ADPT
	5737	"RTN","RCT CSWL1",41, 0)
	5738	. I VAERR K VADM
	5739	"RTN","RCT CSWL1",42, 0)
	5740	. S RCNAM E=VADM(1)
	5741	"RTN","RCT CSWL1",43, 0)
	5742	. S RCPTI D=$E(RCNAM E,1)_VA("B ID")
	5743	"RTN","RCT CSWL1",44, 0)
	5744	S
	5745	A1=$P(^RCD (340,RCDEB TOR,0),";" ,1),A2=$P( $P(^(0),U, 1),";",2), PRCA3=U_A2 _A1_",0)", RCNAME=$S( $D(
	5746	@PRCA3):$P (^(0),U,1) ,1:"")
	5747	"RTN","RCT CSWL1",45, 0)
	5748	S RCBAL=$ $GET1^DIQ( 430,RCBILL _",",11)
	5749	"RTN","RCT CSWL1",46, 0)
	5750	S RCBILLE X=$P($G(^P RCA(430,RC BILL,0)),U ,1) ;Exte rnal Bill Number
	5751	"RTN","RCT CSWL1",47, 0)
	5752	; Set his torical in dicator "y " when ret urned from Treasury
	5753	"RTN","RCT CSWL1",48, 0)
	5754	I $D(^PRC A(430,"AN" ,RCDATE,RC BILL)) S R CBIND="y"
	5755	"RTN","RCT CSWL1",49, 0)
	5756	S
	5757	RCLINE=$G( RCNAME)_U_ $G(RCPTID) _U_$G(RCBA L)_U_$G(DF N)_U_$G(RC BIND)_$G(R CBILLEX)_U _RCDE
	5758	BTOR_U_RCB ILL_U_RCDA TE_U_RCRTC DX
	5759	"RTN","RCT CSWL1",50, 0)
	5760	; Sort by Patient N ame
	5761	"RTN","RCT CSWL1",51, 0)
	5762	I SORTBY= 1 S ^TMP(" RCTCSWL",$ J,RCNAME,R CBILLEX)=R CLINE
	5763	"RTN","RCT CSWL1",52, 0)
	5764	; Sort by Bill Numb er
	5765	"RTN","RCT CSWL1",53, 0)
	5766	I SORTBY= 2 S ^TMP(" RCTCSWL",$ J,RCBILLEX ,RCNAME)=R CLINE
	5767	"RTN","RCT CSWL1",54, 0)
	5768	; Sort by Return Re ason Code
	5769	"RTN","RCT CSWL1",55, 0)
	5770	I SORTBY= 3 S ^TMP(" RCTCSWL",$ J,RCRTCDX, RCBILLEX)= RCLINE
	5771	"RTN","RCT CSWL1",56, 0)
	5772	;
	5773	"RTN","RCT CSWL1",57, 0)
	5774	BLDWL ; Fo rmat main list scree n data lin es
	5775	"RTN","RCT CSWL1",58, 0)
	5776	; build d isplay lin es
	5777	"RTN","RCT CSWL1",59, 0)
	5778	K ^TMP("R CTCSWLX",$ J)
	5779	"RTN","RCT CSWL1",60, 0)
	5780	N
	5781	RCBILL,RCB ILLEX,RCDA TE,RCDEBTO R,RCDFN,RC NAME,RCPAT NAM,RCPTID ,RCRRSN,RC XX,RCY,RCY Y,FIRST
	5782	,LINE,VCNT
	5783	"RTN","RCT CSWL1",61, 0)
	5784	S (VALMCN T,FIRST,VC NT)=0
	5785	"RTN","RCT CSWL1",62, 0)
	5786	S RCY="" F S RCY=$ O(^TMP("RC TCSWL",$J, RCY)) Q:RC Y="" D
	5787	"RTN","RCT CSWL1",63, 0)
	5788	.S RCYY=" " F S RCY Y=$O(^TMP( "RCTCSWL", $J,RCY,RCY Y)) Q:RCYY ="" D
	5789	"RTN","RCT CSWL1",64, 0)
	5790	..S VCNT= VCNT+1
	5791	"RTN","RCT CSWL1",65, 0)
	5792	..S LINE= $$LJ^XLFST R(VCNT,6) ;line #
	5793	"RTN","RCT CSWL1",66, 0)
	5794	..S RCXX= ^TMP("RCTC SWL",$J,RC Y,RCYY)
	5795	"RTN","RCT CSWL1",67, 0)
	5796	..S RCPAT NAM=$P(RCX X,U)
	5797	"RTN","RCT CSWL1",68, 0)
	5798	..S RCPTI D=$P(RCXX, U,2)
	5799	"RTN","RCT CSWL1",69, 0)
	5800	..S RCDFN =$P(RCXX,U ,4)
	5801	"RTN","RCT CSWL1",70, 0)
	5802	..S RCBIL LEX=$P(RCX X,U,5)
	5803	"RTN","RCT CSWL1",71, 0)
	5804	..S RCDEB TOR=$P(RCX X,U,6)
	5805	"RTN","RCT CSWL1",72, 0)
	5806	..S RCBIL L=$P(RCXX, U,7)
	5807	"RTN","RCT CSWL1",73, 0)
	5808	..S RCDAT E=$P(RCXX, U,8)
	5809	"RTN","RCT CSWL1",74, 0)
	5810	..S RCRRS N=$P(RCXX, U,9)
	5811	"RTN","RCT CSWL1",75, 0)
	5812	..I SORTB Y=1 D
	5813	"RTN","RCT CSWL1",76, 0)
	5814	...;Patie nt^Patient ID^Bill N o.^Balance ^Ret Rsn
	5815	"RTN","RCT CSWL1",77, 0)
	5816	...S LINE =$$SETL(LI NE,$P(RCXX ,U),"",4,2 7)
	5817	"RTN","RCT CSWL1",78, 0)
	5818	...S LINE =$$SETL(LI NE,$P(RCXX ,U,2),"",3 2,5)
	5819	"RTN","RCT CSWL1",79, 0)
	5820	...S LINE =$$SETL(LI NE,$P(RCXX ,U,5),"",4 0,12)
	5821	"RTN","RCT CSWL1",80, 0)
	5822	...S LINE =$$SETL(LI NE,$J($P(R CXX,U,3),1 0,2),"",55 ,12)
	5823	"RTN","RCT CSWL1",81, 0)
	5824	...S LINE =$$SETL(LI NE,$P(RCXX ,U,9),"",6 7,3)
	5825	"RTN","RCT CSWL1",82, 0)
	5826	..I SORTB Y=2 D
	5827	"RTN","RCT CSWL1",83, 0)
	5828	...;Bill No.^Patien t ID^Patie nt^Balance ^Ret Rsn
	5829	"RTN","RCT CSWL1",84, 0)
	5830	...S LINE =$$SETL(LI NE,$P(RCXX ,U,5),"",4 ,12)
	5831	"RTN","RCT CSWL1",85, 0)
	5832	...S LINE =$$SETL(LI NE,$P(RCXX ,U,2),"",1 7,5)
	5833	"RTN","RCT CSWL1",86, 0)
	5834	...S LINE =$$SETL(LI NE,$P(RCXX ,U),"",24, 27)
	5835	"RTN","RCT CSWL1",87, 0)
	5836	...S LINE =$$SETL(LI NE,$J($P(R CXX,U,3),1 0,2),"",55 ,12)
	5837	"RTN","RCT CSWL1",88, 0)
	5838	...S LINE =$$SETL(LI NE,$P(RCXX ,U,9),"",6 7,3)
	5839	"RTN","RCT CSWL1",89, 0)
	5840	..I SORTB Y=3 D
	5841	"RTN","RCT CSWL1",90, 0)
	5842	...;Ret R sn^Bill No .^Pt ID^Pa tient^Bala nce
	5843	"RTN","RCT CSWL1",91, 0)
	5844	...S LINE =$$SETL(LI NE,$P(RCXX ,U,9),"",4 ,7)
	5845	"RTN","RCT CSWL1",92, 0)
	5846	...S LINE =$$SETL(LI NE,$P(RCXX ,U,5),"",1 2,12)
	5847	"RTN","RCT CSWL1",93, 0)
	5848	...S LINE =$$SETL(LI NE,$P(RCXX ,U,2),"",2 5,5)
	5849	"RTN","RCT CSWL1",94, 0)
	5850	...S LINE =$$SETL(LI NE,$P(RCXX ,U),"",32, 27)
	5851	"RTN","RCT CSWL1",95, 0)
	5852	...S LINE =$$SETL(LI NE,$J($P(R CXX,U,2),1 0,2),"",64 ,12)
	5853	"RTN","RCT CSWL1",96, 0)
	5854	..S VALMC NT=VALMCNT +1
	5855	"RTN","RCT CSWL1",97, 0)
	5856	..D SET^V ALM10(VALM CNT,LINE,V CNT)
	5857	"RTN","RCT CSWL1",98, 0)
	5858	..S
	5859	^TMP("RCTC SWLX",$J,V CNT)=RCDFN _U_RCPATNA M_U_RCPTID _U_RCDEBTO R_U_RCBILL _U_RCBILLE X_
	5860	U_RCDATE_U _RCRRSN ; This is se t for ACTI ONS
	5861	"RTN","RCT CSWL1",99, 0)
	5862	Q
	5863	"RTN","RCT CSWL1",100 ,0)
	5864	;
	5865	"RTN","RCT CSWL1",101 ,0)
	5866	SETL(LINE, DATA,LABEL ,COL,LNG) ; Creates a line of data to be set into the body
	5867	"RTN","RCT CSWL1",102 ,0)
	5868	; of the worklist
	5869	"RTN","RCT CSWL1",103 ,0)
	5870	; Input: LINE - Cur rent line being crea ted
	5871	"RTN","RCT CSWL1",104 ,0)
	5872	; DATA - Informatio n to be ad ded to the end of th e current line
	5873	"RTN","RCT CSWL1",105 ,0)
	5874	; LABEL - Label to describe t he informa tion being added
	5875	"RTN","RCT CSWL1",106 ,0)
	5876	; COL - C olumn posi tion in li ne to add informatio n add
	5877	"RTN","RCT CSWL1",107 ,0)
	5878	; LNG - M aximum len gth of dat a informat ion to inc lude on th e line
	5879	"RTN","RCT CSWL1",108 ,0)
	5880	; Returns : Line upd ated with added info rmation
	5881	"RTN","RCT CSWL1",109 ,0)
	5882	S LINE=LI NE_$J("",( COL-$L(LAB EL)-$L(LIN E)))_LABEL _$E(DATA,1 ,LNG)
	5883	"RTN","RCT CSWL1",110 ,0)
	5884	Q LINE
	5885	"RTN","RCT CSWL1",111 ,0)
	5886	;
	5887	"RTN","RCT CSWL1",112 ,0)
	5888	EXCEL ;For mat and Pr int EXCEL file
	5889	"RTN","RCT CSWL1",113 ,0)
	5890	W @IOF
	5891	"RTN","RCT CSWL1",114 ,0)
	5892	N RCX,RCX X,RCY,RCYY ,RCZ,RCAMT
	5893	"RTN","RCT CSWL1",115 ,0)
	5894	S RCX=$P( FILTERS(0) ,U,1)
	5895	"RTN","RCT CSWL1",116 ,0)
	5896	S RCXX=$S (RCX=1:"Ba nkruptcy", RCX=2:"Dea ths",RCX=3 :"Uncollec tible",RCX =4:"Paymen t in Full" ,1:"")
	5897	"RTN","RCT CSWL1",117 ,0)
	5898	I $G(RCXX )="" S RCX X=$S(RCX=5 :"Satisfie d PA",RCX= 6:"Comprom ise",RCX=7 :"All Retu rns",1:"")
	5899	"RTN","RCT CSWL1",118 ,0)
	5900	W !,RCXX_ " Report"
	5901	"RTN","RCT CSWL1",119 ,0)
	5902	I SORTBY= 1 W !,"Pat ient Name^ Patient ID ^Bill Numb er^Current Amount^Rt Rsn Code"
	5903	"RTN","RCT CSWL1",120 ,0)
	5904	I SORTBY= 2 W !,"Bil l Number^P atient ID^ Patient Na me^Current Amount^Rt Rsn Code"
	5905	"RTN","RCT CSWL1",121 ,0)
	5906	I SORTBY= 3 W !,"Rt Rsn Code^B ill Number ^Patient I D^Patient Name^Curre nt Amount"
	5907	"RTN","RCT CSWL1",122 ,0)
	5908	S RCY="" F S RCY=$ O(^TMP("RC TCSWL",$J, RCY)) Q:RC Y="" D
	5909	"RTN","RCT CSWL1",123 ,0)
	5910	.S RCYY=" " F S RCY Y=$O(^TMP( "RCTCSWL", $J,RCY,RCY Y)) Q:RCYY ="" D
	5911	"RTN","RCT CSWL1",124 ,0)
	5912	..S RCZ=^ TMP("RCTCS WL",$J,RCY ,RCYY)
	5913	"RTN","RCT CSWL1",125 ,0)
	5914	..;Reform at Excel l ine, based upon sort
	5915	"RTN","RCT CSWL1",126 ,0)
	5916	..;Input from RCZ: PtName_U_P tID_U_CurB al_U_DFN_U _Bill
	5917	No_U_Debto r_U_Intern alBill_U_D ate_U_Retu rnReasonCo de
	5918	"RTN","RCT CSWL1",127 ,0)
	5919	..S RCAMT =$P(RCZ,U, 3)
	5920	"RTN","RCT CSWL1",128 ,0)
	5921	..I RCAMT ="" S RCAM T=0
	5922	"RTN","RCT CSWL1",129 ,0)
	5923	..S RCAMT =$J(RCAMT, 10,2)
	5924	"RTN","RCT CSWL1",130 ,0)
	5925	..I SORTB Y=1 W !,$P (RCZ,U)_"^ ",$P(RCZ,U ,2)_"^"_$P (RCZ,U,5)_ "^"_RCAMT_ "^"_$P(RCZ ,U,9)
	5926	"RTN","RCT CSWL1",131 ,0)
	5927	..I SORTB Y=2 W !,$P (RCZ,U,5)_ "^",$P(RCZ ,U,2)_"^"_ $P(RCZ,U)_ "^"_RCAMT_ "^"_$P(RCZ ,U,9)
	5928	"RTN","RCT CSWL1",132 ,0)
	5929	..I SORTB Y=3 W !,$P (RCZ,U,9)_ "^",$P(RCZ ,U,5)_"^"_ $P(RCZ,U,2 )_"^"_$P(R CZ,U)_"^"_ RCAMT
	5930	"RTN","RCT CSWL1",133 ,0)
	5931	I $E(IOST ,1,2)="C-" ,'EXCEL R !!,"END OF REPORT... PRESS RETU RN TO CONT INUE",X:DT IME W @IOF
	5932	"RTN","RCT CSWL1",134 ,0)
	5933	D ^%ZISC
	5934	"RTN","RCT CSWL1",135 ,0)
	5935	S:$D(ZTQU EUED) ZTRE Q="@"
	5936	"RTN","RCT CSWL1",136 ,0)
	5937	K IOP,%ZI S,ZTQUEUED
	5938	"RTN","RCT CSWL1",137 ,0)
	5939	Q
	5940	"RTN","RCT CSWL1",138 ,0)
	5941	;
	5942	"RTN","RCT CSWL1",139 ,0)
	5943	;RCDIV() N DIC,DIR, DIRUT,DTOU T,DUOUT,X, Y
	5944	"RTN","RCT CSWL1",140 ,0)
	5945	;
	5946	"RTN","RCT CSWL1",141 ,0)
	5947	;Reset RC DIV array
	5948	"RTN","RCT CSWL1",142 ,0)
	5949	K RCDIV
	5950	"RTN","RCT CSWL1",143 ,0)
	5951	;
	5952	"RTN","RCT CSWL1",144 ,0)
	5953	;First se e if they want to en ter indivi dual divis ions or AL L
	5954	"RTN","RCT CSWL1",145 ,0)
	5955	S DIR(0)= "S^D:DIVIS ION;A:ALL"
	5956	"RTN","RCT CSWL1",146 ,0)
	5957	S DIR("A" )="Select Certain (D )ivisions or (A)LL"
	5958	"RTN","RCT CSWL1",147 ,0)
	5959	S DIR("L" ,1)="Selec t one of t he followi ng:"
	5960	"RTN","RCT CSWL1",148 ,0)
	5961	S DIR("L" ,2)=""
	5962	"RTN","RCT CSWL1",149 ,0)
	5963	S DIR("L" ,3)=" D DIVISION"
	5964	"RTN","RCT CSWL1",150 ,0)
	5965	S DIR("L" ,4)=" A ALL"
	5966	"RTN","RCT CSWL1",151 ,0)
	5967	D ^DIR K DIR
	5968	"RTN","RCT CSWL1",152 ,0)
	5969	;
	5970	"RTN","RCT CSWL1",153 ,0)
	5971	;Check fo r "^" or t imeout, ot herwise de fine BPPHA RM
	5972	"RTN","RCT CSWL1",154 ,0)
	5973	I ($G(DUO UT)=1)!($G (DTOUT)=1) S Y="^"
	5974	"RTN","RCT CSWL1",155 ,0)
	5975	E S RCDI V=$S(Y="A" :0,1:1)
	5976	"RTN","RCT CSWL1",156 ,0)
	5977	;
	5978	"RTN","RCT CSWL1",157 ,0)
	5979	;If divis ion select ed, ask pr ompt
	5980	"RTN","RCT CSWL1",158 ,0)
	5981	I $G(RCDI V)=1 F D Q:Y="^"!( Y="")
	5982	"RTN","RCT CSWL1",159 ,0)
	5983	.;
	5984	"RTN","RCT CSWL1",160 ,0)
	5985	.;Prompt for entry
	5986	"RTN","RCT CSWL1",161 ,0)
	5987	.K X S DI C(0)="QEAM ",DIC=40.8 ,DIC("A")= "Select Di vision(s): "
	5988	"RTN","RCT CSWL1",162 ,0)
	5989	.W ! D ^D IC
	5990	"RTN","RCT CSWL1",163 ,0)
	5991	.;
	5992	"RTN","RCT CSWL1",164 ,0)
	5993	.;Check f or "^" or timeout
	5994	"RTN","RCT CSWL1",165 ,0)
	5995	.I ($G(DU OUT)=1)!($ G(DTOUT)=1 ) K RCDIV S Y="^" Q
	5996	"RTN","RCT CSWL1",166 ,0)
	5997	.;
	5998	"RTN","RCT CSWL1",167 ,0)
	5999	.;Check f or blank e ntry, quit if no pre vious sele ctions
	6000	"RTN","RCT CSWL1",168 ,0)
	6001	.I $G(X)= "" S Y=$S( $D(RCDIV)> 9:"",1:"^" ) K:Y="^" RCDIV Q
	6002	"RTN","RCT CSWL1",169 ,0)
	6003	.;
	6004	"RTN","RCT CSWL1",170 ,0)
	6005	.;Handle Deletes
	6006	"RTN","RCT CSWL1",171 ,0)
	6007	.I $D(RCD IV(+Y)) D Q:Y="^" I 1
	6008	"RTN","RCT CSWL1",172 ,0)
	6009	..N P
	6010	"RTN","RCT CSWL1",173 ,0)
	6011	..S P=Y ;Save Orig inal Value
	6012	"RTN","RCT CSWL1",174 ,0)
	6013	..S DIR(0 )="S^Y:YES ;N:NO",DIR ("A")="Del ete "_$P(P ,U,2)_" fr om your li st?"
	6014	"RTN","RCT CSWL1",175 ,0)
	6015	..S DIR(" B")="NO" D ^DIR
	6016	"RTN","RCT CSWL1",176 ,0)
	6017	..I ($G(D UOUT)=1)!( $G(DTOUT)= 1) K RCDIV S Y="^" Q
	6018	"RTN","RCT CSWL1",177 ,0)
	6019	..I Y="Y" K RCDIV(+ P),RCDIV(" B",$P(P,U, 2),+P)
	6020	"RTN","RCT CSWL1",178 ,0)
	6021	..S Y=P ;Restore O riginal Va lue
	6022	"RTN","RCT CSWL1",179 ,0)
	6023	..K P
	6024	"RTN","RCT CSWL1",180 ,0)
	6025	.E D
	6026	"RTN","RCT CSWL1",181 ,0)
	6027	..;Define new entri es in RCDI V array
	6028	"RTN","RCT CSWL1",182 ,0)
	6029	..S VAUTD (+Y)=Y
	6030	"RTN","RCT CSWL1",183 ,0)
	6031	..S RCDIV ("B",$P(Y, U,2),+Y)=" "
	6032	"RTN","RCT CSWL1",184 ,0)
	6033	.;
	6034	"RTN","RCT CSWL1",185 ,0)
	6035	.;Display a list of selected divisions
	6036	"RTN","RCT CSWL1",186 ,0)
	6037	.I $D(RCD IV)>9 D
	6038	"RTN","RCT CSWL1",187 ,0)
	6039	..N X
	6040	"RTN","RCT CSWL1",188 ,0)
	6041	..W !,?2, "Selected: "
	6042	"RTN","RCT CSWL1",189 ,0)
	6043	..S X="" F S X=$O( RCDIV("B", X)) Q:X="" W !,?10, X
	6044	"RTN","RCT CSWL1",190 ,0)
	6045	..K X
	6046	"RTN","RCT CSWL1",191 ,0)
	6047	.Q
	6048	"RTN","RCT CSWL1",192 ,0)
	6049	;
	6050	"RTN","RCT CSWL1",193 ,0)
	6051	K RCDIV(" B")
	6052	"RTN","RCT CSWL1",194 ,0)
	6053	Q Y
	6054	"RTN","RCT CSWL1",195 ,0)
	6055	;
	6056	"RTN","RCT CSWL1",196 ,0)
	6057	CSTOP(BILL ) ;
	6058	"RTN","RCT CSWL1",197 ,0)
	6059	; Input:
	6060	"RTN","RCT CSWL1",198 ,0)
	6061	; BILL - Bill numbe r from #43 0 - Extern al Value ( .01), not IEN
	6062	"RTN","RCT CSWL1",199 ,0)
	6063	; Output:
	6064	"RTN","RCT CSWL1",200 ,0)
	6065	; CSTOP - Cross-ser viced stat us (blank = not foun d, 0 = not stopped, 1 = stoppe d)
	6066	"RTN","RCT CSWL1",201 ,0)
	6067	;
	6068	"RTN","RCT CSWL1",202 ,0)
	6069	N CSTOP,I EN
	6070	"RTN","RCT CSWL1",203 ,0)
	6071	I BILL="" Q "" ;no bill #
	6072	"RTN","RCT CSWL1",204 ,0)
	6073	I '$D(^PR CA(430,"TC SP",BILL)) Q ""
	6074	"RTN","RCT CSWL1",205 ,0)
	6075	S CSTOP=$ $GET1^DIQ( 430,BILL," 157,","IE" )
	6076	"RTN","RCT CSWL1",206 ,0)
	6077	Q CSTOP
	6078	"VER")
	6079	8.0^22.2
	6080	"BLD",1036 1,6)
	6081	1^
	6082	$END KID P RCA4.533 9