RCTCSP1A ;ALBANY/PAW-CROSS-SERVICING REPORT ;03/15/14 3:34 PM
;;4.5;Accounts Receivable;**315,341,433**;Mar 20, 1995;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
CSRPRTH1 ;header for cross-servicing print report 1
W @IOF
S PAGE=PAGE+1,EXCEL=$G(EXCEL)
I 'EXCEL D Q
.W !,"PAGE "_PAGE,?16,"BILLS AT CROSS-SERVICING (SORTED BY BILL NO.)",?68,$$FMTE^XLFDT(DT,"2Z")
.W !,DASH
.; Added AR CAT to column header
.W !,"BILL NO.",?14,"AR CAT",?25,"DEBTOR",?46,"Pt ID",?54,"ORIG AMT",?66,"CS REF DATE",?79,"CURR AMT" ; limited SSN to 4 char - (as per PRCA*4.5*315)
.W !,"---- ---",?14,"------",?25,"------",?46,"-----",?54,"--------",?66,"-----------",?79,"--------"
;EXCEL FORMAT
W !,"PAGE "_PAGE_U_U_"BILLS AT CROSS-SERVICING (SORTED BY BILL NO.)"_U_U_$$FMTE^XLFDT(DT,"2Z")
W !,"BILL NO."_U_"AR CAT"_U_"DEBTOR"_U_"Pt ID"_U_"ORIG AMT"_U_"CS REF DATE"_U_" CURR AMT" ; limited SSN to 4 char - (as per PRCA*4.5*315)
Q
;
CSRPRTH2 ;header for cross-servicing print report 2
W @IOF
S PAGE=PAGE+1,EXCEL=$G(EXCEL)
I 'EXCEL D Q
.W !,"PAGE "_PAGE,?16,"BILLS AT CROSS-SERVICING (SORTED BY DEBTOR)",?68,$$FMTE^XLFDT(DT,"2Z")
.W !,DASH
.W !,"DEBTOR",?21,"AR CAT",?33,"BILL NO.",?46,"Pt ID",?54,"ORIG AMT",?66,"CS REF DATE",?79," CURR AMT" ;PRCA*4.5*433
.W !,"------",?21,"------",?33,"--------",?46,"-----",?54,"--------",?66,"-----------",?79," --------" ;PRCA*4.5*433
;EXCEL FORMAT
W !,"PAGE "_PAGE_U_U_"BILLS AT CROSS-SERVICING (SORTED BY DEBTOR)"_U_U_$$FMTE^XLFDT(DT,"2Z")
W !,"DEBTOR"_U_"AR CAT"_U_"BILL NO."_U_"Pt ID"_U_"ORIG AMT"_U_"CS REF DATE"_U_" CURR AMT" ;PRCA*4.5*433
Q
;
CSRPRTH3 ;header for cross-servicing print report 3
W @IOF
S PAGE=PAGE+1,EXCEL=$G(EXCEL)
I 'EXCEL D Q
.W !,"PAGE "_PAGE,?11,"BILLS AT CROSS-SERVICING (SORTED BY CS REFERRED DATE)",?68,$$FMTE^XLFDT(DT,"2Z")
.W !,DASH
.W !,"CS REF DT",?13,"AR CAT",?25,"DEBTOR",?47,"BILL NO.",?60,"Pt ID",?68,"ORIG AMT",?79," CURR AMT" ;PRCA*4.5*433
.W !,"-----------",?13,"------",?25,"------",?47,"---- ---",?60,"-----",?68,"--------",?79," --------" ;PRCA*4.5*433
;EXCEL FORMAT
W !,"PAGE "_PAGE_U_U_"BILLS AT CROSS-SERVICING (SORTED BY CS REFERRED DATE)"_U_U_$$FMTE^XLFDT(DT,"2Z")
W !,"CS REF DATE"_U_"AR CAT"_U_"DEBTOR"_U_"BILL NO."_U_"Pt ID"_U_"ORIG AMT"_U_" CURR AMT" ; limited SSN to 4 char - (as per PRCA*4.5*315)
Q
;
COUNTRY(Z) ;
N PRCACC
;get treasury country code - moved out of RCTCSP1, due to SACC size limitation error PRCA*4.5*315
I Z<3 S PRCACC="US" G COUNTRYQ
S PRCACC=$S(Z=4:"AF",Z=5:"AL",Z=7:"DZ",Z=8:"AD",Z=9:"AO",Z=180:"AI",Z=10:"AG",Z=12:"AR",Z=18:"AM",Z=151:"AW",Z=13:"AU",Z=14:"AT",Z=11:"AZ",Z=15:"BS",Z=16:"BH",Z=17:"BD",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=19:"BB",Z=36:"BY",Z=20:"BE",Z=28:"BZ",Z=61:"BJ",Z=21:"BM",Z=22:"BT",Z=23:"BO",Z=24:"BA",Z=25:"BW",Z=27:"BR",Z=29:"IO",Z=32:"BN",Z=33:"BG",Z=223:"Faso",Z=35:"BI",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=37:"KH",Z=38:"CM",Z=39:"CA",Z=40:"CV",Z=41:"KY",Z=42:"CF",Z=44:"TD",Z=45:"CL",Z=46:"CN",Z=50:"CO",Z=51:"KM",Z=53:"CG",Z=54:"CD",Z=55:"CK",Z=56:"CR",Z=109:"CI",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=57:"HR",Z=58:"CU",Z=59:"CY",Z=60:"CZ",Z=115:"KP",Z=62:"DK",Z=80:"DJ",Z=63:"DM",Z=64:"DO",Z=172:"TP",Z=65:"EC",Z=220:"EG",Z=66:"SV",Z=67:"GQ",Z=69:"ER",Z=70:"EE",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=68:"ET",Z=72:"FK",Z=71:"FO",Z=74:"FJ",Z=75:"FI",Z=76:"FR",Z=77:"GF",Z=78:"PF",Z=79:"TF",Z=81:"GA",Z=83:"GM",Z=82:"GE",Z=84:"DE",Z=85:"GH",Z=86:"GI",Z=221:"GB",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=88:"GR",Z=89:"GL",Z=90:"GD",Z=91:"GP",Z=92:"GT",Z=93:"GN",Z=171:"GW",Z=94:"GY",Z=95:"HT",Z=98:"HN",Z=99:"HK",Z=100:"HU",Z=101:"IS",Z=102:"IN",Z=103:"ID",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=105:"IQ",Z=106:"IE",Z=107:"IL",Z=108:"IT",Z=110:"JM",Z=111:"JP",Z=113:"JO",Z=112:"KZ",Z=114:"KE",Z=87:"KI",Z=116:"KR",Z=117:"KW",Z=118:"KG",Z=119:"LA",Z=122:"LV",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=120:"LB",Z=121:"LS",Z=123:"LR",Z=124:"LY",Z=125:"LI",Z=126:"LT",Z=127:"LU",Z=128:"MO",Z=129:"MG",Z=130:"MW",Z=131:"MY",Z=132:"MV",Z=133:"ML",Z=134:"MT",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=999:"MH",Z=135:"MQ",Z=136:"MR",Z=137:"MU",Z=52:"YT",Z=138:"MX",Z=161:"FM",Z=141:"MD",Z=139:"MC",Z=140:"MN",Z=142:"MS",Z=143:"MA",Z=144:"MZ",Z=34:"MM",Z=146:"NA",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=147:"NR",Z=148:"NP",Z=149:"NL",Z=150:"AN",Z=152:"NC",Z=154:"NZ",Z=155:"NI",Z=156:"NE",Z=157:"NG",Z=158:"NU",Z=159:"NF",Z=160:"NO",Z=145:"OM",Z=162:"PK",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=999:"PW",Z=163:"PA",Z=164:"PG",Z=165:"PY",Z=166:"PE",Z=167:"PH",Z=168:"PN",Z=169:"PL",Z=170:"PT",Z=173:"QA",Z=999:"RE",Z=175:"RO",Z=176:"RU",Z=177:"RW",Z=178:"SH",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=179:"KN",Z=181:"LC",Z=183:"VC",Z=999:"WS",Z=184:"SM",Z=185:"ST",Z=186:"SA",Z=187:"SN",Z=188:"SC",Z=189:"SL",Z=190:"SG",Z=191:"SK",Z=193:"SI",Z=30:"SB",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=194:"SO",Z=195:"ZA",Z=197:"ES",Z=43:"LK",Z=199:"SD",Z=200:"SR",Z=201:"SZ",Z=202:"SE",Z=203:"CH",Z=204:"SY",Z=205:"TJ",Z=222:"TZ",Z=182:"PM",Z=206:"TH",Z=219:"MK",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=207:"TG",Z=208:"TK",Z=209:"TO",Z=210:"TT",Z=212:"TN",Z=213:"TR",Z=214:"TM",Z=215:"TC",Z=216:"TV",Z=217:"UG",Z=218:"UA",Z=211:"AE",Z=1:"US",Z=224:"UY",1:" ") G:PRCACC'=" " COUNTRYQ
S PRCACC=$S(Z=104:"IR",Z=225:"UZ",Z=153:"VU",Z=97:"VA",Z=226:"VE",Z=183:"VN",Z=31:"VG",Z=227:"WF",Z=228:"YE",Z=229:"YU",Z=230:"ZM",Z=196:"ZW",1:" ") G:PRCACC'=" " COUNTRYQ
COUNTRYQ ;
Q PRCACC
;
;increment batch sequence number, build new header
N RCMSG
S SEQ=SEQ+1
S CNTLID=$$JD()_$$RJZF^RCTCSP1(SEQ,4)
K ^XTMP("RCTCSPD",$J,ACTION,"BUILD",SEQ)
;header is record type H
S RCMSG="H"_CNTLID_$$BLANK^RCTCSP1(14)_"3636001200"
S RCMSG=RCMSG_$$BLANK^RCTCSP1(450-$L(RCMSG))
S REC=REC+1
S ^XTMP("RCTCSPD",$J,SEQ,"BUILD",REC)=$E(RCMSG,1,225)_$C(94)
S REC=REC+1
S ^XTMP("RCTCSPD",$J,SEQ,"BUILD",REC)=$E(RCMSG,226,999)_$C(126)
Q
;
TRAILER ;
;trailer is type Z record
N X
I REC=0 K ^XTMP("RCTCSPD",$J,SEQ,"BUILD") Q ;delete batch if no records processed
N RCMSG
S CNTLID=$$JD()_$$RJZF^RCTCSP1(SEQ,4)
S RCMSG="Z"_$$RJZF^RCTCSP1(RECC,8)
S X=$TR($J(AMOUNT/100,0,2),".")
S X=$E("00000000000",1,14-$L(X))_X ;341/DRF Remove AMOUNT function
S RCMSG=RCMSG_X
S RCMSG=RCMSG_CNTLID_$$BLANK^RCTCSP1(14)_"3636001200"
S RCMSG=RCMSG_$$BLANK^RCTCSP1(450-$L(RCMSG))
S REC=REC+1
S ^XTMP("RCTCSPD",$J,SEQ,"BUILD",REC)=$E(RCMSG,1,225)_$C(94)
S REC=REC+1
S ^XTMP("RCTCSPD",$J,SEQ,"BUILD",REC)=$E(RCMSG,226,999)_$C(126)
S REC=0,RECC=0,AMOUNT=0
Q
;
JD() ; returns today's Julian date YDOY
N XMDDD,XMNOW,XMDT
S XMNOW=$$NOW^XLFDT
S XMDT=$E(XMNOW,1,7)
S XMDDD=$$RJ^XLFSTR($$FMDIFF^XLFDT(XMDT,$E(XMDT,1,3)_"0101",1)+1,3,"0")
Q $E(DT,3)_XMDDD
;
REC5B ;Create record 5B for Treasury ;PRCA*4.5*433 Tag REC5B Moved from routine RCTCSP1 for SACC size compliance
; trnnum transaction number file #433 pass in
; trntyp transaction type pointer to 430.3
; trntypa aia transaction type (aio: dmc agency internal offset, abal: decrease adjustment)
N REC,KNUM,DEBTNR,DEBTORNB,TAMOUNT,TAMTPBAL,TAMTIBAL,TAMTABAL,TAMTFBAL,TAMTCBAL,AMTRFRRD,TRNTYP,TRNTYPA,TRANSNB
N AMTPBAL,AMTIBAL,AMTABAL,AMTFBAL,AMTCBAL,TRN3,TRNNUME,CSPCD
S TRNTYPA="AIO"
S REC="C5B"_ACTION_"3636001200"_"DM1D "_"L"
S KNUM=$P($P(B0,U,1),"-",2)
S DEBTNR=$$AGDEBTID^RCTCSPD,REC=REC_DEBTNR ; PRCA*4.5*350
S DEBTORNB=$E(SITE,1,3)_$TR($J(DEBTOR,12)," ",0)
S REC=REC_DEBTORNB
S TRNTYP=$P($G(^PRCA(433,TRNNUM,1)),U,2) I ",35,73,74,"[TRNTYP S TRNTYPA="ABAL"
S REC=REC_$$LJSF^RCTCSP1(TRNTYPA,9)
S TRNNUME=$$RJZF^RCTCSP1(TRNNUM,10)
S TRNNUME=$E(TRNNUME,5,10) ;max is 999999
I TRNNUME="000000" S TRNNUME="000001" ;min is 1
S REC=REC_$$RJZF^RCTCSP1(TRNNUME,10)
S REC=REC_$$DATE8^RCTCSP1(DT)
S TRANSNB=$E(SITE,1,3)_$TR($J(TRNNUM,12)," ",0)
S REC=REC_TRANSNB
S REC=REC_$$BLANK^RCTCSP1(9)
S TRN3=$G(^PRCA(433,TRNNUM,3))
S TAMTPBAL=$P(TRN3,U,1) ;transaction principle balance
S TAMTIBAL=$P(TRN3,U,2) ;transaction interest balance
S TAMTABAL=$P(TRN3,U,3) ;transaction administrative balance
S TAMTFBAL=$P(TRN3,U,4) ;transaction marshal fee
S TAMTCBAL=$P(TRN3,U,5) ;transaction court cost
I (TAMTPBAL+TAMTIBAL+TAMTABAL+TAMTFBAL+TAMTCBAL)=0 S TAMTPBAL=TRNAMT
S TAMOUNT=$$AMOUNT^RCTCSP1(TAMTPBAL,TRNTYP)
S TAMOUNT=TAMOUNT_$$AMOUNT^RCTCSP1(TAMTIBAL,TRNTYP)
S TAMOUNT=TAMOUNT_$$AMOUNT^RCTCSP1(TAMTABAL,TRNTYP)
S TAMOUNT=TAMOUNT_$$AMOUNT^RCTCSP1(TAMTFBAL+TAMTCBAL,TRNTYP)
S REC=REC_TAMOUNT
S REC=REC_$$AMOUNT^RCTCSP1(TRNAMT,TRNTYP)
S REC=REC_$$BLANK^RCTCSP1(450-$L(REC))
S AMTPBAL=$P(B7,U,1) ;principle balance
S AMTIBAL=$P(B7,U,2) ;interest balance
S AMTABAL=$P(B7,U,3) ;administrative balance
S AMTFBAL=$P(B7,U,4) ;marshal fee
S AMTCBAL=$P(B7,U,5) ;court cost
S AMTRFRRD=AMTPBAL+AMTIBAL+AMTABAL+AMTFBAL+AMTCBAL
I ACTION="U" S $P(^PRCA(430,BILL,16),U,10)=AMTRFRRD
S ^XTMP("RCTCSPD",$J,BILL,ACTION,"5B",TRNNUM)=REC
S ^XTMP("RCTCSPD",$J,"BILL",ACTION,BILL)=$$TAXID^RCTCSP1(DEBTOR)_"^"_$S(TRNTYP=73!(TRNTYP=74):"",1:"-")_+$E(REC,174,184)_"."_$E(REC,185,186)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSP1A 9284 printed Oct 16, 2024@17:49:36 Page 2
RCTCSP1A ;ALBANY/PAW-CROSS-SERVICING REPORT ;03/15/14 3:34 PM
+1 ;;4.5;Accounts Receivable;**315,341,433**;Mar 20, 1995;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
CSRPRTH1 ;header for cross-servicing print report 1
+1 WRITE @IOF
+2 SET PAGE=PAGE+1
SET EXCEL=$GET(EXCEL)
+3 IF 'EXCEL
Begin DoDot:1
+4 WRITE !,"PAGE "_PAGE,?16,"BILLS AT CROSS-SERVICING (SORTED BY BILL NO.)",?68,$$FMTE^XLFDT(DT,"2Z")
+5 WRITE !,DASH
+6 ; Added AR CAT to column header
+7 ; limited SSN to 4 char - (as per PRCA*4.5*315)
WRITE !,"BILL NO.",?14,"AR CAT",?25,"DEBTOR",?46,"Pt ID",?54,"ORIG AMT",?66,"CS REF DATE",?79,"CURR AMT"
+8 WRITE !,"---- ---",?14,"------",?25,"------",?46,"-----",?54,"--------",?66,"-----------",?79,"--------"
End DoDot:1
QUIT
+9 ;EXCEL FORMAT
+10 WRITE !,"PAGE "_PAGE_U_U_"BILLS AT CROSS-SERVICING (SORTED BY BILL NO.)"_U_U_$$FMTE^XLFDT(DT,"2Z")
+11 ; limited SSN to 4 char - (as per PRCA*4.5*315)
WRITE !,"BILL NO."_U_"AR CAT"_U_"DEBTOR"_U_"Pt ID"_U_"ORIG AMT"_U_"CS REF DATE"_U_" CURR AMT"
+12 QUIT
+13 ;
CSRPRTH2 ;header for cross-servicing print report 2
+1 WRITE @IOF
+2 SET PAGE=PAGE+1
SET EXCEL=$GET(EXCEL)
+3 IF 'EXCEL
Begin DoDot:1
+4 WRITE !,"PAGE "_PAGE,?16,"BILLS AT CROSS-SERVICING (SORTED BY DEBTOR)",?68,$$FMTE^XLFDT(DT,"2Z")
+5 WRITE !,DASH
+6 ;PRCA*4.5*433
WRITE !,"DEBTOR",?21,"AR CAT",?33,"BILL NO.",?46,"Pt ID",?54,"ORIG AMT",?66,"CS REF DATE",?79," CURR AMT"
+7 ;PRCA*4.5*433
WRITE !,"------",?21,"------",?33,"--------",?46,"-----",?54,"--------",?66,"-----------",?79," --------"
End DoDot:1
QUIT
+8 ;EXCEL FORMAT
+9 WRITE !,"PAGE "_PAGE_U_U_"BILLS AT CROSS-SERVICING (SORTED BY DEBTOR)"_U_U_$$FMTE^XLFDT(DT,"2Z")
+10 ;PRCA*4.5*433
WRITE !,"DEBTOR"_U_"AR CAT"_U_"BILL NO."_U_"Pt ID"_U_"ORIG AMT"_U_"CS REF DATE"_U_" CURR AMT"
+11 QUIT
+12 ;
CSRPRTH3 ;header for cross-servicing print report 3
+1 WRITE @IOF
+2 SET PAGE=PAGE+1
SET EXCEL=$GET(EXCEL)
+3 IF 'EXCEL
Begin DoDot:1
+4 WRITE !,"PAGE "_PAGE,?11,"BILLS AT CROSS-SERVICING (SORTED BY CS REFERRED DATE)",?68,$$FMTE^XLFDT(DT,"2Z")
+5 WRITE !,DASH
+6 ;PRCA*4.5*433
WRITE !,"CS REF DT",?13,"AR CAT",?25,"DEBTOR",?47,"BILL NO.",?60,"Pt ID",?68,"ORIG AMT",?79," CURR AMT"
+7 ;PRCA*4.5*433
WRITE !,"-----------",?13,"------",?25,"------",?47,"---- ---",?60,"-----",?68,"--------",?79," --------"
End DoDot:1
QUIT
+8 ;EXCEL FORMAT
+9 WRITE !,"PAGE "_PAGE_U_U_"BILLS AT CROSS-SERVICING (SORTED BY CS REFERRED DATE)"_U_U_$$FMTE^XLFDT(DT,"2Z")
+10 ; limited SSN to 4 char - (as per PRCA*4.5*315)
WRITE !,"CS REF DATE"_U_"AR CAT"_U_"DEBTOR"_U_"BILL NO."_U_"Pt ID"_U_"ORIG AMT"_U_" CURR AMT"
+11 QUIT
+12 ;
COUNTRY(Z) ;
+1 NEW PRCACC
+2 ;get treasury country code - moved out of RCTCSP1, due to SACC size limitation error PRCA*4.5*315
+3 IF Z<3
SET PRCACC="US"
GOTO COUNTRYQ
+4 SET PRCACC=$SELECT(Z=4:"AF",Z=5:"AL",Z=7:"DZ",Z=8:"AD",Z=9:"AO",Z=180:"AI",Z=10:"AG",Z=12:"AR",Z=18:"AM",Z=151:"AW",Z=13:"AU",Z=14:"AT",Z=11:"AZ",Z=15:"BS",Z=16:"BH",Z=17:"BD",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+5 SET PRCACC=$SELECT(Z=19:"BB",Z=36:"BY",Z=20:"BE",Z=28:"BZ",Z=61:"BJ",Z=21:"BM",Z=22:"BT",Z=23:"BO",Z=24:"BA",Z=25:"BW",Z=27:"BR",Z=29:"IO",Z=32:"BN",Z=33:"BG",Z=223:"Faso",Z=35:"BI",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+6 SET PRCACC=$SELECT(Z=37:"KH",Z=38:"CM",Z=39:"CA",Z=40:"CV",Z=41:"KY",Z=42:"CF",Z=44:"TD",Z=45:"CL",Z=46:"CN",Z=50:"CO",Z=51:"KM",Z=53:"CG",Z=54:"CD",Z=55:"CK",Z=56:"CR",Z=109:"CI",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+7 SET PRCACC=$SELECT(Z=57:"HR",Z=58:"CU",Z=59:"CY",Z=60:"CZ",Z=115:"KP",Z=62:"DK",Z=80:"DJ",Z=63:"DM",Z=64:"DO",Z=172:"TP",Z=65:"EC",Z=220:"EG",Z=66:"SV",Z=67:"GQ",Z=69:"ER",Z=70:"EE",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+8 SET PRCACC=$SELECT(Z=68:"ET",Z=72:"FK",Z=71:"FO",Z=74:"FJ",Z=75:"FI",Z=76:"FR",Z=77:"GF",Z=78:"PF",Z=79:"TF",Z=81:"GA",Z=83:"GM",Z=82:"GE",Z=84:"DE",Z=85:"GH",Z=86:"GI",Z=221:"GB",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+9 SET PRCACC=$SELECT(Z=88:"GR",Z=89:"GL",Z=90:"GD",Z=91:"GP",Z=92:"GT",Z=93:"GN",Z=171:"GW",Z=94:"GY",Z=95:"HT",Z=98:"HN",Z=99:"HK",Z=100:"HU",Z=101:"IS",Z=102:"IN",Z=103:"ID",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+10 SET PRCACC=$SELECT(Z=105:"IQ",Z=106:"IE",Z=107:"IL",Z=108:"IT",Z=110:"JM",Z=111:"JP",Z=113:"JO",Z=112:"KZ",Z=114:"KE",Z=87:"KI",Z=116:"KR",Z=117:"KW",Z=118:"KG",Z=119:"LA",Z=122:"LV",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+11 SET PRCACC=$SELECT(Z=120:"LB",Z=121:"LS",Z=123:"LR",Z=124:"LY",Z=125:"LI",Z=126:"LT",Z=127:"LU",Z=128:"MO",Z=129:"MG",Z=130:"MW",Z=131:"MY",Z=132:"MV",Z=133:"ML",Z=134:"MT",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+12 SET PRCACC=$SELECT(Z=999:"MH",Z=135:"MQ",Z=136:"MR",Z=137:"MU",Z=52:"YT",Z=138:"MX",Z=161:"FM",Z=141:"MD",Z=139:"MC",Z=140:"MN",Z=142:"MS",Z=143:"MA",Z=144:"MZ",Z=34:"MM",Z=146:"NA",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+13 SET PRCACC=$SELECT(Z=147:"NR",Z=148:"NP",Z=149:"NL",Z=150:"AN",Z=152:"NC",Z=154:"NZ",Z=155:"NI",Z=156:"NE",Z=157:"NG",Z=158:"NU",Z=159:"NF",Z=160:"NO",Z=145:"OM",Z=162:"PK",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+14 SET PRCACC=$SELECT(Z=999:"PW",Z=163:"PA",Z=164:"PG",Z=165:"PY",Z=166:"PE",Z=167:"PH",Z=168:"PN",Z=169:"PL",Z=170:"PT",Z=173:"QA",Z=999:"RE",Z=175:"RO",Z=176:"RU",Z=177:"RW",Z=178:"SH",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+15 SET PRCACC=$SELECT(Z=179:"KN",Z=181:"LC",Z=183:"VC",Z=999:"WS",Z=184:"SM",Z=185:"ST",Z=186:"SA",Z=187:"SN",Z=188:"SC",Z=189:"SL",Z=190:"SG",Z=191:"SK",Z=193:"SI",Z=30:"SB",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+16 SET PRCACC=$SELECT(Z=194:"SO",Z=195:"ZA",Z=197:"ES",Z=43:"LK",Z=199:"SD",Z=200:"SR",Z=201:"SZ",Z=202:"SE",Z=203:"CH",Z=204:"SY",Z=205:"TJ",Z=222:"TZ",Z=182:"PM",Z=206:"TH",Z=219:"MK",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+17 SET PRCACC=$SELECT(Z=207:"TG",Z=208:"TK",Z=209:"TO",Z=210:"TT",Z=212:"TN",Z=213:"TR",Z=214:"TM",Z=215:"TC",Z=216:"TV",Z=217:"UG",Z=218:"UA",Z=211:"AE",Z=1:"US",Z=224:"UY",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
+18 SET PRCACC=$SELECT(Z=104:"IR",Z=225:"UZ",Z=153:"VU",Z=97:"VA",Z=226:"VE",Z=183:"VN",Z=31:"VG",Z=227:"WF",Z=228:"YE",Z=229:"YU",Z=230:"ZM",Z=196:"ZW",1:" ")
if PRCACC'=" "
GOTO COUNTRYQ
COUNTRYQ ;
+1 QUIT PRCACC
+2 ;
+1 ;increment batch sequence number, build new header
+2 NEW RCMSG
+3 SET SEQ=SEQ+1
+4 SET CNTLID=$$JD()_$$RJZF^RCTCSP1(SEQ,4)
+5 KILL ^XTMP("RCTCSPD",$JOB,ACTION,"BUILD",SEQ)
+6 ;header is record type H
+7 SET RCMSG="H"_CNTLID_$$BLANK^RCTCSP1(14)_"3636001200"
+8 SET RCMSG=RCMSG_$$BLANK^RCTCSP1(450-$LENGTH(RCMSG))
+9 SET REC=REC+1
+10 SET ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD",REC)=$EXTRACT(RCMSG,1,225)_$CHAR(94)
+11 SET REC=REC+1
+12 SET ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD",REC)=$EXTRACT(RCMSG,226,999)_$CHAR(126)
+13 QUIT
+14 ;
TRAILER ;
+1 ;trailer is type Z record
+2 NEW X
+3 ;delete batch if no records processed
IF REC=0
KILL ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD")
QUIT
+4 NEW RCMSG
+5 SET CNTLID=$$JD()_$$RJZF^RCTCSP1(SEQ,4)
+6 SET RCMSG="Z"_$$RJZF^RCTCSP1(RECC,8)
+7 SET X=$TRANSLATE($JUSTIFY(AMOUNT/100,0,2),".")
+8 ;341/DRF Remove AMOUNT function
SET X=$EXTRACT("00000000000",1,14-$LENGTH(X))_X
+9 SET RCMSG=RCMSG_X
+10 SET RCMSG=RCMSG_CNTLID_$$BLANK^RCTCSP1(14)_"3636001200"
+11 SET RCMSG=RCMSG_$$BLANK^RCTCSP1(450-$LENGTH(RCMSG))
+12 SET REC=REC+1
+13 SET ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD",REC)=$EXTRACT(RCMSG,1,225)_$CHAR(94)
+14 SET REC=REC+1
+15 SET ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD",REC)=$EXTRACT(RCMSG,226,999)_$CHAR(126)
+16 SET REC=0
SET RECC=0
SET AMOUNT=0
+17 QUIT
+18 ;
JD() ; returns today's Julian date YDOY
+1 NEW XMDDD,XMNOW,XMDT
+2 SET XMNOW=$$NOW^XLFDT
+3 SET XMDT=$EXTRACT(XMNOW,1,7)
+4 SET XMDDD=$$RJ^XLFSTR($$FMDIFF^XLFDT(XMDT,$EXTRACT(XMDT,1,3)_"0101",1)+1,3,"0")
+5 QUIT $EXTRACT(DT,3)_XMDDD
+6 ;
REC5B ;Create record 5B for Treasury ;PRCA*4.5*433 Tag REC5B Moved from routine RCTCSP1 for SACC size compliance
+1 ; trnnum transaction number file #433 pass in
+2 ; trntyp transaction type pointer to 430.3
+3 ; trntypa aia transaction type (aio: dmc agency internal offset, abal: decrease adjustment)
+4 NEW REC,KNUM,DEBTNR,DEBTORNB,TAMOUNT,TAMTPBAL,TAMTIBAL,TAMTABAL,TAMTFBAL,TAMTCBAL,AMTRFRRD,TRNTYP,TRNTYPA,TRANSNB
+5 NEW AMTPBAL,AMTIBAL,AMTABAL,AMTFBAL,AMTCBAL,TRN3,TRNNUME,CSPCD
+6 SET TRNTYPA="AIO"
+7 SET REC="C5B"_ACTION_"3636001200"_"DM1D "_"L"
+8 SET KNUM=$PIECE($PIECE(B0,U,1),"-",2)
+9 ; PRCA*4.5*350
SET DEBTNR=$$AGDEBTID^RCTCSPD
SET REC=REC_DEBTNR
+10 SET DEBTORNB=$EXTRACT(SITE,1,3)_$TRANSLATE($JUSTIFY(DEBTOR,12)," ",0)
+11 SET REC=REC_DEBTORNB
+12 SET TRNTYP=$PIECE($GET(^PRCA(433,TRNNUM,1)),U,2)
IF ",35,73,74,"[TRNTYP
SET TRNTYPA="ABAL"
+13 SET REC=REC_$$LJSF^RCTCSP1(TRNTYPA,9)
+14 SET TRNNUME=$$RJZF^RCTCSP1(TRNNUM,10)
+15 ;max is 999999
SET TRNNUME=$EXTRACT(TRNNUME,5,10)
+16 ;min is 1
IF TRNNUME="000000"
SET TRNNUME="000001"
+17 SET REC=REC_$$RJZF^RCTCSP1(TRNNUME,10)
+18 SET REC=REC_$$DATE8^RCTCSP1(DT)
+19 SET TRANSNB=$EXTRACT(SITE,1,3)_$TRANSLATE($JUSTIFY(TRNNUM,12)," ",0)
+20 SET REC=REC_TRANSNB
+21 SET REC=REC_$$BLANK^RCTCSP1(9)
+22 SET TRN3=$GET(^PRCA(433,TRNNUM,3))
+23 ;transaction principle balance
SET TAMTPBAL=$PIECE(TRN3,U,1)
+24 ;transaction interest balance
SET TAMTIBAL=$PIECE(TRN3,U,2)
+25 ;transaction administrative balance
SET TAMTABAL=$PIECE(TRN3,U,3)
+26 ;transaction marshal fee
SET TAMTFBAL=$PIECE(TRN3,U,4)
+27 ;transaction court cost
SET TAMTCBAL=$PIECE(TRN3,U,5)
+28 IF (TAMTPBAL+TAMTIBAL+TAMTABAL+TAMTFBAL+TAMTCBAL)=0
SET TAMTPBAL=TRNAMT
+29 SET TAMOUNT=$$AMOUNT^RCTCSP1(TAMTPBAL,TRNTYP)
+30 SET TAMOUNT=TAMOUNT_$$AMOUNT^RCTCSP1(TAMTIBAL,TRNTYP)
+31 SET TAMOUNT=TAMOUNT_$$AMOUNT^RCTCSP1(TAMTABAL,TRNTYP)
+32 SET TAMOUNT=TAMOUNT_$$AMOUNT^RCTCSP1(TAMTFBAL+TAMTCBAL,TRNTYP)
+33 SET REC=REC_TAMOUNT
+34 SET REC=REC_$$AMOUNT^RCTCSP1(TRNAMT,TRNTYP)
+35 SET REC=REC_$$BLANK^RCTCSP1(450-$LENGTH(REC))
+36 ;principle balance
SET AMTPBAL=$PIECE(B7,U,1)
+37 ;interest balance
SET AMTIBAL=$PIECE(B7,U,2)
+38 ;administrative balance
SET AMTABAL=$PIECE(B7,U,3)
+39 ;marshal fee
SET AMTFBAL=$PIECE(B7,U,4)
+40 ;court cost
SET AMTCBAL=$PIECE(B7,U,5)
+41 SET AMTRFRRD=AMTPBAL+AMTIBAL+AMTABAL+AMTFBAL+AMTCBAL
+42 IF ACTION="U"
SET $PIECE(^PRCA(430,BILL,16),U,10)=AMTRFRRD
+43 SET ^XTMP("RCTCSPD",$JOB,BILL,ACTION,"5B",TRNNUM)=REC
+44 SET ^XTMP("RCTCSPD",$JOB,"BILL",ACTION,BILL)=$$TAXID^RCTCSP1(DEBTOR)_"^"_$SELECT(TRNTYP=73!(TRNTYP=74):"",1:"-")_+$EXTRACT(REC,174,184)_"."_$EXTRACT(REC,185,186)
+45 QUIT
+46 ;
