RCDPELAR ;EDE/FA - LIST ALL AUTO-POSTED RECEIPTS REPORT ;Nov 17, 2016
;;4.5;Accounts Receivable;**318,321,326,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_LAR"),^TMP("RCDPE_LAR",$J)
K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER")
;
S INPUT=$$STADIV(.RCVAUTD) ; Division filter
Q:'INPUT ; '^' or timeout
S $P(INPUT,"^",2)=$$APORERA() ; Filter by Auto-Post Date or ERA Date Received
Q:'$P(INPUT,"^",2) ; '^' or timeout
S $P(INPUT,"^",3)=$$DTRNG(0) ; Start Date|End date
Q:'$P(INPUT,"^",3) ; '^' or timeout
S $P(INPUT,"^",4)=$$SELERA() ; Select type of ERAS to be displayed
Q:'$P(INPUT,"^",4)
;
; PRCA*4.5*326 - Ask to show Medical/Pharmacy Tricare or All, PRCA*4.5*432 Add CHAMPVA
S $P(INPUT,"^",10)=$$RTYPE^RCDPEU1("")
I $P(INPUT,"^",10)<0 Q
;
S RCPAR("SELC")=$$PAYRNG^RCDPEU1() ; PRCA*4.5*326 - Selected or Range of Payers
Q:RCPAR("SELC")=-1 ; PRCA*4.5*326 '^' or timeout
S $P(INPUT,"^",5)=RCPAR("SELC")
;
I RCPAR("SELC")'="A" D Q:XX=-1 ; PRCA*4.5*326 - Since we don't want all payers
. S RCPAR("TYPE")=$P(INPUT,"^",10) ; prompt for payers we do want
. S RCPAR("FILE")=344.4
. S RCPAR("DICA")="Select Insurance Company NAME: "
. S XX=$$SELPAY^RCDPEU1(.RCPAR)
;
S XX=$P(INPUT,"^",2),YY=$P(INPUT,"^",4)
S $P(INPUT,"^",6)=$$RPTSORT(XX,YY) ; Select Secondary sort
Q:'$P(INPUT,"^",6) ; '^' 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^RCDPELAR(INPUT,.RCVAUTD,.IO,JOB)"
. S ZTDESC="LIST ALL AUTO-POSTED RECEIPTS 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_LAR",$J,CTR)=Line - Array of display lines (no headers)
; for output to Listman
; Only set when A7-1
N HDR
S $P(INPUT,"^",9)=0 ; Initial listman line counter
D REPORT(INPUT,.RCVAUTD,.IO) ; Get the lines to be displayed
S HDR("TITLE")="AUTO-POSTED RECEIPT REPORT"
S HDR(1)=$$HDRLN2^RCDPELA1(INPUT)
S HDR(2)=$$HDRLN3^RCDPELA1(INPUT)
S HDR(3)=""
S HDR(4)=""
S HDR(5)="PAYER"
S HDR(6)=" DATE DATE"
S HDR(7)=$$ERAHDR2^RCDPELA1()
D LMRPT^RCDPEARL(.HDR,$NA(^TMP("RCDPE_LAR",$J))) ; Generate ListMan display
;
D ^%ZISC ; Close the device
K ^TMP("RCDPE_LAR",$J),^TMP($J,"RCDPE_LAR")
K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER")
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
;
APORERA() ; Ask the user if they want to filter by Auto-Post Date or ERA Date
; received
; Input: None
; Returns: 0 - User up-arrowed or timed out
; 1 - Filter by Auto-Post date range
; 2 - Filter by ERA Date Received
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR("A")="(A)uto-Post Date or (E)RA Date Received? (A/E): "
S DIR(0)="SA^A:Auto-Post Date;E:ERA Date Received"
S DIR("?",1)="Enter 'A' to filter by an Auto-Post Date Range."
S DIR("?")="Enter 'E' to filter by an ERA Date Received Date Range."
S DIR("B")="A"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q 0
Q:Y="A" 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)="DAO^:"_DT_":APE"
S DIR("A")="Start Date: "
S XX="Enter the earliest "_$S(WHICH=0:"Auto-Post date",1:"ERA Date Received")
S XX=XX_" for receipts to include on the report"
S DIR("?")=XX
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)="DAO^"_START_":"_DT_":APE"
S DIR("A")="End Date: "
S XX="Enter the latest "_$S(WHICH=0:"Auto-Post date",1:"ERA Date Received")
S XX=XX_" for receipts to include on the report"
S DIR("?")=XX
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
;
SELERA() ; Ask the user which types of ERA the want to see on the report
; Input: None
; Returns: 0 - User up-arrowed or timed out
; 1 - Posted/Completed Receipts
; 2 - Only ERAs with Missing Receipts
; 3 - Both Posted/Completed and Missing Receipts
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR("A")="Select ERAs to be Displayed: "
S DIR(0)="SA^1:Posted/Completed Receipts;2:Missing Receipts;3:Both"
S DIR("B")="Both"
S DIR("?",1)="Enter 1 to only display Posted Receipts."
S DIR("?",2)="Enter 2 to only display ERAs with missing receipts."
S DIR("?")="Enter 3 to display all receipts."
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q 0
Q Y
;
RPTSORT(WHICH,ERASEL) ; Ask the user how they want to sort the data
; Input: WHICH - 1- Filtering by Auto-Post Date
; 2 - Filtering by ERA Date Received
; ERASEL - ERA Filter
; 1 - Posted/Completed Receipts
; 2 - Only ERAs with Missing Receipts
; 3 - Both Posted/Completed and Missing Receipts
; Returns: 0 - User up-arrowed or timed out
; 1 - Auto-Post Date sort
; 2 - Missing Receipts
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
;
; If the user is only showing Posted/Completed Receipts OR
; Missing Receipts then the only possible sort value is by date
I ERASEL'=3 Q 1
S DIR("A")="Sort by (D)ate or (M)issing Receipts: "
S DIR(0)="SA^D:Date;M:Missing Receipts"
S DIR("B")="D"
S XX=$S(WHICH=1:"Auto-Post date.",1:"ERA Date Received.")
S DIR("?",1)="Enter 'D' to sort by "_XX
S DIR("?")="Enter 'M' to display Missing Receipts first."
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q 0
S XX=$S(Y="D":1,Y="P":2,1:3)
Q XX
;
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 - 1 - Filter by Auto-Post date range
; 2 - Filter by ERA Date Received date range
; A3 - B1|B2 - Where:
; B1 - ERA Date Received Start Date if A2=2
; Auto-Post Start Date of A2=1
; B2 - ERA Date Received End Date if A2=2
; Auto-Post End Date of A2=1
; A4 - 1 - Posted/Completed Receipts
; 2 - Only ERAs with Missing Receipts
; 3 - Both Posted/Completed and Missing Receipts
; A5 - 1 - All insurance companies selected
; 2 - Selected insurance companies chosen
; A6 - 1 - Auto-Post Date/ERA Date Received Sort
; 2 - Payer sort
; 3 - Missing Receipts
; 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
; A10 - M/P/T/C/A = Medical/Pharmacy/Tricare/CHAMPVA/All
; RCVAUTD - Array of selected Divisions
; Only passed if A1=2
; IO - Interface device
; JOB - $J (optional, only passed in when report is queued)
; ^TMP("RCSELPAY",$J)- Global Array of selected insurance companies
; Output: ^TMP("RCDPE_LAR",$J,CTR)=Line - Array of display lines (no headers)
; for output to Listman
; Only set when A7-1
N CURDT,DIVFLT,DTEND,DTSTART,ERAFILT,WHICH,RCTYPE,RCPAYS,SORT,STOP,XX
K ^TMP("RCDPE_LAR",$J),^TMP($J,"RCDPE_LAR")
; I '$G(JOB) S JOB=""
U IO
; D PAYERS(JOB) ; Rearrange payer global for easier use
S DIVFLT=$P(INPUT,"^",1) ; Division filter
S WHICH=$P(INPUT,"^",2) ; 1 - Auto-Post date, 2 - ERA Date Received
S SORT=$P(INPUT,"^",6) ; Type of secondary sort
S DTEND=$P($P(INPUT,"^",3),"|",2)_".9999" ; End of Date Range
S DTSTART=$P($P(INPUT,"^",3),"|",1) ; End of Date Range
S ERAFILT=$P(INPUT,"^",4) ; ERA Filter
S RCTYPE=$P(INPUT,"^",10) ; PRCA*4.5*326 Medical/Pharmacy/Tricare/All ; PRCA*4.5*432 Add CHAMPVA
S RCPAYS=$P(INPUT,"^",5) ; Payers All/Selected/Range
;
; First filter and sort the report
S CURDT=(DTSTART-1)_.9999 ;PRCA*4.5*321 Added '_.9999'
F D Q:'CURDT Q:CURDT>(DTEND)
. S:WHICH=1 CURDT=$O(^RCY(344.4,"F",CURDT))
. S:WHICH=2 CURDT=$O(^RCY(344.4,"AFD",CURDT))
. Q:'CURDT
. Q:CURDT>(DTEND)
. I WHICH=2 D RPTE(DIVFLT,CURDT,SORT,ERAFILT,.RCVAUTD,RCTYPE,RCPAYS) Q
. D RPTA(DIVFLT,CURDT,SORT,ERAFILT,.RCVAUTD,RCTYPE,RCPAYS)
;
D RPTOUT^RCDPELA1(INPUT) ; Output the report
;
; Quit if Listman - clean up of ^TMP & device is handled in LMOUT^RCDPELAR
I $P(INPUT,"^",7)=1 Q
;
; Close device
I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP("RCDPE_LAR",$J),^TMP($J,"RCDPE_LAR")
K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER")
K ^TMP("RCDPEU1",$J) ; PRCA*4.5*326
K ZTQUEUED
Q
;
PAYERS(JOB) ; Rearrange payer global for easier use
; Input: ^TMP("RCSELPAY",$J,nn)=Payer Name - Global Array of selected
; insurance companies
; Output ^TMP($J,"SELPAYER",Payer Name)="" - Global Array of selected
; insurance rearranged for easier checks
I JOB="" S JOB=$J
N PAYER,XX
K ^TMP($J,"SELPAYER")
S XX=""
F D Q:XX=""
. S XX=$O(^TMP("RCSELPAY",JOB,XX))
. Q:XX=""
. S PAYER=$$UP^XLFSTR(^TMP("RCSELPAY",JOB,XX))
. S ^TMP($J,"SELPAYER",PAYER)=""
K ^TMP("RCSELPAY",JOB)
Q
;
RPTE(DIVFLT,CURDT,SORT,ERAFILT,VAUTD,RCTYPE,RCPAYS) ; Use the ERA Date Received index and filter out
; divisions, payers that weren't selected
; Input: DIVFLT - 1 - All Divisions selected, 2 otherwise
; CURDT - Date being processed
; SORT - 1 - Auto-Post Date Sort
; 2 - Missing Receipts
; ERAFILT - 1 - Posted/Completed Receipts
; 2 - Only ERAs with Missing Receipts
; 3 - Both Posted/Completed and Missing Receipts
; VAUTD - Array of selected divisions
; RCTYPE - Type of payer - M/P/T/A
; RCPAYS - A - All payers, S - Selected Payers, R - Range of Payers
; ^TMP("RCSELPAY",$J) - Global Array of selected insurance companies
; Output: ^TMP($J,A1,"SEL",A2,A3,A4,A5)="" - if record passed filters Where:
; A1 - "RCDPE_LAR"
; A2 - Uppercased Payer Name (primary sort)
; A3 - Secondary Sort Value
; A4 - Internal IEN for file 344.4
; A5 - Internal IEN for sub file 344.41
N COMPLETE,IEN3444,IEN34441,IENS,PAYER,RECEIPT,SVAL,TIN,XX
S IEN3444=0
F D Q:'IEN3444
. S IEN3444=$O(^RCY(344.4,"AFD",CURDT,IEN3444))
. Q:'IEN3444
. S PAYER=$$GET1^DIQ(344.4,IEN3444,.06,"I") ; Payment From field
. S PAYER=$$UP^XLFSTR(PAYER)
. S XX=1
. I RCPAYS'="A" D Q:'XX
. . S XX=$$ISSEL^RCDPEU1(344.4,IEN3444) ; PRCA*4.5*326 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
. I DIVFLT'=1 Q:'$$CHKDIV^RCDPEDAR(IEN3444,1,.VAUTD) ; Not a selected Division
. S XX=$$GET1^DIQ(344.4,IEN3444,4.01,"I") ; Auto-Post date on ERA
. Q:'XX ; skip if not auto-posted ERA
. S COMPLETE=$$COMPLETE(IEN3444) ; Check for missing receipts
. I ERAFILT=1,'COMPLETE Q ; Missing Receipt
. I ERAFILT=2,COMPLETE Q ; Not a Missing Receipt
. ;
. ; Just showing missing receipts and this ERA doesn't have any
. I ERAFILT=2,COMPLETE Q
. S IEN34441=0
. F D Q:'IEN34441
. . S IEN34441=$O(^RCY(344.4,IEN3444,1,IEN34441))
. . Q:'IEN34441
. . S IENS=IEN34441_","_IEN3444_","
. . S SVAL=$S(SORT=1:CURDT,1:COMPLETE) ; Get the sort value
. . S ^TMP($J,"RCDPE_LAR","SEL",PAYER,SVAL,IEN3444,IEN34441)=""
Q
;
RPTA(DIVFLT,CURDT,SORT,ERAFILT,VAUTD,RCTYPE,RCPAYS) ; Use the Auto-Post Date index and filter out
; divisions, payers that weren't selected
; Input: DIVFLT - 1 - All Divisions selected, 2 otherwise
; CURDT - Date being processed
; SORT - 1 - Auto-Post Date Sort
; 2 - Missing Receipts
; ERAFILT - 1 - Posted/Completed Receipts
; 2 - Only ERAs with Missing Receipts
; 3 - Both Posted/Completed and Missing Receipts
; VAUTD - Array of selected divisions
; RCTYPE - Type of payer - M/P/T/A
; RCPAYS - A - All payers, S - Selected Payers, R - Range of Payers
; ^TMP("RCSELPAY",$J) - Global Array of selected insurance companies
; ^TMP($J,"RCDPE_LAR","ERA") - see output for definition
; Output: ^TMP($J,A1,"SEL",A2,A3,A4,A5)="" - if record passed filters Where:
; A1 - "RCDPE_LAR"
; A2 - Uppercased Payer Name (primary sort)
; A3 - Secondary Sort Value
; A4 - Internal IEN for file 344.4
; A5 - Internal IEN for sub file 344.41
; ^TMP($J,A1,"ERA",A2)="" - List of ERAs that were already pulled Where:
; A1 - "RCDPE_LAR"
; A2 - IEN of #344.4 (ERA #)
;
N COMPLETE,IEN3444,IEN3441,PAYER,SVAL
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,.VAUTD) ; Not a selected Division
. S COMPLETE=$$COMPLETE(IEN3444)
. I ERAFILT=1,'COMPLETE Q ; Missing Receipt
. I ERAFILT=2,COMPLETE Q ; Not a Missing Receipt
. S PAYER=$$GET1^DIQ(344.4,IEN3444,.06,"I") ; Payment From field
. S PAYER=$$UP^XLFSTR(PAYER)
. ; Q:'$D(^TMP($J,"SELPAYER",PAYER)) ; Not a selected payer
. S XX=1
. I RCPAYS'="A" D Q:'XX
. . S XX=$$ISSEL^RCDPEU1(344.4,IEN3444) ; PRCA*4.5*326 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
. Q:$D(^TMP($J,"RCDPE_LAR","ERA",IEN3444)) ; Already pulled this ERA
. ;
. S ^TMP($J,"RCDPE_LAR","ERA",IEN3444)=""
. S IEN34441=0
. F D Q:'IEN34441
. . S IEN34441=$O(^RCY(344.4,IEN3444,1,IEN34441))
. . Q:'IEN34441
. . S SVAL=$S(SORT=1:CURDT,1:COMPLETE) ; Get the sort value
. . S ^TMP($J,"RCDPE_LAR","SEL",PAYER,SVAL,IEN3444,IEN34441)=""
Q
;
COMPLETE(IEN3444) ; Checks an ERA for missing receipts
; Input: IEN3444 - ERA to be checked
; Returns: 0 if at least one detail line of the ERA has a missing receipt
; 1 otherwise
N XX
S XX=$$GET1^DIQ(344.4,IEN3444,4.02,"I") ; Auto-Post Status field
I XX=2 Q 1 ; Complete ERA
Q 0
;
ASKSTOP() ; 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[HRCDPELAR 19815 printed Sep 23, 2025@19:20:43 Page 2
RCDPELAR ;EDE/FA - LIST ALL AUTO-POSTED RECEIPTS REPORT ;Nov 17, 2016
+1 ;;4.5;Accounts Receivable;**318,321,326,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_LAR"),^TMP("RCDPE_LAR",$JOB)
+3 KILL ^TMP("RCSELPAY",$JOB),^TMP($JOB,"SELPAYER")
+4 ;
+5 ; Division filter
SET INPUT=$$STADIV(.RCVAUTD)
+6 ; '^' or timeout
if 'INPUT
QUIT
+7 ; Filter by Auto-Post Date or ERA Date Received
SET $PIECE(INPUT,"^",2)=$$APORERA()
+8 ; '^' or timeout
if '$PIECE(INPUT,"^",2)
QUIT
+9 ; Start Date|End date
SET $PIECE(INPUT,"^",3)=$$DTRNG(0)
+10 ; '^' or timeout
if '$PIECE(INPUT,"^",3)
QUIT
+11 ; Select type of ERAS to be displayed
SET $PIECE(INPUT,"^",4)=$$SELERA()
+12 if '$PIECE(INPUT,"^",4)
QUIT
+13 ;
+14 ; PRCA*4.5*326 - Ask to show Medical/Pharmacy Tricare or All, PRCA*4.5*432 Add CHAMPVA
+15 SET $PIECE(INPUT,"^",10)=$$RTYPE^RCDPEU1("")
+16 IF $PIECE(INPUT,"^",10)<0
QUIT
+17 ;
+18 ; PRCA*4.5*326 - Selected or Range of Payers
SET RCPAR("SELC")=$$PAYRNG^RCDPEU1()
+19 ; PRCA*4.5*326 '^' or timeout
if RCPAR("SELC")=-1
QUIT
+20 SET $PIECE(INPUT,"^",5)=RCPAR("SELC")
+21 ;
+22 ; PRCA*4.5*326 - Since we don't want all payers
IF RCPAR("SELC")'="A"
Begin DoDot:1
+23 ; prompt for payers we do want
SET RCPAR("TYPE")=$PIECE(INPUT,"^",10)
+24 SET RCPAR("FILE")=344.4
+25 SET RCPAR("DICA")="Select Insurance Company NAME: "
+26 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
End DoDot:1
if XX=-1
QUIT
+27 ;
+28 SET XX=$PIECE(INPUT,"^",2)
SET YY=$PIECE(INPUT,"^",4)
+29 ; Select Secondary sort
SET $PIECE(INPUT,"^",6)=$$RPTSORT(XX,YY)
+30 ; '^' or timeout
if '$PIECE(INPUT,"^",6)
QUIT
+31 ; Ask to Display in Listman Template
SET $PIECE(INPUT,"^",7)=$$ASKLM^RCDPEARL
+32 ; '^' or timeout
if $PIECE(INPUT,"^",7)<0
QUIT
+33 ; Compile data and call listman to display
IF $PIECE(INPUT,"^",7)=1
Begin DoDot:1
+34 DO LMOUT(INPUT,.RCVAUTD,.IO)
End DoDot:1
QUIT
+35 ; Ask to output to Excel
SET $PIECE(INPUT,"^",8)=$$EXCEL()
+36 ; '^' or timeout
if $PIECE(INPUT,"^",8)=-1
QUIT
+37 ; Display capture information for Excel
if $PIECE(INPUT,"^",8)=1
DO INFO^RCDPEM6
+38 ; Ask output device
SET $PIECE(INPUT,"^",9)=$$DEVICE($PIECE(INPUT,"^",8),.IO)
+39 if '$PIECE(INPUT,"^",9)
QUIT
+40 ;
+41 ; Option to queue
+42 IF $DATA(IO("Q"))
Begin DoDot:1
+43 NEW JOB
SET JOB=$JOB
+44 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+45 SET ZTRTN="REPORT^RCDPELAR(INPUT,.RCVAUTD,.IO,JOB)"
+46 SET ZTDESC="LIST ALL AUTO-POSTED RECEIPTS REPORT"
+47 MERGE RCPYRSEL=^TMP("RCSELPAY",$JOB)
+48 SET ZTSAVE("RC*")=""
SET ZTSAVE("VAUTD")=""
SET ZTSAVE("IO*")=""
+49 SET ZTSAVE("INPUT")=""
SET ZTSAVE("JOB")=""
+50 SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
+51 DO ^%ZTLOAD
+52 WRITE !!,$SELECT($DATA(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
+53 KILL ZTSK,IO("Q")
+54 DO HOME^%ZIS
End DoDot:1
QUIT
+55 ;
+56 ; Compile and Display Report data
DO REPORT(INPUT,.RCVAUTD,.IO)
+57 QUIT
+58 ;
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_LAR",$J,CTR)=Line - Array of display lines (no headers)
+5 ; for output to Listman
+6 ; Only set when A7-1
+7 NEW HDR
+8 ; Initial listman line counter
SET $PIECE(INPUT,"^",9)=0
+9 ; Get the lines to be displayed
DO REPORT(INPUT,.RCVAUTD,.IO)
+10 SET HDR("TITLE")="AUTO-POSTED RECEIPT REPORT"
+11 SET HDR(1)=$$HDRLN2^RCDPELA1(INPUT)
+12 SET HDR(2)=$$HDRLN3^RCDPELA1(INPUT)
+13 SET HDR(3)=""
+14 SET HDR(4)=""
+15 SET HDR(5)="PAYER"
+16 SET HDR(6)=" DATE DATE"
+17 SET HDR(7)=$$ERAHDR2^RCDPELA1()
+18 ; Generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP("RCDPE_LAR",$JOB)))
+19 ;
+20 ; Close the device
DO ^%ZISC
+21 KILL ^TMP("RCDPE_LAR",$JOB),^TMP($JOB,"RCDPE_LAR")
+22 KILL ^TMP("RCSELPAY",$JOB),^TMP($JOB,"SELPAYER")
+23 QUIT
+24 ;
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 ;
APORERA() ; Ask the user if they want to filter by Auto-Post Date or ERA Date
+1 ; received
+2 ; Input: None
+3 ; Returns: 0 - User up-arrowed or timed out
+4 ; 1 - Filter by Auto-Post date range
+5 ; 2 - Filter by ERA Date Received
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 SET DIR("A")="(A)uto-Post Date or (E)RA Date Received? (A/E): "
+8 SET DIR(0)="SA^A:Auto-Post Date;E:ERA Date Received"
+9 SET DIR("?",1)="Enter 'A' to filter by an Auto-Post Date Range."
+10 SET DIR("?")="Enter 'E' to filter by an ERA Date Received Date Range."
+11 SET DIR("B")="A"
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+14 if Y="A"
QUIT 1
+15 QUIT 2
+16 ;
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)="DAO^:"_DT_":APE"
+10 SET DIR("A")="Start Date: "
+11 SET XX="Enter the earliest "_$SELECT(WHICH=0:"Auto-Post date",1:"ERA Date Received")
+12 SET XX=XX_" for receipts to include on the report"
+13 SET DIR("?")=XX
+14 DO ^DIR
+15 if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+16 SET START=Y
ENDDT ; Prompt for end date
+1 KILL DIR
+2 SET DIR("B")=Y(0)
+3 SET DIR(0)="DAO^"_START_":"_DT_":APE"
+4 SET DIR("A")="End Date: "
+5 SET XX="Enter the latest "_$SELECT(WHICH=0:"Auto-Post date",1:"ERA Date Received")
+6 SET XX=XX_" for receipts to include on the report"
+7 SET DIR("?")=XX
+8 DO ^DIR
+9 if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+10 IF Y<START
Begin DoDot:1
+11 ;****
SET XX=$$FMTE^XLFDT(START,"2ZD")
+12 WRITE !,*7,"Enter an End date that is not less than "_XX
End DoDot:1
GOTO ENDDT
+13 SET RANGE=START_"|"_Y
+14 QUIT RANGE
+15 ;
SELERA() ; Ask the user which types of ERA the want to see on the report
+1 ; Input: None
+2 ; Returns: 0 - User up-arrowed or timed out
+3 ; 1 - Posted/Completed Receipts
+4 ; 2 - Only ERAs with Missing Receipts
+5 ; 3 - Both Posted/Completed and Missing Receipts
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 SET DIR("A")="Select ERAs to be Displayed: "
+8 SET DIR(0)="SA^1:Posted/Completed Receipts;2:Missing Receipts;3:Both"
+9 SET DIR("B")="Both"
+10 SET DIR("?",1)="Enter 1 to only display Posted Receipts."
+11 SET DIR("?",2)="Enter 2 to only display ERAs with missing receipts."
+12 SET DIR("?")="Enter 3 to display all receipts."
+13 DO ^DIR
+14 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+15 QUIT Y
+16 ;
RPTSORT(WHICH,ERASEL) ; Ask the user how they want to sort the data
+1 ; Input: WHICH - 1- Filtering by Auto-Post Date
+2 ; 2 - Filtering by ERA Date Received
+3 ; ERASEL - ERA Filter
+4 ; 1 - Posted/Completed Receipts
+5 ; 2 - Only ERAs with Missing Receipts
+6 ; 3 - Both Posted/Completed and Missing Receipts
+7 ; Returns: 0 - User up-arrowed or timed out
+8 ; 1 - Auto-Post Date sort
+9 ; 2 - Missing Receipts
+10 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
+11 ;
+12 ; If the user is only showing Posted/Completed Receipts OR
+13 ; Missing Receipts then the only possible sort value is by date
+14 IF ERASEL'=3
QUIT 1
+15 SET DIR("A")="Sort by (D)ate or (M)issing Receipts: "
+16 SET DIR(0)="SA^D:Date;M:Missing Receipts"
+17 SET DIR("B")="D"
+18 SET XX=$SELECT(WHICH=1:"Auto-Post date.",1:"ERA Date Received.")
+19 SET DIR("?",1)="Enter 'D' to sort by "_XX
+20 SET DIR("?")="Enter 'M' to display Missing Receipts first."
+21 DO ^DIR
+22 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+23 SET XX=$SELECT(Y="D":1,Y="P":2,1:3)
+24 QUIT XX
+25 ;
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 - 1 - Filter by Auto-Post date range
+6 ; 2 - Filter by ERA Date Received date range
+7 ; A3 - B1|B2 - Where:
+8 ; B1 - ERA Date Received Start Date if A2=2
+9 ; Auto-Post Start Date of A2=1
+10 ; B2 - ERA Date Received End Date if A2=2
+11 ; Auto-Post End Date of A2=1
+12 ; A4 - 1 - Posted/Completed Receipts
+13 ; 2 - Only ERAs with Missing Receipts
+14 ; 3 - Both Posted/Completed and Missing Receipts
+15 ; A5 - 1 - All insurance companies selected
+16 ; 2 - Selected insurance companies chosen
+17 ; A6 - 1 - Auto-Post Date/ERA Date Received Sort
+18 ; 2 - Payer sort
+19 ; 3 - Missing Receipts
+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 ; A10 - M/P/T/C/A = Medical/Pharmacy/Tricare/CHAMPVA/All
+26 ; RCVAUTD - Array of selected Divisions
+27 ; Only passed if A1=2
+28 ; IO - Interface device
+29 ; JOB - $J (optional, only passed in when report is queued)
+30 ; ^TMP("RCSELPAY",$J)- Global Array of selected insurance companies
+31 ; Output: ^TMP("RCDPE_LAR",$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,ERAFILT,WHICH,RCTYPE,RCPAYS,SORT,STOP,XX
+35 KILL ^TMP("RCDPE_LAR",$JOB),^TMP($JOB,"RCDPE_LAR")
+36 ; I '$G(JOB) S JOB=""
+37 USE IO
+38 ; D PAYERS(JOB) ; Rearrange payer global for easier use
+39 ; Division filter
SET DIVFLT=$PIECE(INPUT,"^",1)
+40 ; 1 - Auto-Post date, 2 - ERA Date Received
SET WHICH=$PIECE(INPUT,"^",2)
+41 ; Type of secondary sort
SET SORT=$PIECE(INPUT,"^",6)
+42 ; End of Date Range
SET DTEND=$PIECE($PIECE(INPUT,"^",3),"|",2)_".9999"
+43 ; End of Date Range
SET DTSTART=$PIECE($PIECE(INPUT,"^",3),"|",1)
+44 ; ERA Filter
SET ERAFILT=$PIECE(INPUT,"^",4)
+45 ; PRCA*4.5*326 Medical/Pharmacy/Tricare/All ; PRCA*4.5*432 Add CHAMPVA
SET RCTYPE=$PIECE(INPUT,"^",10)
+46 ; Payers All/Selected/Range
SET RCPAYS=$PIECE(INPUT,"^",5)
+47 ;
+48 ; First filter and sort the report
+49 ;PRCA*4.5*321 Added '_.9999'
SET CURDT=(DTSTART-1)_.9999
+50 FOR
Begin DoDot:1
+51 if WHICH=1
SET CURDT=$ORDER(^RCY(344.4,"F",CURDT))
+52 if WHICH=2
SET CURDT=$ORDER(^RCY(344.4,"AFD",CURDT))
+53 if 'CURDT
QUIT
+54 if CURDT>(DTEND)
QUIT
+55 IF WHICH=2
DO RPTE(DIVFLT,CURDT,SORT,ERAFILT,.RCVAUTD,RCTYPE,RCPAYS)
QUIT
+56 DO RPTA(DIVFLT,CURDT,SORT,ERAFILT,.RCVAUTD,RCTYPE,RCPAYS)
End DoDot:1
if 'CURDT
QUIT
if CURDT>(DTEND)
QUIT
+57 ;
+58 ; Output the report
DO RPTOUT^RCDPELA1(INPUT)
+59 ;
+60 ; Quit if Listman - clean up of ^TMP & device is handled in LMOUT^RCDPELAR
+61 IF $PIECE(INPUT,"^",7)=1
QUIT
+62 ;
+63 ; Close device
+64 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+65 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+66 KILL ^TMP("RCDPE_LAR",$JOB),^TMP($JOB,"RCDPE_LAR")
+67 KILL ^TMP("RCSELPAY",$JOB),^TMP($JOB,"SELPAYER")
+68 ; PRCA*4.5*326
KILL ^TMP("RCDPEU1",$JOB)
+69 KILL ZTQUEUED
+70 QUIT
+71 ;
PAYERS(JOB) ; Rearrange payer global for easier use
+1 ; Input: ^TMP("RCSELPAY",$J,nn)=Payer Name - Global Array of selected
+2 ; insurance companies
+3 ; Output ^TMP($J,"SELPAYER",Payer Name)="" - Global Array of selected
+4 ; insurance rearranged for easier checks
+5 IF JOB=""
SET JOB=$JOB
+6 NEW PAYER,XX
+7 KILL ^TMP($JOB,"SELPAYER")
+8 SET XX=""
+9 FOR
Begin DoDot:1
+10 SET XX=$ORDER(^TMP("RCSELPAY",JOB,XX))
+11 if XX=""
QUIT
+12 SET PAYER=$$UP^XLFSTR(^TMP("RCSELPAY",JOB,XX))
+13 SET ^TMP($JOB,"SELPAYER",PAYER)=""
End DoDot:1
if XX=""
QUIT
+14 KILL ^TMP("RCSELPAY",JOB)
+15 QUIT
+16 ;
RPTE(DIVFLT,CURDT,SORT,ERAFILT,VAUTD,RCTYPE,RCPAYS) ; Use the ERA Date Received index and filter out
+1 ; divisions, payers that weren't selected
+2 ; Input: DIVFLT - 1 - All Divisions selected, 2 otherwise
+3 ; CURDT - Date being processed
+4 ; SORT - 1 - Auto-Post Date Sort
+5 ; 2 - Missing Receipts
+6 ; ERAFILT - 1 - Posted/Completed Receipts
+7 ; 2 - Only ERAs with Missing Receipts
+8 ; 3 - Both Posted/Completed and Missing Receipts
+9 ; VAUTD - Array of selected divisions
+10 ; RCTYPE - Type of payer - M/P/T/A
+11 ; RCPAYS - A - All payers, S - Selected Payers, R - Range of Payers
+12 ; ^TMP("RCSELPAY",$J) - Global Array of selected insurance companies
+13 ; Output: ^TMP($J,A1,"SEL",A2,A3,A4,A5)="" - if record passed filters Where:
+14 ; A1 - "RCDPE_LAR"
+15 ; A2 - Uppercased Payer Name (primary sort)
+16 ; A3 - Secondary Sort Value
+17 ; A4 - Internal IEN for file 344.4
+18 ; A5 - Internal IEN for sub file 344.41
+19 NEW COMPLETE,IEN3444,IEN34441,IENS,PAYER,RECEIPT,SVAL,TIN,XX
+20 SET IEN3444=0
+21 FOR
Begin DoDot:1
+22 SET IEN3444=$ORDER(^RCY(344.4,"AFD",CURDT,IEN3444))
+23 if 'IEN3444
QUIT
+24 ; Payment From field
SET PAYER=$$GET1^DIQ(344.4,IEN3444,.06,"I")
+25 SET PAYER=$$UP^XLFSTR(PAYER)
+26 SET XX=1
+27 IF RCPAYS'="A"
Begin DoDot:2
+28 ; PRCA*4.5*326 Check if payer was selected
SET XX=$$ISSEL^RCDPEU1(344.4,IEN3444)
End DoDot:2
if 'XX
QUIT
+29 ; If all of a give type of payer selected
IF '$TEST
IF RCTYPE'="A"
Begin DoDot:2
+30 ; check that payer matches type
SET XX=$$ISTYPE^RCDPEU1(344.4,IEN3444,RCTYPE)
End DoDot:2
if 'XX
QUIT
+31 ; Not a selected Division
IF DIVFLT'=1
if '$$CHKDIV^RCDPEDAR(IEN3444,1,.VAUTD)
QUIT
+32 ; Auto-Post date on ERA
SET XX=$$GET1^DIQ(344.4,IEN3444,4.01,"I")
+33 ; skip if not auto-posted ERA
if 'XX
QUIT
+34 ; Check for missing receipts
SET COMPLETE=$$COMPLETE(IEN3444)
+35 ; Missing Receipt
IF ERAFILT=1
IF 'COMPLETE
QUIT
+36 ; Not a Missing Receipt
IF ERAFILT=2
IF COMPLETE
QUIT
+37 ;
+38 ; Just showing missing receipts and this ERA doesn't have any
+39 IF ERAFILT=2
IF COMPLETE
QUIT
+40 SET IEN34441=0
+41 FOR
Begin DoDot:2
+42 SET IEN34441=$ORDER(^RCY(344.4,IEN3444,1,IEN34441))
+43 if 'IEN34441
QUIT
+44 SET IENS=IEN34441_","_IEN3444_","
+45 ; Get the sort value
SET SVAL=$SELECT(SORT=1:CURDT,1:COMPLETE)
+46 SET ^TMP($JOB,"RCDPE_LAR","SEL",PAYER,SVAL,IEN3444,IEN34441)=""
End DoDot:2
if 'IEN34441
QUIT
End DoDot:1
if 'IEN3444
QUIT
+47 QUIT
+48 ;
RPTA(DIVFLT,CURDT,SORT,ERAFILT,VAUTD,RCTYPE,RCPAYS) ; Use the Auto-Post Date index and filter out
+1 ; divisions, payers that weren't selected
+2 ; Input: DIVFLT - 1 - All Divisions selected, 2 otherwise
+3 ; CURDT - Date being processed
+4 ; SORT - 1 - Auto-Post Date Sort
+5 ; 2 - Missing Receipts
+6 ; ERAFILT - 1 - Posted/Completed Receipts
+7 ; 2 - Only ERAs with Missing Receipts
+8 ; 3 - Both Posted/Completed and Missing Receipts
+9 ; VAUTD - Array of selected divisions
+10 ; RCTYPE - Type of payer - M/P/T/A
+11 ; RCPAYS - A - All payers, S - Selected Payers, R - Range of Payers
+12 ; ^TMP("RCSELPAY",$J) - Global Array of selected insurance companies
+13 ; ^TMP($J,"RCDPE_LAR","ERA") - see output for definition
+14 ; Output: ^TMP($J,A1,"SEL",A2,A3,A4,A5)="" - if record passed filters Where:
+15 ; A1 - "RCDPE_LAR"
+16 ; A2 - Uppercased Payer Name (primary sort)
+17 ; A3 - Secondary Sort Value
+18 ; A4 - Internal IEN for file 344.4
+19 ; A5 - Internal IEN for sub file 344.41
+20 ; ^TMP($J,A1,"ERA",A2)="" - List of ERAs that were already pulled Where:
+21 ; A1 - "RCDPE_LAR"
+22 ; A2 - IEN of #344.4 (ERA #)
+23 ;
+24 NEW COMPLETE,IEN3444,IEN3441,PAYER,SVAL
+25 SET IEN3444=0
+26 FOR
Begin DoDot:1
+27 SET IEN3444=$ORDER(^RCY(344.4,"F",CURDT,IEN3444))
+28 if 'IEN3444
QUIT
+29 ; Not a selected Division
IF DIVFLT'=1
if '$$CHKDIV^RCDPEDAR(IEN3444,1,.VAUTD)
QUIT
+30 SET COMPLETE=$$COMPLETE(IEN3444)
+31 ; Missing Receipt
IF ERAFILT=1
IF 'COMPLETE
QUIT
+32 ; Not a Missing Receipt
IF ERAFILT=2
IF COMPLETE
QUIT
+33 ; Payment From field
SET PAYER=$$GET1^DIQ(344.4,IEN3444,.06,"I")
+34 SET PAYER=$$UP^XLFSTR(PAYER)
+35 ; Q:'$D(^TMP($J,"SELPAYER",PAYER)) ; Not a selected payer
+36 SET XX=1
+37 IF RCPAYS'="A"
Begin DoDot:2
+38 ; PRCA*4.5*326 Check if payer was selected
SET XX=$$ISSEL^RCDPEU1(344.4,IEN3444)
End DoDot:2
if 'XX
QUIT
+39 ; If all of a give type of payer selected
IF '$TEST
IF RCTYPE'="A"
Begin DoDot:2
+40 ; check that payer matches type
SET XX=$$ISTYPE^RCDPEU1(344.4,IEN3444,RCTYPE)
End DoDot:2
if 'XX
QUIT
+41 ; Already pulled this ERA
if $DATA(^TMP($JOB,"RCDPE_LAR","ERA",IEN3444))
QUIT
+42 ;
+43 SET ^TMP($JOB,"RCDPE_LAR","ERA",IEN3444)=""
+44 SET IEN34441=0
+45 FOR
Begin DoDot:2
+46 SET IEN34441=$ORDER(^RCY(344.4,IEN3444,1,IEN34441))
+47 if 'IEN34441
QUIT
+48 ; Get the sort value
SET SVAL=$SELECT(SORT=1:CURDT,1:COMPLETE)
+49 SET ^TMP($JOB,"RCDPE_LAR","SEL",PAYER,SVAL,IEN3444,IEN34441)=""
End DoDot:2
if 'IEN34441
QUIT
End DoDot:1
if 'IEN3444
QUIT
+50 QUIT
+51 ;
COMPLETE(IEN3444) ; Checks an ERA for missing receipts
+1 ; Input: IEN3444 - ERA to be checked
+2 ; Returns: 0 if at least one detail line of the ERA has a missing receipt
+3 ; 1 otherwise
+4 NEW XX
+5 ; Auto-Post Status field
SET XX=$$GET1^DIQ(344.4,IEN3444,4.02,"I")
+6 ; Complete ERA
IF XX=2
QUIT 1
+7 QUIT 0
+8 ;
ASKSTOP() ; Ask to continue
+1 ; Input: IOST - Device Type
+2 ; Returns: 1 - User wants to quit, 0 otherwise
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 ; Not a terminal
if $EXTRACT(IOST,1,2)'["C-"
QUIT 0
+5 SET DIR(0)="E"
+6 WRITE !
DO ^DIR
+7 IF ($DATA(DIRUT))!($DATA(DUOUT))
QUIT 1
+8 QUIT 0
+9 ;
