RCTCSP2 ;ALBANY/BDB - CROSS-SERVICING TRANSMISSION ;03/15/14 3:34 PM
;;4.5;Accounts Receivable;**301,315,339,340,344,350,369,417**;Mar 20, 1995;Build 30
;;Per VA Directive 6402, this routine should not be modified.
;
;PRCA*4.5*344 Added total record control (>50) to 5B transaction
; handler to insure mail messages stay within a
; record count of 50 transactions.
;PRCA*4.5*369 Add proper text transaction for batch auto recall <$25
;
;PRCA*4.5*417 Ensure resubmitted bills to TCSP use the same logic
; for rec A3 as do rec A1 & A2 for bill number setup.
;
Q
;
COMPILE ;
N RCMSG,BCNTR,REC,RECC,AMOUNT,RCNTR,ACTION,SEQ
S BCNTR=0,REC=0,RECC=0,AMOUNT=0,SEQ=0
F S BCNTR=$O(^XTMP("RCTCSPD",$J,BCNTR)) Q:+BCNTR'>0 D
.I REC>50 D
..D TRAILER^RCTCSP1A
..D AITCMSG
..S REC=0,RECC=0
..Q
.S ACTION="" F S ACTION=$O(^XTMP("RCTCSPD",$J,BCNTR,ACTION)) Q:ACTION="" D
..I REC=0 D HEADER^RCTCSP1A
..F RCNTR=1,2,"2A","2C",3 I $D(^XTMP("RCTCSPD",$J,BCNTR,ACTION,RCNTR)) D
...S REC=REC+1
...S RECC=RECC+1 ;record count for 'c' records on trailer record
...S ^XTMP("RCTCSPD",$J,SEQ,"BUILD",REC)=$E(^XTMP("RCTCSPD",$J,BCNTR,ACTION,RCNTR),1,225)_$C(94)
...S REC=REC+1
...S ^XTMP("RCTCSPD",$J,SEQ,"BUILD",REC)=$E(^XTMP("RCTCSPD",$J,BCNTR,ACTION,RCNTR),226,999)_$C(126)
...I $E(^XTMP("RCTCSPD",$J,BCNTR,ACTION,RCNTR),2)="1" S AMOUNT=AMOUNT+$E(^(RCNTR),91,104)
...Q
..I $D(^XTMP("RCTCSPD",$J,BCNTR,ACTION,"5B")) D
...N TRNNUM
...S TRNNUM=0
...F S TRNNUM=$O(^XTMP("RCTCSPD",$J,BCNTR,ACTION,"5B",TRNNUM)) Q:TRNNUM'?1N.N D
....I REC>50 D ;PRCA*4.5*344
.....D TRAILER^RCTCSP1A
.....D AITCMSG
.....S REC=0,RECC=0
.....Q
....I REC=0 D HEADER^RCTCSP1A ;PRCA*4.5*344
....S REC=REC+1
....S RECC=RECC+1 ;record count for 'c' records on trailer record
....S ^XTMP("RCTCSPD",$J,SEQ,"BUILD",REC)=$E(^XTMP("RCTCSPD",$J,BCNTR,ACTION,"5B",TRNNUM),1,225)_$C(94)
....S REC=REC+1
....S ^XTMP("RCTCSPD",$J,SEQ,"BUILD",REC)=$E(^XTMP("RCTCSPD",$J,BCNTR,ACTION,"5B",TRNNUM),226,999)_$C(126)
....S AMOUNT=AMOUNT+$TR($E(^XTMP("RCTCSPD",$J,BCNTR,ACTION,"5B",TRNNUM),173,186),"-")
....Q
...Q
..Q
.Q
D TRAILER^RCTCSP1A
D AITCMSG
D USRMSG
Q
;
RCLLCHK(BILL) ;
N TOTAL
I $P(B15,U,7) Q 0 ;check stop tcsp referral flag
I $P(B15,U,2),'$P(B15,U,3) D ;recall bill
.N ACTION,BILLCSL
.S ACTION="L"
.S $P(^PRCA(430,BILL,15),U,1)="" ;clear the date referred
.S $P(^PRCA(430,BILL,15),U,3)=DT ;set the recall date
.S $P(^PRCA(430,BILL,15),U,5)=$$GET1^DIQ(430,BILL,11) ;set the recall amount to the current amount
.S B15=^PRCA(430,BILL,15)
.S BILLCSL=BILL ;last cs bill
.D REC1^RCTCSPD
.K ^PRCA(430,"TCSP",BILL) ;set the bill to not sent to cross-servicing
.D RCLL^RCTCSPD4 ; set bill recall non-financial transaction PRCA*4.5*315
;
;recall bill if total <$25
S TOTAL=$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
I TOTAL<25 D Q 0
.N X1,X2,P366DT,X,PRCAEN,I,RECALL
.S RECALL=0
.S X1=DT,X2=-366 D C^%DTC S P366DT=X
.S PRCAEN=0 F I=0:0 S PRCAEN=$O(^PRCA(433,"C",BILL,PRCAEN)) Q:'PRCAEN S:$P($G(^PRCA(433,PRCAEN,1)),U,1)>P366DT RECALL=1
.I RECALL=0 D Q
..S ACTION="L"
..S $P(^PRCA(430,BILL,15),U,1)="" ;clear the date referred
..S $P(^PRCA(430,BILL,15),U,2)=1 ;set the recall flag
..S $P(^PRCA(430,BILL,15),U,3)=DT ;set the recall date
..S $P(^PRCA(430,BILL,15),U,4)="07" ;set the recall reason
..S $P(^PRCA(430,BILL,15),U,5)=$P($G(^PRCA(430,BILL,16)),U,10) ;set the recall amount to the current tcsp amount
..S $P(^PRCA(430,BILL,15),U,7)=1 ;set the stop flag
..S $P(^PRCA(430,BILL,15),U,8)=DT ;set the stop date
..S $P(^PRCA(430,BILL,15),U,9)="O" ;set the stop date
..S $P(^PRCA(430,BILL,15),U,10)="AUTORECALL <$25" ;set the stop reason
..S B15=^PRCA(430,BILL,15)
..D REC1^RCTCSPD,CSAUTORC^RCTCSPD5 ; set CS Bill Auto Recall transaction PRCA*4.5*315/369
..K ^PRCA(430,"TCSP",BILL) ;set the bill to not sent to cross-servicing
..S $P(^PRCA(430,BILL,19),U,10)=1 ;stop interest admin calc
..S B19=$G(^PRCA(430,BILL,19))
..Q
.Q
Q 0
;
RCRPRT ;Reconciliation report
N ZTDESC,ZTRTN,POP,%ZIS,DTFRMTO,DTFRM,DTTO,PROMPT,EXCEL,DATE
S DTFRMTO=$$DTFRMTO Q:'DTFRMTO ;Get date range as per PRCA*4.5*315
S (DATE,DTFRM)=$$FMADD^XLFDT(+$P(DTFRMTO,U,2),-1),DTTO=$P(DTFRMTO,U,3),CURDT=0
S EXCEL=0,PROMPT="CAPTURE Report data to an Excel Document",DIR(0)="Y",DIR("?")="^D HEXC^RCTCSJR"
S EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO") I "01"'[EXCEL S STOP=1 Q
I EXCEL=1 D EXCMSG^RCTCSJR ; Display Excel display message
K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
I $D(IO("Q")) D Q ;
.S ZTSAVE("DTFRMTO")="",ZTSAVE("EXCEL")=""
.S ZTRTN="RCRPRTP^RCTCSP2",ZTDESC="RECONCILIATION REPORT"
.D ^%ZTLOAD,HOME^%ZIS
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR K DIR
.Q
;
RCRPRTP ;print the - reconciliation report, call to build array of bills returned
U IO
N DASH,PAGE,DBTR,DBTRN,RCOUT,CURDT,RC18,RCRTCD,BILLIEN,DATE
K ^TMP("RCTCSP2",$J)
S (DATE,DTFRM)=$$FMADD^XLFDT(+$P(DTFRMTO,U,2),-1),DTTO=$P(DTFRMTO,U,3),CURDT=0
F S DATE=$O(^PRCA(430,"AN",DATE)),BILLIEN=0 Q:DATE=""!(DATE>DTTO) D ;Use new AN xref PRCA*4.5*315
. F S BILLIEN=$O(^PRCA(430,"AN",DATE,BILLIEN)) Q:BILLIEN="" D
..I +$P($G(^PRCA(430,BILLIEN,30)),U,1)=0 Q ;Returned date is NULL
..S DBTR=$P($G(^PRCA(430,BILLIEN,0)),U,9),DBTRN=$$GET1^DIQ(430,BILLIEN,9)
..Q:DBTRN']""
..S ^TMP("RCTCSP2",$J,DBTRN,DBTR)="" ; store scratch by Debtor Name, Debtor IEN
S PAGE=0,RCOUT=0
S DASH="",$P(DASH,"-",78)=""
D RCRPRTH2
;
;New fields added in PRCA*4.5*315:
;AMTREF:(#310) REC ORIGINAL TCSP AMOUNT stored in ^PRCA(430,BILL,30), piece 10
;CORDT:(#312) REC TCSP RECALL EFF. DATE stored in ^PRCA(430,BILL,30), piece 12
;DTREJ: (#172) REJECT DATE (multiple)
;See RCTCSPRS for more information on these fields
;
S DBTRN=0
F S DBTRN=$O(^TMP("RCTCSP2",$J,DBTRN)) Q:DBTRN=""!RCOUT S DBTR=0 F S DBTR=$O(^TMP("RCTCSP2",$J,DBTRN,DBTR)) Q:'DBTR!RCOUT D Q:RCOUT
.S BILL=0
.F S BILL=$O(^PRCA(430,"C",DBTR,BILL)) Q:BILL'?1N.N D Q:RCOUT
..N B0,B30,AMTREF,DTRET,CORDT,SSN
..S B0=$G(^PRCA(430,BILL,0)),B30=$G(^PRCA(430,BILL,30))
..S AMTREF=$J($P(B30,U,10),8,2)
..S DEBTOR=$P(B0,U,9),SSN=$$SSN^RCFN01($P(^RCD(340,DEBTOR,0),"^")),SSN=$S(SSN=-1:"",1:$E(DBTRN))_$E(SSN,6,9)
..S CORDT=$$FMTE^XLFDT($P(B30,U,12),"2Z"),DTRET=""
..S DTRET=$P(B30,U) I DTRET S DTRET=$$FMTE^XLFDT(DTRET,"2Z")
..I +$P(B30,U,1)=0 Q
..I 'EXCEL W $E(DBTRN,1,16)
..I EXCEL W !,$E(DBTRN,1,14)
..I 'EXCEL W ?17,$P(B0,U,1),?29,SSN,?35,AMTREF,?44,CORDT,?53,DTRET,!
..I EXCEL W U_$P($P(B0,U,1),"-",2)_U_SSN_U_AMTREF_U_CORDT_U_DTRET
..S RCRTCD=$P(B30,U,2)
..I 'EXCEL D
...D ;Display return reason code
....I RCRTCD="" W ?6,"NO RETURN REASON CODE",! Q
....W:$D(^PRCA(430.5,RCRTCD,0)) ?6,$P(^PRCA(430.5,RCRTCD,0),U,2),!
....W:'$D(^PRCA(430.5,RCRTCD,0)) ?6,"UNKNOWN RETURN REASON CODE: ",RCRTCD,!
....W:RCRTCD=14 ?7,"Compromise, Please write this bill off by the manual process",!,?8,"Amount (not collected): "_$J($P(B30,U,4),9,2),! ;Added PRCA*4.5*315
....W:RCRTCD=2 ?8,"Date of Death: "_$$FMTE^XLFDT($P(B30,U,7),"2Z"),! ;date type (as per PRCA*4.5*315)
....W:RCRTCD=3 ?8,"Bankruptcy Date: "_$$FMTE^XLFDT($P(B30,U,6),"2Z"),!
...W:+$P(B30,U,8) ?6,"Date of Dissolution: "_$$FMTE^XLFDT($P(B30,U,8),"2Z"),!
..I EXCEL D
...I RCRTCD=14 W U_$P(^PRCA(430.5,RCRTCD,0),U,2)_U_"AMT NOT COLL"_U_$P(B30,U,4)
...I $P(B30,U,3)="Y" W U_"CP"_U_$J($P(B30,U,4),4,2) Q
...I RCRTCD=2 W U_$P(^PRCA(430.5,RCRTCD,0),U,2)_" "_$$FMTE^XLFDT($P(B30,U,7),"2Z") Q
...I RCRTCD=3 W U_$P(^PRCA(430.5,RCRTCD,0),U,2)_" "_$$FMTE^XLFDT($P(B30,U,6),"2Z") Q
...I RCRTCD]"" W U_$S($D(^PRCA(430.5,RCRTCD,0)):$$GET1^DIQ(430.5,RCRTCD,1),1:RCRTCD) Q
..;check for end of page here, if necessary form feed and print header
..I 'EXCEL W ! I ($Y+5)>IOSL D
...I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S RCOUT=1 K X,Y,DIRUT,DTOUT,DUOUT,DIROUT Q
...D RCRPRTH2
I $E(IOST,1,2)="C-" R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
K IOP,%ZIS,ZTQUEUED
K ^TMP("RCTCSP2",$J)
Q
;
RCRPRTH2 ;header for reconciliation report print report 2
W @IOF
S PAGE=PAGE+1
I 'EXCEL W "PAGE "_PAGE,?12,"RECONCILIATION REPORT ",?65,$$FMTE^XLFDT(DT,"2Z")
I 'EXCEL D Q
.W !,DASH
.W !,"DEBTOR",?17,"BILL NO.",?29,"Pt ID",?35,"Amount",?44,"Recall",?53,"Date",!
.W ?35,"Refer",?44,"Eff. Dt",?53,"Return"
.W !,"----------------",?17,"-----------",?29,"-----",?35,"--------",?44,"--------",?53,"--------",!
;EXCEL FORMAT
W "PAGE "_PAGE_U_"RECONCILIATION REPORT "_U_$$FMTE^XLFDT(DT,"2Z")
W !,"DEBTOR"_U_"BILL #"_U_"PT ID"_U_"AMT REF"_U_"DT RCL"_U_"DT RET"_U_"COMMENT"
Q
;
AITCMSG ;
N XMY,XMDUZ,XMSUB,XMTEXT,CNTLID,SYSTYP
S SYSTYP=$$PROD^XUPROD(1)
S CNTLID=$$JD^RCTCSP1A()_$$RJZF^RCTCSP1(SEQ,4)
S XMDUZ="AR PACKAGE"
I SYSTYP S XMY("XXX@Q-TPC.DOMAIN.EXT")=""
I 'SYSTYP S XMY("XXX@Q-TXC.DOMAIN.EXT")=""
S XMY("G.TCSP")=""
S XMSUB=SITE_"/CS TRANSMISSION/BATCH#: "_CNTLID
S XMTEXT="^XTMP(""RCTCSPD"","_$J_","""_SEQ_""",""BUILD"","
D ^XMD
Q
;
USRMSG ;sends mailman message of documents sent to user
N XMY,XMDUZ,XMSUB,XMTEXT,X,RCNT,RCDAT1,RCDAT2
S ACTION="" F S ACTION=$O(^XTMP("RCTCSPD",$J,"BILL",ACTION)) Q:ACTION="" D
.K ^XTMP("RCTCSPD",$J,"BILL","MSG")
.S XMDUZ="AR PACKAGE"
.S XMY("G.TCSP")=""
.S XMSUB="CS "_$S(ACTION="A":"ADD REFERRAL",ACTION="U":"UPDATES",ACTION="L":"RECALLS",ACTION="B":"EXISTING DEBTOR",1:"UNKNOWN")_" SENT ON "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)_" BATCH ID: "_CNTLID
.S ^XTMP("RCTCSPD",$J,"BILL","MSG",1)="Bill# TIN TYPE AMOUNT"
.S ^XTMP("RCTCSPD",$J,"BILL","MSG",2)="----- --- ---- ------"
.S X=0,RCNT=2 F S X=$O(^XTMP("RCTCSPD",$J,"BILL",ACTION,X)) Q:X="" D
..S RCNT=RCNT+1
..S RCDAT1=$P(^XTMP("RCTCSPD",$J,"BILL",ACTION,X),U,1)
..S RCDAT2=$P(^XTMP("RCTCSPD",$J,"BILL",ACTION,X),U,2)
..S ^XTMP("RCTCSPD",$J,"BILL","MSG",RCNT)=$$RJZF($P($G(^PRCA(430,X,0)),U,1),7)_$$BLANK(22)_RCDAT1_" "_ACTION_" "_$S(RCDAT2]"":RCDAT2,1:"")
..Q
.S ^XTMP("RCTCSPD",$J,"BILL","MSG",RCNT+1)="Total Bills: "_(RCNT-2)
.S XMTEXT="^XTMP(""RCTCSPD"","_$J_",""BILL"",""MSG"","
.D ^XMD
.K ^XTMP("RCTCSPD",$J,"BILL","MSG")
Q
;
THIRD ;sends mailman message to user if no third letter found
Q:'$D(^XTMP("RCTCSPD",$J,"THIRD"))
N XMY,XMDUZ,XMSUB,XMTEXT
S XMDUZ="AR PACKAGE"
S XMY("G.TCSP")=""
N TCT,TDEB,TDEB0,TBIL,TSP,FST
S XMSUB="TCSP QUALIFIED/NO 3RD LETTER SENT ON "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
S ^XTMP("RCTCSPD",$J,"THIRD",1)="The following list of debtor bills were not sent to TCSP."
S ^XTMP("RCTCSPD",$J,"THIRD",2)="Please review debtor's account to determine why the third"
S ^XTMP("RCTCSPD",$J,"THIRD",3)="notice letter has not been sent:"
S ^XTMP("RCTCSPD",$J,"THIRD",4)="Name Bill #"
S ^XTMP("RCTCSPD",$J,"THIRD",5)="---- ------"
S TCT=6,TSP=0,TDEB=""
F S TDEB=$O(^XTMP("RCTCSPD",$J,"THIRD",TDEB)) Q:TDEB="" D
.S FST=1,TBIL=""
.I FST,TCT'=6 S ^XTMP("RCTCSPD",$J,"THIRD",TCT)="",TCT=TCT+1,TSP=TSP+1
.F S TBIL=$O(^XTMP("RCTCSPD",$J,"THIRD",TDEB,TBIL)) Q:TBIL="" D
..S TDEB0=$S(FST:TDEB,1:"")
..S ^XTMP("RCTCSPD",$J,"THIRD",TCT)=TDEB0_$J(" ",35-$L(TDEB0))_TBIL
..S TCT=TCT+1,FST=0
S ^XTMP("RCTCSPD",$J,"THIRD",TCT)="Total records: "_(TCT-(6+TSP))
S XMTEXT="^XTMP(""RCTCSPD"","_$J_",""THIRD"","
D ^XMD
K ^XTMP("RCTCSPD",$J,"THIRD")
THIRDQ Q
;
REC3 ;
N REC,KNUM,DEBTNR,DEBTORNB
S REC="C3 "_ACTION_"3636001200"_"DM1D "
S KNUM=$P($P(B0,U,1),"-",2)
S DEBTNR=$$AGDEBTID^RCTCSPD,REC=REC_DEBTNR ; PRCA*4.5*417
S DEBTORNB=$E(SITE,1,3)_$TR($J(DEBTOR,12)," ",0)
S REC=REC_DEBTORNB
S REC=REC_$S(ACTION="L":"15",1:" ")
S REC=REC_"SLF"
S REC=REC_$$BLANK(8)
S REC=REC_$$AMOUNT(0)
S REC=REC_$$BLANK(16)
S REC=REC_"SLFIND"
S REC=REC_$$BLANK(450-$L(REC))
S ^XTMP("RCTCSPD",$J,BILL,ACTION,3)=REC
S $P(^XTMP("RCTCSPD",$J,"BILL",ACTION,BILL),U,1)=$$TAXID(DEBTOR)
Q
;
DATE8(X) ;changes fileman date into 8 digit date yyyymmdd
I +X S X=X+17000000
S X=$E(X,1,8)
Q X
;
AMOUNT(X) ;changes amount to zero filled, right justified
S:X<0 X=-X
S X=$TR($J(X,0,2),".")
S X=$E("000000000000",1,14-$L(X))_X
Q X
;
BLANK(X) ;returns 'x' blank spaces
N BLANK
S BLANK="",$P(BLANK," ",X+1)=""
Q BLANK
;
RJZF(X,Y) ;right justify zero fill width Y
S X=$E("000000000000",1,Y-$L(X))_X
Q X
;
LJSF(X,Y) ;left justified space filled
S X=$E(X,1,Y)
S X=X_$$BLANK(Y-$L(X))
Q X
;
LJZF(X,Y) ;x left justified, y zero filled
S X=X_"0000000000"
S X=$E(X,X,Y)
Q X
;
TAXID(DEBTOR) ;computes TAXID to place on documents
N TAXID,DIC,DA,DR,DIQ
S TAXID=$$SSN^RCFN01(DEBTOR)
S TAXID=$$LJSF(TAXID,9)
Q TAXID
;
DTFRMTO(PROMPT) ;Get from and to dates (added as per PRCA*4.5*315 to be able to sort by dates for reports)
;INPUT:
; PROMPT - Message to display prior to prompting for dates
;OUTPUT:
; 1^BEGDT^ENDDT - Data found
; 0 - User up arrowed or timed out
;
N %DT,Y,X,BEGDT,ENDDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT,DTFROM,DTTO
S OUT=0
W !,$G(PROMPT)
S %DT="AEX"
S %DT("A")="Date Range: FROM: " ;Enter Beginning Date: "
S %DT("B")="T-30"
W !
D ^%DT
K %DT
Q:Y<0 OUT ;Quit if user time out or didn't enter valid date
S DTFROM=+Y
S %DT="AEX"
S %DT("A")=" TO: ",%DT("B")="T" ;"TODAY"
D ^%DT
K %DT
;Quit if user time out or didn't enter valid date
Q:Y<0 OUT
S DTTO=+Y
S OUT=1_U_DTFROM_U_DTTO
;Switch dates if Begin Date is more recent than End Date
S:DTFROM>DTTO OUT=1_U_DTTO_U_DTFROM
Q OUT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSP2 13805 printed Jun 11, 2024@21:33:35 Page 2
RCTCSP2 ;ALBANY/BDB - CROSS-SERVICING TRANSMISSION ;03/15/14 3:34 PM
+1 ;;4.5;Accounts Receivable;**301,315,339,340,344,350,369,417**;Mar 20, 1995;Build 30
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;PRCA*4.5*344 Added total record control (>50) to 5B transaction
+5 ; handler to insure mail messages stay within a
+6 ; record count of 50 transactions.
+7 ;PRCA*4.5*369 Add proper text transaction for batch auto recall <$25
+8 ;
+9 ;PRCA*4.5*417 Ensure resubmitted bills to TCSP use the same logic
+10 ; for rec A3 as do rec A1 & A2 for bill number setup.
+11 ;
+12 QUIT
+13 ;
COMPILE ;
+1 NEW RCMSG,BCNTR,REC,RECC,AMOUNT,RCNTR,ACTION,SEQ
+2 SET BCNTR=0
SET REC=0
SET RECC=0
SET AMOUNT=0
SET SEQ=0
+3 FOR
SET BCNTR=$ORDER(^XTMP("RCTCSPD",$JOB,BCNTR))
if +BCNTR'>0
QUIT
Begin DoDot:1
+4 IF REC>50
Begin DoDot:2
+5 DO TRAILER^RCTCSP1A
+6 DO AITCMSG
+7 SET REC=0
SET RECC=0
+8 QUIT
End DoDot:2
+9 SET ACTION=""
FOR
SET ACTION=$ORDER(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION))
if ACTION=""
QUIT
Begin DoDot:2
+10 IF REC=0
DO HEADER^RCTCSP1A
+11 FOR RCNTR=1,2,"2A","2C",3
IF $DATA(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,RCNTR))
Begin DoDot:3
+12 SET REC=REC+1
+13 ;record count for 'c' records on trailer record
SET RECC=RECC+1
+14 SET ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD",REC)=$EXTRACT(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,RCNTR),1,225)_$CHAR(94)
+15 SET REC=REC+1
+16 SET ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD",REC)=$EXTRACT(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,RCNTR),226,999)_$CHAR(126)
+17 IF $EXTRACT(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,RCNTR),2)="1"
SET AMOUNT=AMOUNT+$EXTRACT(^(RCNTR),91,104)
+18 QUIT
End DoDot:3
+19 IF $DATA(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,"5B"))
Begin DoDot:3
+20 NEW TRNNUM
+21 SET TRNNUM=0
+22 FOR
SET TRNNUM=$ORDER(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,"5B",TRNNUM))
if TRNNUM'?1N.N
QUIT
Begin DoDot:4
+23 ;PRCA*4.5*344
IF REC>50
Begin DoDot:5
+24 DO TRAILER^RCTCSP1A
+25 DO AITCMSG
+26 SET REC=0
SET RECC=0
+27 QUIT
End DoDot:5
+28 ;PRCA*4.5*344
IF REC=0
DO HEADER^RCTCSP1A
+29 SET REC=REC+1
+30 ;record count for 'c' records on trailer record
SET RECC=RECC+1
+31 SET ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD",REC)=$EXTRACT(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,"5B",TRNNUM),1,225)_$CHAR(94)
+32 SET REC=REC+1
+33 SET ^XTMP("RCTCSPD",$JOB,SEQ,"BUILD",REC)=$EXTRACT(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,"5B",TRNNUM),226,999)_$CHAR(126)
+34 SET AMOUNT=AMOUNT+$TRANSLATE($EXTRACT(^XTMP("RCTCSPD",$JOB,BCNTR,ACTION,"5B",TRNNUM),173,186),"-")
+35 QUIT
End DoDot:4
+36 QUIT
End DoDot:3
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 DO TRAILER^RCTCSP1A
+40 DO AITCMSG
+41 DO USRMSG
+42 QUIT
+43 ;
RCLLCHK(BILL) ;
+1 NEW TOTAL
+2 ;check stop tcsp referral flag
IF $PIECE(B15,U,7)
QUIT 0
+3 ;recall bill
IF $PIECE(B15,U,2)
IF '$PIECE(B15,U,3)
Begin DoDot:1
+4 NEW ACTION,BILLCSL
+5 SET ACTION="L"
+6 ;clear the date referred
SET $PIECE(^PRCA(430,BILL,15),U,1)=""
+7 ;set the recall date
SET $PIECE(^PRCA(430,BILL,15),U,3)=DT
+8 ;set the recall amount to the current amount
SET $PIECE(^PRCA(430,BILL,15),U,5)=$$GET1^DIQ(430,BILL,11)
+9 SET B15=^PRCA(430,BILL,15)
+10 ;last cs bill
SET BILLCSL=BILL
+11 DO REC1^RCTCSPD
+12 ;set the bill to not sent to cross-servicing
KILL ^PRCA(430,"TCSP",BILL)
+13 ; set bill recall non-financial transaction PRCA*4.5*315
DO RCLL^RCTCSPD4
End DoDot:1
+14 ;
+15 ;recall bill if total <$25
+16 SET TOTAL=$PIECE(B7,U)+$PIECE(B7,U,2)+$PIECE(B7,U,3)+$PIECE(B7,U,4)+$PIECE(B7,U,5)
+17 IF TOTAL<25
Begin DoDot:1
+18 NEW X1,X2,P366DT,X,PRCAEN,I,RECALL
+19 SET RECALL=0
+20 SET X1=DT
SET X2=-366
DO C^%DTC
SET P366DT=X
+21 SET PRCAEN=0
FOR I=0:0
SET PRCAEN=$ORDER(^PRCA(433,"C",BILL,PRCAEN))
if 'PRCAEN
QUIT
if $PIECE($GET(^PRCA(433,PRCAEN,1)),U,1)>P366DT
SET RECALL=1
+22 IF RECALL=0
Begin DoDot:2
+23 SET ACTION="L"
+24 ;clear the date referred
SET $PIECE(^PRCA(430,BILL,15),U,1)=""
+25 ;set the recall flag
SET $PIECE(^PRCA(430,BILL,15),U,2)=1
+26 ;set the recall date
SET $PIECE(^PRCA(430,BILL,15),U,3)=DT
+27 ;set the recall reason
SET $PIECE(^PRCA(430,BILL,15),U,4)="07"
+28 ;set the recall amount to the current tcsp amount
SET $PIECE(^PRCA(430,BILL,15),U,5)=$PIECE($GET(^PRCA(430,BILL,16)),U,10)
+29 ;set the stop flag
SET $PIECE(^PRCA(430,BILL,15),U,7)=1
+30 ;set the stop date
SET $PIECE(^PRCA(430,BILL,15),U,8)=DT
+31 ;set the stop date
SET $PIECE(^PRCA(430,BILL,15),U,9)="O"
+32 ;set the stop reason
SET $PIECE(^PRCA(430,BILL,15),U,10)="AUTORECALL <$25"
+33 SET B15=^PRCA(430,BILL,15)
+34 ; set CS Bill Auto Recall transaction PRCA*4.5*315/369
DO REC1^RCTCSPD
DO CSAUTORC^RCTCSPD5
+35 ;set the bill to not sent to cross-servicing
KILL ^PRCA(430,"TCSP",BILL)
+36 ;stop interest admin calc
SET $PIECE(^PRCA(430,BILL,19),U,10)=1
+37 SET B19=$GET(^PRCA(430,BILL,19))
+38 QUIT
End DoDot:2
QUIT
+39 QUIT
End DoDot:1
QUIT 0
+40 QUIT 0
+41 ;
RCRPRT ;Reconciliation report
+1 NEW ZTDESC,ZTRTN,POP,%ZIS,DTFRMTO,DTFRM,DTTO,PROMPT,EXCEL,DATE
+2 ;Get date range as per PRCA*4.5*315
SET DTFRMTO=$$DTFRMTO
if 'DTFRMTO
QUIT
+3 SET (DATE,DTFRM)=$$FMADD^XLFDT(+$PIECE(DTFRMTO,U,2),-1)
SET DTTO=$PIECE(DTFRMTO,U,3)
SET CURDT=0
+4 SET EXCEL=0
SET PROMPT="CAPTURE Report data to an Excel Document"
SET DIR(0)="Y"
SET DIR("?")="^D HEXC^RCTCSJR"
+5 SET EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO")
IF "01"'[EXCEL
SET STOP=1
QUIT
+6 ; Display Excel display message
IF EXCEL=1
DO EXCMSG^RCTCSJR
+7 KILL IOP,IO("Q")
SET %ZIS="MQ"
SET %ZIS("B")=""
DO ^%ZIS
if POP
QUIT
+8 ;
IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTSAVE("DTFRMTO")=""
SET ZTSAVE("EXCEL")=""
+10 SET ZTRTN="RCRPRTP^RCTCSP2"
SET ZTDESC="RECONCILIATION REPORT"
+11 DO ^%ZTLOAD
DO HOME^%ZIS
+12 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
+13 QUIT
End DoDot:1
QUIT
+14 ;
RCRPRTP ;print the - reconciliation report, call to build array of bills returned
+1 USE IO
+2 NEW DASH,PAGE,DBTR,DBTRN,RCOUT,CURDT,RC18,RCRTCD,BILLIEN,DATE
+3 KILL ^TMP("RCTCSP2",$JOB)
+4 SET (DATE,DTFRM)=$$FMADD^XLFDT(+$PIECE(DTFRMTO,U,2),-1)
SET DTTO=$PIECE(DTFRMTO,U,3)
SET CURDT=0
+5 ;Use new AN xref PRCA*4.5*315
FOR
SET DATE=$ORDER(^PRCA(430,"AN",DATE))
SET BILLIEN=0
if DATE=""!(DATE>DTTO)
QUIT
Begin DoDot:1
+6 FOR
SET BILLIEN=$ORDER(^PRCA(430,"AN",DATE,BILLIEN))
if BILLIEN=""
QUIT
Begin DoDot:2
+7 ;Returned date is NULL
IF +$PIECE($GET(^PRCA(430,BILLIEN,30)),U,1)=0
QUIT
+8 SET DBTR=$PIECE($GET(^PRCA(430,BILLIEN,0)),U,9)
SET DBTRN=$$GET1^DIQ(430,BILLIEN,9)
+9 if DBTRN']""
QUIT
+10 ; store scratch by Debtor Name, Debtor IEN
SET ^TMP("RCTCSP2",$JOB,DBTRN,DBTR)=""
End DoDot:2
End DoDot:1
+11 SET PAGE=0
SET RCOUT=0
+12 SET DASH=""
SET $PIECE(DASH,"-",78)=""
+13 DO RCRPRTH2
+14 ;
+15 ;New fields added in PRCA*4.5*315:
+16 ;AMTREF:(#310) REC ORIGINAL TCSP AMOUNT stored in ^PRCA(430,BILL,30), piece 10
+17 ;CORDT:(#312) REC TCSP RECALL EFF. DATE stored in ^PRCA(430,BILL,30), piece 12
+18 ;DTREJ: (#172) REJECT DATE (multiple)
+19 ;See RCTCSPRS for more information on these fields
+20 ;
+21 SET DBTRN=0
+22 FOR
SET DBTRN=$ORDER(^TMP("RCTCSP2",$JOB,DBTRN))
if DBTRN=""!RCOUT
QUIT
SET DBTR=0
FOR
SET DBTR=$ORDER(^TMP("RCTCSP2",$JOB,DBTRN,DBTR))
if 'DBTR!RCOUT
QUIT
Begin DoDot:1
+23 SET BILL=0
+24 FOR
SET BILL=$ORDER(^PRCA(430,"C",DBTR,BILL))
if BILL'?1N.N
QUIT
Begin DoDot:2
+25 NEW B0,B30,AMTREF,DTRET,CORDT,SSN
+26 SET B0=$GET(^PRCA(430,BILL,0))
SET B30=$GET(^PRCA(430,BILL,30))
+27 SET AMTREF=$JUSTIFY($PIECE(B30,U,10),8,2)
+28 SET DEBTOR=$PIECE(B0,U,9)
SET SSN=$$SSN^RCFN01($PIECE(^RCD(340,DEBTOR,0),"^"))
SET SSN=$SELECT(SSN=-1:"",1:$EXTRACT(DBTRN))_$EXTRACT(SSN,6,9)
+29 SET CORDT=$$FMTE^XLFDT($PIECE(B30,U,12),"2Z")
SET DTRET=""
+30 SET DTRET=$PIECE(B30,U)
IF DTRET
SET DTRET=$$FMTE^XLFDT(DTRET,"2Z")
+31 IF +$PIECE(B30,U,1)=0
QUIT
+32 IF 'EXCEL
WRITE $EXTRACT(DBTRN,1,16)
+33 IF EXCEL
WRITE !,$EXTRACT(DBTRN,1,14)
+34 IF 'EXCEL
WRITE ?17,$PIECE(B0,U,1),?29,SSN,?35,AMTREF,?44,CORDT,?53,DTRET,!
+35 IF EXCEL
WRITE U_$PIECE($PIECE(B0,U,1),"-",2)_U_SSN_U_AMTREF_U_CORDT_U_DTRET
+36 SET RCRTCD=$PIECE(B30,U,2)
+37 IF 'EXCEL
Begin DoDot:3
+38 ;Display return reason code
Begin DoDot:4
+39 IF RCRTCD=""
WRITE ?6,"NO RETURN REASON CODE",!
QUIT
+40 if $DATA(^PRCA(430.5,RCRTCD,0))
WRITE ?6,$PIECE(^PRCA(430.5,RCRTCD,0),U,2),!
+41 if '$DATA(^PRCA(430.5,RCRTCD,0))
WRITE ?6,"UNKNOWN RETURN REASON CODE: ",RCRTCD,!
+42 ;Added PRCA*4.5*315
if RCRTCD=14
WRITE ?7,"Compromise, Please write this bill off by the manual process",!,?8,"Amount (not collected): "_$JUSTIFY($PIECE(B30,U,4),9,2),!
+43 ;date type (as per PRCA*4.5*315)
if RCRTCD=2
WRITE ?8,"Date of Death: "_$$FMTE^XLFDT($PIECE(B30,U,7),"2Z"),!
+44 if RCRTCD=3
WRITE ?8,"Bankruptcy Date: "_$$FMTE^XLFDT($PIECE(B30,U,6),"2Z"),!
End DoDot:4
+45 if +$PIECE(B30,U,8)
WRITE ?6,"Date of Dissolution: "_$$FMTE^XLFDT($PIECE(B30,U,8),"2Z"),!
End DoDot:3
+46 IF EXCEL
Begin DoDot:3
+47 IF RCRTCD=14
WRITE U_$PIECE(^PRCA(430.5,RCRTCD,0),U,2)_U_"AMT NOT COLL"_U_$PIECE(B30,U,4)
+48 IF $PIECE(B30,U,3)="Y"
WRITE U_"CP"_U_$JUSTIFY($PIECE(B30,U,4),4,2)
QUIT
+49 IF RCRTCD=2
WRITE U_$PIECE(^PRCA(430.5,RCRTCD,0),U,2)_" "_$$FMTE^XLFDT($PIECE(B30,U,7),"2Z")
QUIT
+50 IF RCRTCD=3
WRITE U_$PIECE(^PRCA(430.5,RCRTCD,0),U,2)_" "_$$FMTE^XLFDT($PIECE(B30,U,6),"2Z")
QUIT
+51 IF RCRTCD]""
WRITE U_$SELECT($DATA(^PRCA(430.5,RCRTCD,0)):$$GET1^DIQ(430.5,RCRTCD,1),1:RCRTCD)
QUIT
End DoDot:3
+52 ;check for end of page here, if necessary form feed and print header
+53 IF 'EXCEL
WRITE !
IF ($Y+5)>IOSL
Begin DoDot:3
+54 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
KILL DIRUT
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET RCOUT=1
KILL X,Y,DIRUT,DTOUT,DUOUT,DIROUT
QUIT
+55 DO RCRPRTH2
End DoDot:3
End DoDot:2
if RCOUT
QUIT
End DoDot:1
if RCOUT
QUIT
+56 IF $EXTRACT(IOST,1,2)="C-"
READ !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME
WRITE @IOF
+57 DO ^%ZISC
+58 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+59 KILL IOP,%ZIS,ZTQUEUED
+60 KILL ^TMP("RCTCSP2",$JOB)
+61 QUIT
+62 ;
RCRPRTH2 ;header for reconciliation report print report 2
+1 WRITE @IOF
+2 SET PAGE=PAGE+1
+3 IF 'EXCEL
WRITE "PAGE "_PAGE,?12,"RECONCILIATION REPORT ",?65,$$FMTE^XLFDT(DT,"2Z")
+4 IF 'EXCEL
Begin DoDot:1
+5 WRITE !,DASH
+6 WRITE !,"DEBTOR",?17,"BILL NO.",?29,"Pt ID",?35,"Amount",?44,"Recall",?53,"Date",!
+7 WRITE ?35,"Refer",?44,"Eff. Dt",?53,"Return"
+8 WRITE !,"----------------",?17,"-----------",?29,"-----",?35,"--------",?44,"--------",?53,"--------",!
End DoDot:1
QUIT
+9 ;EXCEL FORMAT
+10 WRITE "PAGE "_PAGE_U_"RECONCILIATION REPORT "_U_$$FMTE^XLFDT(DT,"2Z")
+11 WRITE !,"DEBTOR"_U_"BILL #"_U_"PT ID"_U_"AMT REF"_U_"DT RCL"_U_"DT RET"_U_"COMMENT"
+12 QUIT
+13 ;
AITCMSG ;
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT,CNTLID,SYSTYP
+2 SET SYSTYP=$$PROD^XUPROD(1)
+3 SET CNTLID=$$JD^RCTCSP1A()_$$RJZF^RCTCSP1(SEQ,4)
+4 SET XMDUZ="AR PACKAGE"
+5 IF SYSTYP
SET XMY("XXX@Q-TPC.DOMAIN.EXT")=""
+6 IF 'SYSTYP
SET XMY("XXX@Q-TXC.DOMAIN.EXT")=""
+7 SET XMY("G.TCSP")=""
+8 SET XMSUB=SITE_"/CS TRANSMISSION/BATCH#: "_CNTLID
+9 SET XMTEXT="^XTMP(""RCTCSPD"","_$JOB_","""_SEQ_""",""BUILD"","
+10 DO ^XMD
+11 QUIT
+12 ;
USRMSG ;sends mailman message of documents sent to user
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT,X,RCNT,RCDAT1,RCDAT2
+2 SET ACTION=""
FOR
SET ACTION=$ORDER(^XTMP("RCTCSPD",$JOB,"BILL",ACTION))
if ACTION=""
QUIT
Begin DoDot:1
+3 KILL ^XTMP("RCTCSPD",$JOB,"BILL","MSG")
+4 SET XMDUZ="AR PACKAGE"
+5 SET XMY("G.TCSP")=""
+6 SET XMSUB="CS "_$SELECT(ACTION="A":"ADD REFERRAL",ACTION="U":"UPDATES",ACTION="L":"RECALLS",ACTION="B":"EXISTING DEBTOR",1:"UNKNOWN")_" SENT ON "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)_" BATCH ID: "_CNTLID
+7 SET ^XTMP("RCTCSPD",$JOB,"BILL","MSG",1)="Bill# TIN TYPE AMOUNT"
+8 SET ^XTMP("RCTCSPD",$JOB,"BILL","MSG",2)="----- --- ---- ------"
+9 SET X=0
SET RCNT=2
FOR
SET X=$ORDER(^XTMP("RCTCSPD",$JOB,"BILL",ACTION,X))
if X=""
QUIT
Begin DoDot:2
+10 SET RCNT=RCNT+1
+11 SET RCDAT1=$PIECE(^XTMP("RCTCSPD",$JOB,"BILL",ACTION,X),U,1)
+12 SET RCDAT2=$PIECE(^XTMP("RCTCSPD",$JOB,"BILL",ACTION,X),U,2)
+13 SET ^XTMP("RCTCSPD",$JOB,"BILL","MSG",RCNT)=$$RJZF($PIECE($GET(^PRCA(430,X,0)),U,1),7)_$$BLANK(22)_RCDAT1_" "_ACTION_" "_$SELECT(RCDAT2]"":RCDAT2,1:"")
+14 QUIT
End DoDot:2
+15 SET ^XTMP("RCTCSPD",$JOB,"BILL","MSG",RCNT+1)="Total Bills: "_(RCNT-2)
+16 SET XMTEXT="^XTMP(""RCTCSPD"","_$JOB_",""BILL"",""MSG"","
+17 DO ^XMD
+18 KILL ^XTMP("RCTCSPD",$JOB,"BILL","MSG")
End DoDot:1
+19 QUIT
+20 ;
THIRD ;sends mailman message to user if no third letter found
+1 if '$DATA(^XTMP("RCTCSPD",$JOB,"THIRD"))
QUIT
+2 NEW XMY,XMDUZ,XMSUB,XMTEXT
+3 SET XMDUZ="AR PACKAGE"
+4 SET XMY("G.TCSP")=""
+5 NEW TCT,TDEB,TDEB0,TBIL,TSP,FST
+6 SET XMSUB="TCSP QUALIFIED/NO 3RD LETTER SENT ON "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+7 SET ^XTMP("RCTCSPD",$JOB,"THIRD",1)="The following list of debtor bills were not sent to TCSP."
+8 SET ^XTMP("RCTCSPD",$JOB,"THIRD",2)="Please review debtor's account to determine why the third"
+9 SET ^XTMP("RCTCSPD",$JOB,"THIRD",3)="notice letter has not been sent:"
+10 SET ^XTMP("RCTCSPD",$JOB,"THIRD",4)="Name Bill #"
+11 SET ^XTMP("RCTCSPD",$JOB,"THIRD",5)="---- ------"
+12 SET TCT=6
SET TSP=0
SET TDEB=""
+13 FOR
SET TDEB=$ORDER(^XTMP("RCTCSPD",$JOB,"THIRD",TDEB))
if TDEB=""
QUIT
Begin DoDot:1
+14 SET FST=1
SET TBIL=""
+15 IF FST
IF TCT'=6
SET ^XTMP("RCTCSPD",$JOB,"THIRD",TCT)=""
SET TCT=TCT+1
SET TSP=TSP+1
+16 FOR
SET TBIL=$ORDER(^XTMP("RCTCSPD",$JOB,"THIRD",TDEB,TBIL))
if TBIL=""
QUIT
Begin DoDot:2
+17 SET TDEB0=$SELECT(FST:TDEB,1:"")
+18 SET ^XTMP("RCTCSPD",$JOB,"THIRD",TCT)=TDEB0_$JUSTIFY(" ",35-$LENGTH(TDEB0))_TBIL
+19 SET TCT=TCT+1
SET FST=0
End DoDot:2
End DoDot:1
+20 SET ^XTMP("RCTCSPD",$JOB,"THIRD",TCT)="Total records: "_(TCT-(6+TSP))
+21 SET XMTEXT="^XTMP(""RCTCSPD"","_$JOB_",""THIRD"","
+22 DO ^XMD
+23 KILL ^XTMP("RCTCSPD",$JOB,"THIRD")
THIRDQ QUIT
+1 ;
REC3 ;
+1 NEW REC,KNUM,DEBTNR,DEBTORNB
+2 SET REC="C3 "_ACTION_"3636001200"_"DM1D "
+3 SET KNUM=$PIECE($PIECE(B0,U,1),"-",2)
+4 ; PRCA*4.5*417
SET DEBTNR=$$AGDEBTID^RCTCSPD
SET REC=REC_DEBTNR
+5 SET DEBTORNB=$EXTRACT(SITE,1,3)_$TRANSLATE($JUSTIFY(DEBTOR,12)," ",0)
+6 SET REC=REC_DEBTORNB
+7 SET REC=REC_$SELECT(ACTION="L":"15",1:" ")
+8 SET REC=REC_"SLF"
+9 SET REC=REC_$$BLANK(8)
+10 SET REC=REC_$$AMOUNT(0)
+11 SET REC=REC_$$BLANK(16)
+12 SET REC=REC_"SLFIND"
+13 SET REC=REC_$$BLANK(450-$LENGTH(REC))
+14 SET ^XTMP("RCTCSPD",$JOB,BILL,ACTION,3)=REC
+15 SET $PIECE(^XTMP("RCTCSPD",$JOB,"BILL",ACTION,BILL),U,1)=$$TAXID(DEBTOR)
+16 QUIT
+17 ;
DATE8(X) ;changes fileman date into 8 digit date yyyymmdd
+1 IF +X
SET X=X+17000000
+2 SET X=$EXTRACT(X,1,8)
+3 QUIT X
+4 ;
AMOUNT(X) ;changes amount to zero filled, right justified
+1 if X<0
SET X=-X
+2 SET X=$TRANSLATE($JUSTIFY(X,0,2),".")
+3 SET X=$EXTRACT("000000000000",1,14-$LENGTH(X))_X
+4 QUIT X
+5 ;
BLANK(X) ;returns 'x' blank spaces
+1 NEW BLANK
+2 SET BLANK=""
SET $PIECE(BLANK," ",X+1)=""
+3 QUIT BLANK
+4 ;
RJZF(X,Y) ;right justify zero fill width Y
+1 SET X=$EXTRACT("000000000000",1,Y-$LENGTH(X))_X
+2 QUIT X
+3 ;
LJSF(X,Y) ;left justified space filled
+1 SET X=$EXTRACT(X,1,Y)
+2 SET X=X_$$BLANK(Y-$LENGTH(X))
+3 QUIT X
+4 ;
LJZF(X,Y) ;x left justified, y zero filled
+1 SET X=X_"0000000000"
+2 SET X=$EXTRACT(X,X,Y)
+3 QUIT X
+4 ;
TAXID(DEBTOR) ;computes TAXID to place on documents
+1 NEW TAXID,DIC,DA,DR,DIQ
+2 SET TAXID=$$SSN^RCFN01(DEBTOR)
+3 SET TAXID=$$LJSF(TAXID,9)
+4 QUIT TAXID
+5 ;
DTFRMTO(PROMPT) ;Get from and to dates (added as per PRCA*4.5*315 to be able to sort by dates for reports)
+1 ;INPUT:
+2 ; PROMPT - Message to display prior to prompting for dates
+3 ;OUTPUT:
+4 ; 1^BEGDT^ENDDT - Data found
+5 ; 0 - User up arrowed or timed out
+6 ;
+7 NEW %DT,Y,X,BEGDT,ENDDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT,DTFROM,DTTO
+8 SET OUT=0
+9 WRITE !,$GET(PROMPT)
+10 SET %DT="AEX"
+11 ;Enter Beginning Date: "
SET %DT("A")="Date Range: FROM: "
+12 SET %DT("B")="T-30"
+13 WRITE !
+14 DO ^%DT
+15 KILL %DT
+16 ;Quit if user time out or didn't enter valid date
if Y<0
QUIT OUT
+17 SET DTFROM=+Y
+18 SET %DT="AEX"
+19 ;"TODAY"
SET %DT("A")=" TO: "
SET %DT("B")="T"
+20 DO ^%DT
+21 KILL %DT
+22 ;Quit if user time out or didn't enter valid date
+23 if Y<0
QUIT OUT
+24 SET DTTO=+Y
+25 SET OUT=1_U_DTFROM_U_DTTO
+26 ;Switch dates if Begin Date is more recent than End Date
+27 if DTFROM>DTTO
SET OUT=1_U_DTTO_U_DTFROM
+28 QUIT OUT
+29 ;
