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

RCDPENRU.m

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