RCTCSP5 ;ALBANY/PAW-CROSS-SERVICING RECALL REPORT ;03/15/14 3:34 PM
;;4.5;Accounts Receivable;**315,339,433**;Mar 20, 1995;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
CSRCLRT ;
;cross-servicing recall report, prints sorted individual bills that make up a cross-servicing account
N RCSORT,PAGE,DASH,DTOUT,DUOUT,DIROUT,VALUE,SSN,PROMPT,EXCEL,RCIEN,BILLN,RCDTV,RCUSER,RCTRAN,RCDATE,TERMDIG,CURDT,DATE,DBTR
N DTFRM,DTTO,DTFRMTO,POP,ZTDESC,ZTREQ,ZTSAVE,ZTRTN,ZTSK,X,Y,DIRUT,STOP,FLAG,TRANTYP,RCARCAT ;PRCA*4.5*433
S PAGE=0,DASH="",$P(DASH,"-",91)="",SSN=0000
W !
K ^TMP("RCTCSP5",$J)
S DIR(0)="S^1:Bill Number;2:Debtor Name",DIR("A")="Sort by",DIR("B")=2 D ^DIR K DIR
S RCSORT=Y Q:($D(DTOUT)!$D(DUOUT)!$D(DIROUT))
S DTFRMTO=$$DTFRMTO^RCTCSP2 Q:'DTFRMTO ;Get date range as per PRCA*4.5*315
S (DATE,DTFRM)=$$FMADD^XLFDT(+$P(DTFRMTO,U,2)),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
I 'EXCEL W !,"It is recommended that you Queue this report to a device that is 132 characters wide. "
K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
.S ZTSAVE("RCSORT")="",ZTSAVE("EXCEL")="",ZTSAVE("DTFRM")="",ZTSAVE("DTTO")=""
.S ZTSAVE("PAGE")="",ZTSAVE("SSN")="",ZTSAVE("DASH")=""
.S ZTRTN="PRTSORT^RCTCSP5",ZTDESC="CROSS-SERVICING RECALL REPORT"
.D ^%ZTLOAD,^%ZISC
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR K DIR
.Q
;
I $E(IOST,1,2)="C-" W !!,"Compiling Cross-Servicing Recall Report. Please wait ... ",!
;
PRTSORT ;loop through all bills, find recall bills and corrsponding tranactions
K ^TMP("RCTCSP5",$J)
S (RCIEN)=0 F S RCIEN=$O(^PRCA(430,RCIEN)) Q:'RCIEN D
.S FLAG=0
.Q:('+$P($G(^PRCA(430,RCIEN,15)),U,2)) ;QUIT if 'TCSP RECALL FLAG' is Null
.I $P($G(^PRCA(430,RCIEN,15)),U,3)'="" Q:$P($G(^PRCA(430,RCIEN,15)),U,3)<DTFRM!($P($G(^PRCA(430,RCIEN,15)),U,3)>DTTO) ;If using "recall effective date" to screen
.K RCLIST,LIST,MSG D GETS^DIQ(430,RCIEN_",",".01;2;9;155;151;153;154","IE","LIST","MSG") Q:$D(LIST)<10 S RCLIST=$NA(LIST(430,RCIEN_",")) ;PRCA*4.5*433
.S DEBTOR=$P($G(^PRCA(430,RCIEN,0)),U,9)
.I '$D(^RCD(340,DEBTOR,0)) S SSN=" " ;set SSN to blank if not VA employee or Patient
.I $D(^RCD(340,DEBTOR,0)) S SSN=$E($$SSN^RCFN01($P($G(^RCD(340,DEBTOR,0)),"^")),6,9) S TERMDIG=$E(@RCLIST@(9,"E"),1)_$S(SSN'="":SSN,1:" ")
.;
.;locate recall transaction - loop thru backwards, getting the most recent transaction. stop when we find one.
.S RCUSER="",RCTRAN=""
.S RCARCAT=$E(@RCLIST@(2,"E"),1,10) ;PRCA*4.5*433
.;
.; TCSP RECALL EFFECTIVE DATE is not there
.I $P(^PRCA(430,RCIEN,15),U,3)="" D
..F S RCTRAN=$O(^PRCA(433,"C",RCIEN,RCTRAN),-1) Q:RCTRAN="" D Q:FLAG
...S TRANTYP=$$GET1^DIQ(433,RCTRAN,12) ; transaction type description
...I $F(".CS BILL RECALL.CS CASE RECALL.CS DEBTOR RECALL.CS RECALL PLACED.","."_TRANTYP_".") D
....S RCUSER=$E($$GET1^DIQ(433,RCTRAN,42),1,10),FLAG=1
.;
.; TCSP RECALL EFFECTIVE DATE exists
.I $P(^PRCA(430,RCIEN,15),U,3)'="" D
..F S RCTRAN=$O(^PRCA(433,"C",RCIEN,RCTRAN),-1) Q:RCTRAN="" D Q:FLAG
...S TRANTYP=$$GET1^DIQ(433,RCTRAN,12) ; transaction type description
...I $F(".CS BILL RECALL.CS CASE RECALL.CS DEBTOR RECALL.","."_TRANTYP_".") D
....S RCUSER=$E($$GET1^DIQ(433,RCTRAN,42),1,10),FLAG=1
.;
.;We want to sort by date, but when the date is NULL we need to use alternate
.;data field, so if a date is present use negative value otherwise use RCIEN
.;that allows us to sort by date (newest first). When we print if the number
.;is longer than 8 (negative date) char print "Pending".
.S RCDTV=@RCLIST@(153,"I"),RCDTV=$S(RCDTV'="":-RCDTV,1:RCIEN)
.I RCDTV>0 S RCDTV=-RCDTV D
..I $L(RCDTV)<10 S RCDTV=$E(-99999999,1,(11-$L(RCDTV)))_$E(RCDTV,2,9) Q ;Ensure that entries that use IEN are 9 characters, this makes empty dates float to the top
..I $E(RCDTV,2)<3 S $E(RCDTV,1,4)=-999 ;If IEN is long we need to assure that the first 4 characters are -999 , so that null dates float to the top
.;
.;write records to ^TMP
.I RCSORT=1 D
..S ^TMP("RCTCSP5",$J,@RCLIST@(.01,"E"),RCDTV)=@RCLIST@(.01,"E")_U_RCARCAT_U_$E(@RCLIST@(9,"E"),1,16)_U_TERMDIG ;PRCA*4.5*433
..S ^TMP("RCTCSP5",$J,@RCLIST@(.01,"E"),RCDTV)=^TMP("RCTCSP5",$J,@RCLIST@(.01,"E"),RCDTV)_U_$J(@RCLIST@(155,"E"),9,2)_U_$S($L(RCDTV)=8:$$FMTE^XLFDT(-RCDTV,"2Z"),1:"Pending")_U_@RCLIST@(154,"I")_"-"_$E(@RCLIST@(154,"E"),1,7)_U_RCUSER
.I RCSORT=2 D ; rewrite for EXCEL and faster processing, added User ID (as per PRCA*4.5*315)
.. I EXCEL D Q
...S ^TMP("RCTCSP5",$J,@RCLIST@(9,"E"),RCIEN,RCDTV)=$E(@RCLIST@(9,"E"),1,16)_U_RCARCAT_U_@RCLIST@(.01,"E")_U_TERMDIG_U_$J(@RCLIST@(155,"E"),9,2)_U ;PRCA*4.5*433
...S ^TMP("RCTCSP5",$J,@RCLIST@(9,"E"),RCIEN,RCDTV)=^TMP("RCTCSP5",$J,@RCLIST@(9,"E"),RCIEN,RCDTV)_$S($L(RCDTV)=8:$$FMTE^XLFDT(-RCDTV,"2Z"),1:"Pending")_U_@RCLIST@(154,"I")_"-"_$E(@RCLIST@(154,"E"),1,7)_U_RCUSER Q
..I 'EXCEL D Q
...S ^TMP("RCTCSP5",$J,@RCLIST@(9,"E"),RCIEN,RCDTV)=$E(@RCLIST@(9,"E"),1,16)_U_RCARCAT_U_@RCLIST@(.01,"E")_U_TERMDIG_U_$J(@RCLIST@(155,"E"),9,2)_U_$S($L(RCDTV)=8:$$FMTE^XLFDT(-RCDTV,"2Z"),1:"Pending") ;PRCA*4.5*433
...S ^TMP("RCTCSP5",$J,@RCLIST@(9,"E"),RCIEN,RCDTV)=^TMP("RCTCSP5",$J,@RCLIST@(9,"E"),RCIEN,RCDTV)_U_@RCLIST@(154,"I")_"-"_$E(@RCLIST@(154,"E"),1,7)_U_RCUSER
;
;^TMP global loaded, now print report
U IO
I RCSORT=1 D ;Print bill number sort
.D CSRCLH1
.S (BILLN,RCDTV)="" F S BILLN=$O(^TMP("RCTCSP5",$J,BILLN)) Q:BILLN=""!$D(DIRUT) F S RCDTV=$O(^TMP("RCTCSP5",$J,BILLN,RCDTV)) Q:RCDTV=""!$D(DIRUT) D Q:$D(DIRUT)
..I EXCEL W !,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,1,4)_U_$S($L(RCDTV)=8:$$FMTE^XLFDT(-RCDTV,"2Z"),1:"Pending")_U_$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,6,10) Q
.. ; non-Excel output
..W !,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U),?13,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,2),?25,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,3)
..W ?43,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,4),?50,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,5)
..W ?61,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,6),?71,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,7),?83,$P(^TMP("RCTCSP5",$J,BILLN,RCDTV),U,8)
..;.W !,"BILL NO.",?13,"AR CAT",?25,"DEBTOR",?43,"Pt ID",?50,"RECL AMT",?61,"RECL DT",?71,"RECALL RSN",?83,"USER ID" ;PRCA*4.5*433
..;W !,"----------",?13,"----------",?25,"----------------",?43,"-----",?50,"--------",?61,"--------",?71,"----------",?83,"-------" ;PRCA*4.5*433
.. ; check for page breaks
.. I ($Y+3)>IOSL D
... I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR K DIR Q:$D(DIRUT)
... D CSRCLH1
;
I RCSORT=2 D ;Print debtor sort
.D CSRCLH2
.S (DBTR,RCDTV,RCIEN)="" F S DBTR=$O(^TMP("RCTCSP5",$J,DBTR)) Q:DBTR=""!$D(DIRUT) F S RCIEN=$O(^TMP("RCTCSP5",$J,DBTR,RCIEN)) Q:RCIEN=""!$D(DIRUT) F S RCDTV=$O(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV)) Q:RCDTV=""!$D(DIRUT) D Q:$D(DIRUT)
..I EXCEL W !,^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV) Q
.. ; non-Excel output
..W !,$P(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV),U),?18,$P(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV),U,2)
..W ?30,$P(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV),U,3),?43,$P(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV),U,4)
..W ?49,$P(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV),U,5),?61,$P(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV),U,6)
..W ?71,$P(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV),U,7),?83,$P(^TMP("RCTCSP5",$J,DBTR,RCIEN,RCDTV),U,8)
.. ; check for page breaks
.. I ($Y+3)>IOSL D
... I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR K DIR Q:$D(DIRUT)
... D CSRCLH2
;
;Finish up report
I '$D(^TMP("RCTCSP5",$J)) W !,"No records found",!!
K ^TMP("RCTCSP5",$J)
I $E(IOST,1,2)="C-",'$D(DIRUT) R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
K IOP,%ZIS,ZTQUEUED
Q
;
CSRCLH1 ;header for cross-servicing recall report 1
S PAGE=PAGE+1
I 'EXCEL D Q
.W @IOF
.W !,"PAGE "_PAGE,?12,"CROSS-SERVICING RECALL REPORT (SORTED BY BILL NUMBER)",?81,$$FMTE^XLFDT(DT,"2Z") ;PRCA*4.5*433
.W !,DASH
.W !,"BILL NO.",?13,"AR CAT",?25,"DEBTOR",?43,"Pt ID",?50,"RECL AMT",?61,"RECL DT",?71,"RECALL RSN",?83,"USER ID" ;PRCA*4.5*433
.W !,"----------",?13,"----------",?25,"----------------",?43,"-----",?50,"---------",?61,"--------",?71,"----------",?83,"-------" ;PRCA*4.5*433
;EXCEL FORM
W !,"PAGE "_PAGE_U_U_"CS RECALL RPT (BILL)"_U_U_$$FMTE^XLFDT(DT,"2Z")
W !,"BILL NO."_U_"AR CAT"_U_"DEBTOR"_U_"Pt ID"_U_"RECL AMT"_U_"RECALL DT"_U_"RECALL RSN"_U_"USER ID" ;PRCA*4.5*433
Q
;
CSRCLH2 ;header for cross-servicing recall report 2
S PAGE=PAGE+1
I 'EXCEL D Q
.W @IOF
.W !,"PAGE "_PAGE,?14,"CROSS-SERVICING RECALL REPORT (SORTED BY DEBTOR)",?81,$$FMTE^XLFDT(DT,"2Z") ;PRCA*4.5*433
.W !,DASH
.W !,"DEBTOR",?18,"AR CAT",?30,"BILL NO.",?43,"Pt ID",?50,"RECL AMT",?61,"RECL DT",?71,"RECALL RSN",?83,"USER ID" ;PRCA*4.5*433
.W !,"----------------",?18,"----------",?30,"-----------",?43,"-----",?50,"--------",?61,"--------",?71,"----------",?83,"-------" ;PRCA*4.5*433
;EXCEL FORMAT
W !,"PAGE "_PAGE_U_U_"CS RECALL RPT (DEBTOR)"_U_U_$$FMTE^XLFDT(DT,"2Z")
W !,"DEBTOR"_U_"AR CAT"_U_"BILL NO."_U_"Pt ID"_U_"RECL AMT"_U_"RECALL DT"_U_"RECALL RSN"_U_"USER ID" ;PRCA*4.5*433
Q
;
IAIRPT ;Treasury Cross-Servicing IAI Report
;This report displays a record of current VHA bills at Treasury. It is a tool that can be used to identify bills erroneously
;listed in a referral status in VistA when reconciled with the Print Cross-Servicing Report.
;
N RDATES,RDGBL,NODE,PAGE,DASH,EXCEL,DEBTOR,BILLDA,RCBILL,CNT,CURDT,POP,RCNAME,ZTDESC,ZTREQ,ZTSAVE,ZTSK,ZTRTN,X,Y,STOP,DIRUT
S PAGE=0,DASH="",$P(DASH,"-",78)=""
;Get available report dates
S RDGBL="RCTCSP6",CNT=1 F S RDGBL=$O(^XTMP(RDGBL),-1) Q:RDGBL=""!($E(RDGBL,1)="Q") I RDGBL["RCTCSP5" D
. I $P(RDGBL," - ",2)="" S VALUE="No report data to print" Q
. S RDATES(CNT)=$P(RDGBL," - ",2)_U_$$FMTE^XLFDT($P(RDGBL," - ",2),"2Z"),RDGBL(CNT)=RDGBL,CNT=CNT+1
. Q
I '$D(RDATES(1)) W !,?5,"There is no data available for the report, quitting.",! Q
; Show dates sorted by newest first and only show the last two report dates if they exist
I '$D(RDATES(2)) S DIR(0)="S^1:"_$P(RDATES(1),U,2),DIR("A")="Print date?",DIR("B")=1 D ^DIR K DIR
I $D(RDATES(2)) S DIR(0)="S^1:"_$P(RDATES(1),U,2)_";2:"_$P(RDATES(2),U,2),DIR("A")=" Print IAI report date?",DIR("B")=1 D ^DIR K DIR
Q:$G(DUOUT)
S NODE=RDGBL(Y),RDATES=+RDATES(Y)
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("NODE")="",ZTSAVE("EXCEL")="",ZTSAVE("RDATES")=""
.S ZTRTN="IAIPRNT^RCTCSP5",ZTDESC="CROSS-SERVICING IAI REPORT"
.D ^%ZTLOAD,^%ZISC
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",!
.Q
.;
IAIPRNT ;
N GETNM,GETBL,GLO
S PAGE=0
S GLO=$NA(^TMP("RCTCSP5",$J)) K @GLO
U IO
D IAIHDR
;
; report compile
S DEBTOR=0 F S DEBTOR=$O(^XTMP(NODE,DEBTOR)) Q:'DEBTOR D
. S BILLDA="" F S BILLDA=$O(^XTMP(NODE,DEBTOR,BILLDA)) Q:'BILLDA D
..S RCBILL=$P($G(^PRCA(430,BILLDA,0)),U),RCNAME=$E($$GET1^DIQ(430,BILLDA,9),1,20)
..S SSN=$S($P($G(^RCD(340,DEBTOR,0)),U)'="":$$SSN^RCFN01($P(^RCD(340,DEBTOR,0),"^")),1:"None")
..I SSN<1 S SSN="None"
..S @GLO@(RCNAME,RCBILL)=RCBILL_U_RCNAME_U_SSN Q
;
; report print
S GETNM="" F S GETNM=$O(@GLO@(GETNM)) Q:GETNM=""!$D(DIRUT) S GETBL="" F S GETBL=$O(@GLO@(GETNM,GETBL)) Q:GETBL=""!$D(DIRUT) D Q:$D(DIRUT)
.I 'EXCEL W $P(@GLO@(GETNM,GETBL),U),?15,$P(@GLO@(GETNM,GETBL),U,2),?40,$P(@GLO@(GETNM,GETBL),U,3),!
.I EXCEL W @GLO@(GETNM,GETBL),!
.;check for end of page here, if necessary form feed and print header
.I 'EXCEL,($Y+3)>IOSL D
..I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)
..D IAIHDR
I 'EXCEL,'$D(DIRUT),$E(IOST,1,2)="C-" R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
K @GLO
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
IAIHDR ;
S PAGE=PAGE+1
I 'EXCEL D Q
.W @IOF
.W ?10,"Treasury Cross-Servicing IAI Report",!!,"IAI data compiled date: ",$$FMTE^XLFDT(RDATES,"2Z"),?50,"Page ",PAGE
.W !!,"Bill Number",?20,"Debtor",?43,"SSN"
.W !,"-----------",?15,"-----------------------",?40,"---------",!
;EXCEL FORMAT
W !,"PAGE "_PAGE_U_U_"Treasury Cross-Servicing IAI Report"_U_U_$$FMTE^XLFDT(RDATES,"2Z")
W !,"Bill Number"_U_"Debtor"_U_"SSN",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSP5 12756 printed Nov 22, 2024@16:59:04 Page 2
RCTCSP5 ;ALBANY/PAW-CROSS-SERVICING RECALL REPORT ;03/15/14 3:34 PM
+1 ;;4.5;Accounts Receivable;**315,339,433**;Mar 20, 1995;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
CSRCLRT ;
+1 ;cross-servicing recall report, prints sorted individual bills that make up a cross-servicing account
+2 NEW RCSORT,PAGE,DASH,DTOUT,DUOUT,DIROUT,VALUE,SSN,PROMPT,EXCEL,RCIEN,BILLN,RCDTV,RCUSER,RCTRAN,RCDATE,TERMDIG,CURDT,DATE,DBTR
+3 ;PRCA*4.5*433
NEW DTFRM,DTTO,DTFRMTO,POP,ZTDESC,ZTREQ,ZTSAVE,ZTRTN,ZTSK,X,Y,DIRUT,STOP,FLAG,TRANTYP,RCARCAT
+4 SET PAGE=0
SET DASH=""
SET $PIECE(DASH,"-",91)=""
SET SSN=0000
+5 WRITE !
+6 KILL ^TMP("RCTCSP5",$JOB)
+7 SET DIR(0)="S^1:Bill Number;2:Debtor Name"
SET DIR("A")="Sort by"
SET DIR("B")=2
DO ^DIR
KILL DIR
+8 SET RCSORT=Y
if ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT))
QUIT
+9 ;Get date range as per PRCA*4.5*315
SET DTFRMTO=$$DTFRMTO^RCTCSP2
if 'DTFRMTO
QUIT
+10 SET (DATE,DTFRM)=$$FMADD^XLFDT(+$PIECE(DTFRMTO,U,2))
SET DTTO=$PIECE(DTFRMTO,U,3)
SET CURDT=0
+11 SET EXCEL=0
SET PROMPT="CAPTURE Report data to an Excel Document"
SET DIR(0)="Y"
SET DIR("?")="^D HEXC^RCTCSJR"
+12 SET EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO")
IF "01"'[EXCEL
SET STOP=1
QUIT
+13 ; Display Excel display message
IF EXCEL=1
DO EXCMSG^RCTCSJR
+14 IF 'EXCEL
WRITE !,"It is recommended that you Queue this report to a device that is 132 characters wide. "
+15 KILL IOP,IO("Q")
SET %ZIS="MQ"
SET %ZIS("B")=""
DO ^%ZIS
if POP
QUIT
+16 IF $DATA(IO("Q"))
Begin DoDot:1
+17 SET ZTSAVE("RCSORT")=""
SET ZTSAVE("EXCEL")=""
SET ZTSAVE("DTFRM")=""
SET ZTSAVE("DTTO")=""
+18 SET ZTSAVE("PAGE")=""
SET ZTSAVE("SSN")=""
SET ZTSAVE("DASH")=""
+19 SET ZTRTN="PRTSORT^RCTCSP5"
SET ZTDESC="CROSS-SERVICING RECALL REPORT"
+20 DO ^%ZTLOAD
DO ^%ZISC
+21 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
+22 QUIT
End DoDot:1
QUIT
+23 ;
+24 IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Compiling Cross-Servicing Recall Report. Please wait ... ",!
+25 ;
PRTSORT ;loop through all bills, find recall bills and corrsponding tranactions
+1 KILL ^TMP("RCTCSP5",$JOB)
+2 SET (RCIEN)=0
FOR
SET RCIEN=$ORDER(^PRCA(430,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:1
+3 SET FLAG=0
+4 ;QUIT if 'TCSP RECALL FLAG' is Null
if ('+$PIECE($GET(^PRCA(430,RCIEN,15)),U,2))
QUIT
+5 ;If using "recall effective date" to screen
IF $PIECE($GET(^PRCA(430,RCIEN,15)),U,3)'=""
if $PIECE($GET(^PRCA(430,RCIEN,15)),U,3)<DTFRM!($PIECE($GET(^PRCA(430,RCIEN,15)),U,3)>DTTO)
QUIT
+6 ;PRCA*4.5*433
KILL RCLIST,LIST,MSG
DO GETS^DIQ(430,RCIEN_",",".01;2;9;155;151;153;154","IE","LIST","MSG")
if $DATA(LIST)<10
QUIT
SET RCLIST=$NAME(LIST(430,RCIEN_","))
+7 SET DEBTOR=$PIECE($GET(^PRCA(430,RCIEN,0)),U,9)
+8 ;set SSN to blank if not VA employee or Patient
IF '$DATA(^RCD(340,DEBTOR,0))
SET SSN=" "
+9 IF $DATA(^RCD(340,DEBTOR,0))
SET SSN=$EXTRACT($$SSN^RCFN01($PIECE($GET(^RCD(340,DEBTOR,0)),"^")),6,9)
SET TERMDIG=$EXTRACT(@RCLIST@(9,"E"),1)_$SELECT(SSN'="":SSN,1:" ")
+10 ;
+11 ;locate recall transaction - loop thru backwards, getting the most recent transaction. stop when we find one.
+12 SET RCUSER=""
SET RCTRAN=""
+13 ;PRCA*4.5*433
SET RCARCAT=$EXTRACT(@RCLIST@(2,"E"),1,10)
+14 ;
+15 ; TCSP RECALL EFFECTIVE DATE is not there
+16 IF $PIECE(^PRCA(430,RCIEN,15),U,3)=""
Begin DoDot:2
+17 FOR
SET RCTRAN=$ORDER(^PRCA(433,"C",RCIEN,RCTRAN),-1)
if RCTRAN=""
QUIT
Begin DoDot:3
+18 ; transaction type description
SET TRANTYP=$$GET1^DIQ(433,RCTRAN,12)
+19 IF $FIND(".CS BILL RECALL.CS CASE RECALL.CS DEBTOR RECALL.CS RECALL PLACED.","."_TRANTYP_".")
Begin DoDot:4
+20 SET RCUSER=$EXTRACT($$GET1^DIQ(433,RCTRAN,42),1,10)
SET FLAG=1
End DoDot:4
End DoDot:3
if FLAG
QUIT
End DoDot:2
+21 ;
+22 ; TCSP RECALL EFFECTIVE DATE exists
+23 IF $PIECE(^PRCA(430,RCIEN,15),U,3)'=""
Begin DoDot:2
+24 FOR
SET RCTRAN=$ORDER(^PRCA(433,"C",RCIEN,RCTRAN),-1)
if RCTRAN=""
QUIT
Begin DoDot:3
+25 ; transaction type description
SET TRANTYP=$$GET1^DIQ(433,RCTRAN,12)
+26 IF $FIND(".CS BILL RECALL.CS CASE RECALL.CS DEBTOR RECALL.","."_TRANTYP_".")
Begin DoDot:4
+27 SET RCUSER=$EXTRACT($$GET1^DIQ(433,RCTRAN,42),1,10)
SET FLAG=1
End DoDot:4
End DoDot:3
if FLAG
QUIT
End DoDot:2
+28 ;
+29 ;We want to sort by date, but when the date is NULL we need to use alternate
+30 ;data field, so if a date is present use negative value otherwise use RCIEN
+31 ;that allows us to sort by date (newest first). When we print if the number
+32 ;is longer than 8 (negative date) char print "Pending".
+33 SET RCDTV=@RCLIST@(153,"I")
SET RCDTV=$SELECT(RCDTV'="":-RCDTV,1:RCIEN)
+34 IF RCDTV>0
SET RCDTV=-RCDTV
Begin DoDot:2
+35 ;Ensure that entries that use IEN are 9 characters, this makes empty dates float to the top
IF $LENGTH(RCDTV)<10
SET RCDTV=$EXTRACT(-99999999,1,(11-$LENGTH(RCDTV)))_$EXTRACT(RCDTV,2,9)
QUIT
+36 ;If IEN is long we need to assure that the first 4 characters are -999 , so that null dates float to the top
IF $EXTRACT(RCDTV,2)<3
SET $EXTRACT(RCDTV,1,4)=-999
End DoDot:2
+37 ;
+38 ;write records to ^TMP
+39 IF RCSORT=1
Begin DoDot:2
+40 ;PRCA*4.5*433
SET ^TMP("RCTCSP5",$JOB,@RCLIST@(.01,"E"),RCDTV)=@RCLIST@(.01,"E")_U_RCARCAT_U_$EXTRACT(@RCLIST@(9,"E"),1,16)_U_TERMDIG
+41 SET ^TMP("RCTCSP5",$JOB,@RCLIST@(.01,"E"),RCDTV)=^TMP("RCTCSP5",$JOB,@RCLIST@(.01,"E"),RCDTV)_U_$JUSTIFY(@RCLIST@(155,"E"),9,2)_U_$SELECT($LENGTH(RCDTV)=8:$$FMTE^XLFDT(-RCDTV,"2Z"),1:"Pending")_U_@RCLIST@(154,"I")_"-"_...
... $EXTRACT(@RCLIST@(154,"E"),1,7)_U_RCUSER
End DoDot:2
+42 ; rewrite for EXCEL and faster processing, added User ID (as per PRCA*4.5*315)
IF RCSORT=2
Begin DoDot:2
+43 IF EXCEL
Begin DoDot:3
+44 ;PRCA*4.5*433
SET ^TMP("RCTCSP5",$JOB,@RCLIST@(9,"E"),RCIEN,RCDTV)=$EXTRACT(@RCLIST@(9,"E"),1,16)_U_RCARCAT_U_@RCLIST@(.01,"E")_U_TERMDIG_U_$JUSTIFY(@RCLIST@(155,"E"),9,2)_U
+45 SET ^TMP("RCTCSP5",$JOB,@RCLIST@(9,"E"),RCIEN,RCDTV)=^TMP("RCTCSP5",$JOB,@RCLIST@(9,"E"),RCIEN,RCDTV)_$SELECT($LENGTH(RCDTV)=8:$$FMTE^XLFDT(-RCDTV,"2Z"),1:"Pending")_U_@RCLIST@(154,"I")_"-"_$EXTRACT(@RCLIST@(154,"E"),1,7
)_U_RCUSER
QUIT
End DoDot:3
QUIT
+46 IF 'EXCEL
Begin DoDot:3
+47 ;PRCA*4.5*433
SET ^TMP("RCTCSP5",$JOB,@RCLIST@(9,"E"),RCIEN,RCDTV)=$EXTRACT(@RCLIST@(9,"E"),1,16)_U_RCARCAT_U_@RCLIST@(.01,"E")_U_TERMDIG_U_$JUSTIFY(@RCLIST@(155,"E"),9,2)_U_$SELECT($LENGTH(RCDTV)=8:$$FMTE^XLFDT(-RCDTV,"2Z"),1:"Pendin
g")
+48 SET ^TMP("RCTCSP5",$JOB,@RCLIST@(9,"E"),RCIEN,RCDTV)=^TMP("RCTCSP5",$JOB,@RCLIST@(9,"E"),RCIEN,RCDTV)_U_@RCLIST@(154,"I")_"-"_$EXTRACT(@RCLIST@(154,"E"),1,7)_U_RCUSER
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+49 ;
+50 ;^TMP global loaded, now print report
+51 USE IO
+52 ;Print bill number sort
IF RCSORT=1
Begin DoDot:1
+53 DO CSRCLH1
+54 SET (BILLN,RCDTV)=""
FOR
SET BILLN=$ORDER(^TMP("RCTCSP5",$JOB,BILLN))
if BILLN=""!$DATA(DIRUT)
QUIT
FOR
SET RCDTV=$ORDER(^TMP("RCTCSP5",$JOB,BILLN,RCDTV))
if RCDTV=""!$DATA(DIRUT)
QUIT
Begin DoDot:2
+55 IF EXCEL
WRITE !,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,1,4)_U_$SELECT($LENGTH(RCDTV)=8:$$FMTE^XLFDT(-RCDTV,"2Z"),1:"Pending")_U_$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,6,10)
QUIT
+56 ; non-Excel output
+57 WRITE !,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U),?13,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,2),?25,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,3)
+58 WRITE ?43,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,4),?50,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,5)
+59 WRITE ?61,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,6),?71,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,7),?83,$PIECE(^TMP("RCTCSP5",$JOB,BILLN,RCDTV),U,8)
+60 ;.W !,"BILL NO.",?13,"AR CAT",?25,"DEBTOR",?43,"Pt ID",?50,"RECL AMT",?61,"RECL DT",?71,"RECALL RSN",?83,"USER ID" ;PRCA*4.5*433
+61 ;W !,"----------",?13,"----------",?25,"----------------",?43,"-----",?50,"--------",?61,"--------",?71,"----------",?83,"-------" ;PRCA*4.5*433
+62 ; check for page breaks
+63 IF ($Y+3)>IOSL
Begin DoDot:3
+64 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
KILL DIRUT
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+65 DO CSRCLH1
End DoDot:3
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
+66 ;
+67 ;Print debtor sort
IF RCSORT=2
Begin DoDot:1
+68 DO CSRCLH2
+69 SET (DBTR,RCDTV,RCIEN)=""
FOR
SET DBTR=$ORDER(^TMP("RCTCSP5",$JOB,DBTR))
if DBTR=""!$DATA(DIRUT)
QUIT
FOR
SET RCIEN=$ORDER(^TMP("RCTCSP5",$JOB,DBTR,RCIEN))
if RCIEN=""!$DATA(DIRUT)
QUIT
FOR
SET RCDTV=$ORDER(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV))
if RCDTV=""!$DATA(DIRUT)
QUIT
Begin DoDot:2
+70 IF EXCEL
WRITE !,^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV)
QUIT
+71 ; non-Excel output
+72 WRITE !,$PIECE(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV),U),?18,$PIECE(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV),U,2)
+73 WRITE ?30,$PIECE(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV),U,3),?43,$PIECE(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV),U,4)
+74 WRITE ?49,$PIECE(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV),U,5),?61,$PIECE(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV),U,6)
+75 WRITE ?71,$PIECE(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV),U,7),?83,$PIECE(^TMP("RCTCSP5",$JOB,DBTR,RCIEN,RCDTV),U,8)
+76 ; check for page breaks
+77 IF ($Y+3)>IOSL
Begin DoDot:3
+78 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
KILL DIRUT
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+79 DO CSRCLH2
End DoDot:3
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
+80 ;
+81 ;Finish up report
+82 IF '$DATA(^TMP("RCTCSP5",$JOB))
WRITE !,"No records found",!!
+83 KILL ^TMP("RCTCSP5",$JOB)
+84 IF $EXTRACT(IOST,1,2)="C-"
IF '$DATA(DIRUT)
READ !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME
WRITE @IOF
+85 DO ^%ZISC
+86 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+87 KILL IOP,%ZIS,ZTQUEUED
+88 QUIT
+89 ;
CSRCLH1 ;header for cross-servicing recall report 1
+1 SET PAGE=PAGE+1
+2 IF 'EXCEL
Begin DoDot:1
+3 WRITE @IOF
+4 ;PRCA*4.5*433
WRITE !,"PAGE "_PAGE,?12,"CROSS-SERVICING RECALL REPORT (SORTED BY BILL NUMBER)",?81,$$FMTE^XLFDT(DT,"2Z")
+5 WRITE !,DASH
+6 ;PRCA*4.5*433
WRITE !,"BILL NO.",?13,"AR CAT",?25,"DEBTOR",?43,"Pt ID",?50,"RECL AMT",?61,"RECL DT",?71,"RECALL RSN",?83,"USER ID"
+7 ;PRCA*4.5*433
WRITE !,"----------",?13,"----------",?25,"----------------",?43,"-----",?50,"---------",?61,"--------",?71,"----------",?83,"-------"
End DoDot:1
QUIT
+8 ;EXCEL FORM
+9 WRITE !,"PAGE "_PAGE_U_U_"CS RECALL RPT (BILL)"_U_U_$$FMTE^XLFDT(DT,"2Z")
+10 ;PRCA*4.5*433
WRITE !,"BILL NO."_U_"AR CAT"_U_"DEBTOR"_U_"Pt ID"_U_"RECL AMT"_U_"RECALL DT"_U_"RECALL RSN"_U_"USER ID"
+11 QUIT
+12 ;
CSRCLH2 ;header for cross-servicing recall report 2
+1 SET PAGE=PAGE+1
+2 IF 'EXCEL
Begin DoDot:1
+3 WRITE @IOF
+4 ;PRCA*4.5*433
WRITE !,"PAGE "_PAGE,?14,"CROSS-SERVICING RECALL REPORT (SORTED BY DEBTOR)",?81,$$FMTE^XLFDT(DT,"2Z")
+5 WRITE !,DASH
+6 ;PRCA*4.5*433
WRITE !,"DEBTOR",?18,"AR CAT",?30,"BILL NO.",?43,"Pt ID",?50,"RECL AMT",?61,"RECL DT",?71,"RECALL RSN",?83,"USER ID"
+7 ;PRCA*4.5*433
WRITE !,"----------------",?18,"----------",?30,"-----------",?43,"-----",?50,"--------",?61,"--------",?71,"----------",?83,"-------"
End DoDot:1
QUIT
+8 ;EXCEL FORMAT
+9 WRITE !,"PAGE "_PAGE_U_U_"CS RECALL RPT (DEBTOR)"_U_U_$$FMTE^XLFDT(DT,"2Z")
+10 ;PRCA*4.5*433
WRITE !,"DEBTOR"_U_"AR CAT"_U_"BILL NO."_U_"Pt ID"_U_"RECL AMT"_U_"RECALL DT"_U_"RECALL RSN"_U_"USER ID"
+11 QUIT
+12 ;
IAIRPT ;Treasury Cross-Servicing IAI Report
+1 ;This report displays a record of current VHA bills at Treasury. It is a tool that can be used to identify bills erroneously
+2 ;listed in a referral status in VistA when reconciled with the Print Cross-Servicing Report.
+3 ;
+4 NEW RDATES,RDGBL,NODE,PAGE,DASH,EXCEL,DEBTOR,BILLDA,RCBILL,CNT,CURDT,POP,RCNAME,ZTDESC,ZTREQ,ZTSAVE,ZTSK,ZTRTN,X,Y,STOP,DIRUT
+5 SET PAGE=0
SET DASH=""
SET $PIECE(DASH,"-",78)=""
+6 ;Get available report dates
+7 SET RDGBL="RCTCSP6"
SET CNT=1
FOR
SET RDGBL=$ORDER(^XTMP(RDGBL),-1)
if RDGBL=""!($EXTRACT(RDGBL,1)="Q")
QUIT
IF RDGBL["RCTCSP5"
Begin DoDot:1
+8 IF $PIECE(RDGBL," - ",2)=""
SET VALUE="No report data to print"
QUIT
+9 SET RDATES(CNT)=$PIECE(RDGBL," - ",2)_U_$$FMTE^XLFDT($PIECE(RDGBL," - ",2),"2Z")
SET RDGBL(CNT)=RDGBL
SET CNT=CNT+1
+10 QUIT
End DoDot:1
+11 IF '$DATA(RDATES(1))
WRITE !,?5,"There is no data available for the report, quitting.",!
QUIT
+12 ; Show dates sorted by newest first and only show the last two report dates if they exist
+13 IF '$DATA(RDATES(2))
SET DIR(0)="S^1:"_$PIECE(RDATES(1),U,2)
SET DIR("A")="Print date?"
SET DIR("B")=1
DO ^DIR
KILL DIR
+14 IF $DATA(RDATES(2))
SET DIR(0)="S^1:"_$PIECE(RDATES(1),U,2)_";2:"_$PIECE(RDATES(2),U,2)
SET DIR("A")=" Print IAI report date?"
SET DIR("B")=1
DO ^DIR
KILL DIR
+15 if $GET(DUOUT)
QUIT
+16 SET NODE=RDGBL(Y)
SET RDATES=+RDATES(Y)
+17 SET EXCEL=0
SET PROMPT="CAPTURE Report data to an Excel Document"
SET DIR(0)="Y"
SET DIR("?")="^D HEXC^RCTCSJR"
+18 SET EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO")
IF "01"'[EXCEL
SET STOP=1
QUIT
+19 ; Display Excel display message
IF EXCEL=1
DO EXCMSG^RCTCSJR
+20 ;
+21 KILL IOP,IO("Q")
SET %ZIS="MQ"
SET %ZIS("B")=""
DO ^%ZIS
if POP
QUIT
+22 IF $DATA(IO("Q"))
Begin DoDot:1
+23 SET ZTSAVE("NODE")=""
SET ZTSAVE("EXCEL")=""
SET ZTSAVE("RDATES")=""
+24 SET ZTRTN="IAIPRNT^RCTCSP5"
SET ZTDESC="CROSS-SERVICING IAI REPORT"
+25 DO ^%ZTLOAD
DO ^%ZISC
+26 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
+27 QUIT
+28 ;
End DoDot:1
QUIT
IAIPRNT ;
+1 NEW GETNM,GETBL,GLO
+2 SET PAGE=0
+3 SET GLO=$NAME(^TMP("RCTCSP5",$JOB))
KILL @GLO
+4 USE IO
+5 DO IAIHDR
+6 ;
+7 ; report compile
+8 SET DEBTOR=0
FOR
SET DEBTOR=$ORDER(^XTMP(NODE,DEBTOR))
if 'DEBTOR
QUIT
Begin DoDot:1
+9 SET BILLDA=""
FOR
SET BILLDA=$ORDER(^XTMP(NODE,DEBTOR,BILLDA))
if 'BILLDA
QUIT
Begin DoDot:2
+10 SET RCBILL=$PIECE($GET(^PRCA(430,BILLDA,0)),U)
SET RCNAME=$EXTRACT($$GET1^DIQ(430,BILLDA,9),1,20)
+11 SET SSN=$SELECT($PIECE($GET(^RCD(340,DEBTOR,0)),U)'="":$$SSN^RCFN01($PIECE(^RCD(340,DEBTOR,0),"^")),1:"None")
+12 IF SSN<1
SET SSN="None"
+13 SET @GLO@(RCNAME,RCBILL)=RCBILL_U_RCNAME_U_SSN
QUIT
End DoDot:2
End DoDot:1
+14 ;
+15 ; report print
+16 SET GETNM=""
FOR
SET GETNM=$ORDER(@GLO@(GETNM))
if GETNM=""!$DATA(DIRUT)
QUIT
SET GETBL=""
FOR
SET GETBL=$ORDER(@GLO@(GETNM,GETBL))
if GETBL=""!$DATA(DIRUT)
QUIT
Begin DoDot:1
+17 IF 'EXCEL
WRITE $PIECE(@GLO@(GETNM,GETBL),U),?15,$PIECE(@GLO@(GETNM,GETBL),U,2),?40,$PIECE(@GLO@(GETNM,GETBL),U,3),!
+18 IF EXCEL
WRITE @GLO@(GETNM,GETBL),!
+19 ;check for end of page here, if necessary form feed and print header
+20 IF 'EXCEL
IF ($Y+3)>IOSL
Begin DoDot:2
+21 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
KILL DIRUT
DO ^DIR
if $DATA(DIRUT)
QUIT
+22 DO IAIHDR
End DoDot:2
End DoDot:1
if $DATA(DIRUT)
QUIT
+23 IF 'EXCEL
IF '$DATA(DIRUT)
IF $EXTRACT(IOST,1,2)="C-"
READ !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME
WRITE @IOF
+24 KILL @GLO
+25 DO ^%ZISC
+26 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+27 QUIT
+28 ;
IAIHDR ;
+1 SET PAGE=PAGE+1
+2 IF 'EXCEL
Begin DoDot:1
+3 WRITE @IOF
+4 WRITE ?10,"Treasury Cross-Servicing IAI Report",!!,"IAI data compiled date: ",$$FMTE^XLFDT(RDATES,"2Z"),?50,"Page ",PAGE
+5 WRITE !!,"Bill Number",?20,"Debtor",?43,"SSN"
+6 WRITE !,"-----------",?15,"-----------------------",?40,"---------",!
End DoDot:1
QUIT
+7 ;EXCEL FORMAT
+8 WRITE !,"PAGE "_PAGE_U_U_"Treasury Cross-Servicing IAI Report"_U_U_$$FMTE^XLFDT(RDATES,"2Z")
+9 WRITE !,"Bill Number"_U_"Debtor"_U_"SSN",!
+10 QUIT
