RCDPEMAP.m

RCDPEMAP ;AITC/FA - LIST ALL AUTO-POSTED RECEIPTS REPORT ;Nov 17, 2016

 ;;4.5;Accounts Receivable;**332,432**;Mar 20, 1995;Build 16

 ;Per VA Directive 6402, this routine should not be modified.

 ;

EN ; Main entry point

 N INPUT,RCPAR,RCVAUTD,XX,YY

 K ^TMP($J,"RCDPE_MAP"),^TMP("RCDPE_MAP",$J)

 K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER"),^TMP($J,"SELUSER")

 ;

 S INPUT=$$STADIV(.RCVAUTD)                 ; Division filter

 Q:'INPUT                                   ; '^' or timeout

 S $P(INPUT,"^",2)=$$DTRNG(0)               ; Start Date|End date

 Q:'$P(INPUT,"^",2)                         ; '^' or timeout

 S $P(INPUT,"^",3)=$$RTYPE^RCDPEU1("")      ; M/P/T/C filter   ;PRCA*4.5*432 Add CHAMPVA

 Q:$P(INPUT,"^",3)<0                        ; '^' or timeout

 S RCPAR("SELC")=$$PAYRNG^RCDPEU1()         ; Selected or Range of Payers

 Q:RCPAR("SELC")=-1                         ; '^' or timeout

 S $P(INPUT,"^",4)=RCPAR("SELC")

 ;

 I RCPAR("SELC")'="A" D  Q:XX=-1            ; Since we don't want all payers 

 . S RCPAR("TYPE")=$P(INPUT,"^",3)          ; prompt for payers we do want

 . S RCPAR("FILE")=344.4

 . S RCPAR("DICA")="Select Insurance Company NAME: "

 . S XX=$$SELPAY^RCDPEU1(.RCPAR)

 ;

 S $P(INPUT,"^",5)=$$SELUSER()              ; Selected or All users filter

 Q:$P(INPUT,"^",5)<0                        ; '^' or timeout

 ;

 I $P(INPUT,"^",5)=2 D  Q:XX=-1             ; Prompt for selected users

 . S XX=$$SELUSER2()

 ;

 S $P(INPUT,"^",6)=$$SECSORT()              ; Secondary Sort

 Q:$P(INPUT,"^",6)<0                        ; '^' or timeout

 S $P(INPUT,"^",7)=$$ASKLM^RCDPEARL         ; Ask to Display in Listman Template

 Q:$P(INPUT,"^",7)<0                        ; '^' or timeout

 I $P(INPUT,"^",7)=1 D  Q                   ; Compile data and call listman to display

 . D LMOUT(INPUT,.RCVAUTD,.IO)

 S $P(INPUT,"^",8)=$$EXCEL()                ; Ask to output to Excel

 Q:$P(INPUT,"^",8)=-1                       ; '^' or timeout

 D:$P(INPUT,"^",8)=1 INFO^RCDPEM6           ; Display capture information for Excel

 S $P(INPUT,"^",9)=$$DEVICE($P(INPUT,"^",8),.IO)    ; Ask output device

 Q:'$P(INPUT,"^",9)

 ;

 ; Option to queue

 I $D(IO("Q")) D  Q

 . N JOB S JOB=$J

 . N ZTDESC,ZTRTN,ZTSAVE,ZTSK

 . S ZTRTN="REPORT^RCDPEMAP(INPUT,.RCVAUTD,.IO,JOB)"

 . S ZTDESC="EEOBS MARKED FOR AUTO-POST AUDIT REPORT"

 . M RCPYRSEL=^TMP("RCSELPAY",$J)

 . S ZTSAVE("RC*")="",ZTSAVE("VAUTD")="",ZTSAVE("IO*")=""

 . S ZTSAVE("INPUT")="",ZTSAVE("JOB")=""

 . S ZTSAVE("^TMP(""RCDPEU1"",$J,")=""

 . D ^%ZTLOAD

 . W !!,$S($D(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")

 . K ZTSK,IO("Q")

 . D HOME^%ZIS

 ;

 D REPORT(INPUT,.RCVAUTD,.IO)               ; Compile and Display Report data

 Q

 ;

LMOUT(INPUT,RCVAUTD,IO) ; Output report to Listman

 ; Input:   INPUT       - See REPORT for a complete description

 ;          RCVAUTD     -  Array of selected Divisions

 ;                         Only passed if A1=2

 ; Output:  ^TMP("RCDPE_MAP",$J,CTR)=Line - Array of display lines (no headers)

 ;                                          for output to Listman

 N HDR,RCTEMP

 S $P(INPUT,"^",10)=0                       ; Initial listman line counter

 D REPORT(INPUT,.RCVAUTD,.IO)               ; Get the lines to be displayed

 S HDR("TITLE")="EEOBs MARKED FOR AP AUDIT"

 S HDR(1)=$$HDRLN2^RCDPEMA1(INPUT)

 S HDR(2)=$$HDRLN3^RCDPEMA1(INPUT)

 S HDR(3)=$$HDRLN4^RCDPEMA1(INPUT)

 S HDR(4)="ERA #       Claim #     Trace #"

 S RCTEMP="RCDPE EEOB MARKED FOR AP AUDIT"

 D LMRPT^RCDPEARL(.HDR,$NA(^TMP("RCDPE_MAP",$J)),RCTEMP) ; Generate ListMan display

 ;

 D ^%ZISC                                   ; Close the device

 K ^TMP("RCDPE_MAP",$J),^TMP($J,"RCDPE_MAP")

 K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER"),^TMP($J,"SELUSER")

 Q

 ;

STADIV(RCVAUTD) ; Division/Station Filter

 ; Input:   None

 ; Output:  RCVAUTD     - Array of selected divisions, if 1 is returned

 ; Returns: 0           - User up-arrowed or timed out

 ;          1           - All divisions selected

 ;          2           - Selected Divisions

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,VAUTD,X,Y

 D DIVISION^VAUTOMA                         ; IA #664 allows this

 Q:Y<0 0                                    ; User up-arrowed or timed out

 Q:VAUTD=1 1                                ; All divisions selected

 M RCVAUTD=VAUTD                            ; Save selected divisions (if any)

 Q 2

 ;

SELUSER() ; Ask the user if they only want to all users or only selected ones

 ; Input:   None

 ; Returns: 0 - User up-arrowed or timed out

 ;          1 - Show all users

 ;          2 - Show selected user

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 S DIR("A")="Run Report for (S)pecific or (A)ll Users: "

 S DIR(0)="SA^S:Specific;A:All"

 S DIR("?",1)="Enter 'A' to show EEOBs marked by any user."

 S DIR("?")="Enter 'S' to show EEOBs marked by specific user(s)."

 S DIR("B")="A"

 D ^DIR

 I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1

 Q:Y="A" 1

 Q 2

 ;

SELUSER2(PARAM) ; Allows the user to enter the selected users to filter by

 ; Input:   None

 ; Output:  ^TMP($J,"SELUSER",IEN)="" Where IEN - IEN for file 200

 ; Returns: 1 - Success, -1 - Abort

 N RCA,RET,RETURN,QUIT

 K ^TMP($J,"SELUSER")

 S QUIT=0,RETURN=1

 F  D  Q:QUIT

 . S RET=$$ASKUSER()

 . I RET=-1 S RETURN=-1,QUIT=1 Q

 . I RET=0 D

 . . I $D(^TMP($J,"SELUSER")) S QUIT=1

 . . E  D

 . . . W !!,"You must select at least one user",*7,!

 I RETURN=-1 K ^TMP($J,"SELUSER") Q -1

 S RETURN=$S($D(^TMP($J,"SELUSER")):1,1:-1)

 Q RETURN

 ;

ASKUSER() ; Prompt for a User from file 200

 ; Input:   None

 ; Output:  ^TMP($J,"SELUSER",IEN)="" - Selected User

 ; Returns:  1 - User selected

 ;           0 - No User selected

 ;          -1 - user typed '^' or timed out

 ;

 N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 S RETURN=1

 ;

 S DIC=200,DIC(0)="QEA"

 S DIC("A")="Select User: "

 S DIC("S")="I '$D(^TMP($J,""SELUSER"",Y))"

 D ^DIC

 I $D(DTOUT)!$D(DUOUT) Q -1

 I Y=-1 Q 0

 S ^TMP($J,"SELUSER",+Y)=""

 Q 1

 ;

SECSORT() ; Ask the user if they want the secondary sort by User or Payer Name

 ; Input:   None

 ; Returns: 0       - User up-arrowed or timed out

 ;          1       - Sort by User

 ;          2       - Sort by Payer Name

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 S DIR("A")="Sort by Insurance Company (N)ame or (U)ser: "

 S DIR(0)="SA^N:Name;U:User"

 S DIR("?",1)="Enter 'N' to sort by Payer Name."

 S DIR("?")="Enter 'U' to sort by user."

 S DIR("B")="N"

 D ^DIR

 I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1

 Q:Y="U" 1

 Q 2

 ;

DTRNG(WHICH) ; Allows the user to select the Auto-Post OR ERA Received

 ; date range to be used

 ; Input:   WHICH   - 0 - Auto-Post Date Range

 ;                    1 - ERA Date Received Date Range

 ; Returns: 0       - User up-arrowed or timed out, 1 otherwise

 ;          A1^A2   - Where:

 ;                    A1 - Aut-Post Start Date

 ;                    A2 - Auto-Post End Date

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RANGE,START,X,XX,Y

 S DIR(0)="DA^:"_DT_":APE"

 S DIR("A")="Start Date: "

 S DIR("?")="Enter the earliest Auto-Post date"

 D ^DIR

 Q:$D(DTOUT)!$D(DUOUT)!(Y="") 0

 S START=Y

ENDDT ; Prompt for end date

 K DIR

 S DIR("B")=Y(0)

 S DIR(0)="DA^"_START_":"_DT_":APE"

 S DIR("A")="End Date: "

 S DIR("?")="Enter the latest Auto-Post date"

 D ^DIR

 Q:$D(DTOUT)!$D(DUOUT)!(Y="") 0

 I Y<START D  G ENDDT

 . S XX=$$FMTE^XLFDT(START,"2ZD") ;****

 . W !,*7,"Enter an End date that is not less than "_XX

 S RANGE=START_"|"_Y

 Q RANGE

 ;

EXCEL() ; Ask the user if they want to export to Excel

 ; Input:   None

 ; Returns: -1      - User up-arrowed or timed out

 ;           0      - Output to paper

 ;           1      - Output to Excel

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="Y"

 S DIR("A")="Export the report to Microsoft Excel"

 S DIR("B")="NO"

 S DIR("?")="Enter 'YES' to output to Excel. Otherwise enter 'NO'"

 D ^DIR

 I $G(DUOUT) Q -1

 Q Y

 ;

DEVICE(EXCEL,IO) ; Select the output device

 ; Input:   EXCEL   - 1 - Ouput to Excel, 0 otherwise

 ; Output:  %ZIS    - Selected device

 ;          IO      - Array of selected output info

 ; Returns: 0       - No device selected, 1 otherwise

 N POP,RCPYRSEL,%ZIS

 S %ZIS="QM"

 D ^%ZIS

 Q:POP 0

 Q:EXCEL 1                  ; Output to Excel, no queueing

 ;

 Q 1

 ;

REPORT(INPUT,RCVAUTD,IO,JOB) ; Compile and run the report

 ; Expects ZTQUEUED to be defined already if queued

 ; Input:   INPUT   - A1^A2^A3^...^An Where:

 ;                       A1 - 1 - All divisions selected

 ;                            2 - Selected divisions

 ;                       A2 - B1|B2   - Where:

 ;                             B1 - Auto-Post Start Date

 ;                             B2 - Auto-Post End Date

 ;                       A3 - 'M' - Medical Payers only

 ;                            'P' - Pharmacy Payers only

 ;                            'T' - Tricare Payers only

 ;                            'C' - CHAMPVA Payers only  ;PRCA*4.5*432 Add CHAMPVA

 ;                            'A' - All Payers

 ;                       A4 - 'S' - Specific Payers

 ;                            'R' - Range of Payers

 ;                            'A' - All Payers

 ;                       A5 - 1 - Display all users

 ;                            2 - Display selected users

 ;                       A6 - 1 - Sort by User

 ;                            2 - Sort by Payer Name

 ;                       A7 - 0 - Do not display in a listman template

 ;                            1 - Display in a listman template

 ;                       A8 - 0 - Output to paper

 ;                            1 - Output to Excel

 ;                       A9 - Line counter for Listman output

 ;           RCVAUTD -  Array of selected Divisions

 ;                      Only passed if A1=2

 ;           IO      - Interface device

 ;           JOB     - $J (optional, only passed in when report is queued)

 ;           ^TMP($J,"RCSELPAY") - Global Array of selected insurance companies

 ;           ^TMP($J,"SELUSER")  - Global Array of selected users

 ; Output:   ^TMP("RCDPEMAP",$J,CTR)=Line - Array of display lines (no headers)

 ;                                          for output to Listman

 ;                                          Only set when A7-1

 N CURDT,DIVFLT,DTEND,DTSTART,IENS,IEN3444,IEN34441,PAYER,PAYERU

 N RCTYPE,RCPAYS,SORT,TIN,UIEN,USER,USERU,USERF,SVAL,XX,YY,ZZ

 K ^TMP("RCDPE_MAP",$J),^TMP($J,"RCDPE_MAP")

 ; I '$G(JOB) S JOB=""

 U IO

 S DIVFLT=$P(INPUT,"^",1)                   ; Division filter

 S SORT=$P(INPUT,"^",6)                     ; Type of secondary sort

 S DTEND=$P($P(INPUT,"^",2),"|",2)_".9999"  ; End of Date Range

 S DTSTART=$P($P(INPUT,"^",2),"|",1)        ; End of Date Range

 S RCTYPE=$P(INPUT,"^",3)                   ; Medical/Pharmacy/Tricare/CHAMPVA/All  ;PRCA*4.5*432 Add CHAMPVA

 S RCPAYS=$P(INPUT,"^",4)                   ; Payers All/Selected/Range

 S USERF=$P(INPUT,"^",5)                    ; All Users/Selected Users

 ;

 ; First filter and sort the report

 S CURDT=(DTSTART-1)_.9999

 F  D  Q:'CURDT  Q:CURDT>(DTEND)

 . S CURDT=$O(^RCY(344.4,"F",CURDT))

 . Q:'CURDT

 . Q:CURDT>(DTEND)

 . S IEN3444=0

 . F  D  Q:'IEN3444

 . . S IEN3444=$O(^RCY(344.4,"F",CURDT,IEN3444))

 . . Q:'IEN3444

 . . I DIVFLT'=1 Q:'$$CHKDIV^RCDPEDAR(IEN3444,1,.RCVAUTD)  ; Not a selected Division

 . . S PAYER=$$GET1^DIQ(344.4,IEN3444,.06,"I")             ; Payment From field

 . . S TIN=$$GET1^DIQ(344.4,IEN3444,.03,"I")               ; Insurance Co Id

 . . S PAYERU=$$UP^XLFSTR(PAYER)

 . . S PAYER=TIN_"/"_$E(PAYER,1,70-$L(TIN))

 . . S XX=1

 . . I RCPAYS'="A" D  Q:'XX

 . . . S XX=$$ISSEL^RCDPEU1(344.4,IEN3444)              ; Check if payer was selected

 . . E  I RCTYPE'="A" D  Q:'XX                          ; If all of a give type of payer selected

 . . . S XX=$$ISTYPE^RCDPEU1(344.4,IEN3444,RCTYPE)      ; Check that payer matches type

 . . S IEN34441=""

 . . F  D  Q:IEN34441=""

 . . . S IEN34441=$O(^RCY(344.4,"F",CURDT,IEN3444,IEN34441))

 . . . Q:IEN34441=""

 . . . S IENS=IEN34441_","_IEN3444_","

 . . . S UIEN=$$GET1^DIQ(344.41,IENS,6.01,"I")          ; ERA Detail line Marked Auto-Post User

 . . . Q:UIEN=""                                        ; Not marked for Auto-Post

 . . . S USER=$$GET1^DIQ(200,UIEN_",",.01,"E")

 . . . S USERU=$$UP^XLFSTR(USER)

 . . . I USERF'=1,'$D(^TMP($J,"SELUSER",UIEN)) Q        ; Not a selected User

 . . . S SVAL=$S(SORT=2:PAYERU,1:USERU)                 ; Get the sort value

 . . . S XX=PAYER_"^"_USER

 . . . S $P(XX,"^",3)=$$GET1^DIQ(344.4,IEN3444_",",.01,"E")_"."_IEN34441 ; ERA#_"."_SEQ

 . . . S YY=$$GET1^DIQ(344.41,IENS,.02,"I")                 ; IEN for 361.1

 . . . S ZZ=$$GET1^DIQ(361.1,YY_",",.01,"I")                ; IEN for 399/430

 . . . S ZZ=$$GET1^DIQ(430,ZZ_",",.01,"E")                  ; Claim #

 . . . S ZZ=$TR(ZZ,"-","")

 . . . S $P(XX,"^",4)=ZZ

 . . . S $P(XX,"^",5)=$$GET1^DIQ(361.1,YY_",",.07,"E")      ; Trace #

 . . . ;

 . . . ; Found one that was marked for auto-post

 . . . S ^TMP($J,"RCDPE_MAP","SEL",CURDT)=$$FMTE^XLFDT(CURDT,"2ZD")

 . . . S ^TMP($J,"RCDPE_MAP","SEL",CURDT,SVAL)=$S(SORT=2:PAYER,1:USER)

 . . . S ^TMP($J,"RCDPE_MAP","SEL",CURDT,SVAL,IEN3444,IEN34441)=XX

 ;

 D RPTOUT^RCDPEMA1(INPUT)                   ; Output the report

 ;

 ; Quit if Listman - clean up of ^TMP & device is handled in LMOUT^RCDPELAR

 Q:$P(INPUT,"^",7)=1

 ;

 ; Close device

 I '$D(ZTQUEUED) D ^%ZISC

 I $D(ZTQUEUED) S ZTREQ="@"

 K ^TMP("RCDPE_MAP",$J),^TMP($J,"RCDPE_MAP")

 K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER"),^TMP($J,"SELUSER")

 K ^TMP("RCDPEU1",$J)

 K ZTQUEUED

 Q

 ;

ASKSTOP() ;EP from RCDPEMA1

 ; Ask to continue

 ; Input:   IOST    - Device Type 

 ; Returns: 1 - User wants to quit, 0 otherwise

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT

 Q:$E(IOST,1,2)'["C-" 0                     ; Not a terminal

 S DIR(0)="E"

 W ! D ^DIR

 I ($D(DIRUT))!($D(DUOUT)) Q 1

 Q 0

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RCDPEMAP   14000     printed  Mar 13, 2025@20:49:37                                                                                                                                                                                                   Page 2

RCDPEMAP  ;AITC/FA - LIST ALL AUTO-POSTED RECEIPTS REPORT ;Nov 17, 2016

 +1       ;;4.5;Accounts Receivable;**332,432**;Mar 20, 1995;Build 16

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3       ;

EN        ; Main entry point

 +1        NEW INPUT,RCPAR,RCVAUTD,XX,YY

 +2        KILL ^TMP($JOB,"RCDPE_MAP"),^TMP("RCDPE_MAP",$JOB)

 +3        KILL ^TMP("RCSELPAY",$JOB),^TMP($JOB,"SELPAYER"),^TMP($JOB,"SELUSER")

 +4       ;

 +5       ; Division filter

           SET INPUT=$$STADIV(.RCVAUTD)

 +6       ; '^' or timeout

           if 'INPUT

               QUIT 

 +7       ; Start Date|End date

           SET $PIECE(INPUT,"^",2)=$$DTRNG(0)

 +8       ; '^' or timeout

           if '$PIECE(INPUT,"^",2)

               QUIT 

 +9       ; M/P/T/C filter   ;PRCA*4.5*432 Add CHAMPVA

           SET $PIECE(INPUT,"^",3)=$$RTYPE^RCDPEU1("")

 +10      ; '^' or timeout

           if $PIECE(INPUT,"^",3)<0

               QUIT 

 +11      ; Selected or Range of Payers

           SET RCPAR("SELC")=$$PAYRNG^RCDPEU1()

 +12      ; '^' or timeout

           if RCPAR("SELC")=-1

               QUIT 

 +13       SET $PIECE(INPUT,"^",4)=RCPAR("SELC")

 +14      ;

 +15      ; Since we don't want all payers 

           IF RCPAR("SELC")'="A"

               Begin DoDot:1

 +16      ; prompt for payers we do want

                   SET RCPAR("TYPE")=$PIECE(INPUT,"^",3)

 +17               SET RCPAR("FILE")=344.4

 +18               SET RCPAR("DICA")="Select Insurance Company NAME: "

 +19               SET XX=$$SELPAY^RCDPEU1(.RCPAR)

               End DoDot:1

               if XX=-1

                   QUIT 

 +20      ;

 +21      ; Selected or All users filter

           SET $PIECE(INPUT,"^",5)=$$SELUSER()

 +22      ; '^' or timeout

           if $PIECE(INPUT,"^",5)<0

               QUIT 

 +23      ;

 +24      ; Prompt for selected users

           IF $PIECE(INPUT,"^",5)=2

               Begin DoDot:1

 +25               SET XX=$$SELUSER2()

               End DoDot:1

               if XX=-1

                   QUIT 

 +26      ;

 +27      ; Secondary Sort

           SET $PIECE(INPUT,"^",6)=$$SECSORT()

 +28      ; '^' or timeout

           if $PIECE(INPUT,"^",6)<0

               QUIT 

 +29      ; Ask to Display in Listman Template

           SET $PIECE(INPUT,"^",7)=$$ASKLM^RCDPEARL

 +30      ; '^' or timeout

           if $PIECE(INPUT,"^",7)<0

               QUIT 

 +31      ; Compile data and call listman to display

           IF $PIECE(INPUT,"^",7)=1

               Begin DoDot:1

 +32               DO LMOUT(INPUT,.RCVAUTD,.IO)

               End DoDot:1

               QUIT 

 +33      ; Ask to output to Excel

           SET $PIECE(INPUT,"^",8)=$$EXCEL()

 +34      ; '^' or timeout

           if $PIECE(INPUT,"^",8)=-1

               QUIT 

 +35      ; Display capture information for Excel

           if $PIECE(INPUT,"^",8)=1

               DO INFO^RCDPEM6

 +36      ; Ask output device

           SET $PIECE(INPUT,"^",9)=$$DEVICE($PIECE(INPUT,"^",8),.IO)

 +37       if '$PIECE(INPUT,"^",9)

               QUIT 

 +38      ;

 +39      ; Option to queue

 +40       IF $DATA(IO("Q"))

               Begin DoDot:1

 +41               NEW JOB

                   SET JOB=$JOB

 +42               NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK

 +43               SET ZTRTN="REPORT^RCDPEMAP(INPUT,.RCVAUTD,.IO,JOB)"

 +44               SET ZTDESC="EEOBS MARKED FOR AUTO-POST AUDIT REPORT"

 +45               MERGE RCPYRSEL=^TMP("RCSELPAY",$JOB)

 +46               SET ZTSAVE("RC*")=""

                   SET ZTSAVE("VAUTD")=""

                   SET ZTSAVE("IO*")=""

 +47               SET ZTSAVE("INPUT")=""

                   SET ZTSAVE("JOB")=""

 +48               SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""

 +49               DO ^%ZTLOAD

 +50               WRITE !!,$SELECT($DATA(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")

 +51               KILL ZTSK,IO("Q")

 +52               DO HOME^%ZIS

               End DoDot:1

               QUIT 

 +53      ;

 +54      ; Compile and Display Report data

           DO REPORT(INPUT,.RCVAUTD,.IO)

 +55       QUIT 

 +56      ;

LMOUT(INPUT,RCVAUTD,IO) ; Output report to Listman

 +1       ; Input:   INPUT       - See REPORT for a complete description

 +2       ;          RCVAUTD     -  Array of selected Divisions

 +3       ;                         Only passed if A1=2

 +4       ; Output:  ^TMP("RCDPE_MAP",$J,CTR)=Line - Array of display lines (no headers)

 +5       ;                                          for output to Listman

 +6        NEW HDR,RCTEMP

 +7       ; Initial listman line counter

           SET $PIECE(INPUT,"^",10)=0

 +8       ; Get the lines to be displayed

           DO REPORT(INPUT,.RCVAUTD,.IO)

 +9        SET HDR("TITLE")="EEOBs MARKED FOR AP AUDIT"

 +10       SET HDR(1)=$$HDRLN2^RCDPEMA1(INPUT)

 +11       SET HDR(2)=$$HDRLN3^RCDPEMA1(INPUT)

 +12       SET HDR(3)=$$HDRLN4^RCDPEMA1(INPUT)

 +13       SET HDR(4)="ERA #       Claim #     Trace #"

 +14       SET RCTEMP="RCDPE EEOB MARKED FOR AP AUDIT"

 +15      ; Generate ListMan display

           DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP("RCDPE_MAP",$JOB)),RCTEMP)

 +16      ;

 +17      ; Close the device

           DO ^%ZISC

 +18       KILL ^TMP("RCDPE_MAP",$JOB),^TMP($JOB,"RCDPE_MAP")

 +19       KILL ^TMP("RCSELPAY",$JOB),^TMP($JOB,"SELPAYER"),^TMP($JOB,"SELUSER")

 +20       QUIT 

 +21      ;

STADIV(RCVAUTD) ; Division/Station Filter

 +1       ; Input:   None

 +2       ; Output:  RCVAUTD     - Array of selected divisions, if 1 is returned

 +3       ; Returns: 0           - User up-arrowed or timed out

 +4       ;          1           - All divisions selected

 +5       ;          2           - Selected Divisions

 +6        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,VAUTD,X,Y

 +7       ; IA #664 allows this

           DO DIVISION^VAUTOMA

 +8       ; User up-arrowed or timed out

           if Y<0

               QUIT 0

 +9       ; All divisions selected

           if VAUTD=1

               QUIT 1

 +10      ; Save selected divisions (if any)

           MERGE RCVAUTD=VAUTD

 +11       QUIT 2

 +12      ;

SELUSER() ; Ask the user if they only want to all users or only selected ones

 +1       ; Input:   None

 +2       ; Returns: 0 - User up-arrowed or timed out

 +3       ;          1 - Show all users

 +4       ;          2 - Show selected user

 +5        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +6        SET DIR("A")="Run Report for (S)pecific or (A)ll Users: "

 +7        SET DIR(0)="SA^S:Specific;A:All"

 +8        SET DIR("?",1)="Enter 'A' to show EEOBs marked by any user."

 +9        SET DIR("?")="Enter 'S' to show EEOBs marked by specific user(s)."

 +10       SET DIR("B")="A"

 +11       DO ^DIR

 +12       IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")

               QUIT -1

 +13       if Y="A"

               QUIT 1

 +14       QUIT 2

 +15      ;

SELUSER2(PARAM) ; Allows the user to enter the selected users to filter by

 +1       ; Input:   None

 +2       ; Output:  ^TMP($J,"SELUSER",IEN)="" Where IEN - IEN for file 200

 +3       ; Returns: 1 - Success, -1 - Abort

 +4        NEW RCA,RET,RETURN,QUIT

 +5        KILL ^TMP($JOB,"SELUSER")

 +6        SET QUIT=0

           SET RETURN=1

 +7        FOR 

               Begin DoDot:1

 +8                SET RET=$$ASKUSER()

 +9                IF RET=-1

                       SET RETURN=-1

                       SET QUIT=1

                       QUIT 

 +10               IF RET=0

                       Begin DoDot:2

 +11                       IF $DATA(^TMP($JOB,"SELUSER"))

                               SET QUIT=1

 +12                      IF '$TEST

                               Begin DoDot:3

 +13                               WRITE !!,"You must select at least one user",*7,!

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

               if QUIT

                   QUIT 

 +14       IF RETURN=-1

               KILL ^TMP($JOB,"SELUSER")

               QUIT -1

 +15       SET RETURN=$SELECT($DATA(^TMP($JOB,"SELUSER")):1,1:-1)

 +16       QUIT RETURN

 +17      ;

ASKUSER() ; Prompt for a User from file 200

 +1       ; Input:   None

 +2       ; Output:  ^TMP($J,"SELUSER",IEN)="" - Selected User

 +3       ; Returns:  1 - User selected

 +4       ;           0 - No User selected

 +5       ;          -1 - user typed '^' or timed out

 +6       ;

 +7        NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +8        SET RETURN=1

 +9       ;

 +10       SET DIC=200

           SET DIC(0)="QEA"

 +11       SET DIC("A")="Select User: "

 +12       SET DIC("S")="I '$D(^TMP($J,""SELUSER"",Y))"

 +13       DO ^DIC

 +14       IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT -1

 +15       IF Y=-1

               QUIT 0

 +16       SET ^TMP($JOB,"SELUSER",+Y)=""

 +17       QUIT 1

 +18      ;

SECSORT() ; Ask the user if they want the secondary sort by User or Payer Name

 +1       ; Input:   None

 +2       ; Returns: 0       - User up-arrowed or timed out

 +3       ;          1       - Sort by User

 +4       ;          2       - Sort by Payer Name

 +5        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +6        SET DIR("A")="Sort by Insurance Company (N)ame or (U)ser: "

 +7        SET DIR(0)="SA^N:Name;U:User"

 +8        SET DIR("?",1)="Enter 'N' to sort by Payer Name."

 +9        SET DIR("?")="Enter 'U' to sort by user."

 +10       SET DIR("B")="N"

 +11       DO ^DIR

 +12       IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")

               QUIT -1

 +13       if Y="U"

               QUIT 1

 +14       QUIT 2

 +15      ;

DTRNG(WHICH) ; Allows the user to select the Auto-Post OR ERA Received

 +1       ; date range to be used

 +2       ; Input:   WHICH   - 0 - Auto-Post Date Range

 +3       ;                    1 - ERA Date Received Date Range

 +4       ; Returns: 0       - User up-arrowed or timed out, 1 otherwise

 +5       ;          A1^A2   - Where:

 +6       ;                    A1 - Aut-Post Start Date

 +7       ;                    A2 - Auto-Post End Date

 +8        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RANGE,START,X,XX,Y

 +9        SET DIR(0)="DA^:"_DT_":APE"

 +10       SET DIR("A")="Start Date: "

 +11       SET DIR("?")="Enter the earliest Auto-Post date"

 +12       DO ^DIR

 +13       if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")

               QUIT 0

 +14       SET START=Y

ENDDT     ; Prompt for end date

 +1        KILL DIR

 +2        SET DIR("B")=Y(0)

 +3        SET DIR(0)="DA^"_START_":"_DT_":APE"

 +4        SET DIR("A")="End Date: "

 +5        SET DIR("?")="Enter the latest Auto-Post date"

 +6        DO ^DIR

 +7        if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")

               QUIT 0

 +8        IF Y<START

               Begin DoDot:1

 +9       ;****

                   SET XX=$$FMTE^XLFDT(START,"2ZD")

 +10               WRITE !,*7,"Enter an End date that is not less than "_XX

               End DoDot:1

               GOTO ENDDT

 +11       SET RANGE=START_"|"_Y

 +12       QUIT RANGE

 +13      ;

EXCEL()   ; Ask the user if they want to export to Excel

 +1       ; Input:   None

 +2       ; Returns: -1      - User up-arrowed or timed out

 +3       ;           0      - Output to paper

 +4       ;           1      - Output to Excel

 +5        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +6        SET DIR(0)="Y"

 +7        SET DIR("A")="Export the report to Microsoft Excel"

 +8        SET DIR("B")="NO"

 +9        SET DIR("?")="Enter 'YES' to output to Excel. Otherwise enter 'NO'"

 +10       DO ^DIR

 +11       IF $GET(DUOUT)

               QUIT -1

 +12       QUIT Y

 +13      ;

DEVICE(EXCEL,IO) ; Select the output device

 +1       ; Input:   EXCEL   - 1 - Ouput to Excel, 0 otherwise

 +2       ; Output:  %ZIS    - Selected device

 +3       ;          IO      - Array of selected output info

 +4       ; Returns: 0       - No device selected, 1 otherwise

 +5        NEW POP,RCPYRSEL,%ZIS

 +6        SET %ZIS="QM"

 +7        DO ^%ZIS

 +8        if POP

               QUIT 0

 +9       ; Output to Excel, no queueing

           if EXCEL

               QUIT 1

 +10      ;

 +11       QUIT 1

 +12      ;

REPORT(INPUT,RCVAUTD,IO,JOB) ; Compile and run the report

 +1       ; Expects ZTQUEUED to be defined already if queued

 +2       ; Input:   INPUT   - A1^A2^A3^...^An Where:

 +3       ;                       A1 - 1 - All divisions selected

 +4       ;                            2 - Selected divisions

 +5       ;                       A2 - B1|B2   - Where:

 +6       ;                             B1 - Auto-Post Start Date

 +7       ;                             B2 - Auto-Post End Date

 +8       ;                       A3 - 'M' - Medical Payers only

 +9       ;                            'P' - Pharmacy Payers only

 +10      ;                            'T' - Tricare Payers only

 +11      ;                            'C' - CHAMPVA Payers only  ;PRCA*4.5*432 Add CHAMPVA

 +12      ;                            'A' - All Payers

 +13      ;                       A4 - 'S' - Specific Payers

 +14      ;                            'R' - Range of Payers

 +15      ;                            'A' - All Payers

 +16      ;                       A5 - 1 - Display all users

 +17      ;                            2 - Display selected users

 +18      ;                       A6 - 1 - Sort by User

 +19      ;                            2 - Sort by Payer Name

 +20      ;                       A7 - 0 - Do not display in a listman template

 +21      ;                            1 - Display in a listman template

 +22      ;                       A8 - 0 - Output to paper

 +23      ;                            1 - Output to Excel

 +24      ;                       A9 - Line counter for Listman output

 +25      ;           RCVAUTD -  Array of selected Divisions

 +26      ;                      Only passed if A1=2

 +27      ;           IO      - Interface device

 +28      ;           JOB     - $J (optional, only passed in when report is queued)

 +29      ;           ^TMP($J,"RCSELPAY") - Global Array of selected insurance companies

 +30      ;           ^TMP($J,"SELUSER")  - Global Array of selected users

 +31      ; Output:   ^TMP("RCDPEMAP",$J,CTR)=Line - Array of display lines (no headers)

 +32      ;                                          for output to Listman

 +33      ;                                          Only set when A7-1

 +34       NEW CURDT,DIVFLT,DTEND,DTSTART,IENS,IEN3444,IEN34441,PAYER,PAYERU

 +35       NEW RCTYPE,RCPAYS,SORT,TIN,UIEN,USER,USERU,USERF,SVAL,XX,YY,ZZ

 +36       KILL ^TMP("RCDPE_MAP",$JOB),^TMP($JOB,"RCDPE_MAP")

 +37      ; I '$G(JOB) S JOB=""

 +38       USE IO

 +39      ; Division filter

           SET DIVFLT=$PIECE(INPUT,"^",1)

 +40      ; Type of secondary sort

           SET SORT=$PIECE(INPUT,"^",6)

 +41      ; End of Date Range

           SET DTEND=$PIECE($PIECE(INPUT,"^",2),"|",2)_".9999"

 +42      ; End of Date Range

           SET DTSTART=$PIECE($PIECE(INPUT,"^",2),"|",1)

 +43      ; Medical/Pharmacy/Tricare/CHAMPVA/All  ;PRCA*4.5*432 Add CHAMPVA

           SET RCTYPE=$PIECE(INPUT,"^",3)

 +44      ; Payers All/Selected/Range

           SET RCPAYS=$PIECE(INPUT,"^",4)

 +45      ; All Users/Selected Users

           SET USERF=$PIECE(INPUT,"^",5)

 +46      ;

 +47      ; First filter and sort the report

 +48       SET CURDT=(DTSTART-1)_.9999

 +49       FOR 

               Begin DoDot:1

 +50               SET CURDT=$ORDER(^RCY(344.4,"F",CURDT))

 +51               if 'CURDT

                       QUIT 

 +52               if CURDT>(DTEND)

                       QUIT 

 +53               SET IEN3444=0

 +54               FOR 

                       Begin DoDot:2

 +55                       SET IEN3444=$ORDER(^RCY(344.4,"F",CURDT,IEN3444))

 +56                       if 'IEN3444

                               QUIT 

 +57      ; Not a selected Division

                           IF DIVFLT'=1

                               if '$$CHKDIV^RCDPEDAR(IEN3444,1,.RCVAUTD)

                                   QUIT 

 +58      ; Payment From field

                           SET PAYER=$$GET1^DIQ(344.4,IEN3444,.06,"I")

 +59      ; Insurance Co Id

                           SET TIN=$$GET1^DIQ(344.4,IEN3444,.03,"I")

 +60                       SET PAYERU=$$UP^XLFSTR(PAYER)

 +61                       SET PAYER=TIN_"/"_$EXTRACT(PAYER,1,70-$LENGTH(TIN))

 +62                       SET XX=1

 +63                       IF RCPAYS'="A"

                               Begin DoDot:3

 +64      ; Check if payer was selected

                                   SET XX=$$ISSEL^RCDPEU1(344.4,IEN3444)

                               End DoDot:3

                               if 'XX

                                   QUIT 

 +65      ; If all of a give type of payer selected

                          IF '$TEST

                               IF RCTYPE'="A"

                                   Begin DoDot:3

 +66      ; Check that payer matches type

                                       SET XX=$$ISTYPE^RCDPEU1(344.4,IEN3444,RCTYPE)

                                   End DoDot:3

                                   if 'XX

                                       QUIT 

 +67                       SET IEN34441=""

 +68                       FOR 

                               Begin DoDot:3

 +69                               SET IEN34441=$ORDER(^RCY(344.4,"F",CURDT,IEN3444,IEN34441))

 +70                               if IEN34441=""

                                       QUIT 

 +71                               SET IENS=IEN34441_","_IEN3444_","

 +72      ; ERA Detail line Marked Auto-Post User

                                   SET UIEN=$$GET1^DIQ(344.41,IENS,6.01,"I")