BAREDPCS ; IHS/SD/SDR - ERA Check Summary Report ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**20,21**;OCT 26,2005
; new routine
; *******************************************************************
EN ;
D SELFL^BAREDP00 ;prompt for Import name/Check/EFT trace
;IHS/SD/TPF 8/22/2001 BAR*1.8*21
I +$G(IMPDA)=0 Q ;bar*1.8*21 SDR
I TRNAME[("5010") D EN1^BAR50PCS Q
;END BAR*1.8*21
EN1 ;
F D Q:$D(DIRUT) Q:$D(BARMEDIA) ; Ask Browse or print
.D ASK^BAREDP10 ;prompt for print/browse
I ('$D(IMPDA)!('$D(BARMEDIA))) D Q
.D PAZ^BARRUTL
.D XIT
S $P(BARDASH,"-",81)=""
S $P(BARSTAR,"*",81)=""
D SETHDR ; Set up report header
I BARMEDIA="B" D BROWSE
I BARMEDIA="P" D PRINT
D XIT
Q
SETHDR ;
; Set up Report Header lines
K BARPCIEN,BARPC,BARIIEN,BARAIEN
K IMP
D ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")
S BAR("HD",0)="ERA CHECK NUMBER AND CHECK AMOUNTS REPORT"
S BAR("HD",1)="LOCATION: "_$$GET1^DIQ(4,DUZ(2),.01)
S BAR("HD",2)="FOR FILE NAME: "_IMP(.05)
S BARTMP=BAR("HD",2) ;IHS/SD/TPF 7/27/2011 bar*1.8*21 HEAT42678
D PAD
S BAR("HD",3)="FOR RPMS FILE: "_IMP(.01)
S BAR("HD",4)=BARDASH
Q
PAD ;
N L,I
S L=$L(BARTMP)
F I=L:1:50 S BARTMP=BARTMP_" "
Q
BROWSE ;
; Browse report to screen
; GET DEVICE (QUEUEING ALLOWED)
S XBFLD("BROWSE")=1
S BARIOSL=IOSL
S IOSL=600
D VIEWR^XBLM("PRINTD^BAREDPCS")
D FULL^VALM1
W $$EN^BARVDF("IOF")
D CLEAR^VALM1 ;clears out all list man stuff
K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF
K VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP
K VALMY,XQORS,XQORSPEW,VALMCOFF
S IOSL=BARIOSL
Q
; ********************************************************************
;
PRINT ;
; Print report to device. Queuing allowed.
S BARQ("RC")="COMPUTE^BAREDPCS" ; Build tmp global with data
S BARQ("RP")="PRINTD^BAREDPCS" ; Print reports from tmp global
S BARQ("NS")="BAR" ; Namespace for variables
S ZTSAVE("IMPDA")=""
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
D ^BARDBQUE ; Double queuing
Q
COMPUTE ;EP
; Compute line tag required by BARDBQUE but all processing
; is done under PRINT so just quit here
Q
; ********************************************************************
;
PRINTD ; EP
; PRINT the report (Browse or Print)
S BAR("PG")=0
D DETAIL
W !!!,"**This 835 ERA File contains "_BARTCHKS_" BPR segments totaling $"_$FN(BARTAMT,",",2)
W !,"**Use the Check Posting Summary (CPS) to confirm checks have been batched",!
I $G(BAR("F1"))="" D
. W !,$$CJ^XLFSTR("* * E N D O F R E P O R T * *",IOM)
. D PAZ^BARRUTL
Q
; ********************************************************************
;
HD ; EP
D PAZ^BARRUTL
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q
; -------------------------------
;
HDB ; EP
S BAR("COL")="W !,""SET"",?11,""PAYER"",?26,""CD"",?30,""PAYMENT"",?45,""CHECK"",?71,""CHK DATE"""
S BAR("PG")=BAR("PG")+1
I BAR("PG")>1 S BAR("LVL")=4
D WHD^BARRHD
X BAR("COL")
W !,BARDASH
Q
; ********************************************************************
;
DETAIL ;
; Print report in brief and detail format
D HDB
I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
S BARCK=""
K BARTAMT,BARAMT,BARTCHKS
S BARCK=0,BARTCHKS=0,BARTAMT=0
F S BARCK=$O(^BAREDI("I",DUZ(2),IMPDA,5,BARCK)) Q:'BARCK D Q:$G(BAR("F1"))
.Q:$G(BAR("F1"))
.S BARCHK=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U) ;check
.S BARST=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,2) ;trans set control#
.S BARAMT=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,3) ;check amount
.S BARTCD=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,4) ;trans handling code
.S BARDT=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,5) ;check issue date
.S BARPYR=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,6) ;payer
.W !,$E(BARST,($L(BARST)-3),$L(BARST)),?6,$E(BARPYR,1,18),?26,BARTCD,?28,$J($FN(BARAMT,",",2),12),?41,BARCHK,?71,$$SHDT^BARDUTL(BARDT)
.S BARTCHKS=+$G(BARTCHKS)+1 ;count # of ERA checks
.S BARTAMT=+$G(BARTAMT)+BARAMT ;count total ERA amount
Q
XIT ;
D ^BARVKL0
Q
BAREDPCS ; IHS/SD/SDR - ERA Check Summary Report ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**20,21**;OCT 26,2005
+2 ; new routine
+3 ; *******************************************************************
EN ;
+1 ;prompt for Import name/Check/EFT trace
DO SELFL^BAREDP00
+2 ;IHS/SD/TPF 8/22/2001 BAR*1.8*21
+3 ;bar*1.8*21 SDR
IF +$GET(IMPDA)=0
QUIT
+4 IF TRNAME[("5010")
DO EN1^BAR50PCS
QUIT
+5 ;END BAR*1.8*21
EN1 ;
+1 ; Ask Browse or print
FOR
Begin DoDot:1
+2 ;prompt for print/browse
DO ASK^BAREDP10
End DoDot:1
IF $DATA(DIRUT)
QUIT
IF $DATA(BARMEDIA)
QUIT
+3 IF ('$DATA(IMPDA)!('$DATA(BARMEDIA)))
Begin DoDot:1
+4 DO PAZ^BARRUTL
+5 DO XIT
End DoDot:1
QUIT
+6 SET $PIECE(BARDASH,"-",81)=""
+7 SET $PIECE(BARSTAR,"*",81)=""
+8 ; Set up report header
DO SETHDR
+9 IF BARMEDIA="B"
DO BROWSE
+10 IF BARMEDIA="P"
DO PRINT
+11 DO XIT
+12 QUIT
SETHDR ;
+1 ; Set up Report Header lines
+2 KILL BARPCIEN,BARPC,BARIIEN,BARAIEN
+3 KILL IMP
+4 DO ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")
+5 SET BAR("HD",0)="ERA CHECK NUMBER AND CHECK AMOUNTS REPORT"
+6 SET BAR("HD",1)="LOCATION: "_$$GET1^DIQ(4,DUZ(2),.01)
+7 SET BAR("HD",2)="FOR FILE NAME: "_IMP(.05)
+8 ;IHS/SD/TPF 7/27/2011 bar*1.8*21 HEAT42678
SET BARTMP=BAR("HD",2)
+9 DO PAD
+10 SET BAR("HD",3)="FOR RPMS FILE: "_IMP(.01)
+11 SET BAR("HD",4)=BARDASH
+12 QUIT
PAD ;
+1 NEW L,I
+2 SET L=$LENGTH(BARTMP)
+3 FOR I=L:1:50
SET BARTMP=BARTMP_" "
+4 QUIT
BROWSE ;
+1 ; Browse report to screen
+2 ; GET DEVICE (QUEUEING ALLOWED)
+3 SET XBFLD("BROWSE")=1
+4 SET BARIOSL=IOSL
+5 SET IOSL=600
+6 DO VIEWR^XBLM("PRINTD^BAREDPCS")
+7 DO FULL^VALM1
+8 WRITE $$EN^BARVDF("IOF")
+9 ;clears out all list man stuff
DO CLEAR^VALM1
+10 KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF
+11 KILL VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP
+12 KILL VALMY,XQORS,XQORSPEW,VALMCOFF
+13 SET IOSL=BARIOSL
+14 QUIT
+15 ; ********************************************************************
+16 ;
PRINT ;
+1 ; Print report to device. Queuing allowed.
+2 ; Build tmp global with data
SET BARQ("RC")="COMPUTE^BAREDPCS"
+3 ; Print reports from tmp global
SET BARQ("RP")="PRINTD^BAREDPCS"
+4 ; Namespace for variables
SET BARQ("NS")="BAR"
+5 SET ZTSAVE("IMPDA")=""
+6 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+7 ; Double queuing
DO ^BARDBQUE
+8 QUIT
COMPUTE ;EP
+1 ; Compute line tag required by BARDBQUE but all processing
+2 ; is done under PRINT so just quit here
+3 QUIT
+4 ; ********************************************************************
+5 ;
PRINTD ; EP
+1 ; PRINT the report (Browse or Print)
+2 SET BAR("PG")=0
+3 DO DETAIL
+4 WRITE !!!,"**This 835 ERA File contains "_BARTCHKS_" BPR segments totaling $"_$FNUMBER(BARTAMT,",",2)
+5 WRITE !,"**Use the Check Posting Summary (CPS) to confirm checks have been batched",!
+6 IF $GET(BAR("F1"))=""
Begin DoDot:1
+7 WRITE !,$$CJ^XLFSTR("* * E N D O F R E P O R T * *",IOM)
+8 DO PAZ^BARRUTL
End DoDot:1
+9 QUIT
+10 ; ********************************************************************
+11 ;
HD ; EP
+1 DO PAZ^BARRUTL
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAR("F1")=1
QUIT
+3 ; -------------------------------
+4 ;
HDB ; EP
+1 SET BAR("COL")="W !,""SET"",?11,""PAYER"",?26,""CD"",?30,""PAYMENT"",?45,""CHECK"",?71,""CHK DATE"""
+2 SET BAR("PG")=BAR("PG")+1
+3 IF BAR("PG")>1
SET BAR("LVL")=4
+4 DO WHD^BARRHD
+5 XECUTE BAR("COL")
+6 WRITE !,BARDASH
+7 QUIT
+8 ; ********************************************************************
+9 ;
DETAIL ;
+1 ; Print report in brief and detail format
+2 DO HDB
+3 IF $Y>(IOSL-5)
DO HD
IF $GET(BAR("F1"))
QUIT
+4 SET BARCK=""
+5 KILL BARTAMT,BARAMT,BARTCHKS
+6 SET BARCK=0
SET BARTCHKS=0
SET BARTAMT=0
+7 FOR
SET BARCK=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,BARCK))
IF 'BARCK
QUIT
Begin DoDot:1
+8 IF $GET(BAR("F1"))
QUIT
+9 ;check
SET BARCHK=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U)
+10 ;trans set control#
SET BARST=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,2)
+11 ;check amount
SET BARAMT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,3)
+12 ;trans handling code
SET BARTCD=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,4)
+13 ;check issue date
SET BARDT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,5)
+14 ;payer
SET BARPYR=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCK,0)),U,6)
+15 WRITE !,$EXTRACT(BARST,($LENGTH(BARST)-3),$LENGTH(BARST)),?6,$EXTRACT(BARPYR,1,18),?26,BARTCD,?28,$JUSTIFY($FNUMBER(BARAMT,",",2),12),?41,BARCHK,?71,$$SHDT^BARDUTL(BARDT)
+16 ;count # of ERA checks
SET BARTCHKS=+$GET(BARTCHKS)+1
+17 ;count total ERA amount
SET BARTAMT=+$GET(BARTAMT)+BARAMT
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+18 QUIT
XIT ;
+1 DO ^BARVKL0
+2 QUIT
