Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCTCSP6

RCTCSP6.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. MAIN ;PRCA*4.5*350
  1. ;
  1. BILLREP ;Cross-servicing bill report, prints individual bills that make up a cross-servicing account
  1. N DIC,DEBTOR,ZTSAVE,ZTDESC,ZTRTN,POP,DTFRMTO,PROMPT,EXCEL,RUNDATE,PAGE,DFN
  1. S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
  1. K ^TMP("RCTCSP1",$J)
  1. S PAGE=0
  1. W !,"*** Cross-Servicing Re-Referred Bills Report ***",!
  1. W !,"The Cross-Servicing Re-Referred Bills Report provides a list of all bills"
  1. W !,"that have been re-referred to Cross-Servicing.",!
  1. ;S DIC=340,DIC(0)="AEQM",DIC("S")="I $D(^RCD(340,""TCSP"",+Y))" D ^DIC
  1. ;Q:Y<1 S DEBTOR=+Y
  1. ;S DTFRMTO=$$DTFRMTO^RCTCSP2 Q:'DTFRMTO ;Get date range as per PRCA*4.5*315
  1. S DTFRMTO=$$DATE2^RCDMCUT2(" Enter the Date Range for Bills that have been Re-Referred for Cross-Servicing: ",,"T-7")
  1. S EXCEL=0,PROMPT="CAPTURE Report data to an Excel Document",DIR(0)="Y",DIR("?")="^D HEXC^RCTCSJR"
  1. ;S EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO")
  1. S EXCEL=$$EXCEL^RCDMCUT2
  1. I "01"'[EXCEL Q
  1. I EXCEL D EXCMSG^RCTCSJR ; Display Excel display message
  1. I 'EXCEL W !,"It is recommended that you Queue this report to a device that is 132 characters wide. "
  1. S %ZIS="MQ" D ^%ZIS G:POP BILLREPQ ;PRC*4.5*336
  1. I $D(IO("Q")) D G BILLREPQ
  1. .S ZTSAVE("DEBTOR")="",ZTSAVE("DTFRMTO")="",ZTSAVE("EXCEL")=""
  1. .S ZTRTN="BILLREPP^RCTCSP6",ZTDESC="CROSS-SERVICING BILL REPORT"
  1. .D ^%ZTLOAD,HOME^%ZIS
  1. .I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR K DIR
  1. .Q
  1. ;
  1. BILLREPP ;Call to build array of bills referred
  1. U IO
  1. 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
  1. K ^TMP("RCTCSP6",$J)
  1. S DASH="",$P(DASH,"-",78)="" ;(as per PRCA*4.5*315)
  1. S (DATE,DTFRM)=$$FMADD^XLFDT(+$P(DTFRMTO,U,2)),DTTO=$P(DTFRMTO,U,3)
  1. S (BAMT,BILL,PAGE)=0
  1. ; rewritten to sort by "TCSP" (#151 date referred to TCSP) not the "AB" xref... PRCA*4.5*315 (TV8)
  1. F S BILL=$O(^PRCA(430,"TCSP",BILL)) Q:BILL=""!($D(DIRUT)) D:$$RR^RCTCSPU(BILL)
  1. .S DEBTOR=$P($G(^PRCA(430,BILL,0)),U,9)
  1. .S DFN=$P($G(^RCD(340,DEBTOR,0)),U) Q:DFN'[";DPT"
  1. .S DFN=+DFN
  1. .D DEM^VADPT
  1. .I $G(VAERR)>0 D KVAR^VADPT Q
  1. .S NAME=$G(VADM(1))
  1. .I NAME']"" D KVAR^VADPT Q
  1. .S SSN=$P(VADM(2),U,1)
  1. .S PTID=$E(VADM(1),1)_$S(SSN'="":$E(SSN,6,9),1:"0000") ;PRCA*4.5*433
  1. .Q:'+$G(^PRCA(430,BILL,15))
  1. .S DATDATE=$P($G(^PRCA(430,BILL,15)),U) Q:DATDATE<DTFRM!(DATDATE>DTTO)
  1. .S B7=$G(^PRCA(430,BILL,7))
  1. .S BAMT=0 F I=1:1:5 S BAMT=BAMT+$P(B7,U,I)
  1. .S ^TMP("RCTCSP6",$J,DEBTOR,BILL)=BAMT_U_NAME_U_SSN
  1. D BILLREPH
  1. S DEBTOR="" F S DEBTOR=$O(^TMP("RCTCSP6",$J,DEBTOR)) Q:'DEBTOR!($D(DIRUT)) D Q:$D(DIRUT)
  1. . S BILL=0 F S BILL=$O(^TMP("RCTCSP6",$J,DEBTOR,BILL)) Q:'BILL D Q:$D(DIRUT)
  1. ..Q:'+$G(^PRCA(430,BILL,15))
  1. ..S RCARCAT=$$GET1^DIQ(430,BILL,2,"E") ;PRCA*4.5*433
  1. ..S NODE=^TMP("RCTCSP6",$J,DEBTOR,BILL),BAMT=$P(NODE,U),NAME=$P(NODE,U,2),SSN=$P(NODE,U,3)
  1. ..S FND=1 W !,$P(^PRCA(430,BILL,0),U) ; Bill
  1. ..I 'EXCEL W ?12,$E(RCARCAT,1,9) ;PRCA*4.5*433
  1. ..I EXCEL W U,$E(RCARCAT,1,9) ;PRCA*4.5*433
  1. ..S CSTAT=$P(^(0),U,8),B7=$G(^(7)),B15=$G(^(15)),B16=$G(^(16))
  1. ..I 'EXCEL W ?22,$E(NAME,1,17) ; Name ;PRCA*4.5*433
  1. ..I EXCEL W U,NAME
  1. ..I 'EXCEL W ?40,PTID ; Patient ID ;PRCA*4.5*433
  1. ..I EXCEL W U,PTID
  1. ..I 'EXCEL W ?46,$$FMTE^XLFDT($P(B15,U,1),"2Z") ; Rerefer date ;PRCA*4.5*433
  1. ..I EXCEL W U,$$FMTE^XLFDT($P(B15,U,1),"2Z")
  1. ..S OAMT=$P(B16,U,9) I OAMT'>0 S OAMT=$P($G(^PRCA(430,BILL,30)),U,10)
  1. ..I 'EXCEL W ?57,$J("$"_$FN(OAMT,",",2),11) ; Original Amt ;PRCA*4.5*433
  1. ..I EXCEL W U,"$"_$FN(OAMT,",",2)
  1. ..I 'EXCEL W ?70,$J("$"_$FN(BAMT,",",2),11) ; Curr Amt ;PRCA*4.5*433
  1. ..I EXCEL W U,"$"_$FN(BAMT,",",2)
  1. ..I 'EXCEL,OAMT-BAMT'=0 W ?82,$J("$"_$FN(OAMT-BAMT,",",2),11) ; diff amt ;PRCA*4.5*433
  1. ..I EXCEL W U W:OAMT-BAMT'=0 "$",$FN(OAMT-BAMT,",",2)
  1. ..S LIEN=$O(^PRCA(430,BILL,15.5,"B",0,""),-1)
  1. ..S REASON=$P(^PRCA(430,BILL,15.5,LIEN,0),U,4)
  1. ..S REASON=$S(REASON="T":"Treas RVSL",REASON="R":"Recall Error",REASON="D":"DFLT RPP",REASON="O":"Other")
  1. ..S USER=$P(^PRCA(430,BILL,15.5,LIEN,0),U,3),USER=$P(^VA(200,USER,0),U)
  1. ..I 'EXCEL W ?95,$E(REASON,1,15) ;PRCA*4.5*433
  1. ..I EXCEL W U,REASON
  1. ..I 'EXCEL W ?109,$E(USER,1,16) ;PRCA*4.5*433
  1. ..I EXCEL W U,USER
  1. ..;check for end of page here, if necessary form feed and print header
  1. ..I ($Y+3)>IOSL D
  1. ...I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)
  1. ...D BILLREPH
  1. I $E(IOST,1,2)="C-",'$D(DIRUT) R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
  1. D ^%ZISC
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. K ^TMP("RCTCSP6",$J)
  1. K IOP,%ZIS,ZTQUEUED
  1. BILLREPQ Q
  1. ;
  1. BILLREPH ;header for cross-servicing bill report
  1. W @IOF
  1. S PAGE=PAGE+1
  1. I 'EXCEL D
  1. . W @IOF,"Cross-Servicing Re-Referred Bills Report -- Run Date: ",RUNDATE," --"
  1. . W ?122,"Page "_PAGE
  1. . W !," Re-Referred Dates from ",$$FMTE^XLFDT(DTFRM,"9D")," to ",$$FMTE^XLFDT(DTTO,"9D")
  1. . W !
  1. ;I 'EXCEL W "PAGE "_PAGE,?24,"CROSS-SERVICING BILL REPORT",?60,$$FMTE^XLFDT(DT,"2Z"),!,DASH
  1. ;I EXCEL W "PAGE "_PAGE_U_"CROSS-SERVICING BILL REPORT"_U_U_$$FMTE^XLFDT(DT,"2Z")
  1. ;N RCHDR,RCSSN
  1. ;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
  1. ;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
  1. 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
  1. ;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"
  1. 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
  1. D ULINE^RCDMCUT2("=",$G(IOM))
  1. Q
  1. ;