RCTCSP4 ;HAF/ASF - CS Debt Referral Stop Reactivate Report ;6/1/2017
;;4.5;Accounts Receivable;**315,339,350,433**;Mar 25, 2019;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; main report entry point
;
N BILLDATA,CRT,DEBRANGE,DEBTDATA,DEBTOR,DIC,DIV1,DLEVEL,DV,G,IENS,N1,NN,PTID,RCDT,RCTC,RCTCDATE
N RCTCDB,RCTCDEBT1,RCTCDEBT2,RCTCDIV,RCTCDIVN,RCTCEXCEL,RCTCFLG,RCTCSP4,RCTCSTOP,RTCN,REASON,RCTN,SEPLINE,SR,SRDT,SSN,TRANDATA,USER,XDATE
;
D FLAGGED(.RCTCFLG) Q:RCTCFLG=""
D DEBBILL Q:RCTCDB=""
I RCTCDB="D" D DLEVEL^RCTCSP4E Q
D DEBTORS Q:$D(DIRUT)
D DATES Q:'$D(RCTCDATE)!$D(DIRUT)
S RCTCDIV="" I RCTCDB="B" D DIVSEL Q:RCTCDIV=""
D FORMAT Q:RCTCEXCEL=""
D DEVICE
;D COMP ;PRCA*4.5*433 COMMENTED OUT LINE
K ^TMP("RCTCSP4",$J) ; kill scratch global at end
D ^%ZISC ; close the device
Q
;
EX ; main report exit point
Q
;
STOP() ; Determine if user wants to exit out of the option entirely
; 1=yes, get out entirely
; 0=no, just go back to the previous question
;
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
;
S DIR(0)="Y"
S DIR("A")="Do you want to exit out of this option entirely"
S DIR("B")="YES"
S DIR("?",1)=" Enter YES to immediately exit out of this option."
S DIR("?")=" Enter NO to return to the previous question."
W ! D ^DIR K DIR
I $D(DIRUT) S Y=1
Q Y
;
FLAGGED(RCTCFLG) ; capture if the user wants bills with a current flag, reactivated, or both
; RCTCFLG=C meaning data is currently present in the STOP TCSP REFERRAL FLAG field (430,157)
; RCTCFLG=R meaning data is currently blank in the STOP TCSP REFERRAL FLAG field (430,157)
; RCTCFLG=B meaning either is wanted
; pass parameter by reference
;
N RET,DIR,X,Y
S RCTCFLG="",RET=1
S DIR(0)="S"
S $P(DIR(0),U,2)="C:Currently Flagged;R:Reactivated;B:Both"
S DIR("A")="Run the Report for"
S DIR("B")="B"
S DIR("?",1)="Select 'Currently Flagged' to see bills which currently have the Cross-"
S DIR("?",2)="Servicing activity stop flag set."
S DIR("?",3)="Select 'Reactivated' to see bills in which the stop flag is not currently"
S DIR("?",4)="set, but was once set in the past."
S DIR("?")="Select 'Both' to see bills of both types."
W ! D ^DIR K DIR
I $D(DIRUT)!(Y="") S RET=0 W $C(7) G FLX
S RCTCFLG=Y
FLX ;
Q RET
;
DEBBILL ;
; RCTCDB=C meaning data is currently present in the STOP TCSP REFERRAL FLAG field (430,157)
; RCTCDB=R meaning data is currently blank in the STOP TCSP REFERRAL FLAG field (430,157)
;
N RET,DIR,X,Y
S RCTCDB="",RET=1
S DIR(0)="S"
S $P(DIR(0),U,2)="B:Bill Level;D:Debtor Level;"
S DIR("A")="Run the Report for"
S DIR("B")="Debtor"
S DIR("?")="Select 'Bills' to see selected bills"
S DIR("?",1)="Select 'Debtors' to see selected debtors"
W ! D ^DIR K DIR
I $D(DIRUT)!(Y="") S RET=0 W $C(7) Q
S RCTCDB=Y
Q
DIVSEL ;
N RET,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIC
S RCTCDIV="",RET=1
K RCTC("DIVS")
S DIR(0)="S"
S $P(DIR(0),U,2)="A:All;D:Division"
S DIR("A")="Run the Report for"
S DIR("B")="All"
S DIR("?")="Select 'All' to see all bills, Select Division to see only bills from a single division."
W ! D ^DIR K DIR
I $D(DIRUT)!(Y="") S RET=0 W $C(7) G FLX
S RCTCDIV=Y
Q:RCTCDIV="A"
S DIC=40.8,DIC(0)="AEQZ" F D ^DIC Q:Y'>0 S RCTC("DIVS",$P(Y(0),U,7))="",RCTC("DIVN",$P(Y(0),U))=$P(Y(0),U,2) ;ASF 5/6/19
Q
;
DEBTORS ; select debtor range
DEBTFR ; start with debtor
N RET,DIR,X,Y
S RCTCDEBT1="",RET=1
S DIR(0)="F^1:50"
S DIR("A")="Start with Debtor"
S DIR("B")="FIRST"
S DIR("?",1)="If you want to specify a range of AR debtor names, enter the beginning"
S DIR("?",2)="debtor name here. If you want to include all debtors, accept the default"
S DIR("?")="value of FIRST here."
W ! D ^DIR K DIR
I $D(DIRUT)!(Y="") S RET=0 W $C(7) Q
S RCTCDEBT1=Y
;
DEBTTO ; go to debtor
N RET,DIR,X,Y
DBT1 S RCTCDEBT2="",RET=1
S DIR(0)="F^1:50"
S DIR("A")=" Go to Debtor"
S DIR("B")="LAST"
S DIR("?",1)="If you want to specify a range of AR debtor names, enter the ending debtor"
S DIR("?",2)="name here. If you want to include all debtors, accept the default value of"
S DIR("?")="LAST here."
D ^DIR K DIR
I $D(DIRUT)!(Y="") S RET=0 W $C(7) Q
S RCTCDEBT2=Y
I RCTCDEBT1'="FIRST",RCTCDEBT2'="LAST",RCTCDEBT1]RCTCDEBT2 W $C(7),!!,"You must enter something after '",RCTCDEBT1,"'!",! G DBT1
Q
;
DATES ; all dates or a date range - also capture from and thru dates
; RCTCDATE="A" or "R" if user wants All Dates or to select a Date Range
; RCTCDATE("BEGIN")=starting FM date
; RCTCDATE("END")=ending FM date
;
N RET,DIR,X,Y
K RCTCDATE
S RET=1
S DIR(0)="S^A:All Dates;R:Date Range"
S DIR("A")="Include All Dates or Select by Date Range"
S DIR("B")="Date Range"
S DIR("?",1)="If you want to include all transaction entered dates, please select 'A' -"
S DIR("?",2)="All Dates here. But if you want to specify a date range for the"
S DIR("?",3)="transaction entered dates, then enter 'R' here and then choose the from and"
S DIR("?")="through dates."
W ! D ^DIR K DIR
I $D(DIRUT)!(Y="") S ZZRET=0 W $C(7) Q
S RCTCDATE=Y
I RCTCDATE="A" S RCTCDATE("END")=DT_.9,RCTCDATE("BEGIN")=2840101 Q
;
S DIR(0)="DA^:DT:EX"
S DIR("A")="Date Entered From: "
S DIR("?",1)="The From and To dates for this report refer to the date that the AR"
S DIR("?")="transaction was entered."
W ! D ^DIR K DIR
I $D(DIRUT)!'Y S RET=0 W $C(7) K RCTCDATE Q
S RCTCDATE("BEGIN")=Y
;
S DIR(0)="DA^"_RCTCDATE("BEGIN")_":DT:EX"
S DIR("A")=" Date Entered To: "
S DIR("B")="T"
S DIR("?",1)="The From and To dates for this report refer to the date that the AR"
S DIR("?")="transaction was entered."
D ^DIR K DIR
I $D(DIRUT)!'Y S RET=0 W $C(7) K RCTCDATE Q
S RCTCDATE("END")=Y
Q
;
FORMAT ; output format is Excel format or normal report output
; RCTCEXCEL=0 for normal report output
; RCTCEXCEL=1 for Excel output
; pass parameter by reference
;
N RET,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S RCTCEXCEL="",RET=1
S DIR(0)="Y"
S DIR("A")="Do you want to capture the output in Excel format"
S DIR("B")="NO"
S DIR("?",1)="If you want to capture the output from this report in a format which can"
S DIR("?",2)="easily be imported into Excel, then answer YES here."
S DIR("?",3)=" "
S DIR("?")="If you just want a normal report output, then answer NO here."
W ! D ^DIR K DIR
I $D(DIRUT) S RET=0 W $C(7) Q
S RCTCEXCEL=Y
Q
;
DEVICE() ; Device Selection
N ZTRTN,ZTDESC,ZTSAVE,POP,RET,ZTSK,DIR,X,Y
S RET=1
I 'RCTCEXCEL W !!,"It is recommended that you Queue this report to a device ",!,"that is 140 or greater characters wide",!
I RCTCEXCEL D
. W !!,"To capture as an Excel format, it is recommended that you queue this report to"
. W !,"a spool device with margins of 256 and page length of 99999,"
. W !,"(e.g. spoolname;256;99999).This should help avoid wrapping problems.",!
. W !,"Another method would be to set up your terminal to capture the detail report"
. W !,"data. On some terminals, this can be done by clicking on the 'Tools' menu above,"
. W !,"then click on 'Capture Incoming Data' to save to Desktop."
. W !,"To avoid undesired wrapping of the data saved to the file,"
. W !,"please enter '0;256;99999' at the 'DEVICE:' prompt."
;
S ZTRTN="COMPILE^RCTCSP4"
S ZTDESC="RCTC AR Cross-Servicing Stop Reactivate Report"
S ZTSAVE("RCTC(")=""
S ZTSAVE("RCTCDB")=""
S ZTSAVE("RCTCDIV")=""
S ZTSAVE("RCARCAT")="" ;PRCA*4.5*433
S ZTSAVE("RCTCFLG")=""
S ZTSAVE("RCTCDEBT1")=""
S ZTSAVE("RCTCDEBT2")=""
S ZTSAVE("RCTCDATE")=""
S ZTSAVE("RCTCDATE(")=""
S ZTSAVE("RCTCEXCEL")=""
S ZTSAVE("DEBRANGE")=""
S ZTSAVE("DLEVEL")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
I POP S RET=0
I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR K DIR
Q RET
;
;
COMPILE ; entry point for the report compile to build the scratch global
; may be a background task if job queued
;
I '$D(ZTQUEUED) W !!,"Compiling Cross-Servicing Stop Reactivate Report. Please wait ... "
;
D COMP ; build scratch global
D PRINT ; print the report
D ^%ZISC ; close the device
I $D(ZTQUEUED) S ZTREQ="@" ; purge the task
COMIPLX ;
Q
;
COMP ; compile data into scratch global
N ARTTIEN,RCTCTT,RCTCDTENT,RC433,P0,RCIBN,USER,RCTTNAME,RC340,DEBTNAME,FLAG,RCDEBTOR,RCBILLNUM,RCARCAT ;PRCA*4.5*433
;
; first identify the AR Transaction types eligible for this report (CS STOP PLACED or CS STOP DELETED)
; load into the RCTCTT local array
S ARTTIEN=0 F S ARTTIEN=$O(^PRCA(430.3,ARTTIEN)) Q:'ARTTIEN I $P($G(^PRCA(430.3,ARTTIEN,0)),U,1)["CS STOP" S RCTCTT(ARTTIEN)=""
;
; if no end date specified then assume all dates are OK
I '$G(RCTCDATE("END")) S RCTCDATE("END")=9999999
;
; start loop
S ARTTIEN=0 F S ARTTIEN=$O(RCTCTT(ARTTIEN)) Q:'ARTTIEN D
. ;
. ; determine date to start looping based on if the user specified a start date or not
. S RCTCDTENT=0
. I $G(RCTCDATE("BEGIN")) S RCTCDTENT=$O(^PRCA(433,"AT",ARTTIEN,RCTCDATE("BEGIN")),-1) ; get one day earlier to start
. ;
. F S RCTCDTENT=$O(^PRCA(433,"AT",ARTTIEN,RCTCDTENT)) Q:'RCTCDTENT!(RCTCDTENT>RCTCDATE("END")) D
.. S RC433=0 F S RC433=$O(^PRCA(433,"AT",ARTTIEN,RCTCDTENT,RC433)) Q:'RC433 D
... S P0=$G(^PRCA(433,RC433,0))
... S RCIBN=+$P(P0,U,2) Q:'RCIBN ; bill# ien
... S RCARCAT=$E($$GET1^DIQ(430,RCIBN,2,"E"),1,10) ;AR Category PRCA*4.5*433
... S USER=$P($G(^VA(200,+$P(P0,U,9),0)),U,1) ; processed by user
... S RCTTNAME=$$GET1^DIQ(433,RC433,12) ; trans type name
... ; now get some bill data from 430
... S RC340=+$P($G(^PRCA(430,RCIBN,0)),U,9) ; ar debtor ien
... Q:'RC340
... Q:^RCD(340,RC340,0)'?.N1";DPT".E ; only patients
... S DEBTNAME=$$GET1^DIQ(340,RC340,.01) ; external ar debtor name
... Q:DEBTNAME=""
... ;
... ; check report filter on debtor name ASF
... ;I RCTCDB'="B",'$D(RCTCSP4("DEBTOR",DEBTNAME)) Q
... I RCTCDEBT1'="FIRST",RCTCDEBT1'=DEBTNAME,RCTCDEBT1]DEBTNAME Q ; before name range
... I RCTCDEBT2'="LAST",RCTCDEBT2'=DEBTNAME,DEBTNAME]RCTCDEBT2 Q ; after name range
... ;
... ; Division filter
... S RCTCDIVN=$$GET1^DIQ(430,RCIBN_",",12,"I")
... I RCTCDIV="D",RCTCDIVN="" Q
... I RCTCDIV="D",'$D(RCTC("DIVS",RCTCDIVN)) Q
... ;
... ; get the current flag value and check report filter
... S FLAG=+$P($G(^PRCA(430,RCIBN,15)),U,7) ; stop tcsp referral flag field (430,157) 1:flag set
... I RCTCFLG="R",FLAG Q ; user wants only Reactivated bills and this one is still flagged
... I RCTCFLG="C",'FLAG Q ; user wants only currently flagged bills and this flag is clear
... ;
... S RCDEBTOR=DEBTNAME_U_RC340 ; debtor name^debtor ien (used in subscript)
... S RCBILLNUM=$$GET1^DIQ(430,RCIBN,.01) ; bill#
... Q:RCBILLNUM=""
... ;
... ; store data at the debtor level if not already there
... I '$D(^TMP("RCTCSP4",$J,RCDEBTOR)) D
.... N RCDV,SSN,PTID
.... S (SSN,PTID)=""
.... S SSN=$$SSN^RCFN01(RC340)
.... S PTID=$E(DEBTNAME,1)_$S(SSN'="":$E(SSN,6,9),1:"0000") ; patient id
.... S ^TMP("RCTCSP4",$J,RCDEBTOR)=PTID_U_DEBTNAME_U_$S(SSN?.E9N.E:SSN,1:"") ; save into scratch
.... Q
... ;
... ; store data at the bill# level if not already there
... I '$D(^TMP("RCTCSP4",$J,RCDEBTOR,RCBILLNUM)) D
.... N RCX,CAT
.... S RCX=RCBILLNUM ; bill#
.... S $P(RCX,U,2)=$$GET1^DIQ(430,RCIBN,11) ; current balance
.... S $P(RCX,U,3)=$$GET1^DIQ(430,RCIBN,8) ; current ar status name
.... S $P(RCX,U,4)=$E($$GET1^DIQ(430,RCIBN,2),1,10) ; AR category name first 10 char ;PRCA*4.5*433
.... S $P(RCX,U,5)=$$GET1^DIQ(430,RCIBN,61,"I") ; letter1 date FM format
.... S $P(RCX,U,6)=$$GET1^DIQ(430,RCIBN,158,"I") ; stop tcsp referral eff. date FM format
.... S $P(RCX,U,7)=$$GET1^DIQ(430,RCIBN,159) ; stop tcsp referral reason desc
.... S CAT=+$P($G(^PRCA(430,RCIBN,0)),U,2) ; ar category ien
.... S $P(RCX,U,8)=$$GET1^DIQ(430.2,CAT,1) ; ar category abbreviation
.... S $P(RCX,U,9)=$$GET1^DIQ(430,RCIBN,12,"I") ;site
.... S ^TMP("RCTCSP4",$J,RCDEBTOR,RCBILLNUM)=RCX
... ;
... ; now we can store the AR transaction data
... S ^TMP("RCTCSP4",$J,RCDEBTOR,RCBILLNUM,RC433)=RCTTNAME_U_RCTCDTENT_U_USER
. Q
Q
;
;
PRINT ; entry point for printing the report
N CRT,PAGE,RCTCSTOP,SEPLINE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,RCD,DEBTDATA,BILL,BILLDATA,RC433,TRANDATA
S CRT=$S(IOST["C-":1,1:0)
I RCTCEXCEL S IOSL=999999 ; long screen length for Excel output
S PAGE=0,RCTCSTOP=0,$P(SEPLINE,"-",133)=""
;
I '$D(^TMP("RCTCSP4",$J)) D HDR^RCTCSP4E W !!?5,"No data found for this report." Q
I $G(ZTSTOP) D HDR^RCTCSP4E W !!?5,"This report was halted during compilation by TaskManager Request." D PX
D HDR^RCTCSP4E I RCTCSTOP D PX ; display headers first for both types of output
;
; loop thru scratch, check for RCTCSTOP as we go
;
S RCD="" F S RCD=$O(^TMP("RCTCSP4",$J,RCD)) Q:RCD=""!RCTCSTOP D
. S DEBTDATA=$G(^TMP("RCTCSP4",$J,RCD))
. S BILL="" F S BILL=$O(^TMP("RCTCSP4",$J,RCD,BILL)) Q:BILL=""!RCTCSTOP D
.. S BILLDATA=$G(^TMP("RCTCSP4",$J,RCD,BILL))
.. S RC433=0 F S RC433=$O(^TMP("RCTCSP4",$J,RCD,BILL,RC433)) Q:'RC433!RCTCSTOP D
... S TRANDATA=$G(^TMP("RCTCSP4",$J,RCD,BILL,RC433))
... D RPTLN
... Q
.. Q
. Q
I RCTCSTOP Q ; get out right away if stop flag is set
;
I $Y+3>IOSL D HDR^RCTCSP4E I RCTCSTOP Q
W !!?5,"*** End of Report ***"
;
PX ;
I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR
PRINTX ;
Q
;
I $Y+3>IOSL D HDR^RCTCSP4E I RCTCSTOP D PRINTX
W !!?5,"*** End of Report ***"
Q
;
RPTLN ; display one line on the report - either normal or Excel
N TT
;
; for Excel output, print a line and get out
I RCTCEXCEL D EXCELN^RCTCSP4E Q
;
; page break check
I $Y+3>IOSL D HDR^RCTCSP4E I RCTCSTOP G RPTLNX
;
; write a line of report data
W !,$E($P(DEBTDATA,U,2),1,27) ; debtor name
W ?28,$P(BILLDATA,U,9)," " ;division
W ?34,$P(DEBTDATA,U,1) ; Pt ID
;W ?38,$P(DEBTDATA,U,3) ;SSN
W ?41,$P(BILLDATA,U,1) ; bill#
W ?55,$P(BILLDATA,U,4) ;AR Category PRCA*4.5*433
;W ?34,$$RJ^XLFSTR($FN($P(BILLDATA,U,2),"",2),10) ; current balance
W ?66,$E($P(BILLDATA,U,3),1,11) ; current status PRCA*4.5*433/PRCA*4.5*433
;W ?64,$P(BILLDATA,U,8) ; category abbr
W ?78,$$FMTE^XLFDT($P(BILLDATA,U,5),"2Z") ; letter 1 date PRCA*4.5*433
W ?88,$$FMTE^XLFDT($P(BILLDATA,U,6),"2Z") ; stop date PRCA*4.5*433
W ?100,$E($P(BILLDATA,U,7),1,9) ; stop reason PRCA*4.5*433/PRCA*4.5*433
S TT=$P(TRANDATA,U,1)
W ?110,$S(TT["DELETED":"DEL",TT["PLACED":"ADD",1:"UNK") ; transaction type PRCA*4.5*433
;W ?105,$$FMTE^XLFDT($P(TRANDATA,U,2),"2Z") ; date entered
W ?120,$E($P(TRANDATA,U,3),1,17) ; user PRCA*4.5*433
Q
RPTLNDIV ;Lines for division
N TT
;
; for Excel output, print a line and get out
I RCTCEXCEL D EXCELN^RCTCSP4E Q
;
; page break check
I $Y+3>IOSL D HDR^RCTCSP4E I RCTCSTOP G RPTLNX
;
; write a line of report data
W !,$P(DEBTDATA,U,2) ; debtor name
W ?32,$P(BILLDATA,U,9)," " ;division
W ?37,$P(DEBTDATA,U,1) ; Pt ID
W ?46,$P($P(BILLDATA,U,1),"-",2) ; bill#
W ?55,$P(BILLDATA,U,8) ; category abbr
W ?59,$$FMTE^XLFDT($P(BILLDATA,U,5),"2Z") ; letter 1 date
W ?69,$$FMTE^XLFDT($P(BILLDATA,U,6),"2Z") ; stop date
W ?79,$E($P(BILLDATA,U,7),1,10) ; stop reason
S TT=$P(TRANDATA,U,1)
W ?91,$S(TT["DELETED":"DEL",TT["PLACED":"ADD",1:"UNK") ; transaction type
W ?99,$$FMTE^XLFDT($P(TRANDATA,U,2),"2Z") ; date entered
W ?109,$E($P(TRANDATA,U,3),1,17) ; user
;
RPTLNX ;X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSP4 16705 printed Sep 23, 2025@19:24:59 Page 2
RCTCSP4 ;HAF/ASF - CS Debt Referral Stop Reactivate Report ;6/1/2017
+1 ;;4.5;Accounts Receivable;**315,339,350,433**;Mar 25, 2019;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; main report entry point
+1 ;
+2 NEW BILLDATA,CRT,DEBRANGE,DEBTDATA,DEBTOR,DIC,DIV1,DLEVEL,DV,G,IENS,N1,NN,PTID,RCDT,RCTC,RCTCDATE
+3 NEW RCTCDB,RCTCDEBT1,RCTCDEBT2,RCTCDIV,RCTCDIVN,RCTCEXCEL,RCTCFLG,RCTCSP4,RCTCSTOP,RTCN,REASON,RCTN,SEPLINE,SR,SRDT,SSN,TRANDATA,USER,XDATE
+4 ;
+5 DO FLAGGED(.RCTCFLG)
if RCTCFLG=""
QUIT
+6 DO DEBBILL
if RCTCDB=""
QUIT
+7 IF RCTCDB="D"
DO DLEVEL^RCTCSP4E
QUIT
+8 DO DEBTORS
if $DATA(DIRUT)
QUIT
+9 DO DATES
if '$DATA(RCTCDATE)!$DATA(DIRUT)
QUIT
+10 SET RCTCDIV=""
IF RCTCDB="B"
DO DIVSEL
if RCTCDIV=""
QUIT
+11 DO FORMAT
if RCTCEXCEL=""
QUIT
+12 DO DEVICE
+13 ;D COMP ;PRCA*4.5*433 COMMENTED OUT LINE
+14 ; kill scratch global at end
KILL ^TMP("RCTCSP4",$JOB)
+15 ; close the device
DO ^%ZISC
+16 QUIT
+17 ;
EX ; main report exit point
+1 QUIT
+2 ;
STOP() ; Determine if user wants to exit out of the option entirely
+1 ; 1=yes, get out entirely
+2 ; 0=no, just go back to the previous question
+3 ;
+4 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+5 ;
+6 SET DIR(0)="Y"
+7 SET DIR("A")="Do you want to exit out of this option entirely"
+8 SET DIR("B")="YES"
+9 SET DIR("?",1)=" Enter YES to immediately exit out of this option."
+10 SET DIR("?")=" Enter NO to return to the previous question."
+11 WRITE !
DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
SET Y=1
+13 QUIT Y
+14 ;
FLAGGED(RCTCFLG) ; capture if the user wants bills with a current flag, reactivated, or both
+1 ; RCTCFLG=C meaning data is currently present in the STOP TCSP REFERRAL FLAG field (430,157)
+2 ; RCTCFLG=R meaning data is currently blank in the STOP TCSP REFERRAL FLAG field (430,157)
+3 ; RCTCFLG=B meaning either is wanted
+4 ; pass parameter by reference
+5 ;
+6 NEW RET,DIR,X,Y
+7 SET RCTCFLG=""
SET RET=1
+8 SET DIR(0)="S"
+9 SET $PIECE(DIR(0),U,2)="C:Currently Flagged;R:Reactivated;B:Both"
+10 SET DIR("A")="Run the Report for"
+11 SET DIR("B")="B"
+12 SET DIR("?",1)="Select 'Currently Flagged' to see bills which currently have the Cross-"
+13 SET DIR("?",2)="Servicing activity stop flag set."
+14 SET DIR("?",3)="Select 'Reactivated' to see bills in which the stop flag is not currently"
+15 SET DIR("?",4)="set, but was once set in the past."
+16 SET DIR("?")="Select 'Both' to see bills of both types."
+17 WRITE !
DO ^DIR
KILL DIR
+18 IF $DATA(DIRUT)!(Y="")
SET RET=0
WRITE $CHAR(7)
GOTO FLX
+19 SET RCTCFLG=Y
FLX ;
+1 QUIT RET
+2 ;
DEBBILL ;
+1 ; RCTCDB=C meaning data is currently present in the STOP TCSP REFERRAL FLAG field (430,157)
+2 ; RCTCDB=R meaning data is currently blank in the STOP TCSP REFERRAL FLAG field (430,157)
+3 ;
+4 NEW RET,DIR,X,Y
+5 SET RCTCDB=""
SET RET=1
+6 SET DIR(0)="S"
+7 SET $PIECE(DIR(0),U,2)="B:Bill Level;D:Debtor Level;"
+8 SET DIR("A")="Run the Report for"
+9 SET DIR("B")="Debtor"
+10 SET DIR("?")="Select 'Bills' to see selected bills"
+11 SET DIR("?",1)="Select 'Debtors' to see selected debtors"
+12 WRITE !
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)!(Y="")
SET RET=0
WRITE $CHAR(7)
QUIT
+14 SET RCTCDB=Y
+15 QUIT
DIVSEL ;
+1 NEW RET,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIC
+2 SET RCTCDIV=""
SET RET=1
+3 KILL RCTC("DIVS")
+4 SET DIR(0)="S"
+5 SET $PIECE(DIR(0),U,2)="A:All;D:Division"
+6 SET DIR("A")="Run the Report for"
+7 SET DIR("B")="All"
+8 SET DIR("?")="Select 'All' to see all bills, Select Division to see only bills from a single division."
+9 WRITE !
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)!(Y="")
SET RET=0
WRITE $CHAR(7)
GOTO FLX
+11 SET RCTCDIV=Y
+12 if RCTCDIV="A"
QUIT
+13 ;ASF 5/6/19
SET DIC=40.8
SET DIC(0)="AEQZ"
FOR
DO ^DIC
if Y'>0
QUIT
SET RCTC("DIVS",$PIECE(Y(0),U,7))=""
SET RCTC("DIVN",$PIECE(Y(0),U))=$PIECE(Y(0),U,2)
+14 QUIT
+15 ;
DEBTORS ; select debtor range
DEBTFR ; start with debtor
+1 NEW RET,DIR,X,Y
+2 SET RCTCDEBT1=""
SET RET=1
+3 SET DIR(0)="F^1:50"
+4 SET DIR("A")="Start with Debtor"
+5 SET DIR("B")="FIRST"
+6 SET DIR("?",1)="If you want to specify a range of AR debtor names, enter the beginning"
+7 SET DIR("?",2)="debtor name here. If you want to include all debtors, accept the default"
+8 SET DIR("?")="value of FIRST here."
+9 WRITE !
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)!(Y="")
SET RET=0
WRITE $CHAR(7)
QUIT
+11 SET RCTCDEBT1=Y
+12 ;
DEBTTO ; go to debtor
+1 NEW RET,DIR,X,Y
DBT1 SET RCTCDEBT2=""
SET RET=1
+1 SET DIR(0)="F^1:50"
+2 SET DIR("A")=" Go to Debtor"
+3 SET DIR("B")="LAST"
+4 SET DIR("?",1)="If you want to specify a range of AR debtor names, enter the ending debtor"
+5 SET DIR("?",2)="name here. If you want to include all debtors, accept the default value of"
+6 SET DIR("?")="LAST here."
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)!(Y="")
SET RET=0
WRITE $CHAR(7)
QUIT
+9 SET RCTCDEBT2=Y
+10 IF RCTCDEBT1'="FIRST"
IF RCTCDEBT2'="LAST"
IF RCTCDEBT1]RCTCDEBT2
WRITE $CHAR(7),!!,"You must enter something after '",RCTCDEBT1,"'!",!
GOTO DBT1
+11 QUIT
+12 ;
DATES ; all dates or a date range - also capture from and thru dates
+1 ; RCTCDATE="A" or "R" if user wants All Dates or to select a Date Range
+2 ; RCTCDATE("BEGIN")=starting FM date
+3 ; RCTCDATE("END")=ending FM date
+4 ;
+5 NEW RET,DIR,X,Y
+6 KILL RCTCDATE
+7 SET RET=1
+8 SET DIR(0)="S^A:All Dates;R:Date Range"
+9 SET DIR("A")="Include All Dates or Select by Date Range"
+10 SET DIR("B")="Date Range"
+11 SET DIR("?",1)="If you want to include all transaction entered dates, please select 'A' -"
+12 SET DIR("?",2)="All Dates here. But if you want to specify a date range for the"
+13 SET DIR("?",3)="transaction entered dates, then enter 'R' here and then choose the from and"
+14 SET DIR("?")="through dates."
+15 WRITE !
DO ^DIR
KILL DIR
+16 IF $DATA(DIRUT)!(Y="")
SET ZZRET=0
WRITE $CHAR(7)
QUIT
+17 SET RCTCDATE=Y
+18 IF RCTCDATE="A"
SET RCTCDATE("END")=DT_.9
SET RCTCDATE("BEGIN")=2840101
QUIT
+19 ;
+20 SET DIR(0)="DA^:DT:EX"
+21 SET DIR("A")="Date Entered From: "
+22 SET DIR("?",1)="The From and To dates for this report refer to the date that the AR"
+23 SET DIR("?")="transaction was entered."
+24 WRITE !
DO ^DIR
KILL DIR
+25 IF $DATA(DIRUT)!'Y
SET RET=0
WRITE $CHAR(7)
KILL RCTCDATE
QUIT
+26 SET RCTCDATE("BEGIN")=Y
+27 ;
+28 SET DIR(0)="DA^"_RCTCDATE("BEGIN")_":DT:EX"
+29 SET DIR("A")=" Date Entered To: "
+30 SET DIR("B")="T"
+31 SET DIR("?",1)="The From and To dates for this report refer to the date that the AR"
+32 SET DIR("?")="transaction was entered."
+33 DO ^DIR
KILL DIR
+34 IF $DATA(DIRUT)!'Y
SET RET=0
WRITE $CHAR(7)
KILL RCTCDATE
QUIT
+35 SET RCTCDATE("END")=Y
+36 QUIT
+37 ;
FORMAT ; output format is Excel format or normal report output
+1 ; RCTCEXCEL=0 for normal report output
+2 ; RCTCEXCEL=1 for Excel output
+3 ; pass parameter by reference
+4 ;
+5 NEW RET,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+6 SET RCTCEXCEL=""
SET RET=1
+7 SET DIR(0)="Y"
+8 SET DIR("A")="Do you want to capture the output in Excel format"
+9 SET DIR("B")="NO"
+10 SET DIR("?",1)="If you want to capture the output from this report in a format which can"
+11 SET DIR("?",2)="easily be imported into Excel, then answer YES here."
+12 SET DIR("?",3)=" "
+13 SET DIR("?")="If you just want a normal report output, then answer NO here."
+14 WRITE !
DO ^DIR
KILL DIR
+15 IF $DATA(DIRUT)
SET RET=0
WRITE $CHAR(7)
QUIT
+16 SET RCTCEXCEL=Y
+17 QUIT
+18 ;
DEVICE() ; Device Selection
+1 NEW ZTRTN,ZTDESC,ZTSAVE,POP,RET,ZTSK,DIR,X,Y
+2 SET RET=1
+3 IF 'RCTCEXCEL
WRITE !!,"It is recommended that you Queue this report to a device ",!,"that is 140 or greater characters wide",!
+4 IF RCTCEXCEL
Begin DoDot:1
+5 WRITE !!,"To capture as an Excel format, it is recommended that you queue this report to"
+6 WRITE !,"a spool device with margins of 256 and page length of 99999,"
+7 WRITE !,"(e.g. spoolname;256;99999).This should help avoid wrapping problems.",!
+8 WRITE !,"Another method would be to set up your terminal to capture the detail report"
+9 WRITE !,"data. On some terminals, this can be done by clicking on the 'Tools' menu above,"
+10 WRITE !,"then click on 'Capture Incoming Data' to save to Desktop."
+11 WRITE !,"To avoid undesired wrapping of the data saved to the file,"
+12 WRITE !,"please enter '0;256;99999' at the 'DEVICE:' prompt."
End DoDot:1
+13 ;
+14 SET ZTRTN="COMPILE^RCTCSP4"
+15 SET ZTDESC="RCTC AR Cross-Servicing Stop Reactivate Report"
+16 SET ZTSAVE("RCTC(")=""
+17 SET ZTSAVE("RCTCDB")=""
+18 SET ZTSAVE("RCTCDIV")=""
+19 ;PRCA*4.5*433
SET ZTSAVE("RCARCAT")=""
+20 SET ZTSAVE("RCTCFLG")=""
+21 SET ZTSAVE("RCTCDEBT1")=""
+22 SET ZTSAVE("RCTCDEBT2")=""
+23 SET ZTSAVE("RCTCDATE")=""
+24 SET ZTSAVE("RCTCDATE(")=""
+25 SET ZTSAVE("RCTCEXCEL")=""
+26 SET ZTSAVE("DEBRANGE")=""
+27 SET ZTSAVE("DLEVEL")=""
+28 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+29 IF POP
SET RET=0
+30 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
+31 QUIT RET
+32 ;
+33 ;
COMPILE ; entry point for the report compile to build the scratch global
+1 ; may be a background task if job queued
+2 ;
+3 IF '$DATA(ZTQUEUED)
WRITE !!,"Compiling Cross-Servicing Stop Reactivate Report. Please wait ... "
+4 ;
+5 ; build scratch global
DO COMP
+6 ; print the report
DO PRINT
+7 ; close the device
DO ^%ZISC
+8 ; purge the task
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
COMIPLX ;
+1 QUIT
+2 ;
COMP ; compile data into scratch global
+1 ;PRCA*4.5*433
NEW ARTTIEN,RCTCTT,RCTCDTENT,RC433,P0,RCIBN,USER,RCTTNAME,RC340,DEBTNAME,FLAG,RCDEBTOR,RCBILLNUM,RCARCAT
+2 ;
+3 ; first identify the AR Transaction types eligible for this report (CS STOP PLACED or CS STOP DELETED)
+4 ; load into the RCTCTT local array
+5 SET ARTTIEN=0
FOR
SET ARTTIEN=$ORDER(^PRCA(430.3,ARTTIEN))
if 'ARTTIEN
QUIT
IF $PIECE($GET(^PRCA(430.3,ARTTIEN,0)),U,1)["CS STOP"
SET RCTCTT(ARTTIEN)=""
+6 ;
+7 ; if no end date specified then assume all dates are OK
+8 IF '$GET(RCTCDATE("END"))
SET RCTCDATE("END")=9999999
+9 ;
+10 ; start loop
+11 SET ARTTIEN=0
FOR
SET ARTTIEN=$ORDER(RCTCTT(ARTTIEN))
if 'ARTTIEN
QUIT
Begin DoDot:1
+12 ;
+13 ; determine date to start looping based on if the user specified a start date or not
+14 SET RCTCDTENT=0
+15 ; get one day earlier to start
IF $GET(RCTCDATE("BEGIN"))
SET RCTCDTENT=$ORDER(^PRCA(433,"AT",ARTTIEN,RCTCDATE("BEGIN")),-1)
+16 ;
+17 FOR
SET RCTCDTENT=$ORDER(^PRCA(433,"AT",ARTTIEN,RCTCDTENT))
if 'RCTCDTENT!(RCTCDTENT>RCTCDATE("END"))
QUIT
Begin DoDot:2
+18 SET RC433=0
FOR
SET RC433=$ORDER(^PRCA(433,"AT",ARTTIEN,RCTCDTENT,RC433))
if 'RC433
QUIT
Begin DoDot:3
+19 SET P0=$GET(^PRCA(433,RC433,0))
+20 ; bill# ien
SET RCIBN=+$PIECE(P0,U,2)
if 'RCIBN
QUIT
+21 ;AR Category PRCA*4.5*433
SET RCARCAT=$EXTRACT($$GET1^DIQ(430,RCIBN,2,"E"),1,10)
+22 ; processed by user
SET USER=$PIECE($GET(^VA(200,+$PIECE(P0,U,9),0)),U,1)
+23 ; trans type name
SET RCTTNAME=$$GET1^DIQ(433,RC433,12)
+24 ; now get some bill data from 430
+25 ; ar debtor ien
SET RC340=+$PIECE($GET(^PRCA(430,RCIBN,0)),U,9)
+26 if 'RC340
QUIT
+27 ; only patients
if ^RCD(340,RC340,0)'?.N1";DPT".E
QUIT
+28 ; external ar debtor name
SET DEBTNAME=$$GET1^DIQ(340,RC340,.01)
+29 if DEBTNAME=""
QUIT
+30 ;
+31 ; check report filter on debtor name ASF
+32 ;I RCTCDB'="B",'$D(RCTCSP4("DEBTOR",DEBTNAME)) Q
+33 ; before name range
IF RCTCDEBT1'="FIRST"
IF RCTCDEBT1'=DEBTNAME
IF RCTCDEBT1]DEBTNAME
QUIT
+34 ; after name range
IF RCTCDEBT2'="LAST"
IF RCTCDEBT2'=DEBTNAME
IF DEBTNAME]RCTCDEBT2
QUIT
+35 ;
+36 ; Division filter
+37 SET RCTCDIVN=$$GET1^DIQ(430,RCIBN_",",12,"I")
+38 IF RCTCDIV="D"
IF RCTCDIVN=""
QUIT
+39 IF RCTCDIV="D"
IF '$DATA(RCTC("DIVS",RCTCDIVN))
QUIT
+40 ;
+41 ; get the current flag value and check report filter
+42 ; stop tcsp referral flag field (430,157) 1:flag set
SET FLAG=+$PIECE($GET(^PRCA(430,RCIBN,15)),U,7)
+43 ; user wants only Reactivated bills and this one is still flagged
IF RCTCFLG="R"
IF FLAG
QUIT
+44 ; user wants only currently flagged bills and this flag is clear
IF RCTCFLG="C"
IF 'FLAG
QUIT
+45 ;
+46 ; debtor name^debtor ien (used in subscript)
SET RCDEBTOR=DEBTNAME_U_RC340
+47 ; bill#
SET RCBILLNUM=$$GET1^DIQ(430,RCIBN,.01)
+48 if RCBILLNUM=""
QUIT
+49 ;
+50 ; store data at the debtor level if not already there
+51 IF '$DATA(^TMP("RCTCSP4",$JOB,RCDEBTOR))
Begin DoDot:4
+52 NEW RCDV,SSN,PTID
+53 SET (SSN,PTID)=""
+54 SET SSN=$$SSN^RCFN01(RC340)
+55 ; patient id
SET PTID=$EXTRACT(DEBTNAME,1)_$SELECT(SSN'="":$EXTRACT(SSN,6,9),1:"0000")
+56 ; save into scratch
SET ^TMP("RCTCSP4",$JOB,RCDEBTOR)=PTID_U_DEBTNAME_U_$SELECT(SSN?.E9N.E:SSN,1:"")
+57 QUIT
End DoDot:4
+58 ;
+59 ; store data at the bill# level if not already there
+60 IF '$DATA(^TMP("RCTCSP4",$JOB,RCDEBTOR,RCBILLNUM))
Begin DoDot:4
+61 NEW RCX,CAT
+62 ; bill#
SET RCX=RCBILLNUM
+63 ; current balance
SET $PIECE(RCX,U,2)=$$GET1^DIQ(430,RCIBN,11)
+64 ; current ar status name
SET $PIECE(RCX,U,3)=$$GET1^DIQ(430,RCIBN,8)
+65 ; AR category name first 10 char ;PRCA*4.5*433
SET $PIECE(RCX,U,4)=$EXTRACT($$GET1^DIQ(430,RCIBN,2),1,10)
+66 ; letter1 date FM format
SET $PIECE(RCX,U,5)=$$GET1^DIQ(430,RCIBN,61,"I")
+67 ; stop tcsp referral eff. date FM format
SET $PIECE(RCX,U,6)=$$GET1^DIQ(430,RCIBN,158,"I")
+68 ; stop tcsp referral reason desc
SET $PIECE(RCX,U,7)=$$GET1^DIQ(430,RCIBN,159)
+69 ; ar category ien
SET CAT=+$PIECE($GET(^PRCA(430,RCIBN,0)),U,2)
+70 ; ar category abbreviation
SET $PIECE(RCX,U,8)=$$GET1^DIQ(430.2,CAT,1)
+71 ;site
SET $PIECE(RCX,U,9)=$$GET1^DIQ(430,RCIBN,12,"I")
+72 SET ^TMP("RCTCSP4",$JOB,RCDEBTOR,RCBILLNUM)=RCX
End DoDot:4
+73 ;
+74 ; now we can store the AR transaction data
+75 SET ^TMP("RCTCSP4",$JOB,RCDEBTOR,RCBILLNUM,RC433)=RCTTNAME_U_RCTCDTENT_U_USER
End DoDot:3
End DoDot:2
+76 QUIT
End DoDot:1
+77 QUIT
+78 ;
+79 ;
PRINT ; entry point for printing the report
+1 NEW CRT,PAGE,RCTCSTOP,SEPLINE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,RCD,DEBTDATA,BILL,BILLDATA,RC433,TRANDATA
+2 SET CRT=$SELECT(IOST["C-":1,1:0)
+3 ; long screen length for Excel output
IF RCTCEXCEL
SET IOSL=999999
+4 SET PAGE=0
SET RCTCSTOP=0
SET $PIECE(SEPLINE,"-",133)=""
+5 ;
+6 IF '$DATA(^TMP("RCTCSP4",$JOB))
DO HDR^RCTCSP4E
WRITE !!?5,"No data found for this report."
QUIT
+7 IF $GET(ZTSTOP)
DO HDR^RCTCSP4E
WRITE !!?5,"This report was halted during compilation by TaskManager Request."
DO PX
+8 ; display headers first for both types of output
DO HDR^RCTCSP4E
IF RCTCSTOP
DO PX
+9 ;
+10 ; loop thru scratch, check for RCTCSTOP as we go
+11 ;
+12 SET RCD=""
FOR
SET RCD=$ORDER(^TMP("RCTCSP4",$JOB,RCD))
if RCD=""!RCTCSTOP
QUIT
Begin DoDot:1
+13 SET DEBTDATA=$GET(^TMP("RCTCSP4",$JOB,RCD))
+14 SET BILL=""
FOR
SET BILL=$ORDER(^TMP("RCTCSP4",$JOB,RCD,BILL))
if BILL=""!RCTCSTOP
QUIT
Begin DoDot:2
+15 SET BILLDATA=$GET(^TMP("RCTCSP4",$JOB,RCD,BILL))
+16 SET RC433=0
FOR
SET RC433=$ORDER(^TMP("RCTCSP4",$JOB,RCD,BILL,RC433))
if 'RC433!RCTCSTOP
QUIT
Begin DoDot:3
+17 SET TRANDATA=$GET(^TMP("RCTCSP4",$JOB,RCD,BILL,RC433))
+18 DO RPTLN
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 ; get out right away if stop flag is set
IF RCTCSTOP
QUIT
+23 ;
+24 IF $Y+3>IOSL
DO HDR^RCTCSP4E
IF RCTCSTOP
QUIT
+25 WRITE !!?5,"*** End of Report ***"
+26 ;
PX ;
+1 IF CRT
IF '$DATA(ZTQUEUED)
SET DIR(0)="E"
DO ^DIR
PRINTX ;
+1 QUIT
+2 ;
+3 IF $Y+3>IOSL
DO HDR^RCTCSP4E
IF RCTCSTOP
DO PRINTX
+4 WRITE !!?5,"*** End of Report ***"
+5 QUIT
+6 ;
RPTLN ; display one line on the report - either normal or Excel
+1 NEW TT
+2 ;
+3 ; for Excel output, print a line and get out
+4 IF RCTCEXCEL
DO EXCELN^RCTCSP4E
QUIT
+5 ;
+6 ; page break check
+7 IF $Y+3>IOSL
DO HDR^RCTCSP4E
IF RCTCSTOP
GOTO RPTLNX
+8 ;
+9 ; write a line of report data
+10 ; debtor name
WRITE !,$EXTRACT($PIECE(DEBTDATA,U,2),1,27)
+11 ;division
WRITE ?28,$PIECE(BILLDATA,U,9)," "
+12 ; Pt ID
WRITE ?34,$PIECE(DEBTDATA,U,1)
+13 ;W ?38,$P(DEBTDATA,U,3) ;SSN
+14 ; bill#
WRITE ?41,$PIECE(BILLDATA,U,1)
+15 ;AR Category PRCA*4.5*433
WRITE ?55,$PIECE(BILLDATA,U,4)
+16 ;W ?34,$$RJ^XLFSTR($FN($P(BILLDATA,U,2),"",2),10) ; current balance
+17 ; current status PRCA*4.5*433/PRCA*4.5*433
WRITE ?66,$EXTRACT($PIECE(BILLDATA,U,3),1,11)
+18 ;W ?64,$P(BILLDATA,U,8) ; category abbr
+19 ; letter 1 date PRCA*4.5*433
WRITE ?78,$$FMTE^XLFDT($PIECE(BILLDATA,U,5),"2Z")
+20 ; stop date PRCA*4.5*433
WRITE ?88,$$FMTE^XLFDT($PIECE(BILLDATA,U,6),"2Z")
+21 ; stop reason PRCA*4.5*433/PRCA*4.5*433
WRITE ?100,$EXTRACT($PIECE(BILLDATA,U,7),1,9)
+22 SET TT=$PIECE(TRANDATA,U,1)
+23 ; transaction type PRCA*4.5*433
WRITE ?110,$SELECT(TT["DELETED":"DEL",TT["PLACED":"ADD",1:"UNK")
+24 ;W ?105,$$FMTE^XLFDT($P(TRANDATA,U,2),"2Z") ; date entered
+25 ; user PRCA*4.5*433
WRITE ?120,$EXTRACT($PIECE(TRANDATA,U,3),1,17)
+26 QUIT
RPTLNDIV ;Lines for division
+1 NEW TT
+2 ;
+3 ; for Excel output, print a line and get out
+4 IF RCTCEXCEL
DO EXCELN^RCTCSP4E
QUIT
+5 ;
+6 ; page break check
+7 IF $Y+3>IOSL
DO HDR^RCTCSP4E
IF RCTCSTOP
GOTO RPTLNX
+8 ;
+9 ; write a line of report data
+10 ; debtor name
WRITE !,$PIECE(DEBTDATA,U,2)
+11 ;division
WRITE ?32,$PIECE(BILLDATA,U,9)," "
+12 ; Pt ID
WRITE ?37,$PIECE(DEBTDATA,U,1)
+13 ; bill#
WRITE ?46,$PIECE($PIECE(BILLDATA,U,1),"-",2)
+14 ; category abbr
WRITE ?55,$PIECE(BILLDATA,U,8)
+15 ; letter 1 date
WRITE ?59,$$FMTE^XLFDT($PIECE(BILLDATA,U,5),"2Z")
+16 ; stop date
WRITE ?69,$$FMTE^XLFDT($PIECE(BILLDATA,U,6),"2Z")
+17 ; stop reason
WRITE ?79,$EXTRACT($PIECE(BILLDATA,U,7),1,10)
+18 SET TT=$PIECE(TRANDATA,U,1)
+19 ; transaction type
WRITE ?91,$SELECT(TT["DELETED":"DEL",TT["PLACED":"ADD",1:"UNK")
+20 ; date entered
WRITE ?99,$$FMTE^XLFDT($PIECE(TRANDATA,U,2),"2Z")
+21 ; user
WRITE ?109,$EXTRACT($PIECE(TRANDATA,U,3),1,17)
+22 ;
RPTLNX ;X
+1 QUIT
