RCDPETR ;ALB/TMK,PJH - EOB TRANSFER IN/TRANSFER OUT REPORTS ; 9/17/10 6:31pm
;;4.5;Accounts Receivable;**173,269,265**;Mar 20, 1995;Build 5
;;Per VHA Directive 10-93-142, this routine should not be modified.
; IA for read access to ^IBM(361.1 = 4051
Q
;
RPT ; Transfer In/Out Report
N DIR,X,Y,POP,RCRPT,RCDT1,RCDT2,ZTRTN,ZTSK,ZTDESC,%ZIS
S DIR(0)="SBO^I:TRANSFER IN REPORT;O:TRANSFER OUT REPORT;B:BOTH REPORTS",DIR("A")="SELECT REPORT" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
S RCRPT=Y
S DIR("?")="ENTER THE EARLIEST TRANSFERRED FROM/TO DATE TO INCLUDE ON THE REPORT"
S DIR(0)="DAO^:"_DT_":APE",DIR("A")="START DATE: " D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
S RCDT1=Y
S DIR("?")="ENTER THE LATEST TRANSFERRED FROM/TO DATE TO INCLUDE ON THE REPORT"
S DIR(0)="DAO^"_RCDT1_":"_DT_":APE",DIR("A")="END DATE: " D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
S RCDT2=Y
; Ask device
S %ZIS="QM" D ^%ZIS G:POP RPTQ
I $D(IO("Q")) D G RPTQ
. S ZTRTN="EN^RCDPETR("""_RCRPT_""","""_RCDT1_""","""_RCDT2_""")",ZTDESC="AR - EDI LOCKBOX TRANSFERRED EEOB REPORT"
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
. K ZTSK,IO("Q") D HOME^%ZIS
U IO
D EN(RCRPT,RCDT1,RCDT2)
RPTQ Q
;
EN(RCRPT,RCDT1,RCDT2) ; Entry point for queued job
N Q,Z,Z0,Z1,Z2,ZCT,RCSTOP,RCPG,RCDAT,RCDAT1,RCCT,RCACC,RCNOT,RCRCV,RCNRCV
K ^TMP($J,"RCDPE_TROUT"),^("RCDPE_TRIN")
S (RCSTOP,ZCT)=0
I RCRPT="O"!(RCRPT="B") D ; Transfer out
. S Z=RCDT1-.0001
. F S Z=$O(^RCY(344.4,"ATOUT",Z)) Q:'Z!RCSTOP S Z0=0 F S Z0=$O(^RCY(344.4,"ATOUT",Z,Z0)) Q:'Z0!(Z0>RCDT2)!RCSTOP S Z1=0 F S Z1=$O(^RCY(344.4,"ATOUT",Z,Z0,Z1)) Q:'Z1 D Q:RCSTOP
.. Q:$$STOP(.ZCT,.RCSTOP,0)
.. ; EOB transferred out was found in date range
.. S ^TMP($J,"RCDPE_TROUT",Z,Z0,Z1)=$G(^RCY(344.4,Z0,1,Z1,0))
.. ; sbscrpts are: date,ien file 344.4,ien file 344.41
;
I 'RCSTOP,(RCRPT="I"!(RCRPT="B")) D ; Transfer in
. S Z=RCDT1-.0001 ; Look for accepted ones
. F S Z=$O(^IBM(361.1,"ATIN",Z)) Q:'Z!(Z>RCDT2)!RCSTOP S Z0="" F S Z0=$O(^IBM(361.1,"ATIN",Z,Z0)) Q:Z0=""!RCSTOP S Z1=0 F S Z1=$O(^IBM(361.1,"ATIN",Z,Z0,Z1)) Q:'Z1 D Q:RCSTOP ; IA 4051
.. ; EOB transfer in/accepted was found in date range
.. Q:$$STOP(.ZCT,.RCSTOP,0)
.. S ^TMP($J,"RCDPE_TRIN",Z,361.1,Z0,Z1)=$G(^IBM(361.1,Z1,0)) ; IA 4051
.. ;sbscrpts are: date,file,transferred from name,ien file 361.1
.. S ^TMP($J,"RCDPE_TRIN",Z,361.1,Z0,Z1,7)=$G(^IBM(361.1,Z1,7)) ; IA 4051
.. S ^TMP($J,"RCDPE_TRIN",Z,361.1,Z0,Z1,1)=$G(^IBM(361.1,Z1,1)) ; IA 4051
. Q:RCSTOP
. S Z=RCDT1-.0001 ; Look for pending accept ones
. F S Z=$O(^RCY(344.5,"ATIN",Z)) Q:Z'!(Z>RCDT2)!RCSTOP S Z0="" F S Z0=$O(^RCY(344.5,"ATIN",Z,Z0)) Q:Z0=""!RCSTOP S Z1=0 F S Z1=$O(^RCY(344.5,"ATIN",Z,Z0,Z1)) Q:'Z1 D Q:RCSTOP
.. ; EOB transfer in/pending acceptance was found in date range
.. S ^TMP($J,"RCDPE_TRIN",Z,344.5,Z0,Z1)=$G(^RCY(344.5,Z1,0))
.. ;sbscrpts are: date,file,transferred from name,ien file 344.5
;
G:RCSTOP ENQ
S (RCPG,RCCT,Z,RCACC,RCNOT,RCRCV,RCNRCV)=0
F S Z=$O(^TMP($J,"RCDPE_TROUT",Z)) Q:'Z!RCSTOP S Z0="" F S Z0=$O(^TMP($J,"RCDPE_TROUT",Z,Z0)) Q:Z0=""!RCSTOP S Z1=0 F S Z1=$O(^TMP($J,"RCDPE_TROUT",Z,Z0,Z1)) Q:'Z1 S RCDAT=$G(^(Z1)) D Q:RCSTOP
. I 'RCPG!(($Y+5)>IOSL) D HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2) Q:RCSTOP
. S Q=$$SETSTR^VALM1($P(RCDAT,U,5),"",1,11)
. S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P(RCDAT,U,12),"2D"),Q,14,8)
. S Q=$$SETSTR^VALM1($P($G(^DIC(4,+$P(RCDAT,U,11),0)),U),Q,24,20)
. S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P($G(^RCY(344.4,+Z0,0)),U,4),"2D"),Q,46,8)
. S Q=$$SETSTR^VALM1($J(+$P(RCDAT,U,3),"",2),Q,56,12)
. S Q=$$SETSTR^VALM1($S('$P(RCDAT,U,16):"NOT REC'D",$P(RCDAT,U,10)="":"REC'D",$P(RCDAT,U,10)=0:"NOT ACCPTD",1:"ACCPTD"),Q,70,10)
. I '$P(RCDAT,U,16) S RCNRCV=RCNRCV+1
. I $P(RCDAT,U,16)=1,$P(RCDAT,U,10)="" S RCRCV=RCRCV+1
. I $P(RCDAT,U,10) S RCACC=RCACC+1
. I $P(RCDAT,U,10)=0 S RCNOT=RCNOT+1
. D SETLINE(Q,.RCCT)
;
G:RCSTOP ENQ
;
I RCRPT="B"!(RCRPT="O") D
. I '$O(^TMP($J,"RCDPE_TROUT",0)) D Q
.. D HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2) Q:RCSTOP
.. D SETLINE("** THERE WERE NO EEOBs TRANSFERRED OUT WITHIN THE DATE RANGE SELECTED",.RCCT)
. I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2) Q:RCSTOP
. D SETLINE(" ",.RCCT)
. D SETLINE(" TOTAL # EEOBs NOT CONFIRMED AS 'RECEIVED' BY OTHER SITES: "_RCNRCV,.RCCT)
. D SETLINE(" TOTAL # EEOBs STILL JUST 'RECEIVED' BY OTHER SITES: "_RCRCV,.RCCT)
. D SETLINE(" TOTAL # EEOBs ACCEPTED BY OTHER SITES: "_RCACC,.RCCT)
. D SETLINE(" TOTAL # EEOBs NOT ACCEPTED BY OTHER SITES: "_RCNOT,.RCCT)
;
G:RCSTOP ENQ
;
I RCPG D ASK(.RCSTOP) G:RCSTOP ENQ
S (RCACC,RCNOT,RCPG)=0
S Z=0 F S Z=$O(^TMP($J,"RCDPE_TRIN",Z)) Q:'Z S Z0=0 F S Z0=$O(^TMP($J,"RCDPE_TRIN",Z,Z0)) Q:'Z0 S Z1="" F S Z1=$O(^TMP($J,"RCDPE_TRIN",Z,Z0,Z1)) Q:Z1="" S Z2=0 F S Z2=$O(^TMP($J,"RCDPE_TRIN",Z,Z0,Z1,Z2)) Q:'Z2 D
. S RCDAT=$G(^TMP($J,"RCDPE_TRIN",Z,Z0,Z1,Z2))
. I Z0=361.1 S RCDAT(7)=$G(^TMP($J,"RCDPE_TRIN",Z,Z0,Z1,Z2,7)),RCDAT(1)=$G(^(1))
. I 'RCPG!(($Y+5)>IOSL) D HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2) Q:RCSTOP
. I Z0=361.1 D
.. S Q=$$SETSTR^VALM1($$BN1^PRCAFN(+RCDAT),"",1,11)
.. S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P(RCDAT,U,5),"2D"),Q,14,8)
.. S Q=$$SETSTR^VALM1($P(RCDAT(7),U),Q,24,20)
.. S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P(RCDAT,U,6),"2D"),Q,46,8)
.. S Q=$$SETSTR^VALM1($J(+$P(RCDAT(1),U),"",2),Q,56,12)
.. S Q=$$SETSTR^VALM1("ACCEPTED",Q,70,10)
.. S RCACC=RCACC+1
. E D
.. D RAWBILL(Z2,.RCDAT1)
.. S RCDAT1=+$O(RCDAT1(0)),RCDAT1=$G(RCDAT1(RCDAT1))
.. S Q=$$SETSTR^VALM1($P(RCDAT1,U),"",1,11)
.. S Q=$$SETSTR^VALM1($$FMTE^XLFDT($P(RCDAT,U,3),"2D"),Q,14,8)
.. S Q=$$SETSTR^VALM1($P(RCDAT,U,12),Q,24,20)
.. S Q=$$SETSTR^VALM1($S($G(RCDAT1(0)):$E(RCDAT1(0),5,6)_"/"_$E(RCDAT1(0),7,8)_"/"_$E(RCDAT1(0),3,4),1:""),Q,46,8)
.. S Q=$$SETSTR^VALM1($J(+$P(RCDAT1,U,2),"",2),Q,56,12)
.. S Q=$$SETSTR^VALM1("PENDING",Q,70,10)
.. S RCNOT=RCNOT+1
. D SETLINE(Q,.RCCT)
;
G:RCSTOP ENQ
;
I RCRPT="B"!(RCRPT="I") D
. I '$O(^TMP($J,"RCDPE_TRIN",0)) D Q
.. D HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2) Q:RCSTOP
.. D SETLINE("** THERE WERE NO EEOBs TRANSFERRED 'IN' WITHIN THE DATE RANGE SELECTED",.RCCT)
. I ($Y+5)>IOSL D HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2) Q:RCSTOP
. D SETLINE(" ",.RCCT)
. D SETLINE(" TOTAL # EEOBs YOU ACCEPTED: "_RCACC,.RCCT)
. D SETLINE(" TOTAL # EEOBs STILL PENDING: "_RCNOT,.RCCT)
;
ENQ I '$D(ZTQUEUED) D ^%ZISC I 'RCSTOP,RCPG D ASK(.RCSTOP)
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP($J,"RCDPE_TROUT"),^("RCDPE_TRIN")
Q
;
HDR(RCCT,RCPG,RCSTOP,RCINOUT,RCDT1,RCDT2) ;Prints report heading
; Function returns RCPG = current page # and RCCT = running line count
; and RCSTOP = 1 if user aborted print
; Parameters must be passed by reference
N Z,Z0
I RCPG!($E(IOST,1,2)="C-") D Q:RCSTOP
. I RCPG&($E(IOST,1,2)="C-") D ASK(.RCSTOP) Q:RCSTOP
. W @IOF,*13 ; Write form feed
S RCPG=RCPG+1
S Z0="EDI LOCKBOX EEOBs TRANSFERRED "_$S(RCINOUT=1:"OUT",1:"IN")_" REPORT"
S Z=$$SETSTR^VALM1($J("",80-$L(Z0)\2)_Z0,"",1,79)
S Z=$$SETSTR^VALM1("Page: "_RCPG,Z,70,10)
D SETLINE(Z,.RCCT)
S Z0="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z0=$J("",80-$L(Z0)\2)_Z0
S Z=$$SETSTR^VALM1(Z0,"",1,79)
D SETLINE(Z,.RCCT)
D SETLINE(" ",.RCCT)
D SETLINE("DATE RANGE SELECTED: "_$$FMTE^XLFDT(RCDT1,2)_"-"_$$FMTE^XLFDT(RCDT2,2),.RCCT)
D SETLINE(" ",.RCCT)
S Z=$$SETSTR^VALM1($E("BILL #"_$J("",13),1,13)_"TRANS DT"_$J("",2)_$E("TRANS "_$S(RCINOUT=1:"TO",1:"FROM")_$J("",21),1,21)_"EEOB DATE"_$J("",2)_$E("AMT PAID"_$J("",14),1,14)_"STATUS","",1,80)
D SETLINE(Z,.RCCT)
D SETLINE($TR($J("",IOM-1)," ","="),.RCCT)
I $$STOP(99,.RCSTOP,0)
Q
;
SETLINE(Z,RCCT) ; Writes line
; Z = txt to output
; RCCT = line counter
S RCCT=RCCT+1
W !,Z
Q
;
ASK(RCSTOP) ; Ask to continue
; If passed by reference ,RCSTOP is returned as 1 if print is aborted
I $E(IOST,1,2)'["C-" Q
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E" W ! D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
Q
;
STOP(CT,RCSTOP,RCPG) ; Function returns 1 if queued job/user requested forced exit
; Function returns CT if passed by ref to only check every 100 records
S CT=CT+1
I (CT#100) Q 0
I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q 1
Q 0
;
RAWBILL(RC3445,RCDAT) ; Returns bill specific data for entry in file 344.5
; RC3445 = Ien file 344.5
; FUNCTION RETURNS RCDAT(SEQ #)=Bill #^amt pd^EOB date (pass by ref)
N DAT,Z,Z0,RCT
S (RCT,Z)=0 F S Z=$O(^RCY(344.5,RC3445,2,Z)) Q:'Z S Z0=$G(^(Z,0)) D
. I +Z0=835 S RCDAT(0)=$P(Z0,U,3) Q
. I +Z0=10 S RCT=RCT+1,RCDAT(RCT)=$P(Z0,U,2)_U_$J($P(Z0,U,11)/100,"",2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPETR 8850 printed Apr 09, 2024@20:45:46 Page 2
RCDPETR ;ALB/TMK,PJH - EOB TRANSFER IN/TRANSFER OUT REPORTS ; 9/17/10 6:31pm
+1 ;;4.5;Accounts Receivable;**173,269,265**;Mar 20, 1995;Build 5
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ; IA for read access to ^IBM(361.1 = 4051
+4 QUIT
+5 ;
RPT ; Transfer In/Out Report
+1 NEW DIR,X,Y,POP,RCRPT,RCDT1,RCDT2,ZTRTN,ZTSK,ZTDESC,%ZIS
+2 SET DIR(0)="SBO^I:TRANSFER IN REPORT;O:TRANSFER OUT REPORT;B:BOTH REPORTS"
SET DIR("A")="SELECT REPORT"
DO ^DIR
KILL DIR
+3 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
GOTO RPTQ
+4 SET RCRPT=Y
+5 SET DIR("?")="ENTER THE EARLIEST TRANSFERRED FROM/TO DATE TO INCLUDE ON THE REPORT"
+6 SET DIR(0)="DAO^:"_DT_":APE"
SET DIR("A")="START DATE: "
DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
GOTO RPTQ
+8 SET RCDT1=Y
+9 SET DIR("?")="ENTER THE LATEST TRANSFERRED FROM/TO DATE TO INCLUDE ON THE REPORT"
+10 SET DIR(0)="DAO^"_RCDT1_":"_DT_":APE"
SET DIR("A")="END DATE: "
DO ^DIR
KILL DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
GOTO RPTQ
+12 SET RCDT2=Y
+13 ; Ask device
+14 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO RPTQ
+15 IF $DATA(IO("Q"))
Begin DoDot:1
+16 SET ZTRTN="EN^RCDPETR("""_RCRPT_""","""_RCDT1_""","""_RCDT2_""")"
SET ZTDESC="AR - EDI LOCKBOX TRANSFERRED EEOB REPORT"
+17 DO ^%ZTLOAD
+18 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+19 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO RPTQ
+20 USE IO
+21 DO EN(RCRPT,RCDT1,RCDT2)
RPTQ QUIT
+1 ;
EN(RCRPT,RCDT1,RCDT2) ; Entry point for queued job
+1 NEW Q,Z,Z0,Z1,Z2,ZCT,RCSTOP,RCPG,RCDAT,RCDAT1,RCCT,RCACC,RCNOT,RCRCV,RCNRCV
+2 KILL ^TMP($JOB,"RCDPE_TROUT"),^("RCDPE_TRIN")
+3 SET (RCSTOP,ZCT)=0
+4 ; Transfer out
IF RCRPT="O"!(RCRPT="B")
Begin DoDot:1
+5 SET Z=RCDT1-.0001
+6 FOR
SET Z=$ORDER(^RCY(344.4,"ATOUT",Z))
if 'Z!RCSTOP
QUIT
SET Z0=0
FOR
SET Z0=$ORDER(^RCY(344.4,"ATOUT",Z,Z0))
if 'Z0!(Z0>RCDT2)!RCSTOP
QUIT
SET Z1=0
FOR
SET Z1=$ORDER(^RCY(344.4,"ATOUT",Z,Z0,Z1))
if 'Z1
QUIT
Begin DoDot:2
+7 if $$STOP(.ZCT,.RCSTOP,0)
QUIT
+8 ; EOB transferred out was found in date range
+9 SET ^TMP($JOB,"RCDPE_TROUT",Z,Z0,Z1)=$GET(^RCY(344.4,Z0,1,Z1,0))
+10 ; sbscrpts are: date,ien file 344.4,ien file 344.41
End DoDot:2
if RCSTOP
QUIT
End DoDot:1
+11 ;
+12 ; Transfer in
IF 'RCSTOP
IF (RCRPT="I"!(RCRPT="B"))
Begin DoDot:1
+13 ; Look for accepted ones
SET Z=RCDT1-.0001
+14 ; IA 4051
FOR
SET Z=$ORDER(^IBM(361.1,"ATIN",Z))
if 'Z!(Z>RCDT2)!RCSTOP
QUIT
SET Z0=""
FOR
SET Z0=$ORDER(^IBM(361.1,"ATIN",Z,Z0))
if Z0=""!RCSTOP
QUIT
SET Z1=0
FOR
SET Z1=$ORDER(^IBM(361.1,"ATIN",Z,Z0,Z1))
if 'Z1
QUIT
Begin DoDot:2
+15 ; EOB transfer in/accepted was found in date range
+16 if $$STOP(.ZCT,.RCSTOP,0)
QUIT
+17 ; IA 4051
SET ^TMP($JOB,"RCDPE_TRIN",Z,361.1,Z0,Z1)=$GET(^IBM(361.1,Z1,0))
+18 ;sbscrpts are: date,file,transferred from name,ien file 361.1
+19 ; IA 4051
SET ^TMP($JOB,"RCDPE_TRIN",Z,361.1,Z0,Z1,7)=$GET(^IBM(361.1,Z1,7))
+20 ; IA 4051
SET ^TMP($JOB,"RCDPE_TRIN",Z,361.1,Z0,Z1,1)=$GET(^IBM(361.1,Z1,1))
End DoDot:2
if RCSTOP
QUIT
+21 if RCSTOP
QUIT
+22 ; Look for pending accept ones
SET Z=RCDT1-.0001
+23 FOR
SET Z=$ORDER(^RCY(344.5,"ATIN",Z))
if Z'!(Z>RCDT2)!RCSTOP
QUIT
SET Z0=""
FOR
SET Z0=$ORDER(^RCY(344.5,"ATIN",Z,Z0))
if Z0=""!RCSTOP
QUIT
SET Z1=0
FOR
SET Z1=$ORDER(^RCY(344.5,"ATIN",Z,Z0,Z1))
if 'Z1
QUIT
Begin DoDot:2
+24 ; EOB transfer in/pending acceptance was found in date range
+25 SET ^TMP($JOB,"RCDPE_TRIN",Z,344.5,Z0,Z1)=$GET(^RCY(344.5,Z1,0))
+26 ;sbscrpts are: date,file,transferred from name,ien file 344.5
End DoDot:2
if RCSTOP
QUIT
End DoDot:1
+27 ;
+28 if RCSTOP
GOTO ENQ
+29 SET (RCPG,RCCT,Z,RCACC,RCNOT,RCRCV,RCNRCV)=0
+30 FOR
SET Z=$ORDER(^TMP($JOB,"RCDPE_TROUT",Z))
if 'Z!RCSTOP
QUIT
SET Z0=""
FOR
SET Z0=$ORDER(^TMP($JOB,"RCDPE_TROUT",Z,Z0))
if Z0=""!RCSTOP
QUIT
SET Z1=0
FOR
SET Z1=$ORDER(^TMP($JOB,"RCDPE_TROUT",Z,Z0,Z1))
if 'Z1
QUIT
SET RCDAT=$GET(^(Z1))
Begin DoDot:1
+31 IF 'RCPG!(($Y+5)>IOSL)
DO HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2)
if RCSTOP
QUIT
+32 SET Q=$$SETSTR^VALM1($PIECE(RCDAT,U,5),"",1,11)
+33 SET Q=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(RCDAT,U,12),"2D"),Q,14,8)
+34 SET Q=$$SETSTR^VALM1($PIECE($GET(^DIC(4,+$PIECE(RCDAT,U,11),0)),U),Q,24,20)
+35 SET Q=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE($GET(^RCY(344.4,+Z0,0)),U,4),"2D"),Q,46,8)
+36 SET Q=$$SETSTR^VALM1($JUSTIFY(+$PIECE(RCDAT,U,3),"",2),Q,56,12)
+37 SET Q=$$SETSTR^VALM1($SELECT('$PIECE(RCDAT,U,16):"NOT REC'D",$PIECE(RCDAT,U,10)="":"REC'D",$PIECE(RCDAT,U,10)=0:"NOT ACCPTD",1:"ACCPTD"),Q,70,10)
+38 IF '$PIECE(RCDAT,U,16)
SET RCNRCV=RCNRCV+1
+39 IF $PIECE(RCDAT,U,16)=1
IF $PIECE(RCDAT,U,10)=""
SET RCRCV=RCRCV+1
+40 IF $PIECE(RCDAT,U,10)
SET RCACC=RCACC+1
+41 IF $PIECE(RCDAT,U,10)=0
SET RCNOT=RCNOT+1
+42 DO SETLINE(Q,.RCCT)
End DoDot:1
if RCSTOP
QUIT
+43 ;
+44 if RCSTOP
GOTO ENQ
+45 ;
+46 IF RCRPT="B"!(RCRPT="O")
Begin DoDot:1
+47 IF '$ORDER(^TMP($JOB,"RCDPE_TROUT",0))
Begin DoDot:2
+48 DO HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2)
if RCSTOP
QUIT
+49 DO SETLINE("** THERE WERE NO EEOBs TRANSFERRED OUT WITHIN THE DATE RANGE SELECTED",.RCCT)
End DoDot:2
QUIT
+50 IF ($Y+5)>IOSL
DO HDR(.RCCT,.RCPG,.RCSTOP,1,RCDT1,RCDT2)
if RCSTOP
QUIT
+51 DO SETLINE(" ",.RCCT)
+52 DO SETLINE(" TOTAL # EEOBs NOT CONFIRMED AS 'RECEIVED' BY OTHER SITES: "_RCNRCV,.RCCT)
+53 DO SETLINE(" TOTAL # EEOBs STILL JUST 'RECEIVED' BY OTHER SITES: "_RCRCV,.RCCT)
+54 DO SETLINE(" TOTAL # EEOBs ACCEPTED BY OTHER SITES: "_RCACC,.RCCT)
+55 DO SETLINE(" TOTAL # EEOBs NOT ACCEPTED BY OTHER SITES: "_RCNOT,.RCCT)
End DoDot:1
+56 ;
+57 if RCSTOP
GOTO ENQ
+58 ;
+59 IF RCPG
DO ASK(.RCSTOP)
if RCSTOP
GOTO ENQ
+60 SET (RCACC,RCNOT,RCPG)=0
+61 SET Z=0
FOR
SET Z=$ORDER(^TMP($JOB,"RCDPE_TRIN",Z))
if 'Z
QUIT
SET Z0=0
FOR
SET Z0=$ORDER(^TMP($JOB,"RCDPE_TRIN",Z,Z0))
if 'Z0
QUIT
SET Z1=""
FOR
SET Z1=$ORDER(^TMP($JOB,"RCDPE_TRIN",Z,Z0,Z1))
if Z1=""
QUIT
SET Z2=0
FOR
SET Z2=$ORDER(^TMP($JOB,"RCDPE_TRIN",Z,Z0,Z1,Z2))
if 'Z2
QUIT
Begin DoDot:1
+62 SET RCDAT=$GET(^TMP($JOB,"RCDPE_TRIN",Z,Z0,Z1,Z2))
+63 IF Z0=361.1
SET RCDAT(7)=$GET(^TMP($JOB,"RCDPE_TRIN",Z,Z0,Z1,Z2,7))
SET RCDAT(1)=$GET(^(1))
+64 IF 'RCPG!(($Y+5)>IOSL)
DO HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2)
if RCSTOP
QUIT
+65 IF Z0=361.1
Begin DoDot:2
+66 SET Q=$$SETSTR^VALM1($$BN1^PRCAFN(+RCDAT),"",1,11)
+67 SET Q=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(RCDAT,U,5),"2D"),Q,14,8)
+68 SET Q=$$SETSTR^VALM1($PIECE(RCDAT(7),U),Q,24,20)
+69 SET Q=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(RCDAT,U,6),"2D"),Q,46,8)
+70 SET Q=$$SETSTR^VALM1($JUSTIFY(+$PIECE(RCDAT(1),U),"",2),Q,56,12)
+71 SET Q=$$SETSTR^VALM1("ACCEPTED",Q,70,10)
+72 SET RCACC=RCACC+1
End DoDot:2
+73 IF '$TEST
Begin DoDot:2
+74 DO RAWBILL(Z2,.RCDAT1)
+75 SET RCDAT1=+$ORDER(RCDAT1(0))
SET RCDAT1=$GET(RCDAT1(RCDAT1))
+76 SET Q=$$SETSTR^VALM1($PIECE(RCDAT1,U),"",1,11)
+77 SET Q=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(RCDAT,U,3),"2D"),Q,14,8)
+78 SET Q=$$SETSTR^VALM1($PIECE(RCDAT,U,12),Q,24,20)
+79 SET Q=$$SETSTR^VALM1($SELECT($GET(RCDAT1(0)):$EXTRACT(RCDAT1(0),5,6)_"/"_$EXTRACT(RCDAT1(0),7,8)_"/"_$EXTRACT(RCDAT1(0),3,4),1:""),Q,46,8)
+80 SET Q=$$SETSTR^VALM1($JUSTIFY(+$PIECE(RCDAT1,U,2),"",2),Q,56,12)
+81 SET Q=$$SETSTR^VALM1("PENDING",Q,70,10)
+82 SET RCNOT=RCNOT+1
End DoDot:2
+83 DO SETLINE(Q,.RCCT)
End DoDot:1
+84 ;
+85 if RCSTOP
GOTO ENQ
+86 ;
+87 IF RCRPT="B"!(RCRPT="I")
Begin DoDot:1
+88 IF '$ORDER(^TMP($JOB,"RCDPE_TRIN",0))
Begin DoDot:2
+89 DO HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2)
if RCSTOP
QUIT
+90 DO SETLINE("** THERE WERE NO EEOBs TRANSFERRED 'IN' WITHIN THE DATE RANGE SELECTED",.RCCT)
End DoDot:2
QUIT
+91 IF ($Y+5)>IOSL
DO HDR(.RCCT,.RCPG,.RCSTOP,0,RCDT1,RCDT2)
if RCSTOP
QUIT
+92 DO SETLINE(" ",.RCCT)
+93 DO SETLINE(" TOTAL # EEOBs YOU ACCEPTED: "_RCACC,.RCCT)
+94 DO SETLINE(" TOTAL # EEOBs STILL PENDING: "_RCNOT,.RCCT)
End DoDot:1
+95 ;
ENQ IF '$DATA(ZTQUEUED)
DO ^%ZISC
IF 'RCSTOP
IF RCPG
DO ASK(.RCSTOP)
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP($JOB,"RCDPE_TROUT"),^("RCDPE_TRIN")
+3 QUIT
+4 ;
HDR(RCCT,RCPG,RCSTOP,RCINOUT,RCDT1,RCDT2) ;Prints report heading
+1 ; Function returns RCPG = current page # and RCCT = running line count
+2 ; and RCSTOP = 1 if user aborted print
+3 ; Parameters must be passed by reference
+4 NEW Z,Z0
+5 IF RCPG!($EXTRACT(IOST,1,2)="C-")
Begin DoDot:1
+6 IF RCPG&($EXTRACT(IOST,1,2)="C-")
DO ASK(.RCSTOP)
if RCSTOP
QUIT
+7 ; Write form feed
WRITE @IOF,*13
End DoDot:1
if RCSTOP
QUIT
+8 SET RCPG=RCPG+1
+9 SET Z0="EDI LOCKBOX EEOBs TRANSFERRED "_$SELECT(RCINOUT=1:"OUT",1:"IN")_" REPORT"
+10 SET Z=$$SETSTR^VALM1($JUSTIFY("",80-$LENGTH(Z0)\2)_Z0,"",1,79)
+11 SET Z=$$SETSTR^VALM1("Page: "_RCPG,Z,70,10)
+12 DO SETLINE(Z,.RCCT)
+13 SET Z0="RUN DATE: "_$$FMTE^XLFDT(DT,2)
SET Z0=$JUSTIFY("",80-$LENGTH(Z0)\2)_Z0
+14 SET Z=$$SETSTR^VALM1(Z0,"",1,79)
+15 DO SETLINE(Z,.RCCT)
+16 DO SETLINE(" ",.RCCT)
+17 DO SETLINE("DATE RANGE SELECTED: "_$$FMTE^XLFDT(RCDT1,2)_"-"_$$FMTE^XLFDT(RCDT2,2),.RCCT)
+18 DO SETLINE(" ",.RCCT)
+19 SET Z=$$SETSTR^VALM1($EXTRACT("BILL #"_$JUSTIFY("",13),1,13)_"TRANS DT"_$JUSTIFY("",2)_$EXTRACT("TRANS "_$SELECT(RCINOUT=1:"TO",1:"FROM")_$JUSTIFY("",21),1,21)_"EEOB DATE"_$JUSTIFY("",2)_$EXTRACT("AMT PAID"_$JUSTIFY("",14),1,14)_"STATUS","",1,8
0)
+20 DO SETLINE(Z,.RCCT)
+21 DO SETLINE($TRANSLATE($JUSTIFY("",IOM-1)," ","="),.RCCT)
+22 IF $$STOP(99,.RCSTOP,0)
+23 QUIT
+24 ;
SETLINE(Z,RCCT) ; Writes line
+1 ; Z = txt to output
+2 ; RCCT = line counter
+3 SET RCCT=RCCT+1
+4 WRITE !,Z
+5 QUIT
+6 ;
ASK(RCSTOP) ; Ask to continue
+1 ; If passed by reference ,RCSTOP is returned as 1 if print is aborted
+2 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 SET DIR(0)="E"
WRITE !
DO ^DIR
+5 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET RCSTOP=1
QUIT
+6 QUIT
+7 ;
STOP(CT,RCSTOP,RCPG) ; Function returns 1 if queued job/user requested forced exit
+1 ; Function returns CT if passed by ref to only check every 100 records
+2 SET CT=CT+1
+3 IF (CT#100)
QUIT 0
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (RCSTOP,ZTSTOP)=1
KILL ZTREQ
IF +$GET(RCPG)
WRITE !,"***TASK STOPPED BY USER***"
QUIT 1
+5 QUIT 0
+6 ;
RAWBILL(RC3445,RCDAT) ; Returns bill specific data for entry in file 344.5
+1 ; RC3445 = Ien file 344.5
+2 ; FUNCTION RETURNS RCDAT(SEQ #)=Bill #^amt pd^EOB date (pass by ref)
+3 NEW DAT,Z,Z0,RCT
+4 SET (RCT,Z)=0
FOR
SET Z=$ORDER(^RCY(344.5,RC3445,2,Z))
if 'Z
QUIT
SET Z0=$GET(^(Z,0))
Begin DoDot:1
+5 IF +Z0=835
SET RCDAT(0)=$PIECE(Z0,U,3)
QUIT
+6 IF +Z0=10
SET RCT=RCT+1
SET RCDAT(RCT)=$PIECE(Z0,U,2)_U_$JUSTIFY($PIECE(Z0,U,11)/100,"",2)
End DoDot:1
+7 QUIT
+8 ;
