RCTCSP4.m

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 ---RCTCSP4   16705     printed  Feb 18, 2025@23:15:13                                                                                                                                                                                                    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