RCTCSP4E ;HAF/ASF - CS Debt Referral Stop Reactivate Report ;6/1/2017
;;4.5;Accounts Receivable;**350,433**;Mar 26, 2019;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
HDR ; report header
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,RCSR
;
S CRT=0 S:IOST?1"C".E CRT=1
; Do an end of page reader call if page# exists and device is the screen
I PAGE,CRT S DIR(0)="E" D ^DIR K DIR I 'Y S RCTCSTOP=1 G HDRX
;
; If screen output or page# exists, do a form feed
I PAGE!CRT W @IOF
;
; First printer/file page - do a left margin reset
I 'PAGE,'CRT W $C(13)
;
S PAGE=PAGE+1 ; increment page#
;
; For Excel format, display the column headers only
;
; Display the report headers
;
D DLHDR:RCTCDB="D",DIVHDR:RCTCDB="B"
Q ;
W ?47,"Cross-Servicing Stop Reactivate Report by ",$S(RCTCDIV="D":"Division",1:"Debtor"),?122,"Page: ",PAGE
;
W !,"Date Range: "
I RCTCDATE="A" W "ALL"
E D
. W $$FMTE^XLFDT($G(RCTCDATE("BEGIN")),"2Z")," - "
. W $$FMTE^XLFDT($G(RCTCDATE("END")),"2Z")
. Q
W " Currently Flagged, Reactivated, or Both: "
W $S(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
I RCTCDIV="D" W " Division: " S DIV1=0 F S DIV1=$O(RCTC("DIVS",DIV1)) Q:DIV1'>0 W " "_DIV1
E W " Division: All"
W ?111,$$FMTE^XLFDT($$NOW^XLFDT)
W !,"Debtors: "
I RCTCDB="B"!'$D(RCTCSP4("DEBTOR")) W "ALL"
E D
. S RTCN="" F S RTCN=$O(RCTCSP4("DEBTOR",RTCN)) Q:RTCN="" W RTCN_" "
. Q
;
W !,SEPLINE
W:RCTCDIV="D" !,"Debtor Name",?32,"Pt ID",?39,"Bill#",?49,"Cat",?59,"Letter1",?69,"StopDate",?79,"Reason",?89,"CS STOP",?99,"Entered",?109,"User"
W !,SEPLINE
;
; check for a TaskManager stop request
I $D(ZTQUEUED),$$S^%ZTLOAD() D G HDRX
. S (ZTSTOP,RCTCSTOP)=1
. W !!!?5,"*** Report Halted by TaskManager Request ***"
. Q
;
HDRX ;
Q
;
EXCELHD ; print an Excel header record (only 1 Excel header should print for the whole report)
;W !,"Debtor Name",?28,"Division",?37,"Pt ID",?46,"Bill#",?55,"Status",?67,"Letter1",?77,"StopDate",?89,"Reason",?99,"CS STOP",?109,"User"
N RCH
S RCH=$$CSV("","Debtor Name")
S RCH=$$CSV(RCH,"Division")
;S RCH=$$CSV(RCH,"Patient ID")
S RCH=$$CSV(RCH,"Pt ID")
;S RCH=$$CSV(RCH,"SSN")
;S RCH=$$CSV(RCH,"Bill Number")
S RCH=$$CSV(RCH,"Bill#")
;S RCH=$$CSV(RCH,"Current Balance")
;S RCH=$$CSV(RCH,"Current Status")
S RCH=$$CSV(RCH,"AR CAT") ;PRCA*4.5*433
S RCH=$$CSV(RCH,"Status")
;S RCH=$$CSV(RCH,"Category Name")
;S RCH=$$CSV(RCH,"Category Abbr")
;S RCH=$$CSV(RCH,"Letter1 Date")
S RCH=$$CSV(RCH,"Letter1")
S RCH=$$CSV(RCH,"StopDate")
;S RCH=$$CSV(RCH,"Stop Reason")
S RCH=$$CSV(RCH,"Reason")
;S RCH=$$CSV(RCH,"Transaction Type")
;S RCH=$$CSV(RCH,"Transaction Date Entered")
;S RCH=$$CSV(RCH,"Transaction Processed By")
S RCH=$$CSV(RCH,"CS STOP")
S RCH=$$CSV(RCH,"User")
W RCH
Q
;
EXCELN ; write a line of Excel data
N RCZ
S RCZ=$$CSV("",$P(DEBTDATA,U,2)) ; AR Debtor Name
S RCZ=$$CSV(RCZ,$P(BILLDATA,U,9)) ; Division
S RCZ=$$CSV(RCZ,$P(DEBTDATA,U,1)) ; patient ID
;S RCZ=$$CSV(RCZ,$P(DEBTDATA,U,3)) ; SSN
S RCZ=$$CSV(RCZ,$P(BILLDATA,U,1)) ; bill#
;S RCZ=$$CSV(RCZ,+$P(BILLDATA,U,2)) ; current balance
S RCZ=$$CSV(RCZ,$P(BILLDATA,U,4)) ; AR Category Name PRCA*4.5*433
S RCZ=$$CSV(RCZ,$P(BILLDATA,U,3)) ; AR status name
;S RCZ=$$CSV(RCZ,$P(BILLDATA,U,4)) ; AR category name
;S RCZ=$$CSV(RCZ,$P(BILLDATA,U,8)) ; AR category abbr
S RCZ=$$CSV(RCZ,$$FMTE^XLFDT($P(BILLDATA,U,5),"2Z")) ; letter1 date
S RCZ=$$CSV(RCZ,$$FMTE^XLFDT($P(BILLDATA,U,6),"2Z")) ; stop flag effective date
S RCZ=$$CSV(RCZ,$P(BILLDATA,U,7)) ; stop flag reason
S TT=$P(TRANDATA,U,1)
S RCZ=$$CSV(RCZ,$S(TT["DELETED":"DEL",TT["PLACED":"ADD",1:"UNK"))
;S RCZ=$$CSV(RCZ,$P(TRANDATA,U,1)) ; ar transaction type desc
;S RCZ=$$CSV(RCZ,$$FMTE^XLFDT($P(TRANDATA,U,2),"2Z")) ; transaction date entered
S RCZ=$$CSV(RCZ,$P(TRANDATA,U,3)) ; trans user
W !,RCZ
Q
;
CSV(STRING,DATA) ; build the Excel data string format
S STRING=$S(STRING="":DATA,1:STRING_U_DATA)
Q STRING
;
DIVHDR ;
I RCTCEXCEL D EXCELHD Q
W !,"Date Range: "
I RCTCDATE("BEGIN")=2840101 W "All"
I RCTCDATE("BEGIN")'=2840101 W $$FMTE^XLFDT($G(RCTCDATE("BEGIN")),"2Z")," - ",$$FMTE^XLFDT($G(RCTCDATE("END")),"2Z")
W ?47,"Cross-Servicing Stop Reactivate Report by Bill",?122,"Page: ",PAGE
W ! I RCTCDIV="A" W "Division(s): All"
W ?45," Currently Flagged, Reactivated, or Both: "
W $S(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
W ?111,$P($$FMTE^XLFDT($$NOW^XLFDT),":",1,2)
I RCTCDIV'="A" D
. W !,"Division(s): " S DV="",DV1="" F S DV=$O(RCTC("DIVN",DV)) Q:DV="" S DV1=DV1_RCTC("DIVN",DV)_"-"_DV_", "
. W $E(DV1,1,$L(DV1)-2)
W !,"Debtor Range: "
I RCTCDEBT1=("FIRST")&(RCTCDEBT2="LAST") W "ALL"
E W RCTCDEBT1,":",RCTCDEBT2
W !,SEPLINE
W !,"Debtor Name",?24,"Division",?34,"Pt ID",?44,"Bill#",?55,"AR CAT",?66,"Status",?78,"Letter1",?88,"StopDate",?100,"Reason",?110,"CS STOP",?120,"User" ;PRCA*4.5*433
;W !,"Debtor Name",?24,"Division",?34,"Pt ID",?44,"Bill#",?55,"Status",?67,"Letter1",?77,"StopDate",?89,"Reason",?99,"CS STOP",?109,"User"
W !,SEPLINE
Q
DLEVEL ; stop/reactivate report at 340 debtor level
K ^TMP("RCTC",$J)
D DEBTORS^RCTCSP4 Q:$D(DIRUT)
S DEBRANGE=RCTCDEBT1_":"_RCTCDEBT2
D DATES^RCTCSP4 Q:'$D(RCTCDATE)!$D(DIRUT)
S PAGE=0,RCTCSTOP=0,$P(SEPLINE,"-",133)=""
D FORMAT^RCTCSP4 Q:RCTCEXCEL=""
D DEVICE
Q
QENT ;queue ENTRY
S PAGE=0,RCTCSTOP=0,$P(SEPLINE,"-",133)=""
D HDR
K ^TMP("RCTC",$J)
S DEBTOR=0 F S DEBTOR=$O(^RCD(340,DEBTOR)) Q:DEBTOR'>0 D DSR
D PRINT
Q
DSR Q:^RCD(340,DEBTOR,0)'?.E1"DPT(".E ;only top level debtors
S DEBTNAME=$$GET1^DIQ(340,DEBTOR,.01)
I RCTCDEBT1'="FIRST",RCTCDEBT1'=DEBTNAME,RCTCDEBT1]DEBTNAME Q ; before name range
I RCTCDEBT2'="LAST",RCTCDEBT2'=DEBTNAME,DEBTNAME]RCTCDEBT2 Q ; after name range
S SRDT="" F S SRDT=$O(^RCD(340,DEBTOR,8,"C",SRDT)) Q:SRDT'>0 D
. Q:(RCTCDATE("BEGIN")\1)>SRDT ;check date range
. Q:(RCTCDATE("END")_.99)<SRDT
. S N1=0 F S N1=$O(^RCD(340,DEBTOR,8,"C",SRDT,N1)) Q:N1'>0 D
.. S NN=DEBTNAME
.. S G=^RCD(340,DEBTOR,8,N1,0),RCDT=$P(G,U,2),RCSR=$P(G,U),G(N1)=G
.. I RCTCFLG="R"&(RCSR="R") S ^TMP("RCTC",$J,NN,DEBTOR,RCDT)=N1 ;Filter stops
.. I RCTCFLG="C"&(RCSR="S") S ^TMP("RCTC",$J,NN,DEBTOR,RCDT)=N1 ;Filter reactivates
.. I RCTCFLG="B" S ^TMP("RCTC",$J,NN,DEBTOR,RCDT)=N1
Q
PRINT ;print for debtor level
S NN="" F S NN=$O(^TMP("RCTC",$J,NN)) Q:NN="" Q:RCTCSTOP S DEBTOR=0 F S DEBTOR=$O(^TMP("RCTC",$J,NN,DEBTOR)) Q:DEBTOR'>0 D
. S RCDT=0 F S RCDT=$O(^TMP("RCTC",$J,NN,DEBTOR,RCDT)) Q:RCDT'>0 Q:RCTCSTOP D
.. S N1=^TMP("RCTC",$J,NN,DEBTOR,RCDT)
.. S SSN=$$SSN^RCFN01(DEBTOR)
.. S PTID=$E(NN,1)_$S(SSN'="":$E(SSN,6,9),1:"0000") ; patient id
.. S IENS=N1_","_DEBTOR_"," S REASON=$$GET1^DIQ(340.08,IENS,.04) ; REason
.. S G=^RCD(340,DEBTOR,8,N1,0)
.. S SR=$P(G,U)
.. S XDATE=$E($P(G,U,2),1,12) S XDATE=$E(XDATE,4,5)_"/"_$E(XDATE,6,7)_"/"_$E(XDATE,2,3) ;_"@"_$P(XDATE,".",2)
.. S USER=$P(G,U,3) S USER=$$GET1^DIQ(200,USER_",",.01)
.. I RCTCEXCEL D DEXLN Q
.. W !,NN ;NAME
.. W ?35,PTID
.. W ?42,SSN
.. W ?54,SR
.. W ?57,XDATE
.. W ?75,REASON
.. ;W ?85,$P(G,U,5) ;COMMENT
.. W ?107,USER
.. W *7 I $Y+3>IOSL D HDR^RCTCSP4E ;I RCTCSTOP Q
W !!,?20,"*** ",$S($G(RCTCSTOP):"Report Ended",1:"End of Report")," ***"
I $E(IOST,1,2)="C-",'$D(DIRUT),'$G(RCTCSTOP) R !!,"Type <Enter> to continue or '^' to exit:",X:DTIME W @IOF
Q
DLHDR ;Debtor Level Header
I RCTCEXCEL=1 D DLXHD Q
W !,"Date Range: "
I RCTCDATE="A" W "All"
E W $$FMTE^XLFDT($G(RCTCDATE("BEGIN")),"2Z")," - ",$$FMTE^XLFDT($G(RCTCDATE("END")),"2Z")
W ?35,"Cross-Servicing Stop Reactivate Report at Debtor Level",?122,"Page: ",PAGE
W !?33," Currently Flagged, Reactivated, or Both: "
W $S(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
W !,"Debtor Range: ",DEBRANGE
W ?111,$P($$FMTE^XLFDT($$NOW^XLFDT),":",1,2)
W !,SEPLINE
W !,"Debtor Name",?35,"Pt ID",?42,"SSN",?53,"S/R",?57,"Date",?75,"Reason",?107,"User"
W !,SEPLINE
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 132 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="QENT^RCTCSP4E"
S ZTDESC="RCTC AR Cross-Servicing Stop Reactivate Report DEBTOR LEVEL"
S ZTSAVE("RCTC(")=""
S ZTSAVE("RCTCDB")=""
S ZTSAVE("RCTCDIV")=""
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
;
DLXHD ; print an Excel header record DEBTOR level
N RCH
S RCH=$$CSV("","Debtor Name")
S RCH=$$CSV(RCH,"Pt ID")
S RCH=$$CSV(RCH,"SSN")
S RCH=$$CSV(RCH,"S/R")
S RCH=$$CSV(RCH,"Date")
S RCH=$$CSV(RCH,"Reason")
S RCH=$$CSV(RCH,"User")
W RCH
Q
DEXLN ; write a line of Excel data for debtor
N RCZ
S RCZ=$$CSV("",NN) ; AR Debtor Name
S RCZ=$$CSV(RCZ,PTID) ; patient ID
S RCZ=$$CSV(RCZ,SSN) ; SSN
S RCZ=$$CSV(RCZ,SR) ; SR
S RCZ=$$CSV(RCZ,XDATE) ; Date
S RCZ=$$CSV(RCZ,REASON) ; reason
S RCZ=$$CSV(RCZ,USER) ; CLERK
W !,RCZ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSP4E 10599 printed Dec 13, 2024@01:48:50 Page 2
RCTCSP4E ;HAF/ASF - CS Debt Referral Stop Reactivate Report ;6/1/2017
+1 ;;4.5;Accounts Receivable;**350,433**;Mar 26, 2019;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
HDR ; report header
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,RCSR
+3 ;
+4 SET CRT=0
if IOST?1"C".E
SET CRT=1
+5 ; Do an end of page reader call if page# exists and device is the screen
+6 IF PAGE
IF CRT
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET RCTCSTOP=1
GOTO HDRX
+7 ;
+8 ; If screen output or page# exists, do a form feed
+9 IF PAGE!CRT
WRITE @IOF
+10 ;
+11 ; First printer/file page - do a left margin reset
+12 IF 'PAGE
IF 'CRT
WRITE $CHAR(13)
+13 ;
+14 ; increment page#
SET PAGE=PAGE+1
+15 ;
+16 ; For Excel format, display the column headers only
+17 ;
+18 ; Display the report headers
+19 ;
+20 if RCTCDB="D"
DO DLHDR
if RCTCDB="B"
DO DIVHDR
+21 ;
QUIT
+22 WRITE ?47,"Cross-Servicing Stop Reactivate Report by ",$SELECT(RCTCDIV="D":"Division",1:"Debtor"),?122,"Page: ",PAGE
+23 ;
+24 WRITE !,"Date Range: "
+25 IF RCTCDATE="A"
WRITE "ALL"
+26 IF '$TEST
Begin DoDot:1
+27 WRITE $$FMTE^XLFDT($GET(RCTCDATE("BEGIN")),"2Z")," - "
+28 WRITE $$FMTE^XLFDT($GET(RCTCDATE("END")),"2Z")
+29 QUIT
End DoDot:1
+30 WRITE " Currently Flagged, Reactivated, or Both: "
+31 WRITE $SELECT(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
+32 IF RCTCDIV="D"
WRITE " Division: "
SET DIV1=0
FOR
SET DIV1=$ORDER(RCTC("DIVS",DIV1))
if DIV1'>0
QUIT
WRITE " "_DIV1
+33 IF '$TEST
WRITE " Division: All"
+34 WRITE ?111,$$FMTE^XLFDT($$NOW^XLFDT)
+35 WRITE !,"Debtors: "
+36 IF RCTCDB="B"!'$DATA(RCTCSP4("DEBTOR"))
WRITE "ALL"
+37 IF '$TEST
Begin DoDot:1
+38 SET RTCN=""
FOR
SET RTCN=$ORDER(RCTCSP4("DEBTOR",RTCN))
if RTCN=""
QUIT
WRITE RTCN_" "
+39 QUIT
End DoDot:1
+40 ;
+41 WRITE !,SEPLINE
+42 if RCTCDIV="D"
WRITE !,"Debtor Name",?32,"Pt ID",?39,"Bill#",?49,"Cat",?59,"Letter1",?69,"StopDate",?79,"Reason",?89,"CS STOP",?99,"Entered",?109,"User"
+43 WRITE !,SEPLINE
+44 ;
+45 ; check for a TaskManager stop request
+46 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
Begin DoDot:1
+47 SET (ZTSTOP,RCTCSTOP)=1
+48 WRITE !!!?5,"*** Report Halted by TaskManager Request ***"
+49 QUIT
End DoDot:1
GOTO HDRX
+50 ;
HDRX ;
+1 QUIT
+2 ;
EXCELHD ; print an Excel header record (only 1 Excel header should print for the whole report)
+1 ;W !,"Debtor Name",?28,"Division",?37,"Pt ID",?46,"Bill#",?55,"Status",?67,"Letter1",?77,"StopDate",?89,"Reason",?99,"CS STOP",?109,"User"
+2 NEW RCH
+3 SET RCH=$$CSV("","Debtor Name")
+4 SET RCH=$$CSV(RCH,"Division")
+5 ;S RCH=$$CSV(RCH,"Patient ID")
+6 SET RCH=$$CSV(RCH,"Pt ID")
+7 ;S RCH=$$CSV(RCH,"SSN")
+8 ;S RCH=$$CSV(RCH,"Bill Number")
+9 SET RCH=$$CSV(RCH,"Bill#")
+10 ;S RCH=$$CSV(RCH,"Current Balance")
+11 ;S RCH=$$CSV(RCH,"Current Status")
+12 ;PRCA*4.5*433
SET RCH=$$CSV(RCH,"AR CAT")
+13 SET RCH=$$CSV(RCH,"Status")
+14 ;S RCH=$$CSV(RCH,"Category Name")
+15 ;S RCH=$$CSV(RCH,"Category Abbr")
+16 ;S RCH=$$CSV(RCH,"Letter1 Date")
+17 SET RCH=$$CSV(RCH,"Letter1")
+18 SET RCH=$$CSV(RCH,"StopDate")
+19 ;S RCH=$$CSV(RCH,"Stop Reason")
+20 SET RCH=$$CSV(RCH,"Reason")
+21 ;S RCH=$$CSV(RCH,"Transaction Type")
+22 ;S RCH=$$CSV(RCH,"Transaction Date Entered")
+23 ;S RCH=$$CSV(RCH,"Transaction Processed By")
+24 SET RCH=$$CSV(RCH,"CS STOP")
+25 SET RCH=$$CSV(RCH,"User")
+26 WRITE RCH
+27 QUIT
+28 ;
EXCELN ; write a line of Excel data
+1 NEW RCZ
+2 ; AR Debtor Name
SET RCZ=$$CSV("",$PIECE(DEBTDATA,U,2))
+3 ; Division
SET RCZ=$$CSV(RCZ,$PIECE(BILLDATA,U,9))
+4 ; patient ID
SET RCZ=$$CSV(RCZ,$PIECE(DEBTDATA,U,1))
+5 ;S RCZ=$$CSV(RCZ,$P(DEBTDATA,U,3)) ; SSN
+6 ; bill#
SET RCZ=$$CSV(RCZ,$PIECE(BILLDATA,U,1))
+7 ;S RCZ=$$CSV(RCZ,+$P(BILLDATA,U,2)) ; current balance
+8 ; AR Category Name PRCA*4.5*433
SET RCZ=$$CSV(RCZ,$PIECE(BILLDATA,U,4))
+9 ; AR status name
SET RCZ=$$CSV(RCZ,$PIECE(BILLDATA,U,3))
+10 ;S RCZ=$$CSV(RCZ,$P(BILLDATA,U,4)) ; AR category name
+11 ;S RCZ=$$CSV(RCZ,$P(BILLDATA,U,8)) ; AR category abbr
+12 ; letter1 date
SET RCZ=$$CSV(RCZ,$$FMTE^XLFDT($PIECE(BILLDATA,U,5),"2Z"))
+13 ; stop flag effective date
SET RCZ=$$CSV(RCZ,$$FMTE^XLFDT($PIECE(BILLDATA,U,6),"2Z"))
+14 ; stop flag reason
SET RCZ=$$CSV(RCZ,$PIECE(BILLDATA,U,7))
+15 SET TT=$PIECE(TRANDATA,U,1)
+16 SET RCZ=$$CSV(RCZ,$SELECT(TT["DELETED":"DEL",TT["PLACED":"ADD",1:"UNK"))
+17 ;S RCZ=$$CSV(RCZ,$P(TRANDATA,U,1)) ; ar transaction type desc
+18 ;S RCZ=$$CSV(RCZ,$$FMTE^XLFDT($P(TRANDATA,U,2),"2Z")) ; transaction date entered
+19 ; trans user
SET RCZ=$$CSV(RCZ,$PIECE(TRANDATA,U,3))
+20 WRITE !,RCZ
+21 QUIT
+22 ;
CSV(STRING,DATA) ; build the Excel data string format
+1 SET STRING=$SELECT(STRING="":DATA,1:STRING_U_DATA)
+2 QUIT STRING
+3 ;
DIVHDR ;
+1 IF RCTCEXCEL
DO EXCELHD
QUIT
+2 WRITE !,"Date Range: "
+3 IF RCTCDATE("BEGIN")=2840101
WRITE "All"
+4 IF RCTCDATE("BEGIN")'=2840101
WRITE $$FMTE^XLFDT($GET(RCTCDATE("BEGIN")),"2Z")," - ",$$FMTE^XLFDT($GET(RCTCDATE("END")),"2Z")
+5 WRITE ?47,"Cross-Servicing Stop Reactivate Report by Bill",?122,"Page: ",PAGE
+6 WRITE !
IF RCTCDIV="A"
WRITE "Division(s): All"
+7 WRITE ?45," Currently Flagged, Reactivated, or Both: "
+8 WRITE $SELECT(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
+9 WRITE ?111,$PIECE($$FMTE^XLFDT($$NOW^XLFDT),":",1,2)
+10 IF RCTCDIV'="A"
Begin DoDot:1
+11 WRITE !,"Division(s): "
SET DV=""
SET DV1=""
FOR
SET DV=$ORDER(RCTC("DIVN",DV))
if DV=""
QUIT
SET DV1=DV1_RCTC("DIVN",DV)_"-"_DV_", "
+12 WRITE $EXTRACT(DV1,1,$LENGTH(DV1)-2)
End DoDot:1
+13 WRITE !,"Debtor Range: "
+14 IF RCTCDEBT1=("FIRST")&(RCTCDEBT2="LAST")
WRITE "ALL"
+15 IF '$TEST
WRITE RCTCDEBT1,":",RCTCDEBT2
+16 WRITE !,SEPLINE
+17 ;PRCA*4.5*433
WRITE !,"Debtor Name",?24,"Division",?34,"Pt ID",?44,"Bill#",?55,"AR CAT",?66,"Status",?78,"Letter1",?88,"StopDate",?100,"Reason",?110,"CS STOP",?120,"User"
+18 ;W !,"Debtor Name",?24,"Division",?34,"Pt ID",?44,"Bill#",?55,"Status",?67,"Letter1",?77,"StopDate",?89,"Reason",?99,"CS STOP",?109,"User"
+19 WRITE !,SEPLINE
+20 QUIT
DLEVEL ; stop/reactivate report at 340 debtor level
+1 KILL ^TMP("RCTC",$JOB)
+2 DO DEBTORS^RCTCSP4
if $DATA(DIRUT)
QUIT
+3 SET DEBRANGE=RCTCDEBT1_":"_RCTCDEBT2
+4 DO DATES^RCTCSP4
if '$DATA(RCTCDATE)!$DATA(DIRUT)
QUIT
+5 SET PAGE=0
SET RCTCSTOP=0
SET $PIECE(SEPLINE,"-",133)=""
+6 DO FORMAT^RCTCSP4
if RCTCEXCEL=""
QUIT
+7 DO DEVICE
+8 QUIT
QENT ;queue ENTRY
+1 SET PAGE=0
SET RCTCSTOP=0
SET $PIECE(SEPLINE,"-",133)=""
+2 DO HDR
+3 KILL ^TMP("RCTC",$JOB)
+4 SET DEBTOR=0
FOR
SET DEBTOR=$ORDER(^RCD(340,DEBTOR))
if DEBTOR'>0
QUIT
DO DSR
+5 DO PRINT
+6 QUIT
DSR ;only top level debtors
if ^RCD(340,DEBTOR,0)'?.E1"DPT(".E
QUIT
+1 SET DEBTNAME=$$GET1^DIQ(340,DEBTOR,.01)
+2 ; before name range
IF RCTCDEBT1'="FIRST"
IF RCTCDEBT1'=DEBTNAME
IF RCTCDEBT1]DEBTNAME
QUIT
+3 ; after name range
IF RCTCDEBT2'="LAST"
IF RCTCDEBT2'=DEBTNAME
IF DEBTNAME]RCTCDEBT2
QUIT
+4 SET SRDT=""
FOR
SET SRDT=$ORDER(^RCD(340,DEBTOR,8,"C",SRDT))
if SRDT'>0
QUIT
Begin DoDot:1
+5 ;check date range
if (RCTCDATE("BEGIN")\1)>SRDT
QUIT
+6 if (RCTCDATE("END")_.99)<SRDT
QUIT
+7 SET N1=0
FOR
SET N1=$ORDER(^RCD(340,DEBTOR,8,"C",SRDT,N1))
if N1'>0
QUIT
Begin DoDot:2
+8 SET NN=DEBTNAME
+9 SET G=^RCD(340,DEBTOR,8,N1,0)
SET RCDT=$PIECE(G,U,2)
SET RCSR=$PIECE(G,U)
SET G(N1)=G
+10 ;Filter stops
IF RCTCFLG="R"&(RCSR="R")
SET ^TMP("RCTC",$JOB,NN,DEBTOR,RCDT)=N1
+11 ;Filter reactivates
IF RCTCFLG="C"&(RCSR="S")
SET ^TMP("RCTC",$JOB,NN,DEBTOR,RCDT)=N1
+12 IF RCTCFLG="B"
SET ^TMP("RCTC",$JOB,NN,DEBTOR,RCDT)=N1
End DoDot:2
End DoDot:1
+13 QUIT
PRINT ;print for debtor level
+1 SET NN=""
FOR
SET NN=$ORDER(^TMP("RCTC",$JOB,NN))
if NN=""
QUIT
if RCTCSTOP
QUIT
SET DEBTOR=0
FOR
SET DEBTOR=$ORDER(^TMP("RCTC",$JOB,NN,DEBTOR))
if DEBTOR'>0
QUIT
Begin DoDot:1
+2 SET RCDT=0
FOR
SET RCDT=$ORDER(^TMP("RCTC",$JOB,NN,DEBTOR,RCDT))
if RCDT'>0
QUIT
if RCTCSTOP
QUIT
Begin DoDot:2
+3 SET N1=^TMP("RCTC",$JOB,NN,DEBTOR,RCDT)
+4 SET SSN=$$SSN^RCFN01(DEBTOR)
+5 ; patient id
SET PTID=$EXTRACT(NN,1)_$SELECT(SSN'="":$EXTRACT(SSN,6,9),1:"0000")
+6 ; REason
SET IENS=N1_","_DEBTOR_","
SET REASON=$$GET1^DIQ(340.08,IENS,.04)
+7 SET G=^RCD(340,DEBTOR,8,N1,0)
+8 SET SR=$PIECE(G,U)
+9 ;_"@"_$P(XDATE,".",2)
SET XDATE=$EXTRACT($PIECE(G,U,2),1,12)
SET XDATE=$EXTRACT(XDATE,4,5)_"/"_$EXTRACT(XDATE,6,7)_"/"_$EXTRACT(XDATE,2,3)
+10 SET USER=$PIECE(G,U,3)
SET USER=$$GET1^DIQ(200,USER_",",.01)
+11 IF RCTCEXCEL
DO DEXLN
QUIT
+12 ;NAME
WRITE !,NN
+13 WRITE ?35,PTID
+14 WRITE ?42,SSN
+15 WRITE ?54,SR
+16 WRITE ?57,XDATE
+17 WRITE ?75,REASON
+18 ;W ?85,$P(G,U,5) ;COMMENT
+19 WRITE ?107,USER
+20 ;I RCTCSTOP Q
WRITE *7
IF $Y+3>IOSL
DO HDR^RCTCSP4E
End DoDot:2
End DoDot:1
+21 WRITE !!,?20,"*** ",$SELECT($GET(RCTCSTOP):"Report Ended",1:"End of Report")," ***"
+22 IF $EXTRACT(IOST,1,2)="C-"
IF '$DATA(DIRUT)
IF '$GET(RCTCSTOP)
READ !!,"Type <Enter> to continue or '^' to exit:",X:DTIME
WRITE @IOF
+23 QUIT
DLHDR ;Debtor Level Header
+1 IF RCTCEXCEL=1
DO DLXHD
QUIT
+2 WRITE !,"Date Range: "
+3 IF RCTCDATE="A"
WRITE "All"
+4 IF '$TEST
WRITE $$FMTE^XLFDT($GET(RCTCDATE("BEGIN")),"2Z")," - ",$$FMTE^XLFDT($GET(RCTCDATE("END")),"2Z")
+5 WRITE ?35,"Cross-Servicing Stop Reactivate Report at Debtor Level",?122,"Page: ",PAGE
+6 WRITE !?33," Currently Flagged, Reactivated, or Both: "
+7 WRITE $SELECT(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
+8 WRITE !,"Debtor Range: ",DEBRANGE
+9 WRITE ?111,$PIECE($$FMTE^XLFDT($$NOW^XLFDT),":",1,2)
+10 WRITE !,SEPLINE
+11 WRITE !,"Debtor Name",?35,"Pt ID",?42,"SSN",?53,"S/R",?57,"Date",?75,"Reason",?107,"User"
+12 WRITE !,SEPLINE
+13 QUIT
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 132 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="QENT^RCTCSP4E"
+15 SET ZTDESC="RCTC AR Cross-Servicing Stop Reactivate Report DEBTOR LEVEL"
+16 SET ZTSAVE("RCTC(")=""
+17 SET ZTSAVE("RCTCDB")=""
+18 SET ZTSAVE("RCTCDIV")=""
+19 SET ZTSAVE("RCTCFLG")=""
+20 SET ZTSAVE("RCTCDEBT1")=""
+21 SET ZTSAVE("RCTCDEBT2")=""
+22 SET ZTSAVE("RCTCDATE")=""
+23 SET ZTSAVE("RCTCDATE(")=""
+24 SET ZTSAVE("RCTCEXCEL")=""
+25 SET ZTSAVE("DEBRANGE")=""
+26 SET ZTSAVE("DLEVEL")=""
+27 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+28 IF POP
SET RET=0
+29 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
+30 QUIT RET
+31 ;
DLXHD ; print an Excel header record DEBTOR level
+1 NEW RCH
+2 SET RCH=$$CSV("","Debtor Name")
+3 SET RCH=$$CSV(RCH,"Pt ID")
+4 SET RCH=$$CSV(RCH,"SSN")
+5 SET RCH=$$CSV(RCH,"S/R")
+6 SET RCH=$$CSV(RCH,"Date")
+7 SET RCH=$$CSV(RCH,"Reason")
+8 SET RCH=$$CSV(RCH,"User")
+9 WRITE RCH
+10 QUIT
DEXLN ; write a line of Excel data for debtor
+1 NEW RCZ
+2 ; AR Debtor Name
SET RCZ=$$CSV("",NN)
+3 ; patient ID
SET RCZ=$$CSV(RCZ,PTID)
+4 ; SSN
SET RCZ=$$CSV(RCZ,SSN)
+5 ; SR
SET RCZ=$$CSV(RCZ,SR)
+6 ; Date
SET RCZ=$$CSV(RCZ,XDATE)
+7 ; reason
SET RCZ=$$CSV(RCZ,REASON)
+8 ; CLERK
SET RCZ=$$CSV(RCZ,USER)
+9 WRITE !,RCZ
+10 QUIT
