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

RCTCSP4E.m

Go to the documentation of this file. 
  1. RCTCSP4E ;HAF/ASF - CS Debt Referral Stop Reactivate Report ;6/1/2017
  1.  ;;4.5;Accounts Receivable;**350,433**;Mar 26, 2019;Build 7
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. HDR ; report header
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,RCSR
  1.  ;
  1.  S CRT=0 S:IOST?1"C".E CRT=1
  1.  ; Do an end of page reader call if page# exists and device is the screen
  1.  I PAGE,CRT S DIR(0)="E" D ^DIR K DIR I 'Y S RCTCSTOP=1 G HDRX
  1.  ;
  1.  ; If screen output or page# exists, do a form feed
  1.  I PAGE!CRT W @IOF
  1.  ;
  1.  ; First printer/file page - do a left margin reset
  1.  I 'PAGE,'CRT W $C(13)
  1.  ;
  1.  S PAGE=PAGE+1    ; increment page#
  1.  ;
  1.  ; For Excel format, display the column headers only
  1.  ;
  1.  ; Display the report headers
  1.  ;
  1.  D DLHDR:RCTCDB="D",DIVHDR:RCTCDB="B"
  1.  Q  ;
  1.  W ?47,"Cross-Servicing Stop Reactivate Report by ",$S(RCTCDIV="D":"Division",1:"Debtor"),?122,"Page: ",PAGE
  1.  ;
  1.  W !,"Date Range: "
  1.  I RCTCDATE="A" W "ALL"
  1.  E  D
  1.  . W $$FMTE^XLFDT($G(RCTCDATE("BEGIN")),"2Z")," - "
  1.  . W $$FMTE^XLFDT($G(RCTCDATE("END")),"2Z")
  1.  . Q
  1.  W "  Currently Flagged, Reactivated, or Both: "
  1.  W $S(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
  1.  I RCTCDIV="D" W "  Division: " S DIV1=0 F  S DIV1=$O(RCTC("DIVS",DIV1)) Q:DIV1'>0  W " "_DIV1
  1.  E  W "  Division: All"
  1.  W ?111,$$FMTE^XLFDT($$NOW^XLFDT)
  1.  W !,"Debtors: "
  1.  I RCTCDB="B"!'$D(RCTCSP4("DEBTOR")) W "ALL"
  1.  E  D
  1.  . S RTCN="" F  S RTCN=$O(RCTCSP4("DEBTOR",RTCN)) Q:RTCN=""  W RTCN_" "
  1.  . Q
  1.  ;
  1.  W !,SEPLINE
  1.  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"
  1.  W !,SEPLINE
  1.  ;
  1.  ; check for a TaskManager stop request
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD() D  G HDRX
  1.  . S (ZTSTOP,RCTCSTOP)=1
  1.  . W !!!?5,"*** Report Halted by TaskManager Request ***"
  1.  . Q
  1.  ;
  1. HDRX ;
  1.  Q
  1.  ;
  1. 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"
  1.  N RCH
  1.  S RCH=$$CSV("","Debtor Name")
  1.  S RCH=$$CSV(RCH,"Division")
  1.  ;S RCH=$$CSV(RCH,"Patient ID")
  1.  S RCH=$$CSV(RCH,"Pt ID")
  1.  ;S RCH=$$CSV(RCH,"SSN")
  1.  ;S RCH=$$CSV(RCH,"Bill Number")
  1.  S RCH=$$CSV(RCH,"Bill#")
  1.  ;S RCH=$$CSV(RCH,"Current Balance")
  1.  ;S RCH=$$CSV(RCH,"Current Status")
  1.  S RCH=$$CSV(RCH,"AR CAT") ;PRCA*4.5*433
  1.  S RCH=$$CSV(RCH,"Status")
  1.  ;S RCH=$$CSV(RCH,"Category Name")
  1.  ;S RCH=$$CSV(RCH,"Category Abbr")
  1.  ;S RCH=$$CSV(RCH,"Letter1 Date")
  1.  S RCH=$$CSV(RCH,"Letter1")
  1.  S RCH=$$CSV(RCH,"StopDate")
  1.  ;S RCH=$$CSV(RCH,"Stop Reason")
  1.  S RCH=$$CSV(RCH,"Reason")
  1.  ;S RCH=$$CSV(RCH,"Transaction Type")
  1.  ;S RCH=$$CSV(RCH,"Transaction Date Entered")
  1.  ;S RCH=$$CSV(RCH,"Transaction Processed By")
  1.  S RCH=$$CSV(RCH,"CS STOP")
  1.  S RCH=$$CSV(RCH,"User")
  1.  W RCH
  1.  Q
  1.  ;
  1. EXCELN ; write a line of Excel data
  1.  N RCZ
  1.  S RCZ=$$CSV("",$P(DEBTDATA,U,2))                         ; AR Debtor Name
  1.  S RCZ=$$CSV(RCZ,$P(BILLDATA,U,9))                        ; Division
  1.  S RCZ=$$CSV(RCZ,$P(DEBTDATA,U,1))                        ; patient ID
  1.  ;S RCZ=$$CSV(RCZ,$P(DEBTDATA,U,3))                        ; SSN
  1.  S RCZ=$$CSV(RCZ,$P(BILLDATA,U,1))                        ; bill#
  1.  ;S RCZ=$$CSV(RCZ,+$P(BILLDATA,U,2))                       ; current balance
  1.  S RCZ=$$CSV(RCZ,$P(BILLDATA,U,4))                        ; AR Category Name PRCA*4.5*433
  1.  S RCZ=$$CSV(RCZ,$P(BILLDATA,U,3))                        ; AR status name
  1.  ;S RCZ=$$CSV(RCZ,$P(BILLDATA,U,4))                        ; AR category name
  1.  ;S RCZ=$$CSV(RCZ,$P(BILLDATA,U,8))                        ; AR category abbr
  1.  S RCZ=$$CSV(RCZ,$$FMTE^XLFDT($P(BILLDATA,U,5),"2Z"))     ; letter1 date
  1.  S RCZ=$$CSV(RCZ,$$FMTE^XLFDT($P(BILLDATA,U,6),"2Z"))     ; stop flag effective date
  1.  S RCZ=$$CSV(RCZ,$P(BILLDATA,U,7))                        ; stop flag reason
  1.  S TT=$P(TRANDATA,U,1)
  1.  S RCZ=$$CSV(RCZ,$S(TT["DELETED":"DEL",TT["PLACED":"ADD",1:"UNK"))
  1.  ;S RCZ=$$CSV(RCZ,$P(TRANDATA,U,1))                        ; ar transaction type desc
  1.  ;S RCZ=$$CSV(RCZ,$$FMTE^XLFDT($P(TRANDATA,U,2),"2Z"))     ; transaction date entered
  1.  S RCZ=$$CSV(RCZ,$P(TRANDATA,U,3))                        ; trans user
  1.  W !,RCZ
  1.  Q
  1.  ;
  1. CSV(STRING,DATA) ; build the Excel data string format
  1.  S STRING=$S(STRING="":DATA,1:STRING_U_DATA)
  1.  Q STRING
  1.  ; 
  1. DIVHDR ;
  1.  I RCTCEXCEL D EXCELHD Q
  1.  W !,"Date Range: "
  1.  I RCTCDATE("BEGIN")=2840101 W "All"
  1.  I RCTCDATE("BEGIN")'=2840101 W $$FMTE^XLFDT($G(RCTCDATE("BEGIN")),"2Z")," - ",$$FMTE^XLFDT($G(RCTCDATE("END")),"2Z")
  1.  W ?47,"Cross-Servicing Stop Reactivate Report by Bill",?122,"Page: ",PAGE
  1.  W ! I RCTCDIV="A" W "Division(s): All"
  1.  W ?45,"  Currently Flagged, Reactivated, or Both: "
  1.  W $S(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
  1.  W ?111,$P($$FMTE^XLFDT($$NOW^XLFDT),":",1,2)
  1.  I RCTCDIV'="A" D
  1.  . W !,"Division(s): " S DV="",DV1="" F  S DV=$O(RCTC("DIVN",DV)) Q:DV=""  S DV1=DV1_RCTC("DIVN",DV)_"-"_DV_", "
  1.  . W $E(DV1,1,$L(DV1)-2)
  1.  W !,"Debtor Range: "
  1.  I RCTCDEBT1=("FIRST")&(RCTCDEBT2="LAST") W "ALL"
  1.  E  W RCTCDEBT1,":",RCTCDEBT2
  1.  W !,SEPLINE
  1.  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
  1.  ;W !,"Debtor Name",?24,"Division",?34,"Pt ID",?44,"Bill#",?55,"Status",?67,"Letter1",?77,"StopDate",?89,"Reason",?99,"CS STOP",?109,"User"
  1.  W !,SEPLINE
  1.  Q
  1. DLEVEL ; stop/reactivate report at 340 debtor level
  1.  K ^TMP("RCTC",$J)
  1.  D DEBTORS^RCTCSP4 Q:$D(DIRUT)
  1.  S DEBRANGE=RCTCDEBT1_":"_RCTCDEBT2
  1.  D DATES^RCTCSP4 Q:'$D(RCTCDATE)!$D(DIRUT)
  1.  S PAGE=0,RCTCSTOP=0,$P(SEPLINE,"-",133)=""
  1.  D FORMAT^RCTCSP4 Q:RCTCEXCEL=""
  1.  D DEVICE
  1.  Q
  1. QENT ;queue ENTRY
  1.  S PAGE=0,RCTCSTOP=0,$P(SEPLINE,"-",133)=""
  1.  D HDR
  1.  K ^TMP("RCTC",$J)
  1.  S DEBTOR=0 F  S DEBTOR=$O(^RCD(340,DEBTOR)) Q:DEBTOR'>0  D DSR
  1.  D PRINT
  1.  Q
  1. DSR Q:^RCD(340,DEBTOR,0)'?.E1"DPT(".E  ;only top level debtors
  1.  S DEBTNAME=$$GET1^DIQ(340,DEBTOR,.01)
  1.  I RCTCDEBT1'="FIRST",RCTCDEBT1'=DEBTNAME,RCTCDEBT1]DEBTNAME Q  ; before name range
  1.  I RCTCDEBT2'="LAST",RCTCDEBT2'=DEBTNAME,DEBTNAME]RCTCDEBT2 Q   ; after name range
  1.  S SRDT="" F  S SRDT=$O(^RCD(340,DEBTOR,8,"C",SRDT)) Q:SRDT'>0  D
  1.  . Q:(RCTCDATE("BEGIN")\1)>SRDT  ;check date range
  1.  . Q:(RCTCDATE("END")_.99)<SRDT
  1.  . S N1=0 F  S N1=$O(^RCD(340,DEBTOR,8,"C",SRDT,N1)) Q:N1'>0  D
  1.  .. S NN=DEBTNAME
  1.  .. S G=^RCD(340,DEBTOR,8,N1,0),RCDT=$P(G,U,2),RCSR=$P(G,U),G(N1)=G
  1.  .. I RCTCFLG="R"&(RCSR="R") S ^TMP("RCTC",$J,NN,DEBTOR,RCDT)=N1  ;Filter stops
  1.  .. I RCTCFLG="C"&(RCSR="S") S ^TMP("RCTC",$J,NN,DEBTOR,RCDT)=N1 ;Filter reactivates
  1.  .. I RCTCFLG="B" S ^TMP("RCTC",$J,NN,DEBTOR,RCDT)=N1
  1.  Q
  1. PRINT ;print for debtor level
  1.  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
  1.  . S RCDT=0 F  S RCDT=$O(^TMP("RCTC",$J,NN,DEBTOR,RCDT)) Q:RCDT'>0  Q:RCTCSTOP  D
  1.  .. S N1=^TMP("RCTC",$J,NN,DEBTOR,RCDT)
  1.  .. S SSN=$$SSN^RCFN01(DEBTOR)
  1.  .. S PTID=$E(NN,1)_$S(SSN'="":$E(SSN,6,9),1:"0000")            ; patient id
  1.  .. S IENS=N1_","_DEBTOR_"," S REASON=$$GET1^DIQ(340.08,IENS,.04) ; REason
  1.  .. S G=^RCD(340,DEBTOR,8,N1,0)
  1.  .. S SR=$P(G,U)
  1.  .. 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)
  1.  .. S USER=$P(G,U,3) S USER=$$GET1^DIQ(200,USER_",",.01)
  1.  .. I RCTCEXCEL D DEXLN Q
  1.  .. W !,NN ;NAME
  1.  .. W ?35,PTID
  1.  .. W ?42,SSN
  1.  .. W ?54,SR
  1.  .. W ?57,XDATE
  1.  .. W ?75,REASON
  1.  .. ;W ?85,$P(G,U,5) ;COMMENT
  1.  .. W ?107,USER
  1.  .. W *7 I $Y+3>IOSL D HDR^RCTCSP4E ;I RCTCSTOP Q
  1.  W !!,?20,"*** ",$S($G(RCTCSTOP):"Report Ended",1:"End of Report")," ***"
  1.  I $E(IOST,1,2)="C-",'$D(DIRUT),'$G(RCTCSTOP) R !!,"Type <Enter> to continue or '^' to exit:",X:DTIME W @IOF
  1.  Q
  1. DLHDR ;Debtor Level Header
  1.  I RCTCEXCEL=1 D DLXHD Q
  1.  W !,"Date Range: "
  1.  I RCTCDATE="A" W "All"
  1.  E  W $$FMTE^XLFDT($G(RCTCDATE("BEGIN")),"2Z")," - ",$$FMTE^XLFDT($G(RCTCDATE("END")),"2Z")
  1.  W ?35,"Cross-Servicing Stop Reactivate Report at Debtor Level",?122,"Page: ",PAGE
  1.  W !?33,"  Currently Flagged, Reactivated, or Both: "
  1.  W $S(RCTCFLG="C":"Currently Flagged",RCTCFLG="R":"Reactivated",1:"Both")
  1.  W !,"Debtor Range: ",DEBRANGE
  1.  W ?111,$P($$FMTE^XLFDT($$NOW^XLFDT),":",1,2)
  1.  W !,SEPLINE
  1.  W !,"Debtor Name",?35,"Pt ID",?42,"SSN",?53,"S/R",?57,"Date",?75,"Reason",?107,"User"
  1.  W !,SEPLINE
  1.  Q
  1. DEVICE() ; Device Selection
  1.  N ZTRTN,ZTDESC,ZTSAVE,POP,RET,ZTSK,DIR,X,Y
  1.  S RET=1
  1.  I 'RCTCEXCEL W !!,"It is recommended that you Queue this report to a device ",!,"that is 132 characters wide",!
  1.  I RCTCEXCEL D
  1.  . W !!,"To capture as an Excel format, it is recommended that you queue this report to"
  1.  . W !,"a spool device with margins of 256 and page length of 99999,"
  1.  . W !,"(e.g. spoolname;256;99999).This should help avoid wrapping problems.",!
  1.  . W !,"Another method would be to set up your terminal to capture the detail report"
  1.  . W !,"data. On some terminals, this can be done by clicking on the 'Tools' menu above,"
  1.  . W !,"then click on 'Capture Incoming Data' to save to Desktop."
  1.  . W !,"To avoid undesired wrapping of the data saved to the file,"
  1.  . W !,"please enter '0;256;99999' at the 'DEVICE:' prompt."
  1.  ;
  1.  S ZTRTN="QENT^RCTCSP4E"
  1.  S ZTDESC="RCTC AR Cross-Servicing Stop Reactivate Report DEBTOR LEVEL"
  1.  S ZTSAVE("RCTC(")=""
  1.  S ZTSAVE("RCTCDB")=""
  1.  S ZTSAVE("RCTCDIV")=""
  1.  S ZTSAVE("RCTCFLG")=""
  1.  S ZTSAVE("RCTCDEBT1")=""
  1.  S ZTSAVE("RCTCDEBT2")=""
  1.  S ZTSAVE("RCTCDATE")=""
  1.  S ZTSAVE("RCTCDATE(")=""
  1.  S ZTSAVE("RCTCEXCEL")=""
  1.  S ZTSAVE("DEBRANGE")=""
  1.  S ZTSAVE("DLEVEL")=""
  1.  D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
  1.  I POP S RET=0
  1.  I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR K DIR
  1.  Q RET
  1.  ;
  1. DLXHD ; print an Excel header record DEBTOR level
  1.  N RCH
  1.  S RCH=$$CSV("","Debtor Name")
  1.  S RCH=$$CSV(RCH,"Pt ID")
  1.  S RCH=$$CSV(RCH,"SSN")
  1.  S RCH=$$CSV(RCH,"S/R")
  1.  S RCH=$$CSV(RCH,"Date")
  1.  S RCH=$$CSV(RCH,"Reason")
  1.  S RCH=$$CSV(RCH,"User")
  1.  W RCH
  1.  Q
  1. DEXLN ; write a line of Excel data for debtor
  1.  N RCZ
  1.  S RCZ=$$CSV("",NN)                         ; AR Debtor Name
  1.  S RCZ=$$CSV(RCZ,PTID)                        ; patient ID
  1.  S RCZ=$$CSV(RCZ,SSN)                        ; SSN
  1.  S RCZ=$$CSV(RCZ,SR)                        ; SR
  1.  S RCZ=$$CSV(RCZ,XDATE)                       ; Date
  1.  S RCZ=$$CSV(RCZ,REASON)                       ; reason
  1.  S RCZ=$$CSV(RCZ,USER)                        ; CLERK
  1.  W !,RCZ
  1.  Q