- 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 Feb 18, 2025@23:11:55 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 ;
