RCDPENRU ;ALB/SAB - AR DM DATA EXTRACTION (MENU OPTIONS/TRANSMIT E-MAIL) ;15-JUL-15
;;4.5;Accounts Receivable;**304,326**;Mar 20, 1995;Build 26
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; Tag which runs starts the periodic AR DM reporting processes
AUTO(RCMRUN,RCMAN) ;
;
; RCMRUN - Which report to run
; E-EFT/ERA Trending Report
; V-Volume Statistics Report
; RCMAN - Manual or Automated (1=Manual, 0 or Null - Automated
;
N I,RCBEGDT,RCDATA,RCDIV,RCEFT,RCENDDT,RCFLG,RCPAY,RCPYRLST,RCTYPE,RCVOL,RCWHICH ; PRCA*4.5*326
;
S RCMAN=+$G(RCMAN)
; Set variables
S RCENDDT=$$DT^XLFDT
S RCBEGDT=$$FMADD^XLFDT(RCENDDT,-90) ; Previous 90 days
S RCPYRLST("A")="",(RCPYRLST("START"),RCPYRLST("END"))=""
S RCDIV("A")="" ;all divisions
S (RCTYPE,RCPAY)="A" ; PRCA*4.5*326
S RCWHICH=1 ; PRCA*4.5*326
S:$G(RCMRUN)="" RCMRUN="B"
;
; Quit if the end date (the run date) is not Saturday.
I ('RCMAN),($$DOW^XLFDT(RCENDDT)'="Saturday") Q
;
S (RCVOL,RCEFT,I)=0
; Retrieve enable/disabled flags and location in array for the flag for the reports
F S I=$O(^RCDM(344.9,I)) Q:'I D
. S RCDATA=$G(^RCDM(344.9,I,0))
. Q:RCDATA=""
. S RCFLG(I)=RCDATA
. S:RCDATA["VOLUME" RCVOL=I
. S:RCDATA["EFT/ERA" RCEFT=I
;
; Run Volume Statistics Report if enabled
I +RCVOL,(RCMRUN'="E") D:+$P($G(RCFLG(RCVOL)),U,2) AUTO^RCDPENR1(0,RCBEGDT,RCENDDT,.RCPYRLST,"A","G")
;
S (RCPYRLST("TIN","START"),RCPYRLST("TIN","END"))=""
;
; Run EFT/ERA Trending Report if enabled
I +RCEFT,(RCMRUN'="V") D:+$P($G(RCFLG(RCEFT)),U,2) AUTO^RCDPENR2(0,RCBEGDT,RCENDDT,.RCPYRLST,"A","G",1,8,.RCDIV)
;
;Cleanup
K ^TMP("RCDPENR2",$J),^TMP("RCDPEADP",$J),^TMP("RCDPENR1",$J)
;
; Write mesage back to the user...
I RCMAN W $S(RCMRUN="E":"THE EFT/ERA TRENDING REPORT HAS ",RCMRUN="V":"THE VOLUME STATISTICS REPORT HAS ",1:"ALL REPORTS HAVE "),"BEEN STARTED.",!
;
Q
VPE ; - View/print entries in RCDPE DM REPORT ARCHIVE file (#344.91) for a given report date.
N RCDATA,RCHDR,RCIEN,RCDT,RCRPT,RCPAGE,RCDISP,POP
;
S RCPAGE=0,RCDISP=1
; Check for entries
I '$O(^RCDM(344.91,0)) W !!,"There are no entries available.",*7 Q
;
; Ask for the date to report on
S RCIEN=$$GETDT
Q:RCIEN=-1
;
;Select output device
S %ZIS="QM" D ^%ZIS Q:POP
;Option to queue
I $D(IO("Q")) D Q
.N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
.S ZTRTN="VPE1^RCDPENRU"
.S ZTDESC="EDI Volume Statistics Report"
.S ZTSAVE("RC*")=""
.D ^%ZTLOAD
.I $D(ZTSK) W !!,"Task number "_ZTSK_" has been queued."
.E W !!,"Unable to queue this job."
.K ZTSK,IO("Q") D HOME^%ZIS
;
;
;Reprint the report to the specified device
VPE1 ;
; Display the selected report.
;
S RCRPT=$P(RCIEN,U,2),RCIEN=$P(RCIEN,U)
;
; Extract the data and build the data string or array.
D GETRPT(RCIEN,.RCHDR,.RCDATA)
;
; Print the VOLUME STATISTICS reports
I RCRPT="VOLUME STATISTICS" D REPRINT^RCDPENR1(RCHDR,RCDATA)
I RCRPT="EFT/ERA TRENDING" D REPRINT^RCDPENR2(RCIEN)
;
Q
;
GETDT() ;
;
N X,Y,DIC,DTOUT,DUOUT
;
S DIC="^RCDM(344.91,",DIC(0)="AEMQZ",DIC("A")="Enter MONTH/YEAR: "
S DIC("?")="Enter the Month/Year (MM/DD) of the report(s) to view or print"
S DIC("W")="D EN^DDIOL($$UP^XLFSTR($$FMTE^XLFDT($P(^(0),U,2),9)),,""?40"")"
D ^DIC
K DIC
I $G(DTOUT)!$G(DUOUT) S Y=-1 Q
Q:Y'>0 Y
Q Y
;
;Return the report data
GETRPT(RCIEN,RCHDR,RCDATA) ;
; Input - RCIEN - IEN for the report
; Output - RCHDR - Header information for the report
; RCDATA - Body of data for the report.
;
; Initiaze variables
N RCI,RCSTR,RCD0
;
S RCI=1,RCSTR=""
;
; get the header record info in line one.
S RCHDR=$G(^RCDM(344.91,RCIEN,1,RCI,0))
;
; get the info for the report body
F S RCI=$O(^RCDM(344.91,RCIEN,1,RCI)) Q:'RCI D
. S RCD0=$G(^RCDM(344.91,RCIEN,1,RCI,0))
. S RCSTR=RCSTR_$P(RCD0,U,2)_U
;
; remove the extra ^ piece
S RCDATA=$P(RCSTR,U,1,$L(RCSTR,U)-1)
Q
DER ; - Disable/enable report(s) or extraction process.
N RCSTAT,RCSTTXT,RCSTTXT1,RCDATA,RCIEN,RCDMNM
N X,Y,DIR,DIRUT,DIROUT,DUOUT,DTOUT
;
S (Y,RCIEN)=0
F S RCIEN=$O(^RCDM(344.9,RCIEN)) Q:'RCIEN D Q:Y=-1
. ;
. ; Ask user to disable/enable reports.
. W ! S DIR(0)="Y",DIR("B")="NO"
. ;values should be the same for the reports, so get the status of the first report.
. S RCDATA=$G(^RCDM(344.9,RCIEN,0))
. Q:RCDATA=""
. S RCSTAT=$P(RCDATA,U,2)
. S RCDMNM=$P(RCDATA,U)
. ; set up message
. S:RCSTAT RCSTTXT="enabled",RCSTTXT1="disable"
. S:'RCSTAT RCSTTXT="disabled",RCSTTXT1="re-enable"
. ;
. S DIR("A",1)="The nightly AR DM "_RCDMNM_" report is currently "_RCSTTXT_"."
. S DIR("A")=" Do you want to "_RCSTTXT1_" it?"
. D ^DIR K DIR
. I $G(DTOUT)!$G(DUOUT) S Y=-1 Q
. D:Y UPDSTAT(RCSTAT,RCIEN)
Q
;
; Update the status of the
UPDSTAT(RCSTAT,RCIEN) ;
N DA,DIE,DR,NEWSTAT,X,Y
;
S NEWSTAT=$S(RCSTAT=0:1,1:0)
S DA=RCIEN,DIE="^RCDM(344.9,",DR=".02///"_NEWSTAT
D ^DIE
Q
;
MAN1 ; - Manually start AR DM extraction process.
N DIRUT,DIROUT,DUOUT,X,Y,DTOUT,DIR
;
;Let the process know that this is a rerun, do not transmit.
S DIR("A")="Enter the AR DM report to Manually Start: "
S DIR(0)="SAO^V:VOLUME STATISTICS;E:EFT/ERA TRENDING REPORT;B:BOTH"
S DIR("?",1)="Enter V to Manually start the Volume Statistics report, E for the "
S DIR("?")="EFT/ERA Trending Report, or B for Both reports"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q
;
; Run the selected report
D AUTO(Y,1)
Q
;
MAN2 ; - Manually transmit DM extract file.
N DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT,X
N RCIEN,RCBGDT,RCENDDT,RCSUB,RCXMZ
;
S RCPAGE=0,RCDISP=1
; Check for entries
I '$O(^RCDM(344.91,0)) W !!,"There are no entries available to retransmit.",*7 Q
;
MAN2A ; Ask for the date and report to retransmit
S RCIEN=$$GETDT
Q:RCIEN=-1
;
S RCBGDT=$P($$GET1^DIQ(344.91,+RCIEN_",",".04","I"),".")
S RCENDDT=$P($$GET1^DIQ(344.91,+RCIEN_",",".05","I"),".")
S RCSUB=$$GET1^DIQ(344.91,+RCIEN_",",".01","E")
;
;Confirm the resend
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Are you sure you want to transmit this report? "
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q
;
;Transmit
S RCXMZ=$$XM(+RCIEN,RCBGDT,RCENDDT,RCSUB)
;
;Check for success
I $G(RCXMZ) W " Done."
E D G:Y MAN2A
.S DIR(0)="Y",DIR("B")="NO"
.S DIR("A")="The DM extract message failed to transmit...try again"
.W !,*7 D ^DIR K DIR
.I $D(DTOUT)!$D(DUOUT)!(Y="") Q
;
Q
;
; - DM extract reports message (shown when DM Menu is called up).
MSG ;
N RCDT,RCDT1,RCST,RCN,RCIEN,RCFLG,RCNAME
;
W @IOF
S RCDT=$$M1^RCDPENR4(DT,1),RCDT1=$$M1^RCDPENR4(RCDT,3)
S RCIEN=0,RCFLG=0
F S RCIEN=$O(^RCDM(344.91,"C",RCDT,RCIEN)) Q:'RCIEN D
. S RCN=$G(^RCDM(344.91,RCDT,0)),RCNAME=$P(RCN,U),RCST=$P(RCN,U,3) I 'RCST G ENQ
. I RCST=1 D Q
. . W !,"The "_RCNAME_" DM extract process for ",RCDT1," was initiated on "
. . W $$M1^RCDPENR4($P(RCN,U,4),3),!,"but it hasn't run yet.",!
. . D MSQ
. ;
. I RCST=3 D Q
. . W !,"The "_RCNAME_" DM report data for ",IBDT1," has been successfully"
. . W !,"extracted on ",$$M1^RCDPENR4($P(RCN,U,5),3),". This data has been"
. . W !,"sent to the Central Collections mail group in FORUM.",*7
. ; Set array of reports that are not completed or on standby
. S ^TMP("RCDPENRU",$J,"DM",RCIEN)=""
I $D(^TMP("RCDPENRU",$J,"DM")) D MSG1(RCDT,RCDT1)
K ^TMP("RCDPENRU",$J)
Q
;
; Output those currently started.
MSG1(RCDT,RCDT1) ;
;
N RCIEN
;
W !
D MSH(RCDT1)
W !
S RCIEN=0
F S RCIEN=$O(^TMP("RCDPENRU",$J,"DM",RCIEN)) Q:RCIEN="" D
. S RCDATA=$G(^RCDM(344.91,RCIEN,0))
. Q:'RCDATA
. I $Y'<(IOSL-14) R X:DTIME
. S RCSTAT=$$GET1^DIQ(344.91,RCIEN_",",.03,"E") ; Get the external display for the status
. S RCNAME=$P(RCDATA,U)
. W RCDT1,?12,RCNAME,?35,RCSTAT,!
Q
;
; Restart Message
MSQ ;
W !,"If you want, you can restart the DM extract process"
W !,"by using the ""Manually Start DM Extraction"" option in"
W !,"the Diagnostic Measures Extract Menu."
Q
;
MSH(RCDT1) ; - DM extract reports message header.
W !,"Data for the following DM reports have not been extracted"
W !," for ",RCDT1,":",!!,*7
Q
;
CHK ; - Check file #344.91 for completed and/or transmitted DM extracts
; (shown when DM Extract Menu is called up).
N RCDT,RCDATA,RCDATE,RCENDDT,RCNEXDT,RCDONE,RCMSARY,RCVS,RCTR,RCI,RCJ,RCEMARY
N RCINCARY,RCMSG,RCRPTYPE,RCTREM,RCTRST,RCVSEM,RCVSST,RCJD,RCQ,RC0
;
S RCDT=$$DT^XLFDT,RCI=0
F S RCI=$O(^RCDM(344.91,"C",RCI)) Q:'RCI D
. ; - Check to see if next month is missing from file, if any.
. S RCNEXDT=RCI+$S($E(RCI,4,5)=12:8900,1:100)
. I $D(^RCDM(344.91,"C",RCNEXDT))!(RCNEXDT>RCDT) Q
. ;
. S RCDONE=0
. ;check for any future missing dates between the current and next days run.
. F Q:RCDONE D
. . S RCNEXDT=RCNEXDT+$S($E(RCNEXDT,4,5)=12:8900,1:100)
. . I $D(^RCDM(344.91,"C",RCNEXDT))!(RCNEXDT>RCDT) S RCDONE=1 Q
. . ;
. . ;Date missing update missing array for both reports.
. . S RCMSARY("VS",RCNEXDT)="",RCMSARY("TR",RCNEXDT)=""
. ;
. ;init loop variable and report missing flags to 1 (missing)
. S RCJ=0,RCVS=1,RCTR=1
. F S RCJ=$O(^RCDM(344.91,"C",RCI,RCJ)) Q:'RCJ D
. . S RCJD=$G(^RCDM(344.91,RCJ,0))
. . S RCRPT=$P(RCJD,U)
. . S RCRPTYPE=$S(RCRPT="VOLUME STATISTICS":"VS",1:"TR")
. . I RCRPT="VOLUME STATISTICS" S RCVS=0 Q
. . I RCRPT="EFT/ERA TRENDING REPORT" S RCTR=0
. ;
. ;update missing array
. S:RCVS RCMSARY("VS",RCI)=""
. S:RCTR RCMSARY("TR",RCI)=""
. ;
. ;check status of reports to report completion, transmission issues
. ;init loop variable and report missing flags to 1 (missing)
. S RCJ=0,RCVSST=1,RCTRST=1,RCVSEM=1,RCTREM=1
. F S RCJ=$O(^RCDM(344.91,"C",RCI,RCJ)) Q:'RCJ D
. . S RCJD=$G(^RCDM(344.91,RCJ,0))
. . S RCRPT=$P(RCJD,U),RCSTAT=$P(RCJD,U,3),RCMSG=$P(RCJD,U,7)
. . S RCRPTYPE=$S(RCRPT="VOLUME STATISTICS":"VS",1:"TR")
. . I RCSTAT'=3 S RCINCARY(RCRPTYPE,RCI)=""
. . I 'RCMSG S RCEMARY(RCRPTYPE,RCI)=""
;
I '$D(RCMSARY),'$D(RCINCARY),'$D(RCEMARY) W "Done" Q
;
;Report what dates are missing for which reports, which are incomplete and which were not sent
;
I $D(RCMSARY) D
. S RCJ=0 F S RCJ=$O(RCMSARY(RCJ)) Q:RCJ="" D
. . S RCQ=$S(RCJ="TR":"EFT/ERA TRENDING REPORT",1:"VOLUME STATISTICS")
. . I $D(RCMSARY(RCJ))=10 W !!,"The "_RCQ_" data has NOT been fully extracted for these months:",!,*7
. . S RC0=0 F S RC0=$O(RCMSARY(RCJ,RC0)) Q:'RC0 W " ",$$M1^RCDPENR4(RC0,3)
. W !,"If you want, you can start the DM extract process for these"
. W !,"months by using the ""Manually Start DM Extraction"" option."
;
I $D(RCINCARY) D
. S RCJ=0 F S RCJ=$O(RCINCARY(RCJ)) Q:RCJ="" D
. . S RCQ=$S(RCJ="TR":"EFT/ERA TRENDING REPORT",1:"VOLUME STATISTICS")
. . I $D(RCINCARY(RCJ))=10 W !!,"The "_RCQ_" data has NOT been transmitted for these months:",!,*7
. . S RC0=0 F S RC0=$O(RCINCARY(RCJ,RC0)) Q:'RC0 W " ",$$M1^RCDPENR4(RC0,3)
. W !,"If you want, you can re-transmit the DM extract data for these"
. W !,"months by using the ""Manually Transmit DM Extract"" option."
;
I $D(RCEMARY) D
. S RCJ=0 F S RCJ=$O(RCEMARY(RCJ)) Q:RCJ="" D
. . S RCQ=$S(RCJ="TR":"EFT/ERA TRENDING REPORT",1:"VOLUME STATISTICS")
. . I $D(RCEMARY(RCJ))=10 W !!,"The "_RCQ_" data has NOT stored an email message for these months:",!,*7
. . S RC0=0 F S RC0=$O(RCEMARY(RCJ,RC0)) Q:'RC0 W " ",$$M1^RCDPENR4(RC0,3)
. W !,"If you want, you can re-transmit the DM extract data for these"
. W !,"months by using the ""Manually Transmit DM Extract"" option."
;
Q
XM(RCDMIEN,RCBEGDT,RCENDDT,XMSUB) ; - Create/transmit DM extract file message.
N DA,DIE,DR,RCSTE,X,Y,XMTEXT,XMDUZ,DT,CT,XMZ,RCJ,DT,DT1,DTRNG,RCXMZ,RCMG
S RCXMZ=0
K ^TMP("RCDPENRU",$J) S RCXMZ=0,DT=$$DT^XLFDT,RCSTE=$$SITE^VASITE,X=$E(DT,4,7)_(1700+$E(DT,1,3))
S ^TMP("RCDPENRU",$J,1)="HDR^"_$P(RCSTE,U,3)_U_$P(RCSTE,U,2)_U_X
S CT=1,RCJ=0
S DTRNG=$E(RCBEGDT,4,7)_(1700+$E(RCBEGDT,1,3))_"~"_$E(RCENDDT,4,7)_(1700+$E(RCBEGDT,1,3))
; Build the body of the message
F S RCJ=$O(^RCDM(344.91,RCDMIEN,1,RCJ)) Q:'RCJ D
. S CT=CT+1
. S ^TMP("RCDPENRU",$J,CT)="DAT~"_DTRNG_"^"_$G(^RCDM(344.91,RCDMIEN,1,RCJ,0))
;
S ^TMP("RCDPENRU",$J,CT+1)="END^"_$P(RCSTE,U,3)
S XMSUB=XMSUB_"-"_DTRNG_" ("_$P(RCSTE,U,2)_")"
;
S RCMG=$P($G(^IBE(350.9,1,4)),U,5)
Q:RCMG="" RCXMZ
;
S XMDUZ="ACCOUNTS RECEIVABLE PACKAGE"
S XMTEXT="^TMP(""RCDPENRU"",$J,",XMY(RCMG)=""
S XMTEXT="^TMP(""RCDPENRU"",$J,",XMY(RCMG)=""
D SEND
;
I $G(XMZ) S RCXMZ=XMZ,DIE="^RCDM(344.91,",DA=RCDMIEN,DR=".03///3;.07///1;.06///"_XMZ D ^DIE
;
Q RCXMZ
;
ENQ K IB2,IBDT2,IBD1,IBD2,IBDT,IBFL,IBFR,IBN,IBS,IBST,IBST1,IBX,IBX1,BY,DHD
K DIC,DIOEND,FLDS,FR,IOP,L,TO,X,XMZ,Y,%
ENQ1 K IB0,IB1,IBC,IBDT1,IBMG,IBSTE,XMSUB,XMTEXT,XMY,^TMP("DME",$J)
Q
;
SEND ; Calls ^XMD to send the mail message with the data extracted
; Obs: By NEWing DUZ, ^XMD will assume DUZ=.5 (Sender=POSTMASTER)
;
N DUZ D ^XMD
Q
;
; Pass RCPAY by reference
GETPAY(RCPAY) ; Get payer information
N EX,RCLPAY,DTOUT,DUOUT,X,Y,DIR,DIRUT,DIROUT
S EX=1 ; Exit status
S DIR("A")="Select (A)ll or (R)ange of Payer Names?: ",DIR(0)="SA^A:All Payer Names;R:Range or List of Payer Names"
S DIR("B")="ALL" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S EX=0 Q EX
S RCLPAY=Y I $G(Y)="A" S RCPAY="ALL",RCPAY("DATA")="ALL" G GPO
; Get Range of Payers from Insurance file
I RCLPAY="R" S EX=$$GETRANG(.RCPAY,"P"),RCPAY="R"
GPO ;
Q EX
;
; RTNARR - Indirect Return array
; TYPE - The type of lookup "P" - Payer; "T" - TIN
GETRANG(RTNARR,TYPE) ;
N DIC,D,RCDTN,RCDN,RCPT,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,IDX
I $G(TYPE)=""!("PT"'[$G(TYPE)) S RTNARR="ERROR" Q ; Quit if TYPE not correct
S IDX=$S(TYPE="P":"B",TYPE="T":"C")
K DIC S DIC="^DIC(36,",DIC(0)="AES",D=IDX
S DIC("A")="Start with "_$S(TYPE="P":"Payer Name",TYPE="T":"Payer TIN")_": "
I TYPE="P" S DIC("W")=""
E S DIC("W")="D EN^DDIOL($P(^(0),U,1),,""?35"")"
D IX^DIC I $D(DTOUT)!$D(DUOUT)!(Y="")!(Y=-1) Q 0
S RCDN=$O(^DIC(36,IDX,X,""))
S RTNARR("START")=RCDN_U_X_U_Y,RTNARR("DATA")=X
;
K DIC S DIC="^DIC(36,",DIC(0)="AES",D=IDX
S DIC("A")="Go to with "_$S(TYPE="P":"Payer Name",TYPE="T":"Payer TIN")_": "
I TYPE="P" S DIC("W")=""
E S DIC("W")="D EN^DDIOL($P(^(0),U,1),,""?35"")"
D IX^DIC I $D(DTOUT)!$D(DUOUT)!(Y="")!(Y=-1) Q 0
S RCDN=$O(^DIC(36,IDX,X,""))
S RTNARR("END")=RCDN_U_X_U_Y
I TYPE="P" S RTNARR("DATA")=$P(RTNARR("START"),U,4)_":"_$P(RTNARR("END"),U,4)
I TYPE="T" S RTNARR("DATA")=$P(RTNARR("START"),U,2)_":"_$P(RTNARR("END"),U,2)
Q 1
;
;Retrieve a list of valid payers
GETPAYER(RCPYRLST) ;
;
N RCANS
;
; Initialize start and end nodes in array
S (RCPYRLST("START"),RCPYRLST("END"))=""
;
; Ask user whether they wish to see All payers, a specific Payer, or a range of payers
S RCANS=$$GETANS(1)
I RCANS=-1 S RCPYRLST("QUIT")="" Q
;
; Exit if user wants all payers
Q:$E(RCANS)="A"
;
; Get the payer if the user wishes a single payer
I RCANS="S" D Q
. S RCANS=$$GETANS(2)
. I RCANS=-1 S RCPYRLST("QUIT")="" Q
. S (RCPYRLST("START"),RCPYRLST("END"))=RCANS
;
; User wishes a range, Get the Beginning payer
S RCANS=$$GETANS(3)
I RCANS=-1 S RCPYRLST("QUIT")="" Q
S RCPYRLST("START")=$$UP^XLFSTR(RCANS)
;
; Get the ending payer
S RCANS=$$GETANS(4)
I RCANS=-1 S RCPYRLST("QUIT")="" Q
S RCPYRLST("END")=$$UP^XLFSTR(RCANS)
;
Q
;
;Get users answers to questions for reports.
GETANS(RCIDX) ;
N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT
;
; Ask the user what kind of report
I RCIDX=1 D
. S DIR("?")="Select to (A) to see All payers on the report or (R) for a range of payers."
. S DIR("A")="(A)LL PAYERS, (R)ANGE OF PAYER NAMES: "
. ;S DIR("S")="A:ALL;S:SINGLE;R:RANGE"
. S DIR("B")="ALL",DIR(0)="SA^A:ALL;R:RANGE"
;
; Ask the user for the Payer to report on (Single Payer option)
I RCIDX=2 Q $$SPAY^RCDPENR4
;
; Ask the user for the payer to start the reporting on (Range Option)
I RCIDX=3 D
. S DIR("?")="Enter the first Payer name to run this report on."
. S DIR("A")="Select First Payer: ",DIR(0)="FA"
;
; Ask the user for the payer to end the reporting on (Range Option)
I RCIDX=4 D
. S DIR("?")="Enter the last Payer name to run this report on."
. S DIR("A")="Select Last Payer: ",DIR(0)="FA"
;
I RCIDX=5 D
. S DIR("?")="Select to (A) to see All Payer TINs on the report, or (R) for a Range of Payer TINs."
. S DIR("A")="SELECT (A)LL PAYER TINs, (R)ANGE of PAYER TINs: "
. ;S DIR("S")="A:All;R:Range"
. S DIR("B")="ALL",DIR(0)="SA^A:ALL;R:RANGE"
;
I $G(DIR(0))="" S DIR(0)="FA"
D ^DIR
K DIR
I ($D(DIRUT))!($D(DUOUT)) S Y=-1
I Y="N" S Y=-1
Q Y
;
; Compile the list of payers. The Payer IENS are extracted
PYRARY(RCSTART,RCEND,RCSWITCH) ;
;
;RCSTART - The text to start the search for insurance companies
;RCEND - The text to end the search for insurance companies,
;RCSWITCH - A flag to indicate which file to perform the insurance lookup
; 1 or Null) RCDPE AUTO-PAY EXCLUSION FILE (#344.6)
; 2) INSURANCE COMPANY FILE (#36)
;
N RCI,RCJ,RCFILE
;
; Clear any older data out of the array.
K ^TMP("RCDPEADP",$J,"INS")
;
; If start and end are NULL, then User wishes all payers, set flag and quit
I (RCSTART=""),(RCEND="") S ^TMP("RCDPEADP",$J,"INS","A")="" Q
;
I $G(RCSWITCH)=2 D INSLKUP(RCSTART,RCEND) Q
;
; If single payer, find the IEN if it exists and post it.
I RCSTART=RCEND D Q
. S RCJ=""
. F S RCJ=$O(^RCY(344.6,"B",RCSTART,RCJ)) Q:RCJ="" D
. . S ^TMP("RCDPEADP",$J,"INS",RCJ)=""
;
; For a range of payers, loop through the Payer name list until
; you reach the last payer in the range (RCEND)
;
S RCI=$O(^RCY(344.6,"B",RCSTART),-1) ; Set the starting location for the loop
F S RCI=$O(^RCY(344.6,"B",RCI)) Q:RCI="" Q:(RCI]RCEND) D
. S RCJ=""
. F S RCJ=$O(^RCY(344.6,"B",RCI,RCJ)) Q:RCJ="" D
. . S ^TMP("RCDPEADP",$J,"INS",RCJ)=""
;
Q
;
; Check to see if the Payer is in the list of Payers to process
INSCHK(RCINSIEN) ;
;Return value 0 - No, not in list or 1 - Yes in list
;
; If all payers are supposed to be process, then send back a 1
Q:$D(^TMP("RCDPEADP",$J,"INS","A")) 1
;
; If the payer is in the list of payers, send back yes
Q:$D(^TMP("RCDPEADP",$J,"INS",RCINSIEN)) 1
;
;Payer not in list, quit with No
Q 0
;
; Compile the list of payers from the Insurance File. The Payer IENS are extracted
INSLKUP(RCSTART,RCEND) ;
;
;RCSTART - The text to start the search for insurance companies
;RCEND - The text to end the search for insurance companies,
;
N RCI,RCJ
;
S RCI=RCSTART
;
;Loop through the Payer name list until you reach the last payer in the range (RCEND)
INSLP ;
S RCJ=""
F S RCJ=$O(^DIC(36,"B",RCI,RCJ)) Q:RCJ="" D
. S ^TMP("RCDPEADP",$J,"INS",RCJ)=""
S RCI=$O(^DIC(36,"B",RCI))
G:RCI]RCEND INSQT
G INSLP
;
;Work is done, exit
INSQT ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENRU 19168 printed Sep 23, 2025@19:21:09 Page 2
RCDPENRU ;ALB/SAB - AR DM DATA EXTRACTION (MENU OPTIONS/TRANSMIT E-MAIL) ;15-JUL-15
+1 ;;4.5;Accounts Receivable;**304,326**;Mar 20, 1995;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Tag which runs starts the periodic AR DM reporting processes
AUTO(RCMRUN,RCMAN) ;
+1 ;
+2 ; RCMRUN - Which report to run
+3 ; E-EFT/ERA Trending Report
+4 ; V-Volume Statistics Report
+5 ; RCMAN - Manual or Automated (1=Manual, 0 or Null - Automated
+6 ;
+7 ; PRCA*4.5*326
NEW I,RCBEGDT,RCDATA,RCDIV,RCEFT,RCENDDT,RCFLG,RCPAY,RCPYRLST,RCTYPE,RCVOL,RCWHICH
+8 ;
+9 SET RCMAN=+$GET(RCMAN)
+10 ; Set variables
+11 SET RCENDDT=$$DT^XLFDT
+12 ; Previous 90 days
SET RCBEGDT=$$FMADD^XLFDT(RCENDDT,-90)
+13 SET RCPYRLST("A")=""
SET (RCPYRLST("START"),RCPYRLST("END"))=""
+14 ;all divisions
SET RCDIV("A")=""
+15 ; PRCA*4.5*326
SET (RCTYPE,RCPAY)="A"
+16 ; PRCA*4.5*326
SET RCWHICH=1
+17 if $GET(RCMRUN)=""
SET RCMRUN="B"
+18 ;
+19 ; Quit if the end date (the run date) is not Saturday.
+20 IF ('RCMAN)
IF ($$DOW^XLFDT(RCENDDT)'="Saturday")
QUIT
+21 ;
+22 SET (RCVOL,RCEFT,I)=0
+23 ; Retrieve enable/disabled flags and location in array for the flag for the reports
+24 FOR
SET I=$ORDER(^RCDM(344.9,I))
if 'I
QUIT
Begin DoDot:1
+25 SET RCDATA=$GET(^RCDM(344.9,I,0))
+26 if RCDATA=""
QUIT
+27 SET RCFLG(I)=RCDATA
+28 if RCDATA["VOLUME"
SET RCVOL=I
+29 if RCDATA["EFT/ERA"
SET RCEFT=I
End DoDot:1
+30 ;
+31 ; Run Volume Statistics Report if enabled
+32 IF +RCVOL
IF (RCMRUN'="E")
if +$PIECE($GET(RCFLG(RCVOL)),U,2)
DO AUTO^RCDPENR1(0,RCBEGDT,RCENDDT,.RCPYRLST,"A","G")
+33 ;
+34 SET (RCPYRLST("TIN","START"),RCPYRLST("TIN","END"))=""
+35 ;
+36 ; Run EFT/ERA Trending Report if enabled
+37 IF +RCEFT
IF (RCMRUN'="V")
if +$PIECE($GET(RCFLG(RCEFT)),U,2)
DO AUTO^RCDPENR2(0,RCBEGDT,RCENDDT,.RCPYRLST,"A","G",1,8,.RCDIV)
+38 ;
+39 ;Cleanup
+40 KILL ^TMP("RCDPENR2",$JOB),^TMP("RCDPEADP",$JOB),^TMP("RCDPENR1",$JOB)
+41 ;
+42 ; Write mesage back to the user...
+43 IF RCMAN
WRITE $SELECT(RCMRUN="E":"THE EFT/ERA TRENDING REPORT HAS ",RCMRUN="V":"THE VOLUME STATISTICS REPORT HAS ",1:"ALL REPORTS HAVE "),"BEEN STARTED.",!
+44 ;
+45 QUIT
VPE ; - View/print entries in RCDPE DM REPORT ARCHIVE file (#344.91) for a given report date.
+1 NEW RCDATA,RCHDR,RCIEN,RCDT,RCRPT,RCPAGE,RCDISP,POP
+2 ;
+3 SET RCPAGE=0
SET RCDISP=1
+4 ; Check for entries
+5 IF '$ORDER(^RCDM(344.91,0))
WRITE !!,"There are no entries available.",*7
QUIT
+6 ;
+7 ; Ask for the date to report on
+8 SET RCIEN=$$GETDT
+9 if RCIEN=-1
QUIT
+10 ;
+11 ;Select output device
+12 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+13 ;Option to queue
+14 IF $DATA(IO("Q"))
Begin DoDot:1
+15 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+16 SET ZTRTN="VPE1^RCDPENRU"
+17 SET ZTDESC="EDI Volume Statistics Report"
+18 SET ZTSAVE("RC*")=""
+19 DO ^%ZTLOAD
+20 IF $DATA(ZTSK)
WRITE !!,"Task number "_ZTSK_" has been queued."
+21 IF '$TEST
WRITE !!,"Unable to queue this job."
+22 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+23 ;
+24 ;
+25 ;Reprint the report to the specified device
VPE1 ;
+1 ; Display the selected report.
+2 ;
+3 SET RCRPT=$PIECE(RCIEN,U,2)
SET RCIEN=$PIECE(RCIEN,U)
+4 ;
+5 ; Extract the data and build the data string or array.
+6 DO GETRPT(RCIEN,.RCHDR,.RCDATA)
+7 ;
+8 ; Print the VOLUME STATISTICS reports
+9 IF RCRPT="VOLUME STATISTICS"
DO REPRINT^RCDPENR1(RCHDR,RCDATA)
+10 IF RCRPT="EFT/ERA TRENDING"
DO REPRINT^RCDPENR2(RCIEN)
+11 ;
+12 QUIT
+13 ;
GETDT() ;
+1 ;
+2 NEW X,Y,DIC,DTOUT,DUOUT
+3 ;
+4 SET DIC="^RCDM(344.91,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Enter MONTH/YEAR: "
+5 SET DIC("?")="Enter the Month/Year (MM/DD) of the report(s) to view or print"
+6 SET DIC("W")="D EN^DDIOL($$UP^XLFSTR($$FMTE^XLFDT($P(^(0),U,2),9)),,""?40"")"
+7 DO ^DIC
+8 KILL DIC
+9 IF $GET(DTOUT)!$GET(DUOUT)
SET Y=-1
QUIT
+10 if Y'>0
QUIT Y
+11 QUIT Y
+12 ;
+13 ;Return the report data
GETRPT(RCIEN,RCHDR,RCDATA) ;
+1 ; Input - RCIEN - IEN for the report
+2 ; Output - RCHDR - Header information for the report
+3 ; RCDATA - Body of data for the report.
+4 ;
+5 ; Initiaze variables
+6 NEW RCI,RCSTR,RCD0
+7 ;
+8 SET RCI=1
SET RCSTR=""
+9 ;
+10 ; get the header record info in line one.
+11 SET RCHDR=$GET(^RCDM(344.91,RCIEN,1,RCI,0))
+12 ;
+13 ; get the info for the report body
+14 FOR
SET RCI=$ORDER(^RCDM(344.91,RCIEN,1,RCI))
if 'RCI
QUIT
Begin DoDot:1
+15 SET RCD0=$GET(^RCDM(344.91,RCIEN,1,RCI,0))
+16 SET RCSTR=RCSTR_$PIECE(RCD0,U,2)_U
End DoDot:1
+17 ;
+18 ; remove the extra ^ piece
+19 SET RCDATA=$PIECE(RCSTR,U,1,$LENGTH(RCSTR,U)-1)
+20 QUIT
DER ; - Disable/enable report(s) or extraction process.
+1 NEW RCSTAT,RCSTTXT,RCSTTXT1,RCDATA,RCIEN,RCDMNM
+2 NEW X,Y,DIR,DIRUT,DIROUT,DUOUT,DTOUT
+3 ;
+4 SET (Y,RCIEN)=0
+5 FOR
SET RCIEN=$ORDER(^RCDM(344.9,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:1
+6 ;
+7 ; Ask user to disable/enable reports.
+8 WRITE !
SET DIR(0)="Y"
SET DIR("B")="NO"
+9 ;values should be the same for the reports, so get the status of the first report.
+10 SET RCDATA=$GET(^RCDM(344.9,RCIEN,0))
+11 if RCDATA=""
QUIT
+12 SET RCSTAT=$PIECE(RCDATA,U,2)
+13 SET RCDMNM=$PIECE(RCDATA,U)
+14 ; set up message
+15 if RCSTAT
SET RCSTTXT="enabled"
SET RCSTTXT1="disable"
+16 if 'RCSTAT
SET RCSTTXT="disabled"
SET RCSTTXT1="re-enable"
+17 ;
+18 SET DIR("A",1)="The nightly AR DM "_RCDMNM_" report is currently "_RCSTTXT_"."
+19 SET DIR("A")=" Do you want to "_RCSTTXT1_" it?"
+20 DO ^DIR
KILL DIR
+21 IF $GET(DTOUT)!$GET(DUOUT)
SET Y=-1
QUIT
+22 if Y
DO UPDSTAT(RCSTAT,RCIEN)
End DoDot:1
if Y=-1
QUIT
+23 QUIT
+24 ;
+25 ; Update the status of the
UPDSTAT(RCSTAT,RCIEN) ;
+1 NEW DA,DIE,DR,NEWSTAT,X,Y
+2 ;
+3 SET NEWSTAT=$SELECT(RCSTAT=0:1,1:0)
+4 SET DA=RCIEN
SET DIE="^RCDM(344.9,"
SET DR=".02///"_NEWSTAT
+5 DO ^DIE
+6 QUIT
+7 ;
MAN1 ; - Manually start AR DM extraction process.
+1 NEW DIRUT,DIROUT,DUOUT,X,Y,DTOUT,DIR
+2 ;
+3 ;Let the process know that this is a rerun, do not transmit.
+4 SET DIR("A")="Enter the AR DM report to Manually Start: "
+5 SET DIR(0)="SAO^V:VOLUME STATISTICS;E:EFT/ERA TRENDING REPORT;B:BOTH"
+6 SET DIR("?",1)="Enter V to Manually start the Volume Statistics report, E for the "
+7 SET DIR("?")="EFT/ERA Trending Report, or B for Both reports"
+8 DO ^DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+10 ;
+11 ; Run the selected report
+12 DO AUTO(Y,1)
+13 QUIT
+14 ;
MAN2 ; - Manually transmit DM extract file.
+1 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT,X
+2 NEW RCIEN,RCBGDT,RCENDDT,RCSUB,RCXMZ
+3 ;
+4 SET RCPAGE=0
SET RCDISP=1
+5 ; Check for entries
+6 IF '$ORDER(^RCDM(344.91,0))
WRITE !!,"There are no entries available to retransmit.",*7
QUIT
+7 ;
MAN2A ; Ask for the date and report to retransmit
+1 SET RCIEN=$$GETDT
+2 if RCIEN=-1
QUIT
+3 ;
+4 SET RCBGDT=$PIECE($$GET1^DIQ(344.91,+RCIEN_",",".04","I"),".")
+5 SET RCENDDT=$PIECE($$GET1^DIQ(344.91,+RCIEN_",",".05","I"),".")
+6 SET RCSUB=$$GET1^DIQ(344.91,+RCIEN_",",".01","E")
+7 ;
+8 ;Confirm the resend
+9 SET DIR(0)="Y"
SET DIR("B")="NO"
+10 SET DIR("A")="Are you sure you want to transmit this report? "
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+13 ;
+14 ;Transmit
+15 SET RCXMZ=$$XM(+RCIEN,RCBGDT,RCENDDT,RCSUB)
+16 ;
+17 ;Check for success
+18 IF $GET(RCXMZ)
WRITE " Done."
+19 IF '$TEST
Begin DoDot:1
+20 SET DIR(0)="Y"
SET DIR("B")="NO"
+21 SET DIR("A")="The DM extract message failed to transmit...try again"
+22 WRITE !,*7
DO ^DIR
KILL DIR
+23 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
End DoDot:1
if Y
GOTO MAN2A
+24 ;
+25 QUIT
+26 ;
+27 ; - DM extract reports message (shown when DM Menu is called up).
MSG ;
+1 NEW RCDT,RCDT1,RCST,RCN,RCIEN,RCFLG,RCNAME
+2 ;
+3 WRITE @IOF
+4 SET RCDT=$$M1^RCDPENR4(DT,1)
SET RCDT1=$$M1^RCDPENR4(RCDT,3)
+5 SET RCIEN=0
SET RCFLG=0
+6 FOR
SET RCIEN=$ORDER(^RCDM(344.91,"C",RCDT,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:1
+7 SET RCN=$GET(^RCDM(344.91,RCDT,0))
SET RCNAME=$PIECE(RCN,U)
SET RCST=$PIECE(RCN,U,3)
IF 'RCST
GOTO ENQ
+8 IF RCST=1
Begin DoDot:2
+9 WRITE !,"The "_RCNAME_" DM extract process for ",RCDT1," was initiated on "
+10 WRITE $$M1^RCDPENR4($PIECE(RCN,U,4),3),!,"but it hasn't run yet.",!
+11 DO MSQ
End DoDot:2
QUIT
+12 ;
+13 IF RCST=3
Begin DoDot:2
+14 WRITE !,"The "_RCNAME_" DM report data for ",IBDT1," has been successfully"
+15 WRITE !,"extracted on ",$$M1^RCDPENR4($PIECE(RCN,U,5),3),". This data has been"
+16 WRITE !,"sent to the Central Collections mail group in FORUM.",*7
End DoDot:2
QUIT
+17 ; Set array of reports that are not completed or on standby
+18 SET ^TMP("RCDPENRU",$JOB,"DM",RCIEN)=""
End DoDot:1
+19 IF $DATA(^TMP("RCDPENRU",$JOB,"DM"))
DO MSG1(RCDT,RCDT1)
+20 KILL ^TMP("RCDPENRU",$JOB)
+21 QUIT
+22 ;
+23 ; Output those currently started.
MSG1(RCDT,RCDT1) ;
+1 ;
+2 NEW RCIEN
+3 ;
+4 WRITE !
+5 DO MSH(RCDT1)
+6 WRITE !
+7 SET RCIEN=0
+8 FOR
SET RCIEN=$ORDER(^TMP("RCDPENRU",$JOB,"DM",RCIEN))
if RCIEN=""
QUIT
Begin DoDot:1
+9 SET RCDATA=$GET(^RCDM(344.91,RCIEN,0))
+10 if 'RCDATA
QUIT
+11 IF $Y'<(IOSL-14)
READ X:DTIME
+12 ; Get the external display for the status
SET RCSTAT=$$GET1^DIQ(344.91,RCIEN_",",.03,"E")
+13 SET RCNAME=$PIECE(RCDATA,U)
+14 WRITE RCDT1,?12,RCNAME,?35,RCSTAT,!
End DoDot:1
+15 QUIT
+16 ;
+17 ; Restart Message
MSQ ;
+1 WRITE !,"If you want, you can restart the DM extract process"
+2 WRITE !,"by using the ""Manually Start DM Extraction"" option in"
+3 WRITE !,"the Diagnostic Measures Extract Menu."
+4 QUIT
+5 ;
MSH(RCDT1) ; - DM extract reports message header.
+1 WRITE !,"Data for the following DM reports have not been extracted"
+2 WRITE !," for ",RCDT1,":",!!,*7
+3 QUIT
+4 ;
CHK ; - Check file #344.91 for completed and/or transmitted DM extracts
+1 ; (shown when DM Extract Menu is called up).
+2 NEW RCDT,RCDATA,RCDATE,RCENDDT,RCNEXDT,RCDONE,RCMSARY,RCVS,RCTR,RCI,RCJ,RCEMARY
+3 NEW RCINCARY,RCMSG,RCRPTYPE,RCTREM,RCTRST,RCVSEM,RCVSST,RCJD,RCQ,RC0
+4 ;
+5 SET RCDT=$$DT^XLFDT
SET RCI=0
+6 FOR
SET RCI=$ORDER(^RCDM(344.91,"C",RCI))
if 'RCI
QUIT
Begin DoDot:1
+7 ; - Check to see if next month is missing from file, if any.
+8 SET RCNEXDT=RCI+$SELECT($EXTRACT(RCI,4,5)=12:8900,1:100)
+9 IF $DATA(^RCDM(344.91,"C",RCNEXDT))!(RCNEXDT>RCDT)
QUIT
+10 ;
+11 SET RCDONE=0
+12 ;check for any future missing dates between the current and next days run.
+13 FOR
if RCDONE
QUIT
Begin DoDot:2
+14 SET RCNEXDT=RCNEXDT+$SELECT($EXTRACT(RCNEXDT,4,5)=12:8900,1:100)
+15 IF $DATA(^RCDM(344.91,"C",RCNEXDT))!(RCNEXDT>RCDT)
SET RCDONE=1
QUIT
+16 ;
+17 ;Date missing update missing array for both reports.
+18 SET RCMSARY("VS",RCNEXDT)=""
SET RCMSARY("TR",RCNEXDT)=""
End DoDot:2
+19 ;
+20 ;init loop variable and report missing flags to 1 (missing)
+21 SET RCJ=0
SET RCVS=1
SET RCTR=1
+22 FOR
SET RCJ=$ORDER(^RCDM(344.91,"C",RCI,RCJ))
if 'RCJ
QUIT
Begin DoDot:2
+23 SET RCJD=$GET(^RCDM(344.91,RCJ,0))
+24 SET RCRPT=$PIECE(RCJD,U)
+25 SET RCRPTYPE=$SELECT(RCRPT="VOLUME STATISTICS":"VS",1:"TR")
+26 IF RCRPT="VOLUME STATISTICS"
SET RCVS=0
QUIT
+27 IF RCRPT="EFT/ERA TRENDING REPORT"
SET RCTR=0
End DoDot:2
+28 ;
+29 ;update missing array
+30 if RCVS
SET RCMSARY("VS",RCI)=""
+31 if RCTR
SET RCMSARY("TR",RCI)=""
+32 ;
+33 ;check status of reports to report completion, transmission issues
+34 ;init loop variable and report missing flags to 1 (missing)
+35 SET RCJ=0
SET RCVSST=1
SET RCTRST=1
SET RCVSEM=1
SET RCTREM=1
+36 FOR
SET RCJ=$ORDER(^RCDM(344.91,"C",RCI,RCJ))
if 'RCJ
QUIT
Begin DoDot:2
+37 SET RCJD=$GET(^RCDM(344.91,RCJ,0))
+38 SET RCRPT=$PIECE(RCJD,U)
SET RCSTAT=$PIECE(RCJD,U,3)
SET RCMSG=$PIECE(RCJD,U,7)
+39 SET RCRPTYPE=$SELECT(RCRPT="VOLUME STATISTICS":"VS",1:"TR")
+40 IF RCSTAT'=3
SET RCINCARY(RCRPTYPE,RCI)=""
+41 IF 'RCMSG
SET RCEMARY(RCRPTYPE,RCI)=""
End DoDot:2
End DoDot:1
+42 ;
+43 IF '$DATA(RCMSARY)
IF '$DATA(RCINCARY)
IF '$DATA(RCEMARY)
WRITE "Done"
QUIT
+44 ;
+45 ;Report what dates are missing for which reports, which are incomplete and which were not sent
+46 ;
+47 IF $DATA(RCMSARY)
Begin DoDot:1
+48 SET RCJ=0
FOR
SET RCJ=$ORDER(RCMSARY(RCJ))
if RCJ=""
QUIT
Begin DoDot:2
+49 SET RCQ=$SELECT(RCJ="TR":"EFT/ERA TRENDING REPORT",1:"VOLUME STATISTICS")
+50 IF $DATA(RCMSARY(RCJ))=10
WRITE !!,"The "_RCQ_" data has NOT been fully extracted for these months:",!,*7
+51 SET RC0=0
FOR
SET RC0=$ORDER(RCMSARY(RCJ,RC0))
if 'RC0
QUIT
WRITE " ",$$M1^RCDPENR4(RC0,3)
End DoDot:2
+52 WRITE !,"If you want, you can start the DM extract process for these"
+53 WRITE !,"months by using the ""Manually Start DM Extraction"" option."
End DoDot:1
+54 ;
+55 IF $DATA(RCINCARY)
Begin DoDot:1
+56 SET RCJ=0
FOR
SET RCJ=$ORDER(RCINCARY(RCJ))
if RCJ=""
QUIT
Begin DoDot:2
+57 SET RCQ=$SELECT(RCJ="TR":"EFT/ERA TRENDING REPORT",1:"VOLUME STATISTICS")
+58 IF $DATA(RCINCARY(RCJ))=10
WRITE !!,"The "_RCQ_" data has NOT been transmitted for these months:",!,*7
+59 SET RC0=0
FOR
SET RC0=$ORDER(RCINCARY(RCJ,RC0))
if 'RC0
QUIT
WRITE " ",$$M1^RCDPENR4(RC0,3)
End DoDot:2
+60 WRITE !,"If you want, you can re-transmit the DM extract data for these"
+61 WRITE !,"months by using the ""Manually Transmit DM Extract"" option."
End DoDot:1
+62 ;
+63 IF $DATA(RCEMARY)
Begin DoDot:1
+64 SET RCJ=0
FOR
SET RCJ=$ORDER(RCEMARY(RCJ))
if RCJ=""
QUIT
Begin DoDot:2
+65 SET RCQ=$SELECT(RCJ="TR":"EFT/ERA TRENDING REPORT",1:"VOLUME STATISTICS")
+66 IF $DATA(RCEMARY(RCJ))=10
WRITE !!,"The "_RCQ_" data has NOT stored an email message for these months:",!,*7
+67 SET RC0=0
FOR
SET RC0=$ORDER(RCEMARY(RCJ,RC0))
if 'RC0
QUIT
WRITE " ",$$M1^RCDPENR4(RC0,3)
End DoDot:2
+68 WRITE !,"If you want, you can re-transmit the DM extract data for these"
+69 WRITE !,"months by using the ""Manually Transmit DM Extract"" option."
End DoDot:1
+70 ;
+71 QUIT
XM(RCDMIEN,RCBEGDT,RCENDDT,XMSUB) ; - Create/transmit DM extract file message.
+1 NEW DA,DIE,DR,RCSTE,X,Y,XMTEXT,XMDUZ,DT,CT,XMZ,RCJ,DT,DT1,DTRNG,RCXMZ,RCMG
+2 SET RCXMZ=0
+3 KILL ^TMP("RCDPENRU",$JOB)
SET RCXMZ=0
SET DT=$$DT^XLFDT
SET RCSTE=$$SITE^VASITE
SET X=$EXTRACT(DT,4,7)_(1700+$EXTRACT(DT,1,3))
+4 SET ^TMP("RCDPENRU",$JOB,1)="HDR^"_$PIECE(RCSTE,U,3)_U_$PIECE(RCSTE,U,2)_U_X
+5 SET CT=1
SET RCJ=0
+6 SET DTRNG=$EXTRACT(RCBEGDT,4,7)_(1700+$EXTRACT(RCBEGDT,1,3))_"~"_$EXTRACT(RCENDDT,4,7)_(1700+$EXTRACT(RCBEGDT,1,3))
+7 ; Build the body of the message
+8 FOR
SET RCJ=$ORDER(^RCDM(344.91,RCDMIEN,1,RCJ))
if 'RCJ
QUIT
Begin DoDot:1
+9 SET CT=CT+1
+10 SET ^TMP("RCDPENRU",$JOB,CT)="DAT~"_DTRNG_"^"_$GET(^RCDM(344.91,RCDMIEN,1,RCJ,0))
End DoDot:1
+11 ;
+12 SET ^TMP("RCDPENRU",$JOB,CT+1)="END^"_$PIECE(RCSTE,U,3)
+13 SET XMSUB=XMSUB_"-"_DTRNG_" ("_$PIECE(RCSTE,U,2)_")"
+14 ;
+15 SET RCMG=$PIECE($GET(^IBE(350.9,1,4)),U,5)
+16 if RCMG=""
QUIT RCXMZ
+17 ;
+18 SET XMDUZ="ACCOUNTS RECEIVABLE PACKAGE"
+19 SET XMTEXT="^TMP(""RCDPENRU"",$J,"
SET XMY(RCMG)=""
+20 SET XMTEXT="^TMP(""RCDPENRU"",$J,"
SET XMY(RCMG)=""
+21 DO SEND
+22 ;
+23 IF $GET(XMZ)
SET RCXMZ=XMZ
SET DIE="^RCDM(344.91,"
SET DA=RCDMIEN
SET DR=".03///3;.07///1;.06///"_XMZ
DO ^DIE
+24 ;
+25 QUIT RCXMZ
+26 ;
ENQ KILL IB2,IBDT2,IBD1,IBD2,IBDT,IBFL,IBFR,IBN,IBS,IBST,IBST1,IBX,IBX1,BY,DHD
+1 KILL DIC,DIOEND,FLDS,FR,IOP,L,TO,X,XMZ,Y,%
ENQ1 KILL IB0,IB1,IBC,IBDT1,IBMG,IBSTE,XMSUB,XMTEXT,XMY,^TMP("DME",$JOB)
+1 QUIT
+2 ;
SEND ; Calls ^XMD to send the mail message with the data extracted
+1 ; Obs: By NEWing DUZ, ^XMD will assume DUZ=.5 (Sender=POSTMASTER)
+2 ;
+3 NEW DUZ
DO ^XMD
+4 QUIT
+5 ;
+6 ; Pass RCPAY by reference
GETPAY(RCPAY) ; Get payer information
+1 NEW EX,RCLPAY,DTOUT,DUOUT,X,Y,DIR,DIRUT,DIROUT
+2 ; Exit status
SET EX=1
+3 SET DIR("A")="Select (A)ll or (R)ange of Payer Names?: "
SET DIR(0)="SA^A:All Payer Names;R:Range or List of Payer Names"
+4 SET DIR("B")="ALL"
DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET EX=0
QUIT EX
+6 SET RCLPAY=Y
IF $GET(Y)="A"
SET RCPAY="ALL"
SET RCPAY("DATA")="ALL"
GOTO GPO
+7 ; Get Range of Payers from Insurance file
+8 IF RCLPAY="R"
SET EX=$$GETRANG(.RCPAY,"P")
SET RCPAY="R"
GPO ;
+1 QUIT EX
+2 ;
+3 ; RTNARR - Indirect Return array
+4 ; TYPE - The type of lookup "P" - Payer; "T" - TIN
GETRANG(RTNARR,TYPE) ;
+1 NEW DIC,D,RCDTN,RCDN,RCPT,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,IDX
+2 ; Quit if TYPE not correct
IF $GET(TYPE)=""!("PT"'[$GET(TYPE))
SET RTNARR="ERROR"
QUIT
+3 SET IDX=$SELECT(TYPE="P":"B",TYPE="T":"C")
+4 KILL DIC
SET DIC="^DIC(36,"
SET DIC(0)="AES"
SET D=IDX
+5 SET DIC("A")="Start with "_$SELECT(TYPE="P":"Payer Name",TYPE="T":"Payer TIN")_": "
+6 IF TYPE="P"
SET DIC("W")=""
+7 IF '$TEST
SET DIC("W")="D EN^DDIOL($P(^(0),U,1),,""?35"")"
+8 DO IX^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")!(Y=-1)
QUIT 0
+9 SET RCDN=$ORDER(^DIC(36,IDX,X,""))
+10 SET RTNARR("START")=RCDN_U_X_U_Y
SET RTNARR("DATA")=X
+11 ;
+12 KILL DIC
SET DIC="^DIC(36,"
SET DIC(0)="AES"
SET D=IDX
+13 SET DIC("A")="Go to with "_$SELECT(TYPE="P":"Payer Name",TYPE="T":"Payer TIN")_": "
+14 IF TYPE="P"
SET DIC("W")=""
+15 IF '$TEST
SET DIC("W")="D EN^DDIOL($P(^(0),U,1),,""?35"")"
+16 DO IX^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")!(Y=-1)
QUIT 0
+17 SET RCDN=$ORDER(^DIC(36,IDX,X,""))
+18 SET RTNARR("END")=RCDN_U_X_U_Y
+19 IF TYPE="P"
SET RTNARR("DATA")=$PIECE(RTNARR("START"),U,4)_":"_$PIECE(RTNARR("END"),U,4)
+20 IF TYPE="T"
SET RTNARR("DATA")=$PIECE(RTNARR("START"),U,2)_":"_$PIECE(RTNARR("END"),U,2)
+21 QUIT 1
+22 ;
+23 ;Retrieve a list of valid payers
GETPAYER(RCPYRLST) ;
+1 ;
+2 NEW RCANS
+3 ;
+4 ; Initialize start and end nodes in array
+5 SET (RCPYRLST("START"),RCPYRLST("END"))=""
+6 ;
+7 ; Ask user whether they wish to see All payers, a specific Payer, or a range of payers
+8 SET RCANS=$$GETANS(1)
+9 IF RCANS=-1
SET RCPYRLST("QUIT")=""
QUIT
+10 ;
+11 ; Exit if user wants all payers
+12 if $EXTRACT(RCANS)="A"
QUIT
+13 ;
+14 ; Get the payer if the user wishes a single payer
+15 IF RCANS="S"
Begin DoDot:1
+16 SET RCANS=$$GETANS(2)
+17 IF RCANS=-1
SET RCPYRLST("QUIT")=""
QUIT
+18 SET (RCPYRLST("START"),RCPYRLST("END"))=RCANS
End DoDot:1
QUIT
+19 ;
+20 ; User wishes a range, Get the Beginning payer
+21 SET RCANS=$$GETANS(3)
+22 IF RCANS=-1
SET RCPYRLST("QUIT")=""
QUIT
+23 SET RCPYRLST("START")=$$UP^XLFSTR(RCANS)
+24 ;
+25 ; Get the ending payer
+26 SET RCANS=$$GETANS(4)
+27 IF RCANS=-1
SET RCPYRLST("QUIT")=""
QUIT
+28 SET RCPYRLST("END")=$$UP^XLFSTR(RCANS)
+29 ;
+30 QUIT
+31 ;
+32 ;Get users answers to questions for reports.
GETANS(RCIDX) ;
+1 NEW DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT
+2 ;
+3 ; Ask the user what kind of report
+4 IF RCIDX=1
Begin DoDot:1
+5 SET DIR("?")="Select to (A) to see All payers on the report or (R) for a range of payers."
+6 SET DIR("A")="(A)LL PAYERS, (R)ANGE OF PAYER NAMES: "
+7 ;S DIR("S")="A:ALL;S:SINGLE;R:RANGE"
+8 SET DIR("B")="ALL"
SET DIR(0)="SA^A:ALL;R:RANGE"
End DoDot:1
+9 ;
+10 ; Ask the user for the Payer to report on (Single Payer option)
+11 IF RCIDX=2
QUIT $$SPAY^RCDPENR4
+12 ;
+13 ; Ask the user for the payer to start the reporting on (Range Option)
+14 IF RCIDX=3
Begin DoDot:1
+15 SET DIR("?")="Enter the first Payer name to run this report on."
+16 SET DIR("A")="Select First Payer: "
SET DIR(0)="FA"
End DoDot:1
+17 ;
+18 ; Ask the user for the payer to end the reporting on (Range Option)
+19 IF RCIDX=4
Begin DoDot:1
+20 SET DIR("?")="Enter the last Payer name to run this report on."
+21 SET DIR("A")="Select Last Payer: "
SET DIR(0)="FA"
End DoDot:1
+22 ;
+23 IF RCIDX=5
Begin DoDot:1
+24 SET DIR("?")="Select to (A) to see All Payer TINs on the report, or (R) for a Range of Payer TINs."
+25 SET DIR("A")="SELECT (A)LL PAYER TINs, (R)ANGE of PAYER TINs: "
+26 ;S DIR("S")="A:All;R:Range"
+27 SET DIR("B")="ALL"
SET DIR(0)="SA^A:ALL;R:RANGE"
End DoDot:1
+28 ;
+29 IF $GET(DIR(0))=""
SET DIR(0)="FA"
+30 DO ^DIR
+31 KILL DIR
+32 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET Y=-1
+33 IF Y="N"
SET Y=-1
+34 QUIT Y
+35 ;
+36 ; Compile the list of payers. The Payer IENS are extracted
PYRARY(RCSTART,RCEND,RCSWITCH) ;
+1 ;
+2 ;RCSTART - The text to start the search for insurance companies
+3 ;RCEND - The text to end the search for insurance companies,
+4 ;RCSWITCH - A flag to indicate which file to perform the insurance lookup
+5 ; 1 or Null) RCDPE AUTO-PAY EXCLUSION FILE (#344.6)
+6 ; 2) INSURANCE COMPANY FILE (#36)
+7 ;
+8 NEW RCI,RCJ,RCFILE
+9 ;
+10 ; Clear any older data out of the array.
+11 KILL ^TMP("RCDPEADP",$JOB,"INS")
+12 ;
+13 ; If start and end are NULL, then User wishes all payers, set flag and quit
+14 IF (RCSTART="")
IF (RCEND="")
SET ^TMP("RCDPEADP",$JOB,"INS","A")=""
QUIT
+15 ;
+16 IF $GET(RCSWITCH)=2
DO INSLKUP(RCSTART,RCEND)
QUIT
+17 ;
+18 ; If single payer, find the IEN if it exists and post it.
+19 IF RCSTART=RCEND
Begin DoDot:1
+20 SET RCJ=""
+21 FOR
SET RCJ=$ORDER(^RCY(344.6,"B",RCSTART,RCJ))
if RCJ=""
QUIT
Begin DoDot:2
+22 SET ^TMP("RCDPEADP",$JOB,"INS",RCJ)=""
End DoDot:2
End DoDot:1
QUIT
+23 ;
+24 ; For a range of payers, loop through the Payer name list until
+25 ; you reach the last payer in the range (RCEND)
+26 ;
+27 ; Set the starting location for the loop
SET RCI=$ORDER(^RCY(344.6,"B",RCSTART),-1)
+28 FOR
SET RCI=$ORDER(^RCY(344.6,"B",RCI))
if RCI=""
QUIT
if (RCI]RCEND)
QUIT
Begin DoDot:1
+29 SET RCJ=""
+30 FOR
SET RCJ=$ORDER(^RCY(344.6,"B",RCI,RCJ))
if RCJ=""
QUIT
Begin DoDot:2
+31 SET ^TMP("RCDPEADP",$JOB,"INS",RCJ)=""
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT
+34 ;
+35 ; Check to see if the Payer is in the list of Payers to process
INSCHK(RCINSIEN) ;
+1 ;Return value 0 - No, not in list or 1 - Yes in list
+2 ;
+3 ; If all payers are supposed to be process, then send back a 1
+4 if $DATA(^TMP("RCDPEADP",$JOB,"INS","A"))
QUIT 1
+5 ;
+6 ; If the payer is in the list of payers, send back yes
+7 if $DATA(^TMP("RCDPEADP",$JOB,"INS",RCINSIEN))
QUIT 1
+8 ;
+9 ;Payer not in list, quit with No
+10 QUIT 0
+11 ;
+12 ; Compile the list of payers from the Insurance File. The Payer IENS are extracted
INSLKUP(RCSTART,RCEND) ;
+1 ;
+2 ;RCSTART - The text to start the search for insurance companies
+3 ;RCEND - The text to end the search for insurance companies,
+4 ;
+5 NEW RCI,RCJ
+6 ;
+7 SET RCI=RCSTART
+8 ;
+9 ;Loop through the Payer name list until you reach the last payer in the range (RCEND)
INSLP ;
+1 SET RCJ=""
+2 FOR
SET RCJ=$ORDER(^DIC(36,"B",RCI,RCJ))
if RCJ=""
QUIT
Begin DoDot:1
+3 SET ^TMP("RCDPEADP",$JOB,"INS",RCJ)=""
End DoDot:1
+4 SET RCI=$ORDER(^DIC(36,"B",RCI))
+5 if RCI]RCEND
GOTO INSQT
+6 GOTO INSLP
+7 ;
+8 ;Work is done, exit
INSQT ;
+1 QUIT
+2 ;
