RCDPEADP ;OIFO-BAYPINES/PJH - AUTO-DECREASE REPORT ;Nov 23, 2014@12:48:50
;;4.5;Accounts Receivable;**298,318,326,432**;Mar 20, 1995;Build 16
;;Per VA Directive 6402, this routine should not be modified.
; Read ^DGCR(399) via Private IA 3820
; Read ^DG(40.8) via Controlled IA 417
; Read ^IBM(361.1) via Private IA 4051
; Use DIVISION^VAUTOMA via Controlled IA 664
;
RPT ; entry point for Auto-Decrease Adjustment report [RCDPE AUTO-DECREASE REPORT]
N INPUT,RCVAUTD
S INPUT=$$STADIV(.RCVAUTD) ; Division filter
Q:'INPUT ; '^' or timeout
S $P(INPUT,"^",2)=$$ASKSORT() ; Select Sort Criteria
Q:$P(INPUT,"^",2)="0" ; '^' or timeout
S $P(INPUT,"^",3)=$$SORTORD($P(INPUT,"^",2)) ; Select Sort Order
Q:$P(INPUT,"^",3)="0" ; '^' or timeout
S $P(INPUT,"^",4)=$$DTRNG() ; Select Date Range for Report
Q:'$P(INPUT,"^",4) ; '^' or timeout
S $P(INPUT,"^",4)=$P($P(INPUT,"^",4),"|",2,3)
; PRCA*4.5*326 Filter by payer type
S $P(INPUT,"^",7)=$$RTYPE^RCDPEU1() ; PRCA*4.5*326 Ask for payer types to include
I $P(INPUT,"^",7)<0 Q
S $P(INPUT,"^",6)=$$ASKLM^RCDPEARL ; Ask to Display in Listman Template
Q:$P(INPUT,"^",6)<0 ; '^' or timeout
I $P(INPUT,"^",6)=1 D Q ; Compile data and call listman to display
. D LMOUT^RCDPEAD1(INPUT,.RCVAUTD,.IO)
S $P(INPUT,"^",5)=$$DISPTY() ; Select Display Type
Q:$P(INPUT,"^",5)=-1 ; '^' or timeout
D:$P(INPUT,"^",5)=1 INFO^RCDPEM6 ; Display capture information for Excel
Q:'$$DEVICE($P(INPUT,"^",5),.IO) ; Ask output device
;
; Compile and Display Report data (queued) - not allowed for EXCEL
I $P(INPUT,"^",5)'=1,$D(IO("Q")) D Q
.N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
.S ZTRTN="REPORT^RCDPEADP(INPUT,.RCVAUTD,.IO)"
.S ZTDESC="EDI LOCKBOX AUTO-DECREASE REPORT"
.S ZTSAVE("RC*")="",ZTSAVE("INPUT")="",ZTSAVE("IO*")=""
.D ^%ZTLOAD
.I $D(ZTSK) W !!,"Task number "_ZTSK_" has been queued."
.E W !!,"Unable to queue this job."
.K ZTSK,IO("Q")
.D HOME^%ZIS
; Compile and Display Report data (non-queued)
D REPORT(INPUT,.RCVAUTD,.IO) ; Compile and Display Report data
Q
;
STADIV(RCVAUTD) ; Division/Station Filter
; Input: None
; Output: RCVAUTD() - Array of selected Divisions/Stations if 2 is returned
; Returns: 1 - All Divisions/Stations selected
; 2 - Specified Divisions/Stations selected
; 0 - "^" or timeout
N DIR,DIROUT,DTOUT,DUOUT,VAUTD,Y
;
; Division selection - IA 664
; RETURNS Y=-1 (quit), VAUTD=1 (for all),VAUTD=0 (selected divisions in VAUTD)
D DIVISION^VAUTOMA
Q:Y<0 0
Q:VAUTD=1 1 ; All Divisions selected
M RCVAUTD=VAUTD ; Save selected divisions
Q 2
;
ASKSORT() ; Select the sort criteria
; Input: None
; Returns: C - Sort by Claim
; P - Sort by Payer
; N - Sort by Patient Name
; 0 - User entered '^' or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX
S DIR(0)="SA^C:CLAIM;P:PAYER;N:PATIENT NAME;"
S DIR("A")="Sort by (C)LAIM #, (P)AYER or PATIENT (N)AME?: "
S DIR("?",1)="Enter 'C' to sort by Claim Number, 'P' to sort by Payer or 'N' to sort"
S DIR("?")="by Patient Name."
S DIR("B")="CLAIM"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) 0
Q Y
;
SORTORD(SORT) ; Select the sort order
; Input: SORT - 'C' - Sort by Claim Number
; 'P' - Sort by Payer
; 'N' - Sort by Patient Name
; Returns: F - First to Last
; L - Last to First
; 0 - User entered '^' or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX,YY
S XX=" (F)IRST TO LAST or (L)AST TO FIRST?: "
S YY=$S(SORT="C":"CLAIM",SORT="P":"PAYER",1:"PATIENT NAME")
S DIR("A")="Sort "_YY_XX
S DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST"
S DIR("B")="FIRST TO LAST"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) 0
Q Y
;
DTRNG() ; Get the date range for the report
; Input: None
; Returns: A1|A2|A3 - Where:
; A1 - 0 - User up-arrowed or timed out, 1 otherwise
; A2 - Auto-Post Start Date
; A3 - Auto-Post End Date
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCEND,RCSTART,RNGFLG,X,Y
D DATES(.RCSTART,.RCEND)
Q:RCSTART=-1 0
Q:RCSTART "1|"_RCSTART_"|"_RCEND
Q:'RCSTART "0||"
Q 0
;
DATES(BDATE,EDATE) ; Get a date range.
; Input: None
; Output: BDATE - Internal Auto-Post Start Date
; EDATE - Internal Auto-Post End Date
D1 ; looping tag
S (BDATE,EDATE)=0
S DIR("?")="Enter the earliest Auto-Posting date to include on the report."
S DIR(0)="DAO^:"_DT_":APE"
S DIR("A")="Start Date: "
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q
S BDATE=Y
S DIR("?")="Enter the latest Auto-Posting date to include on the report."
S DIR("B")=Y(0)
S DIR(0)="DAO^"_BDATE_":"_DT_":APE"
S DIR("A")="End Date: "
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q
S EDATE=Y
Q
;
DISPTY() ; Get display/output type
; Input: None
; Returns: 1 - Output to Excel
; 0 - Output to paper
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
S DIR(0)="Y"
S DIR("A")="Export the report to Microsoft Excel"
S DIR("B")="NO"
D ^DIR
I $G(DUOUT) Q -1
Q Y
;
DEVICE(EXCEL,IO) ; Select the output device
; Input: EXCEL - 1 - Output to Excel, 0 otherwise
; Output:
; IO - Array of selected output info
; Returns: 0 - No device selected, 1 Otherwise
N POP,%ZIS
S %ZIS="QM"
D ^%ZIS
Q:POP 0
Q 1
;
REPORT(INPUTS,RCVAUTD,IO) ; EP Compile and print report
; Input: INPUTS - A1^A2^A3^...^An Where:
; A1 - 1 - All divisions selected
; 2 - Selected divisions
; A2 - C - Sort by Claim
; P - Sort by Payer
; N - Sort by Patient Name
; A3 - F - First to Last Sort Order
; L - Last to First Sort Order
; A4 - B1|B2
; B1 - Auto-Post Start Date
; B2 - Auto-Post End Date
; A5 - 1 - Output to Excel
; 0 - Otherwise
; A6 - 1 - Output to List Manager
; 0 - Otherwise
; A7 - M/P/T/A = Medical/Pharmacy/Tricare/All
;
; RCVAUTD - Array of selected Divisions
; Only passed if A1=2
; IO - Output Device
; Output:
N DTOTAL,GTOTAL,XX,ZTREQ
U IO
K ^TMP("RCDPEADP",$J),^TMP("RCDPE_ADP",$J)
D COMPILE^RCDPEAD1(INPUTS,.RCVAUTD,.DTOTAL,.GTOTAL) ; Scan ERA file for entries in date range
D DISP(INPUTS,.DTOTAL,.GTOTAL) ; Display Report
K ^TMP("RCDPEADP",$J),^TMP("RCSELPAY",$J) ; Clear TMP global
D ^%ZISC ; Close device
Q
;
SAVE(ADDATE,ERAIEN,RCRZ,EXCEL,RCSORT,CARCS,RCTR,STNAM,STNUM) ; Put the data into the ^TMP global
; Input: ADDATE - Current Internal Date being processed
; ERAIEN - Internal IEN of the ERA record
; RCRZ - ERA line number
; EXCEL - 1 output to Excel, 0 otherwise
; RCSORT - C - Sort by Claim
; P - Sort by Payer
; N - Sort by Patient Name
; CARCS - ^ delimited string of CARC information found
; on the EOB record pointed to by the ERA detail record
; A1;A2;A3;A4^B1;B2;B3;B4^...^N1;N2;N3;N4 Where:
; A1 - Auto-Decrease amount of the 1st CARC code
; A2 - 1st CARC code
; A3 - Quantity of the first CARC code
; A4 - Truncated Reason text of the 1st CARC
; DTOTAL() - Current Array of totals by Auto-Post Date
; GTOTAL - Current Grand totals
; RCTR - Current Record Counter
; STNAM - Station name
; STNUM - Station number
; ^TMP("RCDPEADP",$J) - Current report data
; See DISP for a full description
; Output: DTOTAL() - Updated Array of totals by Auto-Post Date
; GTOTAL - Updated Grand totals
; RCTR - Updated Record Counter
; ^TMP("RCDPEADP",$J,A1,A2,A3) - B1^B2^B3^...^Bn Where:
; - A1 - "EXCEL" if exporting to excel
; Internal fileman date if not exporting to excel
; A2 - Excel Line Counter if exporting to excel
; External Claim number is sorting by claim
; External Payer Name if sorting by Payer
; External Patient Name if sorting by Patient Name
; A3 - Record Counter
; B1 - External Station Name
; B2 - External Station Number
; B3 - External Claim Number
; B4 - External Patient Name
; B5 - External Payer Name
; B6 - Auto-Decrease Amount
; B7 - Auto-Decrease Date
; ^TMP("RCDPEADP",$J,A1,A2,A3,A4) - C1^C2^C3^C4 Where:
; - A1 - "EXCEL" if exporting to excel
; Internal fileman date if not exporting to excel
; A2 - Excel Line Counter if exporting to excel
; External Claim number is sorting by claim
; External Payer Name if sorting by Payer
; External Patient Name if sorting by Patient Name
; A3 - Record Counter
; A4 - CARC Counter
; C1 - CARC Code (file 361.111, field .01)
; C2 - Decrease Amount (file 361.111, field .02)
; C3 - Quantity (file 361.111, field .03)
; C4 - Reason (file 361.111, field .04)
N A1,A2,AMOUNT,CARC,CLAIM,DATE,EOBIEN,PAYNAM,PTNAM,XX,Y
S PAYNAM=$$GET1^DIQ(344.4,ERAIEN,.06,"E") ; Payer name from ERA record
S DATE=$$FMTE^XLFDT(ADDATE,"2SZ") ; Format Auto-Decrease date
S AMOUNT=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",8,"I") ; Auto-Decrease Amount
Q:+AMOUNT=0
S EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",.02,"I") ; IEN to file 361.1 - ERA Detail
S CLAIM=$$CLAIM^RCDPEAD2(EOBIEN) ; Claim #
S PTNAM=$$PNM4^RCDPEWL1(ERAIEN,RCRZ) ; Patient Name from Claim file #399
S:PTNAM="" PTNAM="(unknown)"
S RCTR=RCTR+1
;
; If EXCEL sorting is done in EXCEL
I EXCEL=1 D
. S A1="EXCEL",A2=$G(^TMP("RCDPEADP",$J,A1))+1
. S ^TMP("RCDPEADP",$J,A1)=A2
;
; Otherwise sort by DATE and selected criteria
I 'EXCEL D
. S A1=ADDATE
. S A2=$S($E(RCSORT)="C":CLAIM,$E(RCSORT)="P":PAYNAM,1:PTNAM)
;
; Update ^TMP global if claim level adjustments are found for this claim
S XX=STNAM_U_STNUM_U_CLAIM_U_PTNAM_U_PAYNAM_U_AMOUNT_U_DATE
S ^TMP("RCDPEADP",$J,A1,A2,RCTR)=XX ; Claim Information
D CARCS^RCDPEAD1(A1,A2,RCTR,CARCS) ; CARC information
;
; Update totals for individual date
S $P(DTOTAL(ADDATE),U)=$P($G(DTOTAL(ADDATE)),U)+1
S $P(DTOTAL(ADDATE),U,2)=$P($G(DTOTAL(ADDATE)),U,2)+AMOUNT
;
; Update totals for date range
S $P(GTOTAL,U)=$P($G(GTOTAL),U)+1,$P(GTOTAL,U,2)=$P($G(GTOTAL),U,2)+AMOUNT
Q
;
DISP(INPUTS,DTOTAL,GTOTAL) ; Format the display for screen/printer or MS Excel
; Input: INPUTS - A1^A2^A3^...^An Where:
; A1 - 1 - All divisions selected
; 2 - Selected divisions
; A2 - C - Sort by Claim
; P - Sort by Payer
; N - Sort by Patient Name
; A3 - F - First to Last Sort Order
; L - Last to First Sort Order
; A4 - B1|B2
; B1 - Auto-Post Start Date
; B2 - Auto-Post End Date
; A5 - 1 - Output to Excel
; 0 - Otherwise
; A6 - 1 - Output to List Manager
; 0 - Otherwise
; A7 - C/M/P/T/A = CHAMPVA/Medical/Pharmacy/Tricare/All
;
; IO - Output Device
; DTOTAL()- Array of totals by Internal Auto-Post date
; GTOTAL - Grand Totals for the selected date period
; ^TMP("RCDPEADP",$J) - See SAVE for a complete description
N A1,A2,A3,DATA,EXCEL,HDRINFO,LMAN,LCNT,MODE,PAGE,RCRDNUM,STOP,Y
U IO ; Use the selected device
S EXCEL=$P(INPUTS,"^",5),LMAN=$P(INPUTS,U,6)
;
; Header information
S XX=$P(INPUTS,"^",4) ; Auto-Post Date range
S HDRINFO("START")=$$FMTE^XLFDT($P(XX,"|",1),"2SZ")
S HDRINFO("END")=$$FMTE^XLFDT($P(XX,"|",2),"2SZ")
S HDRINFO("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
s XX=$P(INPUTS,"^",2) ; Sort Type
S HDRINFO("SORT")="Sorted By: "_$S(XX="C":"Claim",XX="P":"Payer",1:"Patient Name")
S XX=$S($P(INPUTS,"^",3)="L":"Last to First",1:"First to Last")
S HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
; PRCA*4.5*326 - Add M/P/T filter to report
S XX=$P(INPUTS,"^",7) ; C/M/P/T/A = CHAMPVA/Medical/Pharmacy/Tricare/All, PRCA*4.5*432 Add CHAMPVA
S HDRINFO("TYPE")="CHAMPVA/Medical/Pharm/Tricare: " ;PRCA*4.5*432 Add CHAMPVA
S HDRINFO("TYPE")=HDRINFO("TYPE")_$S(XX="C":"CHAMPVA",XX="M":"MEDICAL",XX="P":"PHARMACY",XX="T":"TRICARE",1:"ALL") ;PRCA*4.5*432 Add CHAMPVA
;
; Format Division filter
S XX=$P(INPUTS,"^",1) ; XX=1 - All Divisions, 2- selected
S HDRINFO("DIVISIONS")=$S(XX=2:$$LINE^RCDPEAD2(.RCVAUTD),1:"ALL")
;
S A1="",PAGE=0,STOP=0,LCNT=1
S MODE=$S($P(INPUTS,"^",3)="L":-1,1:1) ; Mode for $ORDER direction
F D Q:(A1="")!STOP
. S A1=$O(^TMP("RCDPEADP",$J,A1))
. Q:A1=""
. I PAGE D ASK(.STOP,0) Q:STOP ; Output to screen, quit if user wants to
. D:'LMAN HDR^RCDPEAD1(EXCEL,.HDRINFO,.PAGE) ; Display Header
. ;
. S A2=""
. F D Q:(A2="")!STOP
. . S A2=$O(^TMP("RCDPEADP",$J,A1,A2),MODE)
. . I 'EXCEL,A2="",'LMAN D TOTALD^RCDPEAD1(EXCEL,.HDRINFO,.PAGE,.STOP,A1,.DTOTAL)
. . Q:A2=""
. . S A3=0
. . F D Q:'A3!STOP
. . . S A3=$O(^TMP("RCDPEADP",$J,A1,A2,A3))
. . . Q:'A3
. . . S DATA=^TMP("RCDPEADP",$J,A1,A2,A3) ; Auto-Decreased Claim
. . . I EXCEL D EXCEL^RCDPEAD2(DATA,A1,A2,A3) Q ; Output to Excel
. . . I LMAN D LMAN^RCDPEAD1(DATA,A1,A2,A3,.LCNT) Q
. . . I $Y>(IOSL-4) D Q:STOP ; End of page
. . . . D ASK(.STOP,0)
. . . . Q:STOP
. . . . D HDR^RCDPEAD1(EXCEL,.HDRINFO,.PAGE)
. . . S Y=$E($P(DATA,U,3),1,12) ; Claim #
. . . S $E(Y,15)=$E($P(DATA,U,4),1,20) ; Patient Name
. . . S $E(Y,37)=$E($P(DATA,U,5),1,19) ; Payer Name
. . . S $E(Y,55)=$J($P(DATA,U,6),12,2) ; Auto-Decrease Amount
. . . S $E(Y,69)=$P(DATA,U,7) ; Auto-Decrease Date
. . . W !,Y
. . . D DCARCS(A1,A2,A3,EXCEL,.HDRINFO,.PAGE,.STOP) ; Display CARCs
. . . W:'EXCEL !
;
; Grand totals
I $D(GTOTAL),'LMAN D
. I 'STOP,'EXCEL D ; Print grand total if not Excel
. . D TOTALG^RCDPEAD1(EXCEL,.HDRINFO,.PAGE,GTOTAL,.STOP)
. I 'STOP D ; Report finished
. . W !,$$ENDORPRT^RCDPEARL,!
. . D ASK(.STOP,1)
;
; Null Report
I '$D(GTOTAL),'LMAN D
. D HDR^RCDPEAD1(EXCEL,.HDRINFO,.PAGE)
. W !!,?26,"*** No Records to Print ***",!
. W !,$$ENDORPRT^RCDPEARL
. S:'$D(ZTQUEUED) X=$$ASKSTOP^RCDPELAR()
;
; List manager
I LMAN D
.S:LCNT=1 ^TMP("RCDPE_ADP",$J,LCNT)=$J("",26)_"*** No Records to Print ***",LCNT=LCNT+1
.S ^TMP("RCDPE_ADP",$J,LCNT)=" ",LCNT=LCNT+1
.S ^TMP("RCDPE_ADP",$J,LCNT)=$$ENDORPRT^RCDPEARL
; Close device
I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
DCARCS(A1,A2,A3,EXCEL,HDRINFO,PAGE,STOP) ; Display detailes CARC information - added as part of PRCA*4.5*318 re-write
; Input: A1 - "EXCEL" if exporting to excel
; Internal fileman date if not exporting to excel
; A2 - Excel Line Counter if exporting to excel
; External Claim number is sorting by claim
; External Payer Name if sorting by Payer
; External Patient Name if sorting by Patient Name
; A3 - Record Counter
; EXCEL - 1 if exporting to Excel, 0 otherwise
; HDRINFO() - Array of header information
; PAGE - Current Page number
; ^TMP("RCDPEADP",$J) - Array of report data. See SAVE for details
; Output: PAGE - Updated Page number
; STOP - 1 if user aborts display, 0 otherwise
N A4,DATA,FIRST,XX
S A4="",FIRST=1
F D Q:(A4="")!STOP
. S A4=$O(^TMP("RCDPEADP",$J,A1,A2,A3,A4))
. Q:A4=""
. S DATA=^TMP("RCDPEADP",$J,A1,A2,A3,A4)
. I 'EXCEL,$Y>(IOSL-4) D Q:STOP ; End of page
. . D ASK(.STOP,0)
. . Q:STOP
. . S FIRST=1
. . D HDR^RCDPEAD1(EXCEL,.HDRINFO,.PAGE,1)
. I FIRST D ; CARC header
. . S FIRST=0
. . I EXCEL D Q
. . . W !!,"CARC^Decrease Amt^Quantity^Reason"
. . W !!," CARC Decrease Amt # Reason"
. . W !," -------------------- ------------- ---- -----------------------------"
. S XX=" "_$E($P(DATA,U,1),1,20) ; CARC
. S $E(XX,27)=$J($P(DATA,U,2),12,2) ; Decrease Amount
. S $E(XX,42)=$J($P(DATA,U,3),4) ; Quantity
. S $E(XX,48)=$E($P(DATA,U,4),1,32) ; Reason
. W !,XX
Q
;
ASK(STOP,TYP) ; Ask to continue, if TYP=1 then prompt to finish
; Input: TYP - 1 - Prompt to finish, 0 Otherwise
; IOST - Device Type
; Output: STOP - 1 to abort print, 0 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
Q:$E(IOST,1,2)'["C-" ; Not a terminal
S:$G(TYP)=1 DIR("A")="Enter RETURN to finish"
S DIR(0)="E"
W !
D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S STOP=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEADP 19432 printed Dec 13, 2024@01:44:15 Page 2
RCDPEADP ;OIFO-BAYPINES/PJH - AUTO-DECREASE REPORT ;Nov 23, 2014@12:48:50
+1 ;;4.5;Accounts Receivable;**298,318,326,432**;Mar 20, 1995;Build 16
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ; Read ^DGCR(399) via Private IA 3820
+4 ; Read ^DG(40.8) via Controlled IA 417
+5 ; Read ^IBM(361.1) via Private IA 4051
+6 ; Use DIVISION^VAUTOMA via Controlled IA 664
+7 ;
RPT ; entry point for Auto-Decrease Adjustment report [RCDPE AUTO-DECREASE REPORT]
+1 NEW INPUT,RCVAUTD
+2 ; Division filter
SET INPUT=$$STADIV(.RCVAUTD)
+3 ; '^' or timeout
if 'INPUT
QUIT
+4 ; Select Sort Criteria
SET $PIECE(INPUT,"^",2)=$$ASKSORT()
+5 ; '^' or timeout
if $PIECE(INPUT,"^",2)="0"
QUIT
+6 ; Select Sort Order
SET $PIECE(INPUT,"^",3)=$$SORTORD($PIECE(INPUT,"^",2))
+7 ; '^' or timeout
if $PIECE(INPUT,"^",3)="0"
QUIT
+8 ; Select Date Range for Report
SET $PIECE(INPUT,"^",4)=$$DTRNG()
+9 ; '^' or timeout
if '$PIECE(INPUT,"^",4)
QUIT
+10 SET $PIECE(INPUT,"^",4)=$PIECE($PIECE(INPUT,"^",4),"|",2,3)
+11 ; PRCA*4.5*326 Filter by payer type
+12 ; PRCA*4.5*326 Ask for payer types to include
SET $PIECE(INPUT,"^",7)=$$RTYPE^RCDPEU1()
+13 IF $PIECE(INPUT,"^",7)<0
QUIT
+14 ; Ask to Display in Listman Template
SET $PIECE(INPUT,"^",6)=$$ASKLM^RCDPEARL
+15 ; '^' or timeout
if $PIECE(INPUT,"^",6)<0
QUIT
+16 ; Compile data and call listman to display
IF $PIECE(INPUT,"^",6)=1
Begin DoDot:1
+17 DO LMOUT^RCDPEAD1(INPUT,.RCVAUTD,.IO)
End DoDot:1
QUIT
+18 ; Select Display Type
SET $PIECE(INPUT,"^",5)=$$DISPTY()
+19 ; '^' or timeout
if $PIECE(INPUT,"^",5)=-1
QUIT
+20 ; Display capture information for Excel
if $PIECE(INPUT,"^",5)=1
DO INFO^RCDPEM6
+21 ; Ask output device
if '$$DEVICE($PIECE(INPUT,"^",5),.IO)
QUIT
+22 ;
+23 ; Compile and Display Report data (queued) - not allowed for EXCEL
+24 IF $PIECE(INPUT,"^",5)'=1
IF $DATA(IO("Q"))
Begin DoDot:1
+25 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+26 SET ZTRTN="REPORT^RCDPEADP(INPUT,.RCVAUTD,.IO)"
+27 SET ZTDESC="EDI LOCKBOX AUTO-DECREASE REPORT"
+28 SET ZTSAVE("RC*")=""
SET ZTSAVE("INPUT")=""
SET ZTSAVE("IO*")=""
+29 DO ^%ZTLOAD
+30 IF $DATA(ZTSK)
WRITE !!,"Task number "_ZTSK_" has been queued."
+31 IF '$TEST
WRITE !!,"Unable to queue this job."
+32 KILL ZTSK,IO("Q")
+33 DO HOME^%ZIS
End DoDot:1
QUIT
+34 ; Compile and Display Report data (non-queued)
+35 ; Compile and Display Report data
DO REPORT(INPUT,.RCVAUTD,.IO)
+36 QUIT
+37 ;
STADIV(RCVAUTD) ; Division/Station Filter
+1 ; Input: None
+2 ; Output: RCVAUTD() - Array of selected Divisions/Stations if 2 is returned
+3 ; Returns: 1 - All Divisions/Stations selected
+4 ; 2 - Specified Divisions/Stations selected
+5 ; 0 - "^" or timeout
+6 NEW DIR,DIROUT,DTOUT,DUOUT,VAUTD,Y
+7 ;
+8 ; Division selection - IA 664
+9 ; RETURNS Y=-1 (quit), VAUTD=1 (for all),VAUTD=0 (selected divisions in VAUTD)
+10 DO DIVISION^VAUTOMA
+11 if Y<0
QUIT 0
+12 ; All Divisions selected
if VAUTD=1
QUIT 1
+13 ; Save selected divisions
MERGE RCVAUTD=VAUTD
+14 QUIT 2
+15 ;
ASKSORT() ; Select the sort criteria
+1 ; Input: None
+2 ; Returns: C - Sort by Claim
+3 ; P - Sort by Payer
+4 ; N - Sort by Patient Name
+5 ; 0 - User entered '^' or timed out
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX
+7 SET DIR(0)="SA^C:CLAIM;P:PAYER;N:PATIENT NAME;"
+8 SET DIR("A")="Sort by (C)LAIM #, (P)AYER or PATIENT (N)AME?: "
+9 SET DIR("?",1)="Enter 'C' to sort by Claim Number, 'P' to sort by Payer or 'N' to sort"
+10 SET DIR("?")="by Patient Name."
+11 SET DIR("B")="CLAIM"
+12 DO ^DIR
+13 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+14 QUIT Y
+15 ;
SORTORD(SORT) ; Select the sort order
+1 ; Input: SORT - 'C' - Sort by Claim Number
+2 ; 'P' - Sort by Payer
+3 ; 'N' - Sort by Patient Name
+4 ; Returns: F - First to Last
+5 ; L - Last to First
+6 ; 0 - User entered '^' or timed out
+7 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX,YY
+8 SET XX=" (F)IRST TO LAST or (L)AST TO FIRST?: "
+9 SET YY=$SELECT(SORT="C":"CLAIM",SORT="P":"PAYER",1:"PATIENT NAME")
+10 SET DIR("A")="Sort "_YY_XX
+11 SET DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST"
+12 SET DIR("B")="FIRST TO LAST"
+13 DO ^DIR
+14 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+15 QUIT Y
+16 ;
DTRNG() ; Get the date range for the report
+1 ; Input: None
+2 ; Returns: A1|A2|A3 - Where:
+3 ; A1 - 0 - User up-arrowed or timed out, 1 otherwise
+4 ; A2 - Auto-Post Start Date
+5 ; A3 - Auto-Post End Date
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCEND,RCSTART,RNGFLG,X,Y
+7 DO DATES(.RCSTART,.RCEND)
+8 if RCSTART=-1
QUIT 0
+9 if RCSTART
QUIT "1|"_RCSTART_"|"_RCEND
+10 if 'RCSTART
QUIT "0||"
+11 QUIT 0
+12 ;
DATES(BDATE,EDATE) ; Get a date range.
+1 ; Input: None
+2 ; Output: BDATE - Internal Auto-Post Start Date
+3 ; EDATE - Internal Auto-Post End Date
D1 ; looping tag
+1 SET (BDATE,EDATE)=0
+2 SET DIR("?")="Enter the earliest Auto-Posting date to include on the report."
+3 SET DIR(0)="DAO^:"_DT_":APE"
+4 SET DIR("A")="Start Date: "
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET BDATE=-1
QUIT
+8 SET BDATE=Y
+9 SET DIR("?")="Enter the latest Auto-Posting date to include on the report."
+10 SET DIR("B")=Y(0)
+11 SET DIR(0)="DAO^"_BDATE_":"_DT_":APE"
+12 SET DIR("A")="End Date: "
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET BDATE=-1
QUIT
+16 SET EDATE=Y
+17 QUIT
+18 ;
DISPTY() ; Get display/output type
+1 ; Input: None
+2 ; Returns: 1 - Output to Excel
+3 ; 0 - Output to paper
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Export the report to Microsoft Excel"
+7 SET DIR("B")="NO"
+8 DO ^DIR
+9 IF $GET(DUOUT)
QUIT -1
+10 QUIT Y
+11 ;
DEVICE(EXCEL,IO) ; Select the output device
+1 ; Input: EXCEL - 1 - Output to Excel, 0 otherwise
+2 ; Output:
+3 ; IO - Array of selected output info
+4 ; Returns: 0 - No device selected, 1 Otherwise
+5 NEW POP,%ZIS
+6 SET %ZIS="QM"
+7 DO ^%ZIS
+8 if POP
QUIT 0
+9 QUIT 1
+10 ;
REPORT(INPUTS,RCVAUTD,IO) ; EP Compile and print report
+1 ; Input: INPUTS - A1^A2^A3^...^An Where:
+2 ; A1 - 1 - All divisions selected
+3 ; 2 - Selected divisions
+4 ; A2 - C - Sort by Claim
+5 ; P - Sort by Payer
+6 ; N - Sort by Patient Name
+7 ; A3 - F - First to Last Sort Order
+8 ; L - Last to First Sort Order
+9 ; A4 - B1|B2
+10 ; B1 - Auto-Post Start Date
+11 ; B2 - Auto-Post End Date
+12 ; A5 - 1 - Output to Excel
+13 ; 0 - Otherwise
+14 ; A6 - 1 - Output to List Manager
+15 ; 0 - Otherwise
+16 ; A7 - M/P/T/A = Medical/Pharmacy/Tricare/All
+17 ;
+18 ; RCVAUTD - Array of selected Divisions
+19 ; Only passed if A1=2
+20 ; IO - Output Device
+21 ; Output:
+22 NEW DTOTAL,GTOTAL,XX,ZTREQ
+23 USE IO
+24 KILL ^TMP("RCDPEADP",$JOB),^TMP("RCDPE_ADP",$JOB)
+25 ; Scan ERA file for entries in date range
DO COMPILE^RCDPEAD1(INPUTS,.RCVAUTD,.DTOTAL,.GTOTAL)
+26 ; Display Report
DO DISP(INPUTS,.DTOTAL,.GTOTAL)
+27 ; Clear TMP global
KILL ^TMP("RCDPEADP",$JOB),^TMP("RCSELPAY",$JOB)
+28 ; Close device
DO ^%ZISC
+29 QUIT
+30 ;
SAVE(ADDATE,ERAIEN,RCRZ,EXCEL,RCSORT,CARCS,RCTR,STNAM,STNUM) ; Put the data into the ^TMP global
+1 ; Input: ADDATE - Current Internal Date being processed
+2 ; ERAIEN - Internal IEN of the ERA record
+3 ; RCRZ - ERA line number
+4 ; EXCEL - 1 output to Excel, 0 otherwise
+5 ; RCSORT - C - Sort by Claim
+6 ; P - Sort by Payer
+7 ; N - Sort by Patient Name
+8 ; CARCS - ^ delimited string of CARC information found
+9 ; on the EOB record pointed to by the ERA detail record
+10 ; A1;A2;A3;A4^B1;B2;B3;B4^...^N1;N2;N3;N4 Where:
+11 ; A1 - Auto-Decrease amount of the 1st CARC code
+12 ; A2 - 1st CARC code
+13 ; A3 - Quantity of the first CARC code
+14 ; A4 - Truncated Reason text of the 1st CARC
+15 ; DTOTAL() - Current Array of totals by Auto-Post Date
+16 ; GTOTAL - Current Grand totals
+17 ; RCTR - Current Record Counter
+18 ; STNAM - Station name
+19 ; STNUM - Station number
+20 ; ^TMP("RCDPEADP",$J) - Current report data
+21 ; See DISP for a full description
+22 ; Output: DTOTAL() - Updated Array of totals by Auto-Post Date
+23 ; GTOTAL - Updated Grand totals
+24 ; RCTR - Updated Record Counter
+25 ; ^TMP("RCDPEADP",$J,A1,A2,A3) - B1^B2^B3^...^Bn Where:
+26 ; - A1 - "EXCEL" if exporting to excel
+27 ; Internal fileman date if not exporting to excel
+28 ; A2 - Excel Line Counter if exporting to excel
+29 ; External Claim number is sorting by claim
+30 ; External Payer Name if sorting by Payer
+31 ; External Patient Name if sorting by Patient Name
+32 ; A3 - Record Counter
+33 ; B1 - External Station Name
+34 ; B2 - External Station Number
+35 ; B3 - External Claim Number
+36 ; B4 - External Patient Name
+37 ; B5 - External Payer Name
+38 ; B6 - Auto-Decrease Amount
+39 ; B7 - Auto-Decrease Date
+40 ; ^TMP("RCDPEADP",$J,A1,A2,A3,A4) - C1^C2^C3^C4 Where:
+41 ; - A1 - "EXCEL" if exporting to excel
+42 ; Internal fileman date if not exporting to excel
+43 ; A2 - Excel Line Counter if exporting to excel
+44 ; External Claim number is sorting by claim
+45 ; External Payer Name if sorting by Payer
+46 ; External Patient Name if sorting by Patient Name
+47 ; A3 - Record Counter
+48 ; A4 - CARC Counter
+49 ; C1 - CARC Code (file 361.111, field .01)
+50 ; C2 - Decrease Amount (file 361.111, field .02)
+51 ; C3 - Quantity (file 361.111, field .03)
+52 ; C4 - Reason (file 361.111, field .04)
+53 NEW A1,A2,AMOUNT,CARC,CLAIM,DATE,EOBIEN,PAYNAM,PTNAM,XX,Y
+54 ; Payer name from ERA record
SET PAYNAM=$$GET1^DIQ(344.4,ERAIEN,.06,"E")
+55 ; Format Auto-Decrease date
SET DATE=$$FMTE^XLFDT(ADDATE,"2SZ")
+56 ; Auto-Decrease Amount
SET AMOUNT=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",8,"I")
+57 if +AMOUNT=0
QUIT
+58 ; IEN to file 361.1 - ERA Detail
SET EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",.02,"I")
+59 ; Claim #
SET CLAIM=$$CLAIM^RCDPEAD2(EOBIEN)
+60 ; Patient Name from Claim file #399
SET PTNAM=$$PNM4^RCDPEWL1(ERAIEN,RCRZ)
+61 if PTNAM=""
SET PTNAM="(unknown)"
+62 SET RCTR=RCTR+1
+63 ;
+64 ; If EXCEL sorting is done in EXCEL
+65 IF EXCEL=1
Begin DoDot:1
+66 SET A1="EXCEL"
SET A2=$GET(^TMP("RCDPEADP",$JOB,A1))+1
+67 SET ^TMP("RCDPEADP",$JOB,A1)=A2
End DoDot:1
+68 ;
+69 ; Otherwise sort by DATE and selected criteria
+70 IF 'EXCEL
Begin DoDot:1
+71 SET A1=ADDATE
+72 SET A2=$SELECT($EXTRACT(RCSORT)="C":CLAIM,$EXTRACT(RCSORT)="P":PAYNAM,1:PTNAM)
End DoDot:1
+73 ;
+74 ; Update ^TMP global if claim level adjustments are found for this claim
+75 SET XX=STNAM_U_STNUM_U_CLAIM_U_PTNAM_U_PAYNAM_U_AMOUNT_U_DATE
+76 ; Claim Information
SET ^TMP("RCDPEADP",$JOB,A1,A2,RCTR)=XX
+77 ; CARC information
DO CARCS^RCDPEAD1(A1,A2,RCTR,CARCS)
+78 ;
+79 ; Update totals for individual date
+80 SET $PIECE(DTOTAL(ADDATE),U)=$PIECE($GET(DTOTAL(ADDATE)),U)+1
+81 SET $PIECE(DTOTAL(ADDATE),U,2)=$PIECE($GET(DTOTAL(ADDATE)),U,2)+AMOUNT
+82 ;
+83 ; Update totals for date range
+84 SET $PIECE(GTOTAL,U)=$PIECE($GET(GTOTAL),U)+1
SET $PIECE(GTOTAL,U,2)=$PIECE($GET(GTOTAL),U,2)+AMOUNT
+85 QUIT
+86 ;
DISP(INPUTS,DTOTAL,GTOTAL) ; Format the display for screen/printer or MS Excel
+1 ; Input: INPUTS - A1^A2^A3^...^An Where:
+2 ; A1 - 1 - All divisions selected
+3 ; 2 - Selected divisions
+4 ; A2 - C - Sort by Claim
+5 ; P - Sort by Payer
+6 ; N - Sort by Patient Name
+7 ; A3 - F - First to Last Sort Order
+8 ; L - Last to First Sort Order
+9 ; A4 - B1|B2
+10 ; B1 - Auto-Post Start Date
+11 ; B2 - Auto-Post End Date
+12 ; A5 - 1 - Output to Excel
+13 ; 0 - Otherwise
+14 ; A6 - 1 - Output to List Manager
+15 ; 0 - Otherwise
+16 ; A7 - C/M/P/T/A = CHAMPVA/Medical/Pharmacy/Tricare/All
+17 ;
+18 ; IO - Output Device
+19 ; DTOTAL()- Array of totals by Internal Auto-Post date
+20 ; GTOTAL - Grand Totals for the selected date period
+21 ; ^TMP("RCDPEADP",$J) - See SAVE for a complete description
+22 NEW A1,A2,A3,DATA,EXCEL,HDRINFO,LMAN,LCNT,MODE,PAGE,RCRDNUM,STOP,Y
+23 ; Use the selected device
USE IO
+24 SET EXCEL=$PIECE(INPUTS,"^",5)
SET LMAN=$PIECE(INPUTS,U,6)
+25 ;
+26 ; Header information
+27 ; Auto-Post Date range
SET XX=$PIECE(INPUTS,"^",4)
+28 SET HDRINFO("START")=$$FMTE^XLFDT($PIECE(XX,"|",1),"2SZ")
+29 SET HDRINFO("END")=$$FMTE^XLFDT($PIECE(XX,"|",2),"2SZ")
+30 SET HDRINFO("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
+31 ; Sort Type
SET XX=$PIECE(INPUTS,"^",2)
+32 SET HDRINFO("SORT")="Sorted By: "_$SELECT(XX="C":"Claim",XX="P":"Payer",1:"Patient Name")
+33 SET XX=$SELECT($PIECE(INPUTS,"^",3)="L":"Last to First",1:"First to Last")
+34 SET HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
+35 ; PRCA*4.5*326 - Add M/P/T filter to report
+36 ; C/M/P/T/A = CHAMPVA/Medical/Pharmacy/Tricare/All, PRCA*4.5*432 Add CHAMPVA
SET XX=$PIECE(INPUTS,"^",7)
+37 ;PRCA*4.5*432 Add CHAMPVA
SET HDRINFO("TYPE")="CHAMPVA/Medical/Pharm/Tricare: "
+38 ;PRCA*4.5*432 Add CHAMPVA
SET HDRINFO("TYPE")=HDRINFO("TYPE")_$SELECT(XX="C":"CHAMPVA",XX="M":"MEDICAL",XX="P":"PHARMACY",XX="T":"TRICARE",1:"ALL")
+39 ;
+40 ; Format Division filter
+41 ; XX=1 - All Divisions, 2- selected
SET XX=$PIECE(INPUTS,"^",1)
+42 SET HDRINFO("DIVISIONS")=$SELECT(XX=2:$$LINE^RCDPEAD2(.RCVAUTD),1:"ALL")
+43 ;
+44 SET A1=""
SET PAGE=0
SET STOP=0
SET LCNT=1
+45 ; Mode for $ORDER direction
SET MODE=$SELECT($PIECE(INPUTS,"^",3)="L":-1,1:1)
+46 FOR
Begin DoDot:1
+47 SET A1=$ORDER(^TMP("RCDPEADP",$JOB,A1))
+48 if A1=""
QUIT
+49 ; Output to screen, quit if user wants to
IF PAGE
DO ASK(.STOP,0)
if STOP
QUIT
+50 ; Display Header
if 'LMAN
DO HDR^RCDPEAD1(EXCEL,.HDRINFO,.PAGE)
+51 ;
+52 SET A2=""
+53 FOR
Begin DoDot:2
+54 SET A2=$ORDER(^TMP("RCDPEADP",$JOB,A1,A2),MODE)
+55 IF 'EXCEL
IF A2=""
IF 'LMAN
DO TOTALD^RCDPEAD1(EXCEL,.HDRINFO,.PAGE,.STOP,A1,.DTOTAL)
+56 if A2=""
QUIT
+57 SET A3=0
+58 FOR
Begin DoDot:3
+59 SET A3=$ORDER(^TMP("RCDPEADP",$JOB,A1,A2,A3))
+60 if 'A3
QUIT
+61 ; Auto-Decreased Claim
SET DATA=^TMP("RCDPEADP",$JOB,A1,A2,A3)
+62 ; Output to Excel
IF EXCEL
DO EXCEL^RCDPEAD2(DATA,A1,A2,A3)
QUIT
+63 IF LMAN
DO LMAN^RCDPEAD1(DATA,A1,A2,A3,.LCNT)
QUIT
+64 ; End of page
IF $Y>(IOSL-4)
Begin DoDot:4
+65 DO ASK(.STOP,0)
+66 if STOP
QUIT
+67 DO HDR^RCDPEAD1(EXCEL,.HDRINFO,.PAGE)
End DoDot:4
if STOP
QUIT
+68 ; Claim #
SET Y=$EXTRACT($PIECE(DATA,U,3),1,12)
+69 ; Patient Name
SET $EXTRACT(Y,15)=$EXTRACT($PIECE(DATA,U,4),1,20)
+70 ; Payer Name
SET $EXTRACT(Y,37)=$EXTRACT($PIECE(DATA,U,5),1,19)
+71 ; Auto-Decrease Amount
SET $EXTRACT(Y,55)=$JUSTIFY($PIECE(DATA,U,6),12,2)
+72 ; Auto-Decrease Date
SET $EXTRACT(Y,69)=$PIECE(DATA,U,7)
+73 WRITE !,Y
+74 ; Display CARCs
DO DCARCS(A1,A2,A3,EXCEL,.HDRINFO,.PAGE,.STOP)
+75 if 'EXCEL
WRITE !
End DoDot:3
if 'A3!STOP
QUIT
End DoDot:2
if (A2="")!STOP
QUIT
End DoDot:1
if (A1="")!STOP
QUIT
+76 ;
+77 ; Grand totals
+78 IF $DATA(GTOTAL)
IF 'LMAN
Begin DoDot:1
+79 ; Print grand total if not Excel
IF 'STOP
IF 'EXCEL
Begin DoDot:2
+80 DO TOTALG^RCDPEAD1(EXCEL,.HDRINFO,.PAGE,GTOTAL,.STOP)
End DoDot:2
+81 ; Report finished
IF 'STOP
Begin DoDot:2
+82 WRITE !,$$ENDORPRT^RCDPEARL,!
+83 DO ASK(.STOP,1)
End DoDot:2
End DoDot:1
+84 ;
+85 ; Null Report
+86 IF '$DATA(GTOTAL)
IF 'LMAN
Begin DoDot:1
+87 DO HDR^RCDPEAD1(EXCEL,.HDRINFO,.PAGE)
+88 WRITE !!,?26,"*** No Records to Print ***",!
+89 WRITE !,$$ENDORPRT^RCDPEARL
+90 if '$DATA(ZTQUEUED)
SET X=$$ASKSTOP^RCDPELAR()
End DoDot:1
+91 ;
+92 ; List manager
+93 IF LMAN
Begin DoDot:1
+94 if LCNT=1
SET ^TMP("RCDPE_ADP",$JOB,LCNT)=$JUSTIFY("",26)_"*** No Records to Print ***"
SET LCNT=LCNT+1
+95 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=" "
SET LCNT=LCNT+1
+96 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=$$ENDORPRT^RCDPEARL
End DoDot:1
+97 ; Close device
+98 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+99 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+100 QUIT
+101 ;
DCARCS(A1,A2,A3,EXCEL,HDRINFO,PAGE,STOP) ; Display detailes CARC information - added as part of PRCA*4.5*318 re-write
+1 ; Input: A1 - "EXCEL" if exporting to excel
+2 ; Internal fileman date if not exporting to excel
+3 ; A2 - Excel Line Counter if exporting to excel
+4 ; External Claim number is sorting by claim
+5 ; External Payer Name if sorting by Payer
+6 ; External Patient Name if sorting by Patient Name
+7 ; A3 - Record Counter
+8 ; EXCEL - 1 if exporting to Excel, 0 otherwise
+9 ; HDRINFO() - Array of header information
+10 ; PAGE - Current Page number
+11 ; ^TMP("RCDPEADP",$J) - Array of report data. See SAVE for details
+12 ; Output: PAGE - Updated Page number
+13 ; STOP - 1 if user aborts display, 0 otherwise
+14 NEW A4,DATA,FIRST,XX
+15 SET A4=""
SET FIRST=1
+16 FOR
Begin DoDot:1
+17 SET A4=$ORDER(^TMP("RCDPEADP",$JOB,A1,A2,A3,A4))
+18 if A4=""
QUIT
+19 SET DATA=^TMP("RCDPEADP",$JOB,A1,A2,A3,A4)
+20 ; End of page
IF 'EXCEL
IF $Y>(IOSL-4)
Begin DoDot:2
+21 DO ASK(.STOP,0)
+22 if STOP
QUIT
+23 SET FIRST=1
+24 DO HDR^RCDPEAD1(EXCEL,.HDRINFO,.PAGE,1)
End DoDot:2
if STOP
QUIT
+25 ; CARC header
IF FIRST
Begin DoDot:2
+26 SET FIRST=0
+27 IF EXCEL
Begin DoDot:3
+28 WRITE !!,"CARC^Decrease Amt^Quantity^Reason"
End DoDot:3
QUIT
+29 WRITE !!," CARC Decrease Amt # Reason"
+30 WRITE !," -------------------- ------------- ---- -----------------------------"
End DoDot:2
+31 ; CARC
SET XX=" "_$EXTRACT($PIECE(DATA,U,1),1,20)
+32 ; Decrease Amount
SET $EXTRACT(XX,27)=$JUSTIFY($PIECE(DATA,U,2),12,2)
+33 ; Quantity
SET $EXTRACT(XX,42)=$JUSTIFY($PIECE(DATA,U,3),4)
+34 ; Reason
SET $EXTRACT(XX,48)=$EXTRACT($PIECE(DATA,U,4),1,32)
+35 WRITE !,XX
End DoDot:1
if (A4="")!STOP
QUIT
+36 QUIT
+37 ;
ASK(STOP,TYP) ; Ask to continue, if TYP=1 then prompt to finish
+1 ; Input: TYP - 1 - Prompt to finish, 0 Otherwise
+2 ; IOST - Device Type
+3 ; Output: STOP - 1 to abort print, 0 otherwise
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+5 ; Not a terminal
if $EXTRACT(IOST,1,2)'["C-"
QUIT
+6 if $GET(TYP)=1
SET DIR("A")="Enter RETURN to finish"
+7 SET DIR(0)="E"
+8 WRITE !
+9 DO ^DIR
+10 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET STOP=1
+11 QUIT
