RCDPEMAR ;ALB/CNF - MANUAL AUDIT REPORT ;12/31/24
;;4.5;Accounts Receivable;**446**;Mar 20, 1995;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; DESCRIPTION: The following generates a report that displays manually audited electronic bills
;
EN ; Main entry point for this report
; Ask Summary or Detail output
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCDT1,RCDT2,RCEXCEL,RCEXSTOP,RCLSTMGR,RCREP,RCTMPND,X,Y
;
S:$G(U)="" U="^"
;
; Summary or Detail
W !
S DIR(0)="SOA^S:Summary Information Only;D:Detail Report"
S DIR("A")="(S)ummary or (D)etail Report format? "
S DIR("B")="SUMMARY"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q
S RCREP=Y
;
; Start Date
W !
K DIR
S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Start Date: ",DIR("B")="T"
S DIR("?")="ENTER THE EARLIEST DATE OF A MANUAL AUDIT TO INCLUDE ON THE REPORT"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q
S RCDT1=Y
;
; End Date
W !
K DIR
S DIR(0)="DAO^"_RCDT1_":"_DT_":APE",DIR("A")="End Date: ",DIR("B")="T"
S DIR("?")="ENTER THE LATEST DATE OF A MANUAL AUDIT TO INCLUDE ON THE REPORT"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q
S RCDT2=Y
;
; If user selected detail report (RCREP=D), offer option of Excel format
S RCEXCEL=0,RCEXSTOP=0 I RCREP="D" D Q:RCEXSTOP
. W !
. S RCEXCEL=$$DISPTY^RCDPEM3() I RCEXCEL<0 S RCEXSTOP=1 Q
. ; display device info about Excel format, set ListMan flag to prevent question
. I RCEXCEL S RCLSTMGR="^" D INFO^RCDPEM6
. I $D(DUOUT)!$D(DTOUT) S RCEXSTOP=1 Q
;
; If not output to Excel, ask for ListMan display if user selected detail report (RCREP=D), quit if timeout or "^"
S RCLSTMGR=0 I 'RCEXCEL I RCREP="D" W ! S RCLSTMGR=$$ASKLM^RCDPEARL Q:RCLSTMGR<0
;
S RCTMPND="RCDPE_MAR" K ^TMP($J,RCTMPND)
;
; ListManager Display
I RCLSTMGR=1 D Q
. N RCHDR,RCSTOP
. D COMPILE(RCDT1,RCDT2,RCREP)
. D REPDET(RCDT1,RCDT2) ; Put formatted lines in TMP array
. D LMHDR(.RCSTOP,RCDT1,RCDT2,.RCHDR) ; Create lines for header
. D LMRPT(.RCHDR,$NA(^TMP($J,RCTMPND)),"") ; Generate ListMan display
. K ^TMP($J,RCTMPND)
;
; Ask device
S %ZIS="QM"
D ^%ZIS
Q:POP
;
I $D(IO("Q")) D Q ; Queued Report
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK
. S ZTRTN="BK^RCDPMAR"
. S ZTDESC="AR - EDI LOCKBOX MANUAL AUDIT REPORT"
. S ZTSAVE("RC*")=""
. ;
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
. K ZTSK,IO("Q")
. D HOME^%ZIS
;
U IO
;
; Compile Data
D COMPILE(RCDT1,RCDT2,RCREP)
;
I RCREP="S" D REPSUM(RCDT1,RCDT2)
I RCREP="D" D
. I RCEXCEL D REPEXC Q
. D REPDET(RCDT1,RCDT2)
. N QUIT S QUIT=0 D PRINTDET(.QUIT)
. I '$D(IO("Q")) I 'QUIT D
. . S XX=""
. . D ASK^RCDPEARL(.XX)
;
K ^TMP("RCDPMAR",$J)
K ^TMP($J,RCTMPND)
;
Q
;
DISPLAY(ROW,EFTIEN,TRANS) ; Display EFT detail during user selection process ; PRCA*4.5*439 Modified display
; Input: ROW - Current row number
; EFTIEN - IEN for EFT (#344.31)
; TRANS - EFT transaction number e.g. 999.1
;
; Output is written to the screen
N PAYER,SUFX,TRANS
S TRANS=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")
S SUFX=$$GET1^DIQ(344.31,EFTIEN_",",.14)
S:SUFX SUFX="."_SUFX
S PAYER=$$GET1^DIQ(344.31,EFTIEN_",",.02)
;
W !,$E(ROW_". ",1,5) ; Row Number
W $J(TRANS_SUFX,9) ; EFT number with suffix
W " "_$E(PAYER,1,45)_$E($J("",45),1,45-$L(PAYER)) ; Payer Name
W " "_$J($$GET1^DIQ(344.31,EFTIEN_",",.07),19) ; Amount
W !,$J(" ",15)_$$GET1^DIQ(344.31,EFTIEN_",",.04) ; Trace number
Q
;
COMPILE(RCDT1,RCDT2,RCREP) ; Compile data for display
; Input: RCDT1 - Beginning date
; RCDT2 - Ending date
; RCREP - D if Detail format, S if Summary format
; Output: ^TMP("RCDPMAR",$J)
;
N AUTODUZ,DATA,IEN399,RCDT,RCDATE,RCDUZ,RCIEN,X,Y
K ^TMP("RCDPMAR",$J)
;
; Get DUZ for auto-audit
S AUTODUZ=+$O(^VA(200,"B","PRCA,AUTOAUDIT",0))
;
; Loop through entries by date and approver
K TOTALS
S RCDT=RCDT1_".0000001",RCDT=$O(^PRCA(430,"AUDF",RCDT),-1)
F S RCDT=$O(^PRCA(430,"AUDF",RCDT)) Q:(RCDT\1)>RCDT2 Q:RCDT="" S RCDUZ="" D
. F S RCDUZ=$O(^PRCA(430,"AUDF",RCDT,RCDUZ)) Q:'RCDUZ D
. . ;
. . S RCDATE=RCDT\1
. . ; Accumulate totals by date, sorted between auto-audits and manual audits
. . S Y=$G(TOTALS("TOTAL",RCDATE)) S:'$L($P(Y,U,1)) $P(Y,U,1)=0 S:'$L($P(Y,U,2)) $P(Y,U,2)=0
. . I RCDUZ=AUTODUZ S $P(Y,U,1)=$P(Y,U,1)+1,TOTALS("TOTAL",RCDATE)=Y
. . E S $P(Y,U,2)=$P(Y,U,2)+1,TOTALS("TOTAL",RCDATE)=Y
. . ;
. . ; Stop if user selected summary format
. . I RCREP="S" Q
. . ;
. . ; Stop if entry is not a manual audit
. . I RCDUZ=AUTODUZ Q
. . ;
. . ; Get internal number
. . S RCIEN="",RCIEN=$O(^PRCA(430,"AUDF",RCDT,RCDUZ,RCIEN))
. . ;
. . ; Quit if internal number is invalid
. . Q:'RCIEN ; Quit if internal number is invalid
. . S X=$G(^PRCA(430,RCIEN,0)) Q:'$L(X) ; Quit if internal number is invalid
. . ;
. . ; Get data to print
. . S DATA=""
. . S $P(DATA,U,1)=RCDT ; AR DATE SIGNED, #92
. . S $P(DATA,U,2)=$$GET1^DIQ(430,RCIEN,.01) ; BILL
. . S X=$P(DATA,U,2) S:X["-" X=$P(X,"-",2) ; Remove Station Code
. . ;
. . S IEN399="",IEN399=$O(^DGCR(399,"B",X,"")) ; Get IEN for Bill in #399
. . Q:'IEN399 Q:'$D(^DGCR(399,IEN399)) ; Quit if record doesn't exist IN Bill file
. . ;
. . S $P(DATA,U,3)=$$GET1^DIQ(399,IEN399,.07,"I") ; RATE TYPE CODE (IEN), pointer to #399.3
. . S $P(DATA,U,4)=$$GET1^DIQ(399,IEN399,.07,"E") ; RATE TYPE DESCRIPTION
. . S $P(DATA,U,5)=RCDUZ ; APPROVED BY (FISCAL), #90 (DUZ, IEN to #200)
. . S $P(DATA,U,6)=$$GET1^DIQ(430,RCIEN,90,"E") ; APPROVED BY (FISCAL), Name
. . ;
. . S X=$$PAYER(IEN399) ; Get Payer Information
. . S $P(DATA,U,7)=$P(X,U,1) ; PAYER (IEN), pointer to #36
. . S $P(DATA,U,8)=$P(X,U,2) ; PAYER Name
. . S $P(DATA,U,9)=$P(X,U,3) ; PAYER Tin
. . ;
. . S ^TMP("RCDPMAR",$J,"DATA",RCDT,RCIEN)=DATA
. . ;
. . ; Store up to 4 comment lines
. . I '$D(^PRCA(430,RCIEN,10)) Q ; Quit if there aren't any comments
. . F X=1:1:4 S ^TMP("RCDPMAR",$J,"DATA",RCDT,RCIEN,X)=$G(^PRCA(430,RCIEN,10,X,0))
;
; Merge totals into TMP global, format for array: TOTALS("TOTAL",date)=total count for auto-audit ^ total count for manual audit
M ^TMP("RCDPMAR",$J,"TOTAL")=TOTALS("TOTAL")
;
Q
;
REPSUM(RCDT1,RCDT2) ; Print Summary report
; Input: RCDT1 - Start Date
; RCDT2 - End Date
; Output: Written to device
;
N CNT,DATE,DATA,GTOT,J,LINES,RCHR,RCNOW,RCPG,RCSCR,STOP
;
; Initialize Report Date, Page Number and String of underscores
S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
S RCNOW=$$UP^XLFSTR($$NOW^RCDPRU()),RCPG=0,RCHR="",$P(RCHR,"-",IOM+1)=""
;
U IO
D HEADER("S",RCNOW,.RCPG,RCHR,RCDT1,RCDT2)
I '$D(^TMP("RCDPMAR",$J,"TOTAL")) W !,"No data found"
;
I $D(^TMP("RCDPMAR",$J,"TOTAL")) D
. S GTOT="0^0" ; Initialize grand total
. ; Display body of the report
. S DATE="" F S DATE=$O(^TMP("RCDPMAR",$J,"TOTAL",DATE)) Q:'DATE D I RCPG=0 Q
.. S DATA=^TMP("RCDPMAR",$J,"TOTAL",DATE)
.. S LINES=1
.. I RCSCR S LINES=LINES+1
.. D CHKP("S",RCNOW,.RCPG,RCHR,RCDT1,RCDT2,RCSCR,.LINES) I RCPG=0 Q
.. W !,$$FMTE^XLFDT(DATE\1,"2Z"),?13,$J($P(DATA,U,2),6),?23,$J($P(DATA,U,1),6)
.. F J=1:1:2 S $P(GTOT,U,J)=$P(GTOT,U,J)+$P(DATA,U,J) ;Accumulate grand total
.;
.W !," Total:",?12,$J($P(GTOT,U,2),7),?22,$J($P(GTOT,U,1),7)
.W !!,"Percentage of Manually Audited Bills: "
.I $P(GTOT,U,2) S J=($P(GTOT,U,2)/($P(GTOT,U,2)+$P(GTOT,U,1))),J=J*100,J=J+.5,J=J\1 W J
.W:'$P(GTOT,U,2) "0"
.W "%"
;
I 'RCSCR W !,@IOF
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
;
W !,$$ENDORPRT^RCDPEARL()
I RCPG,RCSCR S STOP=$S('$$PAUSE():1,1:0)
;
Q
;
REPDET(RCDT1,RCDT2) ; Build Detailed report in TMP
; Input: RCDT1 - Start Date
; RCDT2 - End Date
; Output: Saved to ^TMP in generic RCDP ListMan report format
;
N CNT,DATE,DATA,J,K,LINES,PCS,RCHR,RCNOW,RCPG,RCSCR,X,X1,X2
;
S LINES=1
I '$D(^TMP("RCDPMAR",$J,"DATA")) S X="No data found" D SAVE(X,.LINES)
; Display the detail
S DATE="" F S DATE=$O(^TMP("RCDPMAR",$J,"DATA",DATE)) Q:'DATE D
. S CNT=0 F S CNT=$O(^TMP("RCDPMAR",$J,"DATA",DATE,CNT)) Q:'CNT D
. . S DATA=^TMP("RCDPMAR",$J,"DATA",DATE,CNT)
. . S X=$$FMTE^XLFDT(DATE\1,"2Z"),X=X_$$SPACES(X,11) ; Date
. . S X1=$P(DATA,U,2) S:$L(X1)>11 X1=$E(X1,1,11) ; Bill, Max of 11 characters
. . S X=X_X1 S X=X_$$SPACES(X,24)
. . S X1=$P(DATA,U,3)_" "_$P(DATA,U,4) S:$L(X1)>23 X1=$E(X1,1,23) ; Rate Type Code and Name, Max of 23 characters
. . S X=X_X1 S X=X_$$SPACES(X,49)
. . S X1=$P(DATA,U,6) S:$L(X1)>32 X1=$E(X1,1,32) ; User, Max of 32 characters
. . S X=X_X1 S X=X_$$SPACES(X,52)
. . D SAVE(X,.LINES)
. . S X=" "_$P(DATA,U,8)_" / "_$P(DATA,U,9) ; Payer/Tin
. . S:$L(X)>78 X=$E(X,1,78) ; Max of 76 characters + 2 spaces
. . D SAVE(X,.LINES)
. . F J=1:1:4 S X=$G(^TMP("RCDPMAR",$J,"DATA",DATE,CNT,J)) I $L(X) S X=" "_X D
. . . I $L(X)<81 D SAVE(X,.LINES) Q ; Max length of 77 + 3 spaces
. . . ; If line is longer than 80 characters, wrap the line. Break at a space, not in the middle of a word.
. . . S X1=X,X2="",PCS=$L(X," ") F K=1:1:PCS Q:$L(X1)<81 S X1=$P(X," ",1,(PCS-K)),X2=$P(X," ",(PCS-K+1),PCS)
. . . S X2=" "_X2
. . . D SAVE(X1,.LINES),SAVE(X2,.LINES) ; Long line becomes 2 lines
. . S X="" D SAVE(X,.LINES)
S X=$$ENDORPRT^RCDPEARL()
D SAVE(X,.LINES) ; End of report
;
Q
;
SPACES(DATA,COL) ; Return spaces for padding output
; INPUT DATA: String of data
; COL: Column to begin for next data piece
;
; OUTPUT Spaces to pad data string
;
N LEN,NUM,SPACE,SPACES
S $P(SPACE," ",80)="" ; string of 80 spaces
S LEN=$L(DATA) ; length of existing data string
S NUM=COL-LEN I NUM<0 S SPACES="" Q "" ; NUM is the number of spaces needed to pad to the column number (COL)
Q $E(SPACE,2,NUM) ; return spaces
;
REPEXC ; Print Excel report
N CNT,DATA,DATE,X
;
; Header
W !,"DATE^BILL^RATE TYPE CODE^RATE TYPE NAME^USER^PAYER NAME^PAYER TIN^COMMENT 1^COMMENT 2^COMMENT 3^COMMENT 4"
;
; Data
I '$D(^TMP("RCDPMAR",$J,"DATA")) W !,"No data found" D Q
. N STOP S STOP=""
. D ASK^RCDPEARL(.STOP)
;
; Display the detail
S DATE="" F S DATE=$O(^TMP("RCDPMAR",$J,"DATA",DATE)) Q:'DATE D
. S CNT=0 F S CNT=$O(^TMP("RCDPMAR",$J,"DATA",DATE,CNT)) Q:'CNT D
. . S DATA=^TMP("RCDPMAR",$J,"DATA",DATE,CNT)
. . W !,$$FMTE^XLFDT(DATE\1,"2Z"),"^",$P(DATA,U,2),"^",$P(DATA,U,3),"^",$P(DATA,U,4),"^",$P(DATA,U,6),"^",$P(DATA,U,8),"^",$P(DATA,U,9)
. . F J=1:1:4 S X=$G(^TMP("RCDPMAR",$J,"DATA",DATE,CNT,J)) I $L(X) W "^",X
W !,"*** END OF REPORT ***",!
N STOP S STOP=""
D ASK^RCDPEARL(.STOP)
Q
;
SAVE(X,LINES) ; Save a line of the report to the ^TMP global
S ^TMP($J,RCTMPND,LINES)=X
S LINES=LINES+1
Q
;
BK ; Run report in background through task manager
D COMPILE
D REPDET(RCDT1,RCDT2)
N QUIT S QUIT=0 D PRINTDET(.QUIT)
Q
;
PRINTDET(QUIT) ; Print line in ^TMP global to output the detail report to screen or printer
;INPUT - QUIT - User exits out of report
;
; Initialize Report Date, Page Number and String of underscores
I $G(QUIT)="" S QUIT=0 ; Make sure quit is initialized
;
N RCSCR,RCNOW,RCPG,RCHR
S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
S RCNOW=$$UP^XLFSTR($$NOW^RCDPRU()),RCPG=0,RCHR="",$P(RCHR,"-",IOM+1)=""
;
N COUNT,LINE
D HEADER("D",RCNOW,.RCPG,RCHR,RCDT1,RCDT2)
S (COUNT,LINE,QUIT)=0
F S LINE=$O(^TMP($J,RCTMPND,LINE)) Q:'LINE D I QUIT S RCPG=0 Q
. S COUNT=COUNT+1
. I (COUNT+8)>IOSL D I QUIT Q
. . I $D(RCSCR) D I QUIT Q
. . . S QUIT='$$PAUSE()
. . D HEADER("D",RCNOW,.RCPG,RCHR,RCDT1,RCDT2)
. . S COUNT=1
. W !,^TMP($J,RCTMPND,LINE)
Q
;
PAUSE() ; Pause at end of each page for user input
; Input: None
; Output: User response
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="E"
D ^DIR
Q Y
;
CHKP(RCREP,RCNOW,RCPG,RCHR,RCDT1,RCDT2,RCSCR,LINES) ; Check if we need to do a page break
; Input: RCREP - D for Detail format, S for Summary format
; RCNOW - DATE/TIME in external format
; RCPG - Current page number
; RCHR - Line of "-" to margin width
; RCDT1 - Start date
; RCDT2 - End date
; RCSCR - 1 - Output is going to the users screen, 0 - to printer
; LINES - Current line count
;
I $Y'>(IOSL-LINES) Q
I RCSCR,'$$PAUSE S RCPG=0 Q
D HEADER(RCREP,RCNOW,.RCPG,RCHR,RCDT1,RCDT2)
S LINES=1
Q
;
; Input: RCREP - D for Detail format, S for Summary format
; RCNOW - DATE/TIME in external format
; RCPG - Current page number
; RCHR - Line of "-" to margin width
; RCDT1 - Start date
; RCDT2 - End date
; Output: Write statements
;
N LINE
;
W @IOF
S RCPG=RCPG+1
W "MANUAL AUDIT REPORT - ",$S(RCREP="D":"DETAIL",1:"SUMMARY")
S LINE=RCNOW_" PAGE: "_RCPG_" "
W ?(IOM-$L(LINE)),LINE
W !,"MANUAL AUDIT DATE RANGE: ",$$FMTE^XLFDT(RCDT1\1,"2Z")," - ",$$FMTE^XLFDT(RCDT2,"2Z"),!
;
; Write column headings for Detail report format
I RCREP="D" D
. W !,"DATE",?10,"BILL",?23,"RATE TYPE",?48,"USER",!,?2,"PAYER/TIN",!,?3,"COMMENTS"
;
; Write column headings for Summary report format
I RCREP="S" D
. W !,?14,"MANUAL",?24,"AUTO",!,"DATE",?13,"# BILLS",?22,"# BILLS"
;
; Write line of dashes, to margin width
W !,RCHR
Q
;
LMHDR(RCSTOP,RCDT1,RCDT2,RCHDR) ;
; ListMan report heading
; Input: RCDT1 - Internal Start Date of date range
; RCDT2 - Internal End Date of date range
; Output: RCHDR - Array of listman header lines
; RCSTOP - 1 if user stopped
;
N RCCT,X,XX,Y,Z,Z0,Z1
S RCCT=0
S RCHDR("TITLE")="MANUAL AUDIT REPORT"
S Z1=""
;
S XX="MANUAL AUDIT DATE RANGE: "_$$FMTE^XLFDT(RCDT1\1,"2Z")_" - "
S XX=XX_$$FMTE^XLFDT(RCDT2\1,"2Z")
S RCCT=RCCT+1,RCHDR(RCCT)=XX
S RCCT=RCCT+1,RCHDR(RCCT)="" ; blank line
S XX="DATE BILL RATE TYPE USER"
S RCCT=RCCT+1,RCHDR(RCCT)=XX
S XX=" PAYER/TIN"
S RCCT=RCCT+1,RCHDR(RCCT)=XX
S XX=" COMMENTS"
S RCCT=RCCT+1,RCHDR(RCCT)=XX
Q
;
LMRPT(RCLMHDR,RCLMND,LMTMP) ; ListMan display
; Input: RCLMHDR - Header text, passed by ref. (required)
; RCLMND - Storage node for ListMan data (required)
; LMTMP - Name of a listman template to use
; Optional, defaults to ""
Q:'$D(RCLMHDR) Q:($G(RCLMND)="") ; both required
S LMTMP="RCDPE MISC REPORTS TM8" ; top margin is 8 lines
;
N XX
S XX=$S($G(LMTMP)'="":LMTMP,1:"RCDPE MISC REPORTS")
D EN^VALM(XX)
Q
;
PAYER(IEN399) ; Get Payer Name and TIN
; Input: IEN399 - IEN to #399
; Output: Payer IEN ^ Payer Name ^ Payer TIN
;
N IEN3611,STOP,X,Y,Z
;
S IEN3611="",STOP=0,X="",Y="",Z=""
F S IEN3611=$O(^IBM(361.1,"B",IEN399,IEN3611)) Q:'IEN3611 Q:STOP D
. S X=$$GET1^DIQ(361.1,IEN3611,.02,"I") ; Payer IEN
. S Y=$$GET1^DIQ(361.1,IEN3611,.02,"E") ; Payer Name
. S Z=$$GET1^DIQ(361.1,IEN3611,.03) ; Payer TIN
. I X S STOP=1 ; If we found a payer, stop searching
;
I 'X D
. S X=$$GET1^DIQ(399,IEN399,101,"I") ; PAYER IEN
. S Y=$$GET1^DIQ(399,IEN399,101,"E") ; PAYER Name
. S Z=""
;
Q X_"^"_Y_"^"_Z
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEMAR 15942 printed Sep 23, 2025@19:21 Page 2
RCDPEMAR ;ALB/CNF - MANUAL AUDIT REPORT ;12/31/24
+1 ;;4.5;Accounts Receivable;**446**;Mar 20, 1995;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; DESCRIPTION: The following generates a report that displays manually audited electronic bills
+7 ;
EN ; Main entry point for this report
+1 ; Ask Summary or Detail output
+2 ;
+3 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCDT1,RCDT2,RCEXCEL,RCEXSTOP,RCLSTMGR,RCREP,RCTMPND,X,Y
+4 ;
+5 if $GET(U)=""
SET U="^"
+6 ;
+7 ; Summary or Detail
+8 WRITE !
+9 SET DIR(0)="SOA^S:Summary Information Only;D:Detail Report"
+10 SET DIR("A")="(S)ummary or (D)etail Report format? "
+11 SET DIR("B")="SUMMARY"
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+14 SET RCREP=Y
+15 ;
+16 ; Start Date
+17 WRITE !
+18 KILL DIR
+19 SET DIR(0)="DAO^:"_DT_":APE"
SET DIR("A")="Start Date: "
SET DIR("B")="T"
+20 SET DIR("?")="ENTER THE EARLIEST DATE OF A MANUAL AUDIT TO INCLUDE ON THE REPORT"
+21 DO ^DIR
+22 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+23 SET RCDT1=Y
+24 ;
+25 ; End Date
+26 WRITE !
+27 KILL DIR
+28 SET DIR(0)="DAO^"_RCDT1_":"_DT_":APE"
SET DIR("A")="End Date: "
SET DIR("B")="T"
+29 SET DIR("?")="ENTER THE LATEST DATE OF A MANUAL AUDIT TO INCLUDE ON THE REPORT"
+30 DO ^DIR
+31 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+32 SET RCDT2=Y
+33 ;
+34 ; If user selected detail report (RCREP=D), offer option of Excel format
+35 SET RCEXCEL=0
SET RCEXSTOP=0
IF RCREP="D"
Begin DoDot:1
+36 WRITE !
+37 SET RCEXCEL=$$DISPTY^RCDPEM3()
IF RCEXCEL<0
SET RCEXSTOP=1
QUIT
+38 ; display device info about Excel format, set ListMan flag to prevent question
+39 IF RCEXCEL
SET RCLSTMGR="^"
DO INFO^RCDPEM6
+40 IF $DATA(DUOUT)!$DATA(DTOUT)
SET RCEXSTOP=1
QUIT
End DoDot:1
if RCEXSTOP
QUIT
+41 ;
+42 ; If not output to Excel, ask for ListMan display if user selected detail report (RCREP=D), quit if timeout or "^"
+43 SET RCLSTMGR=0
IF 'RCEXCEL
IF RCREP="D"
WRITE !
SET RCLSTMGR=$$ASKLM^RCDPEARL
if RCLSTMGR<0
QUIT
+44 ;
+45 SET RCTMPND="RCDPE_MAR"
KILL ^TMP($JOB,RCTMPND)
+46 ;
+47 ; ListManager Display
+48 IF RCLSTMGR=1
Begin DoDot:1
+49 NEW RCHDR,RCSTOP
+50 DO COMPILE(RCDT1,RCDT2,RCREP)
+51 ; Put formatted lines in TMP array
DO REPDET(RCDT1,RCDT2)
+52 ; Create lines for header
DO LMHDR(.RCSTOP,RCDT1,RCDT2,.RCHDR)
+53 ; Generate ListMan display
DO LMRPT(.RCHDR,$NAME(^TMP($JOB,RCTMPND)),"")
+54 KILL ^TMP($JOB,RCTMPND)
End DoDot:1
QUIT
+55 ;
+56 ; Ask device
+57 SET %ZIS="QM"
+58 DO ^%ZIS
+59 if POP
QUIT
+60 ;
+61 ; Queued Report
IF $DATA(IO("Q"))
Begin DoDot:1
+62 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+63 SET ZTRTN="BK^RCDPMAR"
+64 SET ZTDESC="AR - EDI LOCKBOX MANUAL AUDIT REPORT"
+65 SET ZTSAVE("RC*")=""
+66 ;
+67 DO ^%ZTLOAD
+68 WRITE !!,$SELECT($DATA(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
+69 KILL ZTSK,IO("Q")
+70 DO HOME^%ZIS
End DoDot:1
QUIT
+71 ;
+72 USE IO
+73 ;
+74 ; Compile Data
+75 DO COMPILE(RCDT1,RCDT2,RCREP)
+76 ;
+77 IF RCREP="S"
DO REPSUM(RCDT1,RCDT2)
+78 IF RCREP="D"
Begin DoDot:1
+79 IF RCEXCEL
DO REPEXC
QUIT
+80 DO REPDET(RCDT1,RCDT2)
+81 NEW QUIT
SET QUIT=0
DO PRINTDET(.QUIT)
+82 IF '$DATA(IO("Q"))
IF 'QUIT
Begin DoDot:2
+83 SET XX=""
+84 DO ASK^RCDPEARL(.XX)
End DoDot:2
End DoDot:1
+85 ;
+86 KILL ^TMP("RCDPMAR",$JOB)
+87 KILL ^TMP($JOB,RCTMPND)
+88 ;
+89 QUIT
+90 ;
DISPLAY(ROW,EFTIEN,TRANS) ; Display EFT detail during user selection process ; PRCA*4.5*439 Modified display
+1 ; Input: ROW - Current row number
+2 ; EFTIEN - IEN for EFT (#344.31)
+3 ; TRANS - EFT transaction number e.g. 999.1
+4 ;
+5 ; Output is written to the screen
+6 NEW PAYER,SUFX,TRANS
+7 SET TRANS=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")
+8 SET SUFX=$$GET1^DIQ(344.31,EFTIEN_",",.14)
+9 if SUFX
SET SUFX="."_SUFX
+10 SET PAYER=$$GET1^DIQ(344.31,EFTIEN_",",.02)
+11 ;
+12 ; Row Number
WRITE !,$EXTRACT(ROW_". ",1,5)
+13 ; EFT number with suffix
WRITE $JUSTIFY(TRANS_SUFX,9)
+14 ; Payer Name
WRITE " "_$EXTRACT(PAYER,1,45)_$EXTRACT($JUSTIFY("",45),1,45-$LENGTH(PAYER))
+15 ; Amount
WRITE " "_$JUSTIFY($$GET1^DIQ(344.31,EFTIEN_",",.07),19)
+16 ; Trace number
WRITE !,$JUSTIFY(" ",15)_$$GET1^DIQ(344.31,EFTIEN_",",.04)
+17 QUIT
+18 ;
COMPILE(RCDT1,RCDT2,RCREP) ; Compile data for display
+1 ; Input: RCDT1 - Beginning date
+2 ; RCDT2 - Ending date
+3 ; RCREP - D if Detail format, S if Summary format
+4 ; Output: ^TMP("RCDPMAR",$J)
+5 ;
+6 NEW AUTODUZ,DATA,IEN399,RCDT,RCDATE,RCDUZ,RCIEN,X,Y
+7 KILL ^TMP("RCDPMAR",$JOB)
+8 ;
+9 ; Get DUZ for auto-audit
+10 SET AUTODUZ=+$ORDER(^VA(200,"B","PRCA,AUTOAUDIT",0))
+11 ;
+12 ; Loop through entries by date and approver
+13 KILL TOTALS
+14 SET RCDT=RCDT1_".0000001"
SET RCDT=$ORDER(^PRCA(430,"AUDF",RCDT),-1)
+15 FOR
SET RCDT=$ORDER(^PRCA(430,"AUDF",RCDT))
if (RCDT\1)>RCDT2
QUIT
if RCDT=""
QUIT
SET RCDUZ=""
Begin DoDot:1
+16 FOR
SET RCDUZ=$ORDER(^PRCA(430,"AUDF",RCDT,RCDUZ))
if 'RCDUZ
QUIT
Begin DoDot:2
+17 ;
+18 SET RCDATE=RCDT\1
+19 ; Accumulate totals by date, sorted between auto-audits and manual audits
+20 SET Y=$GET(TOTALS("TOTAL",RCDATE))
if '$LENGTH($PIECE(Y,U,1))
SET $PIECE(Y,U,1)=0
if '$LENGTH($PIECE(Y,U,2))
SET $PIECE(Y,U,2)=0
+21 IF RCDUZ=AUTODUZ
SET $PIECE(Y,U,1)=$PIECE(Y,U,1)+1
SET TOTALS("TOTAL",RCDATE)=Y
+22 IF '$TEST
SET $PIECE(Y,U,2)=$PIECE(Y,U,2)+1
SET TOTALS("TOTAL",RCDATE)=Y
+23 ;
+24 ; Stop if user selected summary format
+25 IF RCREP="S"
QUIT
+26 ;
+27 ; Stop if entry is not a manual audit
+28 IF RCDUZ=AUTODUZ
QUIT
+29 ;
+30 ; Get internal number
+31 SET RCIEN=""
SET RCIEN=$ORDER(^PRCA(430,"AUDF",RCDT,RCDUZ,RCIEN))
+32 ;
+33 ; Quit if internal number is invalid
+34 ; Quit if internal number is invalid
if 'RCIEN
QUIT
+35 ; Quit if internal number is invalid
SET X=$GET(^PRCA(430,RCIEN,0))
if '$LENGTH(X)
QUIT
+36 ;
+37 ; Get data to print
+38 SET DATA=""
+39 ; AR DATE SIGNED, #92
SET $PIECE(DATA,U,1)=RCDT
+40 ; BILL
SET $PIECE(DATA,U,2)=$$GET1^DIQ(430,RCIEN,.01)
+41 ; Remove Station Code
SET X=$PIECE(DATA,U,2)
if X["-"
SET X=$PIECE(X,"-",2)
+42 ;
+43 ; Get IEN for Bill in #399
SET IEN399=""
SET IEN399=$ORDER(^DGCR(399,"B",X,""))
+44 ; Quit if record doesn't exist IN Bill file
if 'IEN399
QUIT
if '$DATA(^DGCR(399,IEN399))
QUIT
+45 ;
+46 ; RATE TYPE CODE (IEN), pointer to #399.3
SET $PIECE(DATA,U,3)=$$GET1^DIQ(399,IEN399,.07,"I")
+47 ; RATE TYPE DESCRIPTION
SET $PIECE(DATA,U,4)=$$GET1^DIQ(399,IEN399,.07,"E")
+48 ; APPROVED BY (FISCAL), #90 (DUZ, IEN to #200)
SET $PIECE(DATA,U,5)=RCDUZ
+49 ; APPROVED BY (FISCAL), Name
SET $PIECE(DATA,U,6)=$$GET1^DIQ(430,RCIEN,90,"E")
+50 ;
+51 ; Get Payer Information
SET X=$$PAYER(IEN399)
+52 ; PAYER (IEN), pointer to #36
SET $PIECE(DATA,U,7)=$PIECE(X,U,1)
+53 ; PAYER Name
SET $PIECE(DATA,U,8)=$PIECE(X,U,2)
+54 ; PAYER Tin
SET $PIECE(DATA,U,9)=$PIECE(X,U,3)
+55 ;
+56 SET ^TMP("RCDPMAR",$JOB,"DATA",RCDT,RCIEN)=DATA
+57 ;
+58 ; Store up to 4 comment lines
+59 ; Quit if there aren't any comments
IF '$DATA(^PRCA(430,RCIEN,10))
QUIT
+60 FOR X=1:1:4
SET ^TMP("RCDPMAR",$JOB,"DATA",RCDT,RCIEN,X)=$GET(^PRCA(430,RCIEN,10,X,0))
End DoDot:2
End DoDot:1
+61 ;
+62 ; Merge totals into TMP global, format for array: TOTALS("TOTAL",date)=total count for auto-audit ^ total count for manual audit
+63 MERGE ^TMP("RCDPMAR",$JOB,"TOTAL")=TOTALS("TOTAL")
+64 ;
+65 QUIT
+66 ;
REPSUM(RCDT1,RCDT2) ; Print Summary report
+1 ; Input: RCDT1 - Start Date
+2 ; RCDT2 - End Date
+3 ; Output: Written to device
+4 ;
+5 NEW CNT,DATE,DATA,GTOT,J,LINES,RCHR,RCNOW,RCPG,RCSCR,STOP
+6 ;
+7 ; Initialize Report Date, Page Number and String of underscores
+8 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+9 SET RCNOW=$$UP^XLFSTR($$NOW^RCDPRU())
SET RCPG=0
SET RCHR=""
SET $PIECE(RCHR,"-",IOM+1)=""
+10 ;
+11 USE IO
+12 DO HEADER("S",RCNOW,.RCPG,RCHR,RCDT1,RCDT2)
+13 IF '$DATA(^TMP("RCDPMAR",$JOB,"TOTAL"))
WRITE !,"No data found"
+14 ;
+15 IF $DATA(^TMP("RCDPMAR",$JOB,"TOTAL"))
Begin DoDot:1
+16 ; Initialize grand total
SET GTOT="0^0"
+17 ; Display body of the report
+18 SET DATE=""
FOR
SET DATE=$ORDER(^TMP("RCDPMAR",$JOB,"TOTAL",DATE))
if 'DATE
QUIT
Begin DoDot:2
+19 SET DATA=^TMP("RCDPMAR",$JOB,"TOTAL",DATE)
+20 SET LINES=1
+21 IF RCSCR
SET LINES=LINES+1
+22 DO CHKP("S",RCNOW,.RCPG,RCHR,RCDT1,RCDT2,RCSCR,.LINES)
IF RCPG=0
QUIT
+23 WRITE !,$$FMTE^XLFDT(DATE\1,"2Z"),?13,$JUSTIFY($PIECE(DATA,U,2),6),?23,$JUSTIFY($PIECE(DATA,U,1),6)
+24 ;Accumulate grand total
FOR J=1:1:2
SET $PIECE(GTOT,U,J)=$PIECE(GTOT,U,J)+$PIECE(DATA,U,J)
End DoDot:2
IF RCPG=0
QUIT
+25 ;
+26 WRITE !," Total:",?12,$JUSTIFY($PIECE(GTOT,U,2),7),?22,$JUSTIFY($PIECE(GTOT,U,1),7)
+27 WRITE !!,"Percentage of Manually Audited Bills: "
+28 IF $PIECE(GTOT,U,2)
SET J=($PIECE(GTOT,U,2)/($PIECE(GTOT,U,2)+$PIECE(GTOT,U,1)))
SET J=J*100
SET J=J+.5
SET J=J\1
WRITE J
+29 if '$PIECE(GTOT,U,2)
WRITE "0"
+30 WRITE "%"
End DoDot:1
+31 ;
+32 IF 'RCSCR
WRITE !,@IOF
+33 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+34 DO ^%ZISC
+35 ;
+36 WRITE !,$$ENDORPRT^RCDPEARL()
+37 IF RCPG
IF RCSCR
SET STOP=$SELECT('$$PAUSE():1,1:0)
+38 ;
+39 QUIT
+40 ;
REPDET(RCDT1,RCDT2) ; Build Detailed report in TMP
+1 ; Input: RCDT1 - Start Date
+2 ; RCDT2 - End Date
+3 ; Output: Saved to ^TMP in generic RCDP ListMan report format
+4 ;
+5 NEW CNT,DATE,DATA,J,K,LINES,PCS,RCHR,RCNOW,RCPG,RCSCR,X,X1,X2
+6 ;
+7 SET LINES=1
+8 IF '$DATA(^TMP("RCDPMAR",$JOB,"DATA"))
SET X="No data found"
DO SAVE(X,.LINES)
+9 ; Display the detail
+10 SET DATE=""
FOR
SET DATE=$ORDER(^TMP("RCDPMAR",$JOB,"DATA",DATE))
if 'DATE
QUIT
Begin DoDot:1
+11 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("RCDPMAR",$JOB,"DATA",DATE,CNT))
if 'CNT
QUIT
Begin DoDot:2
+12 SET DATA=^TMP("RCDPMAR",$JOB,"DATA",DATE,CNT)
+13 ; Date
SET X=$$FMTE^XLFDT(DATE\1,"2Z")
SET X=X_$$SPACES(X,11)
+14 ; Bill, Max of 11 characters
SET X1=$PIECE(DATA,U,2)
if $LENGTH(X1)>11
SET X1=$EXTRACT(X1,1,11)
+15 SET X=X_X1
SET X=X_$$SPACES(X,24)
+16 ; Rate Type Code and Name, Max of 23 characters
SET X1=$PIECE(DATA,U,3)_" "_$PIECE(DATA,U,4)
if $LENGTH(X1)>23
SET X1=$EXTRACT(X1,1,23)
+17 SET X=X_X1
SET X=X_$$SPACES(X,49)
+18 ; User, Max of 32 characters
SET X1=$PIECE(DATA,U,6)
if $LENGTH(X1)>32
SET X1=$EXTRACT(X1,1,32)
+19 SET X=X_X1
SET X=X_$$SPACES(X,52)
+20 DO SAVE(X,.LINES)
+21 ; Payer/Tin
SET X=" "_$PIECE(DATA,U,8)_" / "_$PIECE(DATA,U,9)
+22 ; Max of 76 characters + 2 spaces
if $LENGTH(X)>78
SET X=$EXTRACT(X,1,78)
+23 DO SAVE(X,.LINES)
+24 FOR J=1:1:4
SET X=$GET(^TMP("RCDPMAR",$JOB,"DATA",DATE,CNT,J))
IF $LENGTH(X)
SET X=" "_X
Begin DoDot:3
+25 ; Max length of 77 + 3 spaces
IF $LENGTH(X)<81
DO SAVE(X,.LINES)
QUIT
+26 ; If line is longer than 80 characters, wrap the line. Break at a space, not in the middle of a word.
+27 SET X1=X
SET X2=""
SET PCS=$LENGTH(X," ")
FOR K=1:1:PCS
if $LENGTH(X1)<81
QUIT
SET X1=$PIECE(X," ",1,(PCS-K))
SET X2=$PIECE(X," ",(PCS-K+1),PCS)
+28 SET X2=" "_X2
+29 ; Long line becomes 2 lines
DO SAVE(X1,.LINES)
DO SAVE(X2,.LINES)
End DoDot:3
+30 SET X=""
DO SAVE(X,.LINES)
End DoDot:2
End DoDot:1
+31 SET X=$$ENDORPRT^RCDPEARL()
+32 ; End of report
DO SAVE(X,.LINES)
+33 ;
+34 QUIT
+35 ;
SPACES(DATA,COL) ; Return spaces for padding output
+1 ; INPUT DATA: String of data
+2 ; COL: Column to begin for next data piece
+3 ;
+4 ; OUTPUT Spaces to pad data string
+5 ;
+6 NEW LEN,NUM,SPACE,SPACES
+7 ; string of 80 spaces
SET $PIECE(SPACE," ",80)=""
+8 ; length of existing data string
SET LEN=$LENGTH(DATA)
+9 ; NUM is the number of spaces needed to pad to the column number (COL)
SET NUM=COL-LEN
IF NUM<0
SET SPACES=""
QUIT ""
+10 ; return spaces
QUIT $EXTRACT(SPACE,2,NUM)
+11 ;
REPEXC ; Print Excel report
+1 NEW CNT,DATA,DATE,X
+2 ;
+3 ; Header
+4 WRITE !,"DATE^BILL^RATE TYPE CODE^RATE TYPE NAME^USER^PAYER NAME^PAYER TIN^COMMENT 1^COMMENT 2^COMMENT 3^COMMENT 4"
+5 ;
+6 ; Data
+7 IF '$DATA(^TMP("RCDPMAR",$JOB,"DATA"))
WRITE !,"No data found"
Begin DoDot:1
+8 NEW STOP
SET STOP=""
+9 DO ASK^RCDPEARL(.STOP)
End DoDot:1
QUIT
+10 ;
+11 ; Display the detail
+12 SET DATE=""
FOR
SET DATE=$ORDER(^TMP("RCDPMAR",$JOB,"DATA",DATE))
if 'DATE
QUIT
Begin DoDot:1
+13 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("RCDPMAR",$JOB,"DATA",DATE,CNT))
if 'CNT
QUIT
Begin DoDot:2
+14 SET DATA=^TMP("RCDPMAR",$JOB,"DATA",DATE,CNT)
+15 WRITE !,$$FMTE^XLFDT(DATE\1,"2Z"),"^",$PIECE(DATA,U,2),"^",$PIECE(DATA,U,3),"^",$PIECE(DATA,U,4),"^",$PIECE(DATA,U,6),"^",$PIECE(DATA,U,8),"^",$PIECE(DATA,U,9)
+16 FOR J=1:1:4
SET X=$GET(^TMP("RCDPMAR",$JOB,"DATA",DATE,CNT,J))
IF $LENGTH(X)
WRITE "^",X
End DoDot:2
End DoDot:1
+17 WRITE !,"*** END OF REPORT ***",!
+18 NEW STOP
SET STOP=""
+19 DO ASK^RCDPEARL(.STOP)
+20 QUIT
+21 ;
SAVE(X,LINES) ; Save a line of the report to the ^TMP global
+1 SET ^TMP($JOB,RCTMPND,LINES)=X
+2 SET LINES=LINES+1
+3 QUIT
+4 ;
BK ; Run report in background through task manager
+1 DO COMPILE
+2 DO REPDET(RCDT1,RCDT2)
+3 NEW QUIT
SET QUIT=0
DO PRINTDET(.QUIT)
+4 QUIT
+5 ;
PRINTDET(QUIT) ; Print line in ^TMP global to output the detail report to screen or printer
+1 ;INPUT - QUIT - User exits out of report
+2 ;
+3 ; Initialize Report Date, Page Number and String of underscores
+4 ; Make sure quit is initialized
IF $GET(QUIT)=""
SET QUIT=0
+5 ;
+6 NEW RCSCR,RCNOW,RCPG,RCHR
+7 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+8 SET RCNOW=$$UP^XLFSTR($$NOW^RCDPRU())
SET RCPG=0
SET RCHR=""
SET $PIECE(RCHR,"-",IOM+1)=""
+9 ;
+10 NEW COUNT,LINE
+11 DO HEADER("D",RCNOW,.RCPG,RCHR,RCDT1,RCDT2)
+12 SET (COUNT,LINE,QUIT)=0
+13 FOR
SET LINE=$ORDER(^TMP($JOB,RCTMPND,LINE))
if 'LINE
QUIT
Begin DoDot:1
+14 SET COUNT=COUNT+1
+15 IF (COUNT+8)>IOSL
Begin DoDot:2
+16 IF $DATA(RCSCR)
Begin DoDot:3
+17 SET QUIT='$$PAUSE()
End DoDot:3
IF QUIT
QUIT
+18 DO HEADER("D",RCNOW,.RCPG,RCHR,RCDT1,RCDT2)
+19 SET COUNT=1
End DoDot:2
IF QUIT
QUIT
+20 WRITE !,^TMP($JOB,RCTMPND,LINE)
End DoDot:1
IF QUIT
SET RCPG=0
QUIT
+21 QUIT
+22 ;
PAUSE() ; Pause at end of each page for user input
+1 ; Input: None
+2 ; Output: User response
+3 ;
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 QUIT Y
+8 ;
CHKP(RCREP,RCNOW,RCPG,RCHR,RCDT1,RCDT2,RCSCR,LINES) ; Check if we need to do a page break
+1 ; Input: RCREP - D for Detail format, S for Summary format
+2 ; RCNOW - DATE/TIME in external format
+3 ; RCPG - Current page number
+4 ; RCHR - Line of "-" to margin width
+5 ; RCDT1 - Start date
+6 ; RCDT2 - End date
+7 ; RCSCR - 1 - Output is going to the users screen, 0 - to printer
+8 ; LINES - Current line count
+9 ;
+10 IF $Y'>(IOSL-LINES)
QUIT
+11 IF RCSCR
IF '$$PAUSE
SET RCPG=0
QUIT
+12 DO HEADER(RCREP,RCNOW,.RCPG,RCHR,RCDT1,RCDT2)
+13 SET LINES=1
+14 QUIT
+15 ;
+1 ; Input: RCREP - D for Detail format, S for Summary format
+2 ; RCNOW - DATE/TIME in external format
+3 ; RCPG - Current page number
+4 ; RCHR - Line of "-" to margin width
+5 ; RCDT1 - Start date
+6 ; RCDT2 - End date
+7 ; Output: Write statements
+8 ;
+9 NEW LINE
+10 ;
+11 WRITE @IOF
+12 SET RCPG=RCPG+1
+13 WRITE "MANUAL AUDIT REPORT - ",$SELECT(RCREP="D":"DETAIL",1:"SUMMARY")
+14 SET LINE=RCNOW_" PAGE: "_RCPG_" "
+15 WRITE ?(IOM-$LENGTH(LINE)),LINE
+16 WRITE !,"MANUAL AUDIT DATE RANGE: ",$$FMTE^XLFDT(RCDT1\1,"2Z")," - ",$$FMTE^XLFDT(RCDT2,"2Z"),!
+17 ;
+18 ; Write column headings for Detail report format
+19 IF RCREP="D"
Begin DoDot:1
+20 WRITE !,"DATE",?10,"BILL",?23,"RATE TYPE",?48,"USER",!,?2,"PAYER/TIN",!,?3,"COMMENTS"
End DoDot:1
+21 ;
+22 ; Write column headings for Summary report format
+23 IF RCREP="S"
Begin DoDot:1
+24 WRITE !,?14,"MANUAL",?24,"AUTO",!,"DATE",?13,"# BILLS",?22,"# BILLS"
End DoDot:1
+25 ;
+26 ; Write line of dashes, to margin width
+27 WRITE !,RCHR
+28 QUIT
+29 ;
LMHDR(RCSTOP,RCDT1,RCDT2,RCHDR) ;
+1 ; ListMan report heading
+2 ; Input: RCDT1 - Internal Start Date of date range
+3 ; RCDT2 - Internal End Date of date range
+4 ; Output: RCHDR - Array of listman header lines
+5 ; RCSTOP - 1 if user stopped
+6 ;
+7 NEW RCCT,X,XX,Y,Z,Z0,Z1
+8 SET RCCT=0
+9 SET RCHDR("TITLE")="MANUAL AUDIT REPORT"
+10 SET Z1=""
+11 ;
+12 SET XX="MANUAL AUDIT DATE RANGE: "_$$FMTE^XLFDT(RCDT1\1,"2Z")_" - "
+13 SET XX=XX_$$FMTE^XLFDT(RCDT2\1,"2Z")
+14 SET RCCT=RCCT+1
SET RCHDR(RCCT)=XX
+15 ; blank line
SET RCCT=RCCT+1
SET RCHDR(RCCT)=""
+16 SET XX="DATE BILL RATE TYPE USER"
+17 SET RCCT=RCCT+1
SET RCHDR(RCCT)=XX
+18 SET XX=" PAYER/TIN"
+19 SET RCCT=RCCT+1
SET RCHDR(RCCT)=XX
+20 SET XX=" COMMENTS"
+21 SET RCCT=RCCT+1
SET RCHDR(RCCT)=XX
+22 QUIT
+23 ;
LMRPT(RCLMHDR,RCLMND,LMTMP) ; ListMan display
+1 ; Input: RCLMHDR - Header text, passed by ref. (required)
+2 ; RCLMND - Storage node for ListMan data (required)
+3 ; LMTMP - Name of a listman template to use
+4 ; Optional, defaults to ""
+5 ; both required
if '$DATA(RCLMHDR)
QUIT
if ($GET(RCLMND)="")
QUIT
+6 ; top margin is 8 lines
SET LMTMP="RCDPE MISC REPORTS TM8"
+7 ;
+8 NEW XX
+9 SET XX=$SELECT($GET(LMTMP)'="":LMTMP,1:"RCDPE MISC REPORTS")
+10 DO EN^VALM(XX)
+11 QUIT
+12 ;
PAYER(IEN399) ; Get Payer Name and TIN
+1 ; Input: IEN399 - IEN to #399
+2 ; Output: Payer IEN ^ Payer Name ^ Payer TIN
+3 ;
+4 NEW IEN3611,STOP,X,Y,Z
+5 ;
+6 SET IEN3611=""
SET STOP=0
SET X=""
SET Y=""
SET Z=""
+7 FOR
SET IEN3611=$ORDER(^IBM(361.1,"B",IEN399,IEN3611))
if 'IEN3611
QUIT
if STOP
QUIT
Begin DoDot:1
+8 ; Payer IEN
SET X=$$GET1^DIQ(361.1,IEN3611,.02,"I")
+9 ; Payer Name
SET Y=$$GET1^DIQ(361.1,IEN3611,.02,"E")
+10 ; Payer TIN
SET Z=$$GET1^DIQ(361.1,IEN3611,.03)
+11 ; If we found a payer, stop searching
IF X
SET STOP=1
End DoDot:1
+12 ;
+13 IF 'X
Begin DoDot:1
+14 ; PAYER IEN
SET X=$$GET1^DIQ(399,IEN399,101,"I")
+15 ; PAYER Name
SET Y=$$GET1^DIQ(399,IEN399,101,"E")
+16 SET Z=""
End DoDot:1
+17 ;
+18 QUIT X_"^"_Y_"^"_Z
