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 ---[H[J[2J[HRCDPEMAP 14000 printed Dec 13, 2024@01:44:56 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")
+73 ; Not marked for Auto-Post
if UIEN=""
QUIT
+74 SET USER=$$GET1^DIQ(200,UIEN_",",.01,"E")
+75 SET USERU=$$UP^XLFSTR(USER)
+76 ; Not a selected User
IF USERF'=1
IF '$DATA(^TMP($JOB,"SELUSER",UIEN))
QUIT
+77 ; Get the sort value
SET SVAL=$SELECT(SORT=2:PAYERU,1:USERU)
+78 SET XX=PAYER_"^"_USER
+79 ; ERA#_"."_SEQ
SET $PIECE(XX,"^",3)=$$GET1^DIQ(344.4,IEN3444_",",.01,"E")_"."_IEN34441
+80 ; IEN for 361.1
SET YY=$$GET1^DIQ(344.41,IENS,.02,"I")
+81 ; IEN for 399/430
SET ZZ=$$GET1^DIQ(361.1,YY_",",.01,"I")
+82 ; Claim #
SET ZZ=$$GET1^DIQ(430,ZZ_",",.01,"E")
+83 SET ZZ=$TRANSLATE(ZZ,"-","")
+84 SET $PIECE(XX,"^",4)=ZZ
+85 ; Trace #
SET $PIECE(XX,"^",5)=$$GET1^DIQ(361.1,YY_",",.07,"E")
+86 ;
+87 ; Found one that was marked for auto-post
+88 SET ^TMP($JOB,"RCDPE_MAP","SEL",CURDT)=$$FMTE^XLFDT(CURDT,"2ZD")
+89 SET ^TMP($JOB,"RCDPE_MAP","SEL",CURDT,SVAL)=$SELECT(SORT=2:PAYER,1:USER)
+90 SET ^TMP($JOB,"RCDPE_MAP","SEL",CURDT,SVAL,IEN3444,IEN34441)=XX
End DoDot:3
if IEN34441=""
QUIT
End DoDot:2
if 'IEN3444
QUIT
End DoDot:1
if 'CURDT
QUIT
if CURDT>(DTEND)
QUIT
+91 ;
+92 ; Output the report
DO RPTOUT^RCDPEMA1(INPUT)
+93 ;
+94 ; Quit if Listman - clean up of ^TMP & device is handled in LMOUT^RCDPELAR
+95 if $PIECE(INPUT,"^",7)=1
QUIT
+96 ;
+97 ; Close device
+98 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+99 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+100 KILL ^TMP("RCDPE_MAP",$JOB),^TMP($JOB,"RCDPE_MAP")
+101 KILL ^TMP("RCSELPAY",$JOB),^TMP($JOB,"SELPAYER"),^TMP($JOB,"SELUSER")
+102 KILL ^TMP("RCDPEU1",$JOB)
+103 KILL ZTQUEUED
+104 QUIT
+105 ;
ASKSTOP() ;EP from RCDPEMA1
+1 ; Ask to continue
+2 ; Input: IOST - Device Type
+3 ; Returns: 1 - User wants to quit, 0 otherwise
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+5 ; Not a terminal
if $EXTRACT(IOST,1,2)'["C-"
QUIT 0
+6 SET DIR(0)="E"
+7 WRITE !
DO ^DIR
+8 IF ($DATA(DIRUT))!($DATA(DUOUT))
QUIT 1
+9 QUIT 0
+10 ;
