- RCDPEAR2 ;ALB/TMK/PJH - EFT Unmatched Aging Report - FILE 344.3 ;Nov 24, 2014@18:31:57
- ;;4.5;Accounts Receivable;**173,269,276,284,283,293,298,318,321,326,432**;Mar 20, 1995;Build 16
- ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- ; PRCA*4.5*298 notes at bottom
- EN1 ; option: EFT Unmatched Aging Report [RCDPE EFT AGING REPORT]
- N %ZIS,DIC,DIR,DTOUT,DUOUT,POP,RCDISPTY,RCDTRNG,RCEND,RCHDR
- N RCJOB1,RCLSTMGR,RCPAR,RCPAY,RCPGNUM,RCSTART,RCTMPND,RCTYPE,X,Y
- ; RCDISPTY = display type
- ; RCEND = end date
- ; RCLSTMGR = list manager flag
- ; RCTYPE = Type of payers to include M/P/T/C/A MEDICAL/PHARMACY/TRICARE/CHAMPVA/ALL
- ; RCDTRNG= "1^start date^end date"
- ; RCSTART = start date
- ; RCTMPND = name of the subscript for ^TMP to use
- ; RCPAY = A - All payers, S - Selected Payers, R - Range of Payers
- ;
- S RCLSTMGR="" ; initial value
- S RCDTRNG=$$DTRNG^RCDPEM4() G:'(RCDTRNG>0) EN1Q
- S RCSTART=$P(RCDTRNG,U,2)-1,RCEND=$P(RCDTRNG,U,3)
- ;
- ; PRCA*4.5*326 - Ask to show Medical/Pharmacy Tricare or All ; PRCA*4.5*4.32 CHAMPVA
- S RCTYPE=$$RTYPE^RCDPEU1("")
- I RCTYPE=-1 G EN1Q
- ;
- S RCPAY=$$PAYRNG^RCDPEU1() ; PRCA*4.5*326 - Selected or Range of Payers
- I RCPAY=-1 G EN1Q ; PRCA*4.5*326 '^' or timeout
- ;
- I RCPAY'="A" D I XX=-1 G EN1Q ; PRCA*4.5*326 - Since we don't want all payers
- . S RCPAR("TYPE")=RCTYPE ; prompt for payers we do want
- . S RCPAR("SELC")=RCPAY
- . S RCPAR("FILE")=344.31
- . S RCPAR("DICA")="Select Insurance Company NAME: "
- . S XX=$$SELPAY^RCDPEU1(.RCPAR)
- ;
- ;Get display type
- S RCDISPTY=$$DISPTY^RCDPEM3() G:RCDISPTY<0 EN1Q
- ; display device info about Excel format, set ListMan flag to prevent question
- I RCDISPTY S RCLSTMGR="^" D INFO^RCDPEM6
- I $D(DUOUT)!$D(DTOUT) G EN1Q
- ;
- ; if not output to Excel ask for ListMan display, exit if timeout or '^' - PRCA*4.5*298
- I RCLSTMGR="" S RCLSTMGR=$$ASKLM^RCDPEARL I RCLSTMGR<0 G EN1Q
- ; display in ListMan format and exit on return
- I RCLSTMGR D G EN1Q
- .S RCTMPND=$T(+0)_"^EFT UNMATCHED AGING" K ^TMP($J,RCTMPND) ; clean any residue
- .D RPTOUT
- .N H,L,HDR S L=0
- .S HDR("TITLE")=$$HDRNM
- .F H=1:1:7 I $D(RCHDR(H)) S L=H,HDR(H)=RCHDR(H) ; take first 3 lines of report header
- .I $O(RCHDR(L)) D ; any remaining header lines at top of report
- ..N N S N=0,H=L F S H=$O(RCHDR(H)) Q:'H S N=N+.001,^TMP($J,RCTMPND,N)=RCHDR(H)
- .D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display
- ;
- S RCTMPND=""
- ; Ask device
- S %ZIS="QM" D ^%ZIS G:POP EN1Q
- I $D(IO("Q")) D G EN1Q
- .N ZTDESC,ZTRTN,ZTSAVE,ZTSTOP
- .S ZTRTN="RPTOUT^RCDPEAR2",ZTDESC="EFT AGING REPORT"
- .S ZTSAVE("RC*")="",ZTSAVE("VAUTD")=""
- .S ZTSAVE("^TMP(""RCDPEU1"",$J,")="" ; PRCA*4.5*326
- .D ^%ZTLOAD
- .W !!,$S($G(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this task.")
- .K ZTSK,IO("Q") D HOME^%ZIS
- ;
- U IO D RPTOUT
- ;
- EN1Q ; exit and clean up
- I 'RCLSTMGR D ^%ZISC
- K ^TMP("RCSELPAY",$J),^TMP("RCPAYER",$J),^TMP("RCDPEU1",$J) ; PRCA*4.5*326
- Q
- ;
- RPTOUT ; Entry point for queued job, nightly job
- ; RCTMPND = name of the subscript for ^TMP to use to return all lines
- ; If undefined or null, output is printed
- ; Return global if RCTMPND not null: ^TMP($J,RCTMPND,line#)=line text
- N DIC,DUOUT,RC0,RC13,RC3443,RCCT,RCIEN,RCNT,RCOUT,RCPAYER,RCPAYID
- N RCSTOP,RCTOT,RCZ,X,XX,YY,Z,Z0,ZZ
- S RCTMPND=$G(RCTMPND)
- S (RCCT,RCSTOP,RCNT,RCTOT)=0
- K ^TMP($J,"RCERA_AGED"),^TMP($J,"RCERA_ADJ")
- ; build local payer array here
- I RCTMPND'="" K ^TMP($J,RCTMPND)
- ; cross-ref on file #344.31 field #.08 - MATCH STATUS
- S RCIEN=0 F S RCIEN=$O(^RCY(344.31,"AMATCH",0,RCIEN)) Q:'RCIEN D ;unmatched entries only
- .Q:$P($G(^RCY(344.31,RCIEN,3)),U) ; EFT has been removed
- .Q:$P($G(^RCY(344.31,RCIEN,0)),U,7)=0 ; payment of zero
- .;
- .S RC13=$P($G(^RCY(344.31,RCIEN,0)),U,13) ; date received
- .; Check for payer match
- .I RCPAY'="A" D Q:'XX
- .. S XX=$$ISSEL^RCDPEU1(344.31,RCIEN) ; 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.31,RCIEN,RCTYPE) ; check that payer matches type
- .; Check date range
- .Q:(RCSTART>RC13)!(RC13>RCEND)
- .; Passed all the filters - include on report
- .S ^TMP($J,"RCEFT_AGED",$$FMDIFF^XLFDT(RC13,DT),RCIEN)=0,RCNT=RCNT+1
- ;
- D:'RCLSTMGR HDRBLD ; create header
- D:RCLSTMGR HDRLM ; create Listman header
- ;
- I RCDISPTY D EXCEL Q
- ;
- ; Find total amount of EFTs
- S RCZ="" F S RCZ=$O(^TMP($J,"RCEFT_AGED",RCZ)) Q:RCZ="" S RCIEN=0 F S RCIEN=$O(^TMP($J,"RCEFT_AGED",RCZ,RCIEN)) Q:'RCIEN D G:RCSTOP PRTQ
- .I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPGNUM) W:RCTMPND="" !!,"***TASK STOPPED BY USER***" Q
- .S RC0=$G(^RCY(344.31,RCIEN,0)),RC3443=$G(^RCY(344.3,+RC0,0))
- .D DEBEFT^RCDPEARL(.RC0) ;Add minus sign for debit amounts PRCA*4.5*432
- .S RCTOT=RCTOT+$P(RC0,U,7)
- ;
- D:'RCLSTMGR HDRLST^RCDPEARL(.RCSTOP,.RCHDR) ; initial report header
- ;
- S Z=$$SETSTR^VALM1("Totals:","",1,79)
- D SL^RCDPEARL(Z,.RCCT,RCTMPND)
- S Z=$$SETSTR^VALM1(" Number Aged Electronic EFT Messages Found: "_RCNT,"",1,79)
- D SL^RCDPEARL(Z,.RCCT,RCTMPND)
- S Z=$$SETSTR^VALM1(" Amount Aged Electronic EFT Messages Found: $"_$FN(+RCTOT,",",2),"",1,79)
- D SL^RCDPEARL(Z,.RCCT,RCTMPND)
- D SL^RCDPEARL($TR($J("",IOM)," ","="),.RCCT,RCTMPND)
- ;
- S RCZ="" F S RCZ=$O(^TMP($J,"RCEFT_AGED",RCZ)) Q:RCZ="" S RCIEN=0 F S RCIEN=$O(^TMP($J,"RCEFT_AGED",RCZ,RCIEN)) Q:'RCIEN D G:RCSTOP PRTQ
- .I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPGNUM) W:RCTMPND="" !!,"***TASK STOPPED BY USER***" Q
- .I RCPGNUM D SL^RCDPEARL(" ",.RCCT,.RCTMPND) ; On detail list, skip line
- .I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
- .S RC0=$G(^RCY(344.31,RCIEN,0)),RC3443=$G(^RCY(344.3,+RC0,0))
- .D DEBEFT^RCDPEARL(.RC0) ;Add minus sign for debit amounts PRCA*4.5*432
- .S RCTOT=RCTOT+$P(RC0,U,7)
- .S Z=$$SETSTR^VALM1($J(-RCZ,4),"",1,4)
- .; PRCA*4.5*318 moved deposit date up a row to give more room for payer/payer ID
- .S Z=$$SETSTR^VALM1(" "_$P(RC0,U,4),Z,5,52) ;trace#
- .S Z=$$SETSTR^VALM1($$FMTE^XLFDT($P(RC0,U,12),2),Z,73,8) ; deposit date
- .D SL^RCDPEARL(Z,.RCCT,RCTMPND)
- .N RCPAY S RCPAY=$P(RC0,U,2) S:RCPAY="" RCPAY="NO PAYER NAME RECEIVED" ; PRCA*4.5*298
- .S RCPAYID=$P(RC0,U,3) ; Payer ID ;PRCA*4.5*298
- .;PRCA*4.5*318 dynamically display payer name/ID based on length
- .S RCPAYER=RCPAY_"/"_RCPAYID
- .I $L(RCPAYER)>76 D
- . . S ZZ=$L(RCPAYER,"/"),XX=$P(RCPAYER,"/",1,ZZ-1),YY=$P(RCPAYER,"/",ZZ)
- . . S XX=$E(RCPAYER,1,$L(XX)-($L(RCPAYER)-76)),RCPAYER=XX_"/"_YY
- .S Z=$$SETSTR^VALM1(RCPAYER,"",5,76) ; PRCA*4.5*298 (payer/payer ID)
- .;S Z=$$SETSTR^VALM1(" "_$$FMTE^XLFDT($P(RC0,U,12),2),Z,70,10) ; deposit date
- .;end of PRCA*4.5*318 display change
- .D SL^RCDPEARL(Z,.RCCT,RCTMPND)
- .S Z=$$SETSTR^VALM1($J("",6)_$S($P(RC0,U,13):$$FMTE^XLFDT($P(RC0,U,13),2),1:""),"",1,17)
- .S Z=$$SETSTR^VALM1(" "_$J($P(RC0,U,7),15,2),Z,18,17)
- .; PRCA*4.5*283 - change length from 8 to 11 to allow for 9 digit DEP #'s
- .; PRCA*4.5*326 - add EFT identifier
- .S Z=$$SETSTR^VALM1(" "_$P(RC3443,U,6)_"/"_$$GET1^DIQ(344.31,RCIEN_",",.01,"E"),Z,35,17)
- .S Z=$$SETSTR^VALM1(" "_$S($P(RC3443,U,12):"",1:"NOT ")_"Posted to 8NZZ"_$S($P(RC3443,U,12):" "_$$FMTE^XLFDT($P(RC3443,U,11),2),1:""),Z,52,36)
- .D SL^RCDPEARL(Z,.RCCT,RCTMPND)
- .K RCOUT
- .D GETS^DIQ(344.31,RCIEN_",",2,"E","RCOUT")
- .Q:'$O(RCOUT(344.31,RCIEN_",",2,0))
- .D SL^RCDPEARL($J("",8)_"--EXCEPTION NOTES--",.RCCT,RCTMPND)
- .S Z=0 F S Z=$O(RCOUT(344.31,RCIEN_",",2,Z)) Q:'Z D Q:RCSTOP
- ..I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
- ..D SL^RCDPEARL($J("",8)_" "_RCOUT(344.31,RCIEN_",",2,Z),.RCCT,RCTMPND)
- ;
- ;
- ; PRCA*4.5*298, put end-of-report into SL^RCDPEARL
- D SL^RCDPEARL(" ",.RCCT,RCTMPND) ; skip a line
- D SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCCT,RCTMPND)
- ;
- PRTQ ;
- ; PRCA*4.5*298, added ListMan check
- I '$D(ZTQUEUED),'RCLSTMGR,'RCSTOP D ASK^RCDPEARL(.RCSTOP)
- I $D(ZTQUEUED) S ZTREQ="@"
- I '$D(ZTQUEUED) D ^%ZISC
- K ^TMP($J,"RCEFT_AGED"),ZTQUEUED
- K ^TMP("RCDPEU1",$J) ; PRCA*4.5*326
- Q
- ;
- ; extrinsic variable, text for header PRCA*4.5*298
- HDRNM() Q "EFT UNMATCHED AGING REPORT"
- ;
- HDRBLD ; create the report header
- ; returns RCHDR, RCPGNUM, RCSTOP
- ; RCHDR(0) = header text line count
- ; RCHDR("XECUTE") = M code for page number
- ; RCHDR("RUNDATE") = date/time report generated, external format
- ; RCPGNUM - page counter
- ; RCSTOP - flag to exit
- ;INPUT:
- ; RCDTRNG - date range filter value to be printed as part of the header
- ; RCPAY - Payer filter value(s)
- ; RCLSTMGR
- ;
- K RCHDR S RCHDR("RUNDATE")=$$NOW^RCDPEARL,RCPGNUM=0,RCSTOP=0
- ;
- I RCDISPTY D Q ; Excel format, xecute code is QUIT, null page number
- .S RCHDR(0)=1,RCHDR("XECUTE")="Q",RCPGNUM=""
- .S RCHDR(1)="Aged Days^Trace #^Deposit From/ID^File Date^Deposit Amount^Dep#/EFT#^Deposit Post Status^Deposit Date" ; PRCA*4.3*326
- ;
- N START,END,MSG,DATE,Y,DIV,HCNT
- S START=$$FMTE^XLFDT($P(RCDTRNG,U,2),2),END=$$FMTE^XLFDT($P(RCDTRNG,U,3),2)
- ;
- S Y=$$HDRNM,HCNT=1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y ; line 1 will be replaced by XECUTE code below
- S RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$T(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"
- S Y="RUN DATE: "_RCHDR("RUNDATE"),HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y ; line 1 will be replaced by XECUTE code below
- ;
- ; Payer(s) - PRCA*4.5*326 Add MPT filter
- S Y="PAYERS: "_$S(RCPAY="R":"RANGE",RCPAY="S":"SELECTED",1:"ALL")
- S Y=$E(Y_$J("",80),1,38)_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: " ; PRCA*4.5*4.32 CHAMPVA, 41->38
- S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL") ; PRCA*4.5*4.32 CHAMPVA
- S HCNT=HCNT+1,RCHDR(HCNT)=Y
- S Y="DATE RANGE: "_$P($$FMTE^XLFDT(START,2),"@")_" - "_$P($$FMTE^XLFDT(END,2),"@")_" (DATE EFT FILED)"
- S Y=$J("",80-$L(Y)\2)_Y,HCNT=HCNT+1,RCHDR(HCNT)=Y
- ;
- S Y="AGED",HCNT=HCNT+1,RCHDR(HCNT)=Y
- ; PRCA*4.5*318 moved deposit date up a row
- S Y="DAYS TRACE # DEP DATE",HCNT=HCNT+1,RCHDR(HCNT)=Y
- S Y=" DEPOSIT FROM/ID",HCNT=HCNT+1,RCHDR(HCNT)=Y
- S Y=" FILE DATE DEPOSIT AMOUNT DEP#/EFT# DEPOSIT POST STATUS",HCNT=HCNT+1,RCHDR(HCNT)=Y ; PRCA*4.5*326
- S Y="",$P(Y,"=",81)="",HCNT=HCNT+1,RCHDR(HCNT)=Y ; row of equal signs at bottom
- ;
- S RCHDR(0)=HCNT
- ;
- Q
- ;
- HDRLM ; create the Listman header section
- ; returns RCHDR
- ; RCHDR(0) = header text line count
- ;INPUT:
- ; RCDTRNG - date range filter value to be printed as part of the header
- ; RCPAY - Payer filter value(s)
- ;
- K RCHDR S RCPGNUM=0,RCSTOP=0
- ;
- N START,END,MSG,DATE,Y,DIV,HCNT
- S START=$$FMTE^XLFDT($P(RCDTRNG,U,2),2),END=$$FMTE^XLFDT($P(RCDTRNG,U,3),2)
- S Y="DATE RANGE: "_$P($$FMTE^XLFDT(START,2),"@")_" - "_$P($$FMTE^XLFDT(END,2),"@")_" (DATE EFT FILED)"
- S HCNT=1,RCHDR(HCNT)=Y
- ; Payer(s) - PRCA*4.5*326 Add MPT filter
- S Y="PAYERS: "_$S(RCPAY="R":"RANGE",RCPAY="S":"SELECTED",1:"ALL")
- S Y=$E(Y_$J("",80),1,38)_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: " ; PRCA*4.5*4.32 CHAMPVA, 41->38
- S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL") ; PRCA*4.5*4.32 CHAMPVA
- S HCNT=HCNT+1,RCHDR(HCNT)=Y
- ;
- S HCNT=HCNT+1,RCHDR(HCNT)=""
- S Y="AGED",HCNT=HCNT+1,RCHDR(HCNT)=Y
- ; PRCA*4.5*318 moved deposit date up a row
- S Y="DAYS TRACE # DEP DATE",HCNT=HCNT+1,RCHDR(HCNT)=Y
- S Y=" DEPOSIT FROM/ID",HCNT=HCNT+1,RCHDR(HCNT)=Y
- S Y=" FILE DATE DEPOSIT AMOUNT DEP#/EFT# DEPOSIT POST STATUS",HCNT=HCNT+1,RCHDR(HCNT)=Y ; PRCA*4.5*326
- ;
- S RCHDR(0)=HCNT
- ;
- Q
- ;
- EXCEL ; Print report to screen, one record per line for export to MS Excel.
- ; RCTMPND = name of the subscript for ^TMP to use
- W !!,"Aged Days^Trace #^Deposit From/ID^File Date^Deposit Amount^Dep#/EFT#^Deposit Post Status^Deposit Date" ; PRCA*4.5*326
- S RCZ="" F S RCZ=$O(^TMP($J,"RCEFT_AGED",RCZ)) Q:RCZ="" S RCIEN=0 F S RCIEN=$O(^TMP($J,"RCEFT_AGED",RCZ,RCIEN)) Q:'RCIEN D G:RCSTOP PRTQ2
- .I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W:RCTMPND="" !!,"***TASK STOPPED BY USER***" Q
- .S RC0=$G(^RCY(344.31,RCIEN,0)),RC3443=$G(^RCY(344.3,+RC0,0))
- .D DEBEFT^RCDPEARL(.RC0) ;Add minus sign for debit amounts PRCA*4.5*432
- .N RCPAY S RCPAY=$P(RC0,U,2) S:RCPAY="" RCPAY="NO PAYER NAME RECEIVED" ; PRCA*4.5*298
- .S Z=$J(-RCZ,4)_"^"_$P(RC0,U,4)_"^"_RCPAY_"/"_$P(RC0,U,3)_"^"_$S($P(RC0,U,13):$$FMTE^XLFDT($P(RC0,U,13),2),1:"")_"^" ; PRCA*4.5*298
- .S Z=Z_$P(RC0,U,7)_"^"_$P(RC3443,U,6)_"/"_$P(RC0,U)_"."_$P(RC0,U,14)_"^" ; PRCA*4.5*326
- .S Z=Z_$S($P(RC3443,U,12):"",1:"NOT ")_"Posted to 8NZZ"_$S($P(RC3443,U,12):"^"_$$FMTE^XLFDT($P(RC0,U,12),2),1:"") ; PRCA*4.5*326
- .W !,Z
- W !!,"*** END OF REPORT ***",!
- ;
- PRTQ2 ;
- I $D(ZTQUEUED) S ZTREQ="@"
- I '$D(ZTQUEUED) D ^%ZISC
- K ^TMP($J,"RCEFT_AGED"),^TMP("RCSELPAY",$J),^TMP("RCPAYER",$J),^TMP($J,"RCERA_ADJ")
- Q
- ;
- ;PRCA*4.5*298
- ; removed RCIND local variable
- ; changed RC00 to RC3443
- ; replaced SETLINE with SL^RCDPEARL
- ; added $$HDRNM
- ; added RCLSTMGR in checks for header
- ; changed upper case text to mixed case throughout
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAR2 13532 printed Jan 18, 2025@02:45:37 Page 2
- RCDPEAR2 ;ALB/TMK/PJH - EFT Unmatched Aging Report - FILE 344.3 ;Nov 24, 2014@18:31:57
- +1 ;;4.5;Accounts Receivable;**173,269,276,284,283,293,298,318,321,326,432**;Mar 20, 1995;Build 16
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ; PRCA*4.5*298 notes at bottom
- EN1 ; option: EFT Unmatched Aging Report [RCDPE EFT AGING REPORT]
- +1 NEW %ZIS,DIC,DIR,DTOUT,DUOUT,POP,RCDISPTY,RCDTRNG,RCEND,RCHDR
- +2 NEW RCJOB1,RCLSTMGR,RCPAR,RCPAY,RCPGNUM,RCSTART,RCTMPND,RCTYPE,X,Y
- +3 ; RCDISPTY = display type
- +4 ; RCEND = end date
- +5 ; RCLSTMGR = list manager flag
- +6 ; RCTYPE = Type of payers to include M/P/T/C/A MEDICAL/PHARMACY/TRICARE/CHAMPVA/ALL
- +7 ; RCDTRNG= "1^start date^end date"
- +8 ; RCSTART = start date
- +9 ; RCTMPND = name of the subscript for ^TMP to use
- +10 ; RCPAY = A - All payers, S - Selected Payers, R - Range of Payers
- +11 ;
- +12 ; initial value
- SET RCLSTMGR=""
- +13 SET RCDTRNG=$$DTRNG^RCDPEM4()
- if '(RCDTRNG>0)
- GOTO EN1Q
- +14 SET RCSTART=$PIECE(RCDTRNG,U,2)-1
- SET RCEND=$PIECE(RCDTRNG,U,3)
- +15 ;
- +16 ; PRCA*4.5*326 - Ask to show Medical/Pharmacy Tricare or All ; PRCA*4.5*4.32 CHAMPVA
- +17 SET RCTYPE=$$RTYPE^RCDPEU1("")
- +18 IF RCTYPE=-1
- GOTO EN1Q
- +19 ;
- +20 ; PRCA*4.5*326 - Selected or Range of Payers
- SET RCPAY=$$PAYRNG^RCDPEU1()
- +21 ; PRCA*4.5*326 '^' or timeout
- IF RCPAY=-1
- GOTO EN1Q
- +22 ;
- +23 ; PRCA*4.5*326 - Since we don't want all payers
- IF RCPAY'="A"
- Begin DoDot:1
- +24 ; prompt for payers we do want
- SET RCPAR("TYPE")=RCTYPE
- +25 SET RCPAR("SELC")=RCPAY
- +26 SET RCPAR("FILE")=344.31
- +27 SET RCPAR("DICA")="Select Insurance Company NAME: "
- +28 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
- End DoDot:1
- IF XX=-1
- GOTO EN1Q
- +29 ;
- +30 ;Get display type
- +31 SET RCDISPTY=$$DISPTY^RCDPEM3()
- if RCDISPTY<0
- GOTO EN1Q
- +32 ; display device info about Excel format, set ListMan flag to prevent question
- +33 IF RCDISPTY
- SET RCLSTMGR="^"
- DO INFO^RCDPEM6
- +34 IF $DATA(DUOUT)!$DATA(DTOUT)
- GOTO EN1Q
- +35 ;
- +36 ; if not output to Excel ask for ListMan display, exit if timeout or '^' - PRCA*4.5*298
- +37 IF RCLSTMGR=""
- SET RCLSTMGR=$$ASKLM^RCDPEARL
- IF RCLSTMGR<0
- GOTO EN1Q
- +38 ; display in ListMan format and exit on return
- +39 IF RCLSTMGR
- Begin DoDot:1
- +40 ; clean any residue
- SET RCTMPND=$TEXT(+0)_"^EFT UNMATCHED AGING"
- KILL ^TMP($JOB,RCTMPND)
- +41 DO RPTOUT
- +42 NEW H,L,HDR
- SET L=0
- +43 SET HDR("TITLE")=$$HDRNM
- +44 ; take first 3 lines of report header
- FOR H=1:1:7
- IF $DATA(RCHDR(H))
- SET L=H
- SET HDR(H)=RCHDR(H)
- +45 ; any remaining header lines at top of report
- IF $ORDER(RCHDR(L))
- Begin DoDot:2
- +46 NEW N
- SET N=0
- SET H=L
- FOR
- SET H=$ORDER(RCHDR(H))
- if 'H
- QUIT
- SET N=N+.001
- SET ^TMP($JOB,RCTMPND,N)=RCHDR(H)
- End DoDot:2
- +47 ; generate ListMan display
- DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP($JOB,RCTMPND)))
- End DoDot:1
- GOTO EN1Q
- +48 ;
- +49 SET RCTMPND=""
- +50 ; Ask device
- +51 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO EN1Q
- +52 IF $DATA(IO("Q"))
- Begin DoDot:1
- +53 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSTOP
- +54 SET ZTRTN="RPTOUT^RCDPEAR2"
- SET ZTDESC="EFT AGING REPORT"
- +55 SET ZTSAVE("RC*")=""
- SET ZTSAVE("VAUTD")=""
- +56 ; PRCA*4.5*326
- SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
- +57 DO ^%ZTLOAD
- +58 WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this task.")
- +59 KILL ZTSK,IO("Q")
- DO HOME^%ZIS
- End DoDot:1
- GOTO EN1Q
- +60 ;
- +61 USE IO
- DO RPTOUT
- +62 ;
- EN1Q ; exit and clean up
- +1 IF 'RCLSTMGR
- DO ^%ZISC
- +2 ; PRCA*4.5*326
- KILL ^TMP("RCSELPAY",$JOB),^TMP("RCPAYER",$JOB),^TMP("RCDPEU1",$JOB)
- +3 QUIT
- +4 ;
- RPTOUT ; Entry point for queued job, nightly job
- +1 ; RCTMPND = name of the subscript for ^TMP to use to return all lines
- +2 ; If undefined or null, output is printed
- +3 ; Return global if RCTMPND not null: ^TMP($J,RCTMPND,line#)=line text
- +4 NEW DIC,DUOUT,RC0,RC13,RC3443,RCCT,RCIEN,RCNT,RCOUT,RCPAYER,RCPAYID
- +5 NEW RCSTOP,RCTOT,RCZ,X,XX,YY,Z,Z0,ZZ
- +6 SET RCTMPND=$GET(RCTMPND)
- +7 SET (RCCT,RCSTOP,RCNT,RCTOT)=0
- +8 KILL ^TMP($JOB,"RCERA_AGED"),^TMP($JOB,"RCERA_ADJ")
- +9 ; build local payer array here
- +10 IF RCTMPND'=""
- KILL ^TMP($JOB,RCTMPND)
- +11 ; cross-ref on file #344.31 field #.08 - MATCH STATUS
- +12 ;unmatched entries only
- SET RCIEN=0
- FOR
- SET RCIEN=$ORDER(^RCY(344.31,"AMATCH",0,RCIEN))
- if 'RCIEN
- QUIT
- Begin DoDot:1
- +13 ; EFT has been removed
- if $PIECE($GET(^RCY(344.31,RCIEN,3)),U)
- QUIT
- +14 ; payment of zero
- if $PIECE($GET(^RCY(344.31,RCIEN,0)),U,7)=0
- QUIT
- +15 ;
- +16 ; date received
- SET RC13=$PIECE($GET(^RCY(344.31,RCIEN,0)),U,13)
- +17 ; Check for payer match
- +18 IF RCPAY'="A"
- Begin DoDot:2
- +19 ; PRCA*4.5*326 Check if payer was selected
- SET XX=$$ISSEL^RCDPEU1(344.31,RCIEN)
- End DoDot:2
- if 'XX
- QUIT
- +20 ; If all of a give type of payer selected
- IF '$TEST
- IF RCTYPE'="A"
- Begin DoDot:2
- +21 ; check that payer matches type
- SET XX=$$ISTYPE^RCDPEU1(344.31,RCIEN,RCTYPE)
- End DoDot:2
- if 'XX
- QUIT
- +22 ; Check date range
- +23 if (RCSTART>RC13)!(RC13>RCEND)
- QUIT
- +24 ; Passed all the filters - include on report
- +25 SET ^TMP($JOB,"RCEFT_AGED",$$FMDIFF^XLFDT(RC13,DT),RCIEN)=0
- SET RCNT=RCNT+1
- End DoDot:1
- +26 ;
- +27 ; create header
- if 'RCLSTMGR
- DO HDRBLD
- +28 ; create Listman header
- if RCLSTMGR
- DO HDRLM
- +29 ;
- +30 IF RCDISPTY
- DO EXCEL
- QUIT
- +31 ;
- +32 ; Find total amount of EFTs
- +33 SET RCZ=""
- FOR
- SET RCZ=$ORDER(^TMP($JOB,"RCEFT_AGED",RCZ))
- if RCZ=""
- QUIT
- SET RCIEN=0
- FOR
- SET RCIEN=$ORDER(^TMP($JOB,"RCEFT_AGED",RCZ,RCIEN))
- if 'RCIEN
- QUIT
- Begin DoDot:1
- +34 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET (RCSTOP,ZTSTOP)=1
- KILL ZTREQ
- IF +$GET(RCPGNUM)
- if RCTMPND=""
- WRITE !!,"***TASK STOPPED BY USER***"
- QUIT
- +35 SET RC0=$GET(^RCY(344.31,RCIEN,0))
- SET RC3443=$GET(^RCY(344.3,+RC0,0))
- +36 ;Add minus sign for debit amounts PRCA*4.5*432
- DO DEBEFT^RCDPEARL(.RC0)
- +37 SET RCTOT=RCTOT+$PIECE(RC0,U,7)
- End DoDot:1
- if RCSTOP
- GOTO PRTQ
- +38 ;
- +39 ; initial report header
- if 'RCLSTMGR
- DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
- +40 ;
- +41 SET Z=$$SETSTR^VALM1("Totals:","",1,79)
- +42 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
- +43 SET Z=$$SETSTR^VALM1(" Number Aged Electronic EFT Messages Found: "_RCNT,"",1,79)
- +44 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
- +45 SET Z=$$SETSTR^VALM1(" Amount Aged Electronic EFT Messages Found: $"_$FNUMBER(+RCTOT,",",2),"",1,79)
- +46 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
- +47 DO SL^RCDPEARL($TRANSLATE($JUSTIFY("",IOM)," ","="),.RCCT,RCTMPND)
- +48 ;
- +49 SET RCZ=""
- FOR
- SET RCZ=$ORDER(^TMP($JOB,"RCEFT_AGED",RCZ))
- if RCZ=""
- QUIT
- SET RCIEN=0
- FOR
- SET RCIEN=$ORDER(^TMP($JOB,"RCEFT_AGED",RCZ,RCIEN))
- if 'RCIEN
- QUIT
- Begin DoDot:1
- +50 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET (RCSTOP,ZTSTOP)=1
- KILL ZTREQ
- IF +$GET(RCPGNUM)
- if RCTMPND=""
- WRITE !!,"***TASK STOPPED BY USER***"
- QUIT
- +51 ; On detail list, skip line
- IF RCPGNUM
- DO SL^RCDPEARL(" ",.RCCT,.RCTMPND)
- +52 IF 'RCLSTMGR
- IF $Y>(IOSL-RCHDR(0))
- DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
- if RCSTOP
- QUIT
- +53 SET RC0=$GET(^RCY(344.31,RCIEN,0))
- SET RC3443=$GET(^RCY(344.3,+RC0,0))
- +54 ;Add minus sign for debit amounts PRCA*4.5*432
- DO DEBEFT^RCDPEARL(.RC0)
- +55 SET RCTOT=RCTOT+$PIECE(RC0,U,7)
- +56 SET Z=$$SETSTR^VALM1($JUSTIFY(-RCZ,4),"",1,4)
- +57 ; PRCA*4.5*318 moved deposit date up a row to give more room for payer/payer ID
- +58 ;trace#
- SET Z=$$SETSTR^VALM1(" "_$PIECE(RC0,U,4),Z,5,52)
- +59 ; deposit date
- SET Z=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(RC0,U,12),2),Z,73,8)
- +60 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
- +61 ; PRCA*4.5*298
- NEW RCPAY
- SET RCPAY=$PIECE(RC0,U,2)
- if RCPAY=""
- SET RCPAY="NO PAYER NAME RECEIVED"
- +62 ; Payer ID ;PRCA*4.5*298
- SET RCPAYID=$PIECE(RC0,U,3)
- +63 ;PRCA*4.5*318 dynamically display payer name/ID based on length
- +64 SET RCPAYER=RCPAY_"/"_RCPAYID
- +65 IF $LENGTH(RCPAYER)>76
- Begin DoDot:2
- +66 SET ZZ=$LENGTH(RCPAYER,"/")
- SET XX=$PIECE(RCPAYER,"/",1,ZZ-1)
- SET YY=$PIECE(RCPAYER,"/",ZZ)
- +67 SET XX=$EXTRACT(RCPAYER,1,$LENGTH(XX)-($LENGTH(RCPAYER)-76))
- SET RCPAYER=XX_"/"_YY
- End DoDot:2
- +68 ; PRCA*4.5*298 (payer/payer ID)
- SET Z=$$SETSTR^VALM1(RCPAYER,"",5,76)
- +69 ;S Z=$$SETSTR^VALM1(" "_$$FMTE^XLFDT($P(RC0,U,12),2),Z,70,10) ; deposit date
- +70 ;end of PRCA*4.5*318 display change
- +71 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
- +72 SET Z=$$SETSTR^VALM1($JUSTIFY("",6)_$SELECT($PIECE(RC0,U,13):$$FMTE^XLFDT($PIECE(RC0,U,13),2),1:""),"",1,17)
- +73 SET Z=$$SETSTR^VALM1(" "_$JUSTIFY($PIECE(RC0,U,7),15,2),Z,18,17)
- +74 ; PRCA*4.5*283 - change length from 8 to 11 to allow for 9 digit DEP #'s
- +75 ; PRCA*4.5*326 - add EFT identifier
- +76 SET Z=$$SETSTR^VALM1(" "_$PIECE(RC3443,U,6)_"/"_$$GET1^DIQ(344.31,RCIEN_",",.01,"E"),Z,35,17)
- +77 SET Z=$$SETSTR^VALM1(" "_$SELECT($PIECE(RC3443,U,12):"",1:"NOT ")_"Posted to 8NZZ"_$SELECT($PIECE(RC3443,U,12):" "_$$FMTE^XLFDT($PIECE(RC3443,U,11),2),1:""),Z,52,36)
- +78 DO SL^RCDPEARL(Z,.RCCT,RCTMPND)
- +79 KILL RCOUT
- +80 DO GETS^DIQ(344.31,RCIEN_",",2,"E","RCOUT")
- +81 if '$ORDER(RCOUT(344.31,RCIEN_",",2,0))
- QUIT
- +82 DO SL^RCDPEARL($JUSTIFY("",8)_"--EXCEPTION NOTES--",.RCCT,RCTMPND)
- +83 SET Z=0
- FOR
- SET Z=$ORDER(RCOUT(344.31,RCIEN_",",2,Z))
- if 'Z
- QUIT
- Begin DoDot:2
- +84 IF 'RCLSTMGR
- IF $Y>(IOSL-RCHDR(0))
- DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
- if RCSTOP
- QUIT
- +85 DO SL^RCDPEARL($JUSTIFY("",8)_" "_RCOUT(344.31,RCIEN_",",2,Z),.RCCT,RCTMPND)
- End DoDot:2
- if RCSTOP
- QUIT
- End DoDot:1
- if RCSTOP
- GOTO PRTQ
- +86 ;
- +87 ;
- +88 ; PRCA*4.5*298, put end-of-report into SL^RCDPEARL
- +89 ; skip a line
- DO SL^RCDPEARL(" ",.RCCT,RCTMPND)
- +90 DO SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCCT,RCTMPND)
- +91 ;
- PRTQ ;
- +1 ; PRCA*4.5*298, added ListMan check
- +2 IF '$DATA(ZTQUEUED)
- IF 'RCLSTMGR
- IF 'RCSTOP
- DO ASK^RCDPEARL(.RCSTOP)
- +3 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 IF '$DATA(ZTQUEUED)
- DO ^%ZISC
- +5 KILL ^TMP($JOB,"RCEFT_AGED"),ZTQUEUED
- +6 ; PRCA*4.5*326
- KILL ^TMP("RCDPEU1",$JOB)
- +7 QUIT
- +8 ;
- +9 ; extrinsic variable, text for header PRCA*4.5*298
- HDRNM() QUIT "EFT UNMATCHED AGING REPORT"
- +1 ;
- HDRBLD ; create the report header
- +1 ; returns RCHDR, RCPGNUM, RCSTOP
- +2 ; RCHDR(0) = header text line count
- +3 ; RCHDR("XECUTE") = M code for page number
- +4 ; RCHDR("RUNDATE") = date/time report generated, external format
- +5 ; RCPGNUM - page counter
- +6 ; RCSTOP - flag to exit
- +7 ;INPUT:
- +8 ; RCDTRNG - date range filter value to be printed as part of the header
- +9 ; RCPAY - Payer filter value(s)
- +10 ; RCLSTMGR
- +11 ;
- +12 KILL RCHDR
- SET RCHDR("RUNDATE")=$$NOW^RCDPEARL
- SET RCPGNUM=0
- SET RCSTOP=0
- +13 ;
- +14 ; Excel format, xecute code is QUIT, null page number
- IF RCDISPTY
- Begin DoDot:1
- +15 SET RCHDR(0)=1
- SET RCHDR("XECUTE")="Q"
- SET RCPGNUM=""
- +16 ; PRCA*4.3*326
- SET RCHDR(1)="Aged Days^Trace #^Deposit From/ID^File Date^Deposit Amount^Dep#/EFT#^Deposit Post Status^Deposit Date"
- End DoDot:1
- QUIT
- +17 ;
- +18 NEW START,END,MSG,DATE,Y,DIV,HCNT
- +19 SET START=$$FMTE^XLFDT($PIECE(RCDTRNG,U,2),2)
- SET END=$$FMTE^XLFDT($PIECE(RCDTRNG,U,3),2)
- +20 ;
- +21 ; line 1 will be replaced by XECUTE code below
- SET Y=$$HDRNM
- SET HCNT=1
- SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
- +22 SET RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$TEXT(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"
- +23 ; line 1 will be replaced by XECUTE code below
- SET Y="RUN DATE: "_RCHDR("RUNDATE")
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
- +24 ;
- +25 ; Payer(s) - PRCA*4.5*326 Add MPT filter
- +26 SET Y="PAYERS: "_$SELECT(RCPAY="R":"RANGE",RCPAY="S":"SELECTED",1:"ALL")
- +27 ; PRCA*4.5*4.32 CHAMPVA, 41->38
- SET Y=$EXTRACT(Y_$JUSTIFY("",80),1,38)_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "
- +28 ; PRCA*4.5*4.32 CHAMPVA
- SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")
- +29 SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +30 SET Y="DATE RANGE: "_$PIECE($$FMTE^XLFDT(START,2),"@")_" - "_$PIECE($$FMTE^XLFDT(END,2),"@")_" (DATE EFT FILED)"
- +31 SET Y=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +32 ;
- +33 SET Y="AGED"
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +34 ; PRCA*4.5*318 moved deposit date up a row
- +35 SET Y="DAYS TRACE # DEP DATE"
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +36 SET Y=" DEPOSIT FROM/ID"
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +37 ; PRCA*4.5*326
- SET Y=" FILE DATE DEPOSIT AMOUNT DEP#/EFT# DEPOSIT POST STATUS"
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +38 ; row of equal signs at bottom
- SET Y=""
- SET $PIECE(Y,"=",81)=""
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +39 ;
- +40 SET RCHDR(0)=HCNT
- +41 ;
- +42 QUIT
- +43 ;
- HDRLM ; create the Listman header section
- +1 ; returns RCHDR
- +2 ; RCHDR(0) = header text line count
- +3 ;INPUT:
- +4 ; RCDTRNG - date range filter value to be printed as part of the header
- +5 ; RCPAY - Payer filter value(s)
- +6 ;
- +7 KILL RCHDR
- SET RCPGNUM=0
- SET RCSTOP=0
- +8 ;
- +9 NEW START,END,MSG,DATE,Y,DIV,HCNT
- +10 SET START=$$FMTE^XLFDT($PIECE(RCDTRNG,U,2),2)
- SET END=$$FMTE^XLFDT($PIECE(RCDTRNG,U,3),2)
- +11 SET Y="DATE RANGE: "_$PIECE($$FMTE^XLFDT(START,2),"@")_" - "_$PIECE($$FMTE^XLFDT(END,2),"@")_" (DATE EFT FILED)"
- +12 SET HCNT=1
- SET RCHDR(HCNT)=Y
- +13 ; Payer(s) - PRCA*4.5*326 Add MPT filter
- +14 SET Y="PAYERS: "_$SELECT(RCPAY="R":"RANGE",RCPAY="S":"SELECTED",1:"ALL")
- +15 ; PRCA*4.5*4.32 CHAMPVA, 41->38
- SET Y=$EXTRACT(Y_$JUSTIFY("",80),1,38)_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "
- +16 ; PRCA*4.5*4.32 CHAMPVA
- SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")
- +17 SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +18 ;
- +19 SET HCNT=HCNT+1
- SET RCHDR(HCNT)=""
- +20 SET Y="AGED"
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +21 ; PRCA*4.5*318 moved deposit date up a row
- +22 SET Y="DAYS TRACE # DEP DATE"
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +23 SET Y=" DEPOSIT FROM/ID"
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +24 ; PRCA*4.5*326
- SET Y=" FILE DATE DEPOSIT AMOUNT DEP#/EFT# DEPOSIT POST STATUS"
- SET HCNT=HCNT+1
- SET RCHDR(HCNT)=Y
- +25 ;
- +26 SET RCHDR(0)=HCNT
- +27 ;
- +28 QUIT
- +29 ;
- EXCEL ; Print report to screen, one record per line for export to MS Excel.
- +1 ; RCTMPND = name of the subscript for ^TMP to use
- +2 ; PRCA*4.5*326
- WRITE !!,"Aged Days^Trace #^Deposit From/ID^File Date^Deposit Amount^Dep#/EFT#^Deposit Post Status^Deposit Date"
- +3 SET RCZ=""
- FOR
- SET RCZ=$ORDER(^TMP($JOB,"RCEFT_AGED",RCZ))
- if RCZ=""
- QUIT
- SET RCIEN=0
- FOR
- SET RCIEN=$ORDER(^TMP($JOB,"RCEFT_AGED",RCZ,RCIEN))
- if 'RCIEN
- QUIT
- Begin DoDot:1
- +4 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET (RCSTOP,ZTSTOP)=1
- KILL ZTREQ
- IF +$GET(RCPG)
- if RCTMPND=""
- WRITE !!,"***TASK STOPPED BY USER***"
- QUIT
- +5 SET RC0=$GET(^RCY(344.31,RCIEN,0))
- SET RC3443=$GET(^RCY(344.3,+RC0,0))
- +6 ;Add minus sign for debit amounts PRCA*4.5*432
- DO DEBEFT^RCDPEARL(.RC0)
- +7 ; PRCA*4.5*298
- NEW RCPAY
- SET RCPAY=$PIECE(RC0,U,2)
- if RCPAY=""
- SET RCPAY="NO PAYER NAME RECEIVED"
- +8 ; PRCA*4.5*298
- SET Z=$JUSTIFY(-RCZ,4)_"^"_$PIECE(RC0,U,4)_"^"_RCPAY_"/"_$PIECE(RC0,U,3)_"^"_$SELECT($PIECE(RC0,U,13):$$FMTE^XLFDT($PIECE(RC0,U,13),2),1:"")_"^"
- +9 ; PRCA*4.5*326
- SET Z=Z_$PIECE(RC0,U,7)_"^"_$PIECE(RC3443,U,6)_"/"_$PIECE(RC0,U)_"."_$PIECE(RC0,U,14)_"^"
- +10 ; PRCA*4.5*326
- SET Z=Z_$SELECT($PIECE(RC3443,U,12):"",1:"NOT ")_"Posted to 8NZZ"_$SELECT($PIECE(RC3443,U,12):"^"_$$FMTE^XLFDT($PIECE(RC0,U,12),2),1:"")
- +11 WRITE !,Z
- End DoDot:1
- if RCSTOP
- GOTO PRTQ2
- +12 WRITE !!,"*** END OF REPORT ***",!
- +13 ;
- PRTQ2 ;
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 IF '$DATA(ZTQUEUED)
- DO ^%ZISC
- +3 KILL ^TMP($JOB,"RCEFT_AGED"),^TMP("RCSELPAY",$JOB),^TMP("RCPAYER",$JOB),^TMP($JOB,"RCERA_ADJ")
- +4 QUIT
- +5 ;
- +6 ;PRCA*4.5*298
- +7 ; removed RCIND local variable
- +8 ; changed RC00 to RC3443
- +9 ; replaced SETLINE with SL^RCDPEARL
- +10 ; added $$HDRNM
- +11 ; added RCLSTMGR in checks for header
- +12 ; changed upper case text to mixed case throughout
- +13 ;