IBCEQBS.m

IBCEQBS ;ALB/TMP - 837 EDI QUERY BATCH STATUS REPORTS ;05-SEP-96

 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94

 Q

QSTAT ; Query Pending Batch Transmit Status

 N IBQ,IBQ1,DIC,IBBDA,IBMSG,IBST,Y,DIR,DIRUT,DTOUT,DUOUT,Z

 S IBQ=$P($G(^IBE(350.9,1,8)),U),IBQ1=$P($G(^(8)),U,9)

 I IBQ="",IBQ1="" W !,*7,"No 837 data queues are set up" S DIR(0)="E" D ^DIR Q

 S DIC="^IBA(364.1,",DIC("S")="I $P(^(0),U,2)=""P""",DIC(0)="AEMQZ" D ^DIC

 Q:Y<0  S IBBDA=+Y

 S %ZIS="QM" D ^%ZIS Q:POP

 I $D(IO("Q")) K IO("Q") S ZTRTN="STAT^IBCEQBS",ZTSAVE("IB*")="",ZTDESC="PRINT TXMN STATUS OF PENDING BATCH" D ^%ZTLOAD K ZTSK D HOME^%ZIS Q

 U IO

 D STAT

 Q

 ;

STAT ; Queued job entrypoint

 N Y

 W:$E(IOST,1,2)["C-" @IOF

 W !,"PENDING BATCH TRANSMISSION STATUS REPORT",?50,"Run Date: ",$$HTE^XLFDT($H,"2P"),!

 S Y=IBBDA,Y(0)=$G(^IBA(364.1,IBBDA,0)),Y(1)=$G(^(1))

 S:$P(Y(0),U,14) IBQ=IBQ1

 S IBMSG=$P(Y(0),U,4),Y(1)=$G(^IBA(364.1,+Y,1)),IBST=$$STATUS^XMS1(IBMSG,"XXX@Q-"_IBQ_".DOMAIN.EXT")

 W !,"Status of batch ",$P(Y,U,2)," (mail message #: ",IBMSG,"): ",$S(IBST'="":IBST,1:"Sent")

 S Z=$$EXPAND^IBTRE(364.1,1.02,$P(Y(1),U,2))

 W !!,"First Sent: ",$$FMTE^XLFDT(+Y(1),"2P"),?35,"By: ",$S(Z'="":Z,1:"Unknown")

 S Z=$$EXPAND^IBTRE(364.1,1.04,$P(Y(1),U,4))

 W !," Last Sent: ",$$FMTE^XLFDT($P(Y(1),U,3),"2P"),?35,"By: ",$S(Z'="":Z,1:"Unknown")

 D ^%ZISC

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCEQBS   1358     printed  Apr 09, 2024@21:05:30                                                                                                                                                                                                     Page 2

IBCEQBS   ;ALB/TMP - 837 EDI QUERY BATCH STATUS REPORTS ;05-SEP-96

 +1       ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94

 +2        QUIT 

QSTAT     ; Query Pending Batch Transmit Status

 +1        NEW IBQ,IBQ1,DIC,IBBDA,IBMSG,IBST,Y,DIR,DIRUT,DTOUT,DUOUT,Z

 +2        SET IBQ=$PIECE($GET(^IBE(350.9,1,8)),U)

           SET IBQ1=$PIECE($GET(^(8)),U,9)

 +3        IF IBQ=""

               IF IBQ1=""

                   WRITE !,*7,"No 837 data queues are set up"

                   SET DIR(0)="E"

                   DO ^DIR

                   QUIT 

 +4        SET DIC="^IBA(364.1,"

           SET DIC("S")="I $P(^(0),U,2)=""P"""

           SET DIC(0)="AEMQZ"

           DO ^DIC

 +5        if Y<0

               QUIT 

           SET IBBDA=+Y

 +6        SET %ZIS="QM"

           DO ^%ZIS

           if POP

               QUIT 

 +7        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="STAT^IBCEQBS"

               SET ZTSAVE("IB*")=""

               SET ZTDESC="PRINT TXMN STATUS OF PENDING BATCH"

               DO ^%ZTLOAD

               KILL ZTSK

               DO HOME^%ZIS

               QUIT 

 +8        USE IO

 +9        DO STAT

 +10       QUIT 

 +11      ;

STAT      ; Queued job entrypoint

 +1        NEW Y

 +2        if $EXTRACT(IOST,1,2)["C-"

               WRITE @IOF

 +3        WRITE !,"PENDING BATCH TRANSMISSION STATUS REPORT",?50,"Run Date: ",$$HTE^XLFDT($HOROLOG,"2P"),!

 +4        SET Y=IBBDA

           SET Y(0)=$GET(^IBA(364.1,IBBDA,0))

           SET Y(1)=$GET(^(1))

 +5        if $PIECE(Y(0),U,14)

               SET IBQ=IBQ1

 +6        SET IBMSG=$PIECE(Y(0),U,4)

           SET Y(1)=$GET(^IBA(364.1,+Y,1))

           SET IBST=$$STATUS^XMS1(IBMSG,"XXX@Q-"_IBQ_".DOMAIN.EXT")

 +7        WRITE !,"Status of batch ",$PIECE(Y,U,2)," (mail message #: ",IBMSG,"): ",$SELECT(IBST'="":IBST,1:"Sent")

 +8        SET Z=$$EXPAND^IBTRE(364.1,1.02,$PIECE(Y(1),U,2))

 +9        WRITE !!,"First Sent: ",$$FMTE^XLFDT(+Y(1),"2P"),?35,"By: ",$SELECT(Z'="":Z,1:"Unknown")

 +10       SET Z=$$EXPAND^IBTRE(364.1,1.04,$PIECE(Y(1),U,4))

 +11       WRITE !," Last Sent: ",$$FMTE^XLFDT($PIECE(Y(1),U,3),"2P"),?35,"By: ",$SELECT(Z'="":Z,1:"Unknown")

 +12       DO ^%ZISC

 +13       QUIT 

 +14      ;