IBCERP4 ;ALB/TMP - EDI RECEIPT/REJECTION MSGS STILL PENDING/UPDATNG ; 4/22/03 8:29am
;;2.0;INTEGRATED BILLING;**137,211**;21-MAR-94
Q
PENDING ; Report of EDI messages still waiting to be filed
; after a user-specified # of days.
N DIR,IBDAYS
W !!
S DIR(0)="NA^1:999",DIR("B")=1,DIR("A")="MINIMUM # OF DAYS MSGS WAITING TO BE FILED: ",DIR("?",1)="Enter the minimum number of days a message has been waiting to be filed",DIR("?")="before it appears on this report" D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
S IBDAYS=+Y
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) K IO("Q") S ZTSAVE("IB*")="",ZTRTN="EN^IBCERP4",ZTDESC="REPORT OF EDI MSGS PENDING TOO LONG TO BE FILED" D ^%ZTLOAD K ZTSK D HOME^%ZIS Q
U IO
EN ; Queued job entrypoint
N IBPAGE,IBHDRDT,IBLINE,IBSTOP,IBDA,IBCT,IBM,IBMSG,IB0,IB1,IB,DIR,Y
;
K ^TMP($J,"IBSORT")
S IBDA=0 F S IBDA=$O(^IBA(364.2,IBDA)) Q:'IBDA S IB0=$G(^IBA(364.2,IBDA,0)),IB1=$G(^(1)),IBM=+$P(IB0,U,2) D
.; IB*2.0*211 - kill off records with dangling nodes
. I IB0="",IB1'="" N DA,DIK,Y S DA=IBDA,DIK="^IBA(364.2," D ^DIK Q
. I DT-($P(IB1,U,3)\1)'<IBDAYS,'$P(IB0,U,12) D
.. S ^TMP($J,"IBSORT",$P(IB0,U),IBDA)=$P(IB0,U)_U_$P(IB0,U,6)_U_$P(IB1,U,3)_U_$P(IB0,U,4,5),$P(^(IBDA),U,6)=IBM
;
W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
;
S (IBPAGE,IBSTOP,IBCT,IBMSG,IBLINE)=0
D HDR1
I '$D(^TMP($J,"IBSORT")) W !,"No data found for this report",!
F S IBMSG=$O(^TMP($J,"IBSORT",IBMSG)) Q:'IBMSG!(IBSTOP) S IBDA=0 F S IBDA=$O(^TMP($J,"IBSORT",IBMSG,IBDA)) Q:'IBDA S IBV=$G(^(IBDA)) D Q:IBSTOP
. D:IBLINE>(IOSL-5) HDR1 Q:IBSTOP
. W !,?2,$P($G(^IBE(364.3,+$P(IBV,U,6),0)),U,5)
. W !,?4,$P(IBV,U),?15,$$EXPAND^IBTRE(364.2,.06,$P(IBV,U,2)),?31,$$FMTE^XLFDT($P(IBV,U,3),1),?54,$$EXPAND^IBTRE(364.2,.04,$P(IBV,U,4))
. S Z=$$BN1^PRCAFN(+$G(^IBA(364,+$P(IBV,U,5),0)))
. I Z'=-1 W ?65,Z
. S IBCT=IBCT+1,IBLINE=IBLINE+1
;
W !!,"TOTAL # OF MESSAGES WAITING OVER "_IBDAYS_" DAY"_$S(IBDAYS>1:"S",1:"")_" TO BE FILED: ",IBCT
;
I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
STOP I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP($J,"IBSORT")
Q
;
HDR1 ; Report header
;IB = the text for the type of batch
N Z,DIR,Y
I 'IBPAGE S IBHDRDT=$$HTE^XLFDT($H,"2")
I IBPAGE D Q:IBSTOP
. I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) Q:IBSTOP
. W @IOF
;
S IBPAGE=IBPAGE+1,Z="EDI MESSAGES WAITING TO BE FILED OVER "_IBDAYS_" DAY"_$S(IBDAYS>1:"S",1:"")
W !,?((80-$L(Z))\2),Z,?70,"PAGE: ",IBPAGE,!
W !,?26,"RUN DATE: ",IBHDRDT,!
W !,?2,"MESSAGE TYPE"
W !,?4,"MAIL",?31,"IN CURRENT",!,?4,"MESSAGE #",?15,"CURRENT STATUS",?31,"STATUS SINCE",?54,"BATCH #",?65,"BILL #",!
S Z="",$P(Z,"-",76)="" W ?2,Z,!
S IBLINE=7
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCERP4 2774 printed Apr 09, 2024@21:35 Page 2
IBCERP4 ;ALB/TMP - EDI RECEIPT/REJECTION MSGS STILL PENDING/UPDATNG ; 4/22/03 8:29am
+1 ;;2.0;INTEGRATED BILLING;**137,211**;21-MAR-94
+2 QUIT
PENDING ; Report of EDI messages still waiting to be filed
+1 ; after a user-specified # of days.
+2 NEW DIR,IBDAYS
+3 WRITE !!
+4 SET DIR(0)="NA^1:999"
SET DIR("B")=1
SET DIR("A")="MINIMUM # OF DAYS MSGS WAITING TO BE FILED: "
SET DIR("?",1)="Enter the minimum number of days a message has been waiting to be filed"
SET DIR("?")="before it appears on this report"
DO ^DIR
KILL DIR
+5 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 SET IBDAYS=+Y
+7 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+8 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTSAVE("IB*")=""
SET ZTRTN="EN^IBCERP4"
SET ZTDESC="REPORT OF EDI MSGS PENDING TOO LONG TO BE FILED"
DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
QUIT
+9 USE IO
EN ; Queued job entrypoint
+1 NEW IBPAGE,IBHDRDT,IBLINE,IBSTOP,IBDA,IBCT,IBM,IBMSG,IB0,IB1,IB,DIR,Y
+2 ;
+3 KILL ^TMP($JOB,"IBSORT")
+4 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBA(364.2,IBDA))
if 'IBDA
QUIT
SET IB0=$GET(^IBA(364.2,IBDA,0))
SET IB1=$GET(^(1))
SET IBM=+$PIECE(IB0,U,2)
Begin DoDot:1
+5 ; IB*2.0*211 - kill off records with dangling nodes
+6 IF IB0=""
IF IB1'=""
NEW DA,DIK,Y
SET DA=IBDA
SET DIK="^IBA(364.2,"
DO ^DIK
QUIT
+7 IF DT-($PIECE(IB1,U,3)\1)'<IBDAYS
IF '$PIECE(IB0,U,12)
Begin DoDot:2
+8 SET ^TMP($JOB,"IBSORT",$PIECE(IB0,U),IBDA)=$PIECE(IB0,U)_U_$PIECE(IB0,U,6)_U_$PIECE(IB1,U,3)_U_$PIECE(IB0,U,4,5)
SET $PIECE(^(IBDA),U,6)=IBM
End DoDot:2
End DoDot:1
+9 ;
+10 ;Only initial form feed for print to screen
if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+11 ;
+12 SET (IBPAGE,IBSTOP,IBCT,IBMSG,IBLINE)=0
+13 DO HDR1
+14 IF '$DATA(^TMP($JOB,"IBSORT"))
WRITE !,"No data found for this report",!
+15 FOR
SET IBMSG=$ORDER(^TMP($JOB,"IBSORT",IBMSG))
if 'IBMSG!(IBSTOP)
QUIT
SET IBDA=0
FOR
SET IBDA=$ORDER(^TMP($JOB,"IBSORT",IBMSG,IBDA))
if 'IBDA
QUIT
SET IBV=$GET(^(IBDA))
Begin DoDot:1
+16 if IBLINE>(IOSL-5)
DO HDR1
if IBSTOP
QUIT
+17 WRITE !,?2,$PIECE($GET(^IBE(364.3,+$PIECE(IBV,U,6),0)),U,5)
+18 WRITE !,?4,$PIECE(IBV,U),?15,$$EXPAND^IBTRE(364.2,.06,$PIECE(IBV,U,2)),?31,$$FMTE^XLFDT($PIECE(IBV,U,3),1),?54,$$EXPAND^IBTRE(364.2,.04,$PIECE(IBV,U,4))
+19 SET Z=$$BN1^PRCAFN(+$GET(^IBA(364,+$PIECE(IBV,U,5),0)))
+20 IF Z'=-1
WRITE ?65,Z
+21 SET IBCT=IBCT+1
SET IBLINE=IBLINE+1
End DoDot:1
if IBSTOP
QUIT
+22 ;
+23 WRITE !!,"TOTAL # OF MESSAGES WAITING OVER "_IBDAYS_" DAY"_$SELECT(IBDAYS>1:"S",1:"")_" TO BE FILED: ",IBCT
+24 ;
+25 IF $EXTRACT(IOST,1,2)["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
STOP IF '$DATA(ZTQUEUED)
DO ^%ZISC
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP($JOB,"IBSORT")
+3 QUIT
+4 ;
HDR1 ; Report header
+1 ;IB = the text for the type of batch
+2 NEW Z,DIR,Y
+3 IF 'IBPAGE
SET IBHDRDT=$$HTE^XLFDT($HOROLOG,"2")
+4 IF IBPAGE
Begin DoDot:1
+5 IF $EXTRACT(IOST,1,2)["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET IBSTOP=('Y)
if IBSTOP
QUIT
+6 WRITE @IOF
End DoDot:1
if IBSTOP
QUIT
+7 ;
+8 SET IBPAGE=IBPAGE+1
SET Z="EDI MESSAGES WAITING TO BE FILED OVER "_IBDAYS_" DAY"_$SELECT(IBDAYS>1:"S",1:"")
+9 WRITE !,?((80-$LENGTH(Z))\2),Z,?70,"PAGE: ",IBPAGE,!
+10 WRITE !,?26,"RUN DATE: ",IBHDRDT,!
+11 WRITE !,?2,"MESSAGE TYPE"
+12 WRITE !,?4,"MAIL",?31,"IN CURRENT",!,?4,"MESSAGE #",?15,"CURRENT STATUS",?31,"STATUS SINCE",?54,"BATCH #",?65,"BILL #",!
+13 SET Z=""
SET $PIECE(Z,"-",76)=""
WRITE ?2,Z,!
+14 SET IBLINE=7
+15 QUIT
+16 ;
