- RCTCSP6 ;ALB/YG - Cross-Servicing Re-Referred Bills Report;03/15/14 3:34 PM
- ;;4.5;Accounts Receivable;**350,433**;Mar 20, 1995;Build 7
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;
- MAIN ;PRCA*4.5*350
- ;
- BILLREP ;Cross-servicing bill report, prints individual bills that make up a cross-servicing account
- N DIC,DEBTOR,ZTSAVE,ZTDESC,ZTRTN,POP,DTFRMTO,PROMPT,EXCEL,RUNDATE,PAGE,DFN
- S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
- K ^TMP("RCTCSP1",$J)
- S PAGE=0
- W !,"*** Cross-Servicing Re-Referred Bills Report ***",!
- W !,"The Cross-Servicing Re-Referred Bills Report provides a list of all bills"
- W !,"that have been re-referred to Cross-Servicing.",!
- ;S DIC=340,DIC(0)="AEQM",DIC("S")="I $D(^RCD(340,""TCSP"",+Y))" D ^DIC
- ;Q:Y<1 S DEBTOR=+Y
- ;S DTFRMTO=$$DTFRMTO^RCTCSP2 Q:'DTFRMTO ;Get date range as per PRCA*4.5*315
- S DTFRMTO=$$DATE2^RCDMCUT2(" Enter the Date Range for Bills that have been Re-Referred for Cross-Servicing: ",,"T-7")
- S EXCEL=0,PROMPT="CAPTURE Report data to an Excel Document",DIR(0)="Y",DIR("?")="^D HEXC^RCTCSJR"
- ;S EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO")
- S EXCEL=$$EXCEL^RCDMCUT2
- I "01"'[EXCEL Q
- I EXCEL 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. "
- S %ZIS="MQ" D ^%ZIS G:POP BILLREPQ ;PRC*4.5*336
- I $D(IO("Q")) D G BILLREPQ
- .S ZTSAVE("DEBTOR")="",ZTSAVE("DTFRMTO")="",ZTSAVE("EXCEL")=""
- .S ZTRTN="BILLREPP^RCTCSP6",ZTDESC="CROSS-SERVICING BILL 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
- ;
- BILLREPP ;Call to build array of bills referred
- U IO
- N BILL,B7,B14,B15,B16,D4,FND,BAMT,DIRUT,TNM,TID,TDT,DASH,CSTAT,PAGE,DASH,TMP,I,DATE,DTFRM,DTTO,DATDATE,REASON,COMMENT,USER,OAMT,LIEN,NAME,NODE,SSN,PTID,RCARCAT
- K ^TMP("RCTCSP6",$J)
- S DASH="",$P(DASH,"-",78)="" ;(as per PRCA*4.5*315)
- S (DATE,DTFRM)=$$FMADD^XLFDT(+$P(DTFRMTO,U,2)),DTTO=$P(DTFRMTO,U,3)
- S (BAMT,BILL,PAGE)=0
- ; rewritten to sort by "TCSP" (#151 date referred to TCSP) not the "AB" xref... PRCA*4.5*315 (TV8)
- F S BILL=$O(^PRCA(430,"TCSP",BILL)) Q:BILL=""!($D(DIRUT)) D:$$RR^RCTCSPU(BILL)
- .S DEBTOR=$P($G(^PRCA(430,BILL,0)),U,9)
- .S DFN=$P($G(^RCD(340,DEBTOR,0)),U) Q:DFN'[";DPT"
- .S DFN=+DFN
- .D DEM^VADPT
- .I $G(VAERR)>0 D KVAR^VADPT Q
- .S NAME=$G(VADM(1))
- .I NAME']"" D KVAR^VADPT Q
- .S SSN=$P(VADM(2),U,1)
- .S PTID=$E(VADM(1),1)_$S(SSN'="":$E(SSN,6,9),1:"0000") ;PRCA*4.5*433
- .Q:'+$G(^PRCA(430,BILL,15))
- .S DATDATE=$P($G(^PRCA(430,BILL,15)),U) Q:DATDATE<DTFRM!(DATDATE>DTTO)
- .S B7=$G(^PRCA(430,BILL,7))
- .S BAMT=0 F I=1:1:5 S BAMT=BAMT+$P(B7,U,I)
- .S ^TMP("RCTCSP6",$J,DEBTOR,BILL)=BAMT_U_NAME_U_SSN
- D BILLREPH
- S DEBTOR="" F S DEBTOR=$O(^TMP("RCTCSP6",$J,DEBTOR)) Q:'DEBTOR!($D(DIRUT)) D Q:$D(DIRUT)
- . S BILL=0 F S BILL=$O(^TMP("RCTCSP6",$J,DEBTOR,BILL)) Q:'BILL D Q:$D(DIRUT)
- ..Q:'+$G(^PRCA(430,BILL,15))
- ..S RCARCAT=$$GET1^DIQ(430,BILL,2,"E") ;PRCA*4.5*433
- ..S NODE=^TMP("RCTCSP6",$J,DEBTOR,BILL),BAMT=$P(NODE,U),NAME=$P(NODE,U,2),SSN=$P(NODE,U,3)
- ..S FND=1 W !,$P(^PRCA(430,BILL,0),U) ; Bill
- ..I 'EXCEL W ?12,$E(RCARCAT,1,9) ;PRCA*4.5*433
- ..I EXCEL W U,$E(RCARCAT,1,9) ;PRCA*4.5*433
- ..S CSTAT=$P(^(0),U,8),B7=$G(^(7)),B15=$G(^(15)),B16=$G(^(16))
- ..I 'EXCEL W ?22,$E(NAME,1,17) ; Name ;PRCA*4.5*433
- ..I EXCEL W U,NAME
- ..I 'EXCEL W ?40,PTID ; Patient ID ;PRCA*4.5*433
- ..I EXCEL W U,PTID
- ..I 'EXCEL W ?46,$$FMTE^XLFDT($P(B15,U,1),"2Z") ; Rerefer date ;PRCA*4.5*433
- ..I EXCEL W U,$$FMTE^XLFDT($P(B15,U,1),"2Z")
- ..S OAMT=$P(B16,U,9) I OAMT'>0 S OAMT=$P($G(^PRCA(430,BILL,30)),U,10)
- ..I 'EXCEL W ?57,$J("$"_$FN(OAMT,",",2),11) ; Original Amt ;PRCA*4.5*433
- ..I EXCEL W U,"$"_$FN(OAMT,",",2)
- ..I 'EXCEL W ?70,$J("$"_$FN(BAMT,",",2),11) ; Curr Amt ;PRCA*4.5*433
- ..I EXCEL W U,"$"_$FN(BAMT,",",2)
- ..I 'EXCEL,OAMT-BAMT'=0 W ?82,$J("$"_$FN(OAMT-BAMT,",",2),11) ; diff amt ;PRCA*4.5*433
- ..I EXCEL W U W:OAMT-BAMT'=0 "$",$FN(OAMT-BAMT,",",2)
- ..S LIEN=$O(^PRCA(430,BILL,15.5,"B",0,""),-1)
- ..S REASON=$P(^PRCA(430,BILL,15.5,LIEN,0),U,4)
- ..S REASON=$S(REASON="T":"Treas RVSL",REASON="R":"Recall Error",REASON="D":"DFLT RPP",REASON="O":"Other")
- ..S USER=$P(^PRCA(430,BILL,15.5,LIEN,0),U,3),USER=$P(^VA(200,USER,0),U)
- ..I 'EXCEL W ?95,$E(REASON,1,15) ;PRCA*4.5*433
- ..I EXCEL W U,REASON
- ..I 'EXCEL W ?109,$E(USER,1,16) ;PRCA*4.5*433
- ..I EXCEL W U,USER
- ..;check for end of page here, if necessary form feed and print header
- ..I ($Y+3)>IOSL D
- ...I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)
- ...D BILLREPH
- 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 ^TMP("RCTCSP6",$J)
- K IOP,%ZIS,ZTQUEUED
- BILLREPQ Q
- ;
- BILLREPH ;header for cross-servicing bill report
- W @IOF
- S PAGE=PAGE+1
- I 'EXCEL D
- . W @IOF,"Cross-Servicing Re-Referred Bills Report -- Run Date: ",RUNDATE," --"
- . W ?122,"Page "_PAGE
- . W !," Re-Referred Dates from ",$$FMTE^XLFDT(DTFRM,"9D")," to ",$$FMTE^XLFDT(DTTO,"9D")
- . W !
- ;I 'EXCEL W "PAGE "_PAGE,?24,"CROSS-SERVICING BILL REPORT",?60,$$FMTE^XLFDT(DT,"2Z"),!,DASH
- ;I EXCEL W "PAGE "_PAGE_U_"CROSS-SERVICING BILL REPORT"_U_U_$$FMTE^XLFDT(DT,"2Z")
- ;N RCHDR,RCSSN
- ;S RCHDR=$$ACCNTHDR^RCDPAPLM(DEBTOR),RCSSN=$S($P(RCHDR,U,2)["P":$E($P(RCHDR,U,2),7,11),1:$E($P(RCHDR,U,2),6,9)) ;Pseudo SSN shouldn't be allowed but we allowed for it to print
- ;I EXCEL W !,"Bill #",U,"Debtor Name",U,"SSN",U,"Re-Refer Date",U,"Orig Amt",U,"Curr Amt",U,"Diff Amt",U,"Reason",U,"User ID" Q
- I EXCEL W !,"Bill #",U,"AR Cat",U,"Debtor Name",U,"PT ID",U,"Re-Refer Date",U,"Orig Amt",U,"Curr Amt",U,"Diff Amt",U,"Reason",U,"User ID" Q ;PRCA*4.5*433
- ;W !,"Bill #",?19,"Debtor Name",?37,"SSN",?43,"Re-Refer Date",?57,"Orig Amt",?72,"Curr Amt",?87,"Diff Amt",?102,"Reason",?120,"User ID"
- W !,"Bill #",?12,"AR Cat",?22,"Debtor Name",?40,"PT ID",?46,"Re-Refer Dt",?58,"Orig Amt",?71,"Curr Amt",?83,"Diff Amt",?95,"Reason",?110,"User ID" ;PRCA*4.5*433
- D ULINE^RCDMCUT2("=",$G(IOM))
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSP6 6164 printed Jan 18, 2025@02:50:06 Page 2
- RCTCSP6 ;ALB/YG - Cross-Servicing Re-Referred Bills Report;03/15/14 3:34 PM
- +1 ;;4.5;Accounts Receivable;**350,433**;Mar 20, 1995;Build 7
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;
- MAIN ;PRCA*4.5*350
- +1 ;
- BILLREP ;Cross-servicing bill report, prints individual bills that make up a cross-servicing account
- +1 NEW DIC,DEBTOR,ZTSAVE,ZTDESC,ZTRTN,POP,DTFRMTO,PROMPT,EXCEL,RUNDATE,PAGE,DFN
- +2 SET RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
- +3 KILL ^TMP("RCTCSP1",$JOB)
- +4 SET PAGE=0
- +5 WRITE !,"*** Cross-Servicing Re-Referred Bills Report ***",!
- +6 WRITE !,"The Cross-Servicing Re-Referred Bills Report provides a list of all bills"
- +7 WRITE !,"that have been re-referred to Cross-Servicing.",!
- +8 ;S DIC=340,DIC(0)="AEQM",DIC("S")="I $D(^RCD(340,""TCSP"",+Y))" D ^DIC
- +9 ;Q:Y<1 S DEBTOR=+Y
- +10 ;S DTFRMTO=$$DTFRMTO^RCTCSP2 Q:'DTFRMTO ;Get date range as per PRCA*4.5*315
- +11 SET DTFRMTO=$$DATE2^RCDMCUT2(" Enter the Date Range for Bills that have been Re-Referred for Cross-Servicing: ",,"T-7")
- +12 SET EXCEL=0
- SET PROMPT="CAPTURE Report data to an Excel Document"
- SET DIR(0)="Y"
- SET DIR("?")="^D HEXC^RCTCSJR"
- +13 ;S EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO")
- +14 SET EXCEL=$$EXCEL^RCDMCUT2
- +15 IF "01"'[EXCEL
- QUIT
- +16 ; Display Excel display message
- IF EXCEL
- DO EXCMSG^RCTCSJR
- +17 IF 'EXCEL
- WRITE !,"It is recommended that you Queue this report to a device that is 132 characters wide. "
- +18 ;PRC*4.5*336
- SET %ZIS="MQ"
- DO ^%ZIS
- if POP
- GOTO BILLREPQ
- +19 IF $DATA(IO("Q"))
- Begin DoDot:1
- +20 SET ZTSAVE("DEBTOR")=""
- SET ZTSAVE("DTFRMTO")=""
- SET ZTSAVE("EXCEL")=""
- +21 SET ZTRTN="BILLREPP^RCTCSP6"
- SET ZTDESC="CROSS-SERVICING BILL REPORT"
- +22 DO ^%ZTLOAD
- DO HOME^%ZIS
- +23 IF $GET(ZTSK)
- WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +24 QUIT
- End DoDot:1
- GOTO BILLREPQ
- +25 ;
- BILLREPP ;Call to build array of bills referred
- +1 USE IO
- +2 NEW BILL,B7,B14,B15,B16,D4,FND,BAMT,DIRUT,TNM,TID,TDT,DASH,CSTAT,PAGE,DASH,TMP,I,DATE,DTFRM,DTTO,DATDATE,REASON,COMMENT,USER,OAMT,LIEN,NAME,NODE,SSN,PTID,RCARCAT
- +3 KILL ^TMP("RCTCSP6",$JOB)
- +4 ;(as per PRCA*4.5*315)
- SET DASH=""
- SET $PIECE(DASH,"-",78)=""
- +5 SET (DATE,DTFRM)=$$FMADD^XLFDT(+$PIECE(DTFRMTO,U,2))
- SET DTTO=$PIECE(DTFRMTO,U,3)
- +6 SET (BAMT,BILL,PAGE)=0
- +7 ; rewritten to sort by "TCSP" (#151 date referred to TCSP) not the "AB" xref... PRCA*4.5*315 (TV8)
- +8 FOR
- SET BILL=$ORDER(^PRCA(430,"TCSP",BILL))
- if BILL=""!($DATA(DIRUT))
- QUIT
- if $$RR^RCTCSPU(BILL)
- Begin DoDot:1
- +9 SET DEBTOR=$PIECE($GET(^PRCA(430,BILL,0)),U,9)
- +10 SET DFN=$PIECE($GET(^RCD(340,DEBTOR,0)),U)
- if DFN'[";DPT"
- QUIT
- +11 SET DFN=+DFN
- +12 DO DEM^VADPT
- +13 IF $GET(VAERR)>0
- DO KVAR^VADPT
- QUIT
- +14 SET NAME=$GET(VADM(1))
- +15 IF NAME']""
- DO KVAR^VADPT
- QUIT
- +16 SET SSN=$PIECE(VADM(2),U,1)
- +17 ;PRCA*4.5*433
- SET PTID=$EXTRACT(VADM(1),1)_$SELECT(SSN'="":$EXTRACT(SSN,6,9),1:"0000")
- +18 if '+$GET(^PRCA(430,BILL,15))
- QUIT
- +19 SET DATDATE=$PIECE($GET(^PRCA(430,BILL,15)),U)
- if DATDATE<DTFRM!(DATDATE>DTTO)
- QUIT
- +20 SET B7=$GET(^PRCA(430,BILL,7))
- +21 SET BAMT=0
- FOR I=1:1:5
- SET BAMT=BAMT+$PIECE(B7,U,I)
- +22 SET ^TMP("RCTCSP6",$JOB,DEBTOR,BILL)=BAMT_U_NAME_U_SSN
- End DoDot:1
- +23 DO BILLREPH
- +24 SET DEBTOR=""
- FOR
- SET DEBTOR=$ORDER(^TMP("RCTCSP6",$JOB,DEBTOR))
- if 'DEBTOR!($DATA(DIRUT))
- QUIT
- Begin DoDot:1
- +25 SET BILL=0
- FOR
- SET BILL=$ORDER(^TMP("RCTCSP6",$JOB,DEBTOR,BILL))
- if 'BILL
- QUIT
- Begin DoDot:2
- +26 if '+$GET(^PRCA(430,BILL,15))
- QUIT
- +27 ;PRCA*4.5*433
- SET RCARCAT=$$GET1^DIQ(430,BILL,2,"E")
- +28 SET NODE=^TMP("RCTCSP6",$JOB,DEBTOR,BILL)
- SET BAMT=$PIECE(NODE,U)
- SET NAME=$PIECE(NODE,U,2)
- SET SSN=$PIECE(NODE,U,3)
- +29 ; Bill
- SET FND=1
- WRITE !,$PIECE(^PRCA(430,BILL,0),U)
- +30 ;PRCA*4.5*433
- IF 'EXCEL
- WRITE ?12,$EXTRACT(RCARCAT,1,9)
- +31 ;PRCA*4.5*433
- IF EXCEL
- WRITE U,$EXTRACT(RCARCAT,1,9)
- +32 SET CSTAT=$PIECE(^(0),U,8)
- SET B7=$GET(^(7))
- SET B15=$GET(^(15))
- SET B16=$GET(^(16))
- +33 ; Name ;PRCA*4.5*433
- IF 'EXCEL
- WRITE ?22,$EXTRACT(NAME,1,17)
- +34 IF EXCEL
- WRITE U,NAME
- +35 ; Patient ID ;PRCA*4.5*433
- IF 'EXCEL
- WRITE ?40,PTID
- +36 IF EXCEL
- WRITE U,PTID
- +37 ; Rerefer date ;PRCA*4.5*433
- IF 'EXCEL
- WRITE ?46,$$FMTE^XLFDT($PIECE(B15,U,1),"2Z")
- +38 IF EXCEL
- WRITE U,$$FMTE^XLFDT($PIECE(B15,U,1),"2Z")
- +39 SET OAMT=$PIECE(B16,U,9)
- IF OAMT'>0
- SET OAMT=$PIECE($GET(^PRCA(430,BILL,30)),U,10)
- +40 ; Original Amt ;PRCA*4.5*433
- IF 'EXCEL
- WRITE ?57,$JUSTIFY("$"_$FNUMBER(OAMT,",",2),11)
- +41 IF EXCEL
- WRITE U,"$"_$FNUMBER(OAMT,",",2)
- +42 ; Curr Amt ;PRCA*4.5*433
- IF 'EXCEL
- WRITE ?70,$JUSTIFY("$"_$FNUMBER(BAMT,",",2),11)
- +43 IF EXCEL
- WRITE U,"$"_$FNUMBER(BAMT,",",2)
- +44 ; diff amt ;PRCA*4.5*433
- IF 'EXCEL
- IF OAMT-BAMT'=0
- WRITE ?82,$JUSTIFY("$"_$FNUMBER(OAMT-BAMT,",",2),11)
- +45 IF EXCEL
- WRITE U
- if OAMT-BAMT'=0
- WRITE "$",$FNUMBER(OAMT-BAMT,",",2)
- +46 SET LIEN=$ORDER(^PRCA(430,BILL,15.5,"B",0,""),-1)
- +47 SET REASON=$PIECE(^PRCA(430,BILL,15.5,LIEN,0),U,4)
- +48 SET REASON=$SELECT(REASON="T":"Treas RVSL",REASON="R":"Recall Error",REASON="D":"DFLT RPP",REASON="O":"Other")
- +49 SET USER=$PIECE(^PRCA(430,BILL,15.5,LIEN,0),U,3)
- SET USER=$PIECE(^VA(200,USER,0),U)
- +50 ;PRCA*4.5*433
- IF 'EXCEL
- WRITE ?95,$EXTRACT(REASON,1,15)
- +51 IF EXCEL
- WRITE U,REASON
- +52 ;PRCA*4.5*433
- IF 'EXCEL
- WRITE ?109,$EXTRACT(USER,1,16)
- +53 IF EXCEL
- WRITE U,USER
- +54 ;check for end of page here, if necessary form feed and print header
- +55 IF ($Y+3)>IOSL
- Begin DoDot:3
- +56 IF $EXTRACT(IOST,1,2)="C-"
- SET DIR(0)="E"
- KILL DIRUT
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- +57 DO BILLREPH
- End DoDot:3
- End DoDot:2
- if $DATA(DIRUT)
- QUIT
- End DoDot:1
- if $DATA(DIRUT)
- QUIT
- +58 IF $EXTRACT(IOST,1,2)="C-"
- IF '$DATA(DIRUT)
- READ !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME
- WRITE @IOF
- +59 DO ^%ZISC
- +60 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +61 KILL ^TMP("RCTCSP6",$JOB)
- +62 KILL IOP,%ZIS,ZTQUEUED
- BILLREPQ QUIT
- +1 ;
- BILLREPH ;header for cross-servicing bill report
- +1 WRITE @IOF
- +2 SET PAGE=PAGE+1
- +3 IF 'EXCEL
- Begin DoDot:1
- +4 WRITE @IOF,"Cross-Servicing Re-Referred Bills Report -- Run Date: ",RUNDATE," --"
- +5 WRITE ?122,"Page "_PAGE
- +6 WRITE !," Re-Referred Dates from ",$$FMTE^XLFDT(DTFRM,"9D")," to ",$$FMTE^XLFDT(DTTO,"9D")
- +7 WRITE !
- End DoDot:1
- +8 ;I 'EXCEL W "PAGE "_PAGE,?24,"CROSS-SERVICING BILL REPORT",?60,$$FMTE^XLFDT(DT,"2Z"),!,DASH
- +9 ;I EXCEL W "PAGE "_PAGE_U_"CROSS-SERVICING BILL REPORT"_U_U_$$FMTE^XLFDT(DT,"2Z")
- +10 ;N RCHDR,RCSSN
- +11 ;S RCHDR=$$ACCNTHDR^RCDPAPLM(DEBTOR),RCSSN=$S($P(RCHDR,U,2)["P":$E($P(RCHDR,U,2),7,11),1:$E($P(RCHDR,U,2),6,9)) ;Pseudo SSN shouldn't be allowed but we allowed for it to print
- +12 ;I EXCEL W !,"Bill #",U,"Debtor Name",U,"SSN",U,"Re-Refer Date",U,"Orig Amt",U,"Curr Amt",U,"Diff Amt",U,"Reason",U,"User ID" Q
- +13 ;PRCA*4.5*433
- IF EXCEL
- WRITE !,"Bill #",U,"AR Cat",U,"Debtor Name",U,"PT ID",U,"Re-Refer Date",U,"Orig Amt",U,"Curr Amt",U,"Diff Amt",U,"Reason",U,"User ID"
- QUIT
- +14 ;W !,"Bill #",?19,"Debtor Name",?37,"SSN",?43,"Re-Refer Date",?57,"Orig Amt",?72,"Curr Amt",?87,"Diff Amt",?102,"Reason",?120,"User ID"
- +15 ;PRCA*4.5*433
- WRITE !,"Bill #",?12,"AR Cat",?22,"Debtor Name",?40,"PT ID",?46,"Re-Refer Dt",?58,"Orig Amt",?71,"Curr Amt",?83,"Diff Amt",?95,"Reason",?110,"User ID"
- +16 DO ULINE^RCDMCUT2("=",$GET(IOM))
- +17 QUIT
- +18 ;