- 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 Feb 18, 2025@23:11:29 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 ;