Routine: PSXREJ

PSXREJ ;BIR/BAB-Rejected Messages Report ;04/08/97  2:06 PM

 ;;2.0;CMOP;**38**;11 Apr 97

EN ;GET BEGIN DATE

 S %DT="AEX",%DT("A")="ENTER BEGINNING DATE:  ",%DT("B")="NOW",%DT(0)="-NOW" D ^%DT K %DT,%DT(0),%DT("A"),%DT("B") G:$G(Y)<0!($D(DTOUT)) EXIT

 S PSXA=$P(Y,".",1),START=$$FMTE^XLFDT(Y,"1D")

ENDATE ;GET ENDING DATE

 S %DT="AEX",%DT("A")="ENTER ENDING DATE:  ",%DT("B")="NOW",%DT(0)="-NOW" D ^%DT K %DT,%DT(0),%DT("A"),%DT("B") G:$G(Y)<0!($D(DTOUT)) EXIT

 S PSXE=$P(Y,".",1),FINISH=$$FMTE^XLFDT(Y,"1D")

 K X,Y

 I PSXE<PSXA W !,"Ending date must follow beginning date!" G ENDATE

 S PSXA=PSXA-.00001,PSXE=PSXE+.99999

END S %ZIS="Q" D ^%ZIS S PSXLION=ION I POP W !,"No Device Selected" G EXIT

 I $D(IO("Q")) D QUE G EXIT

 D START,EXIT

QUE ;

 S ZTRTN="START^PSXREJ",ZTDESC="CMOP Rejected Messages Report"

 S ZTSAVE("PSXB")="",ZTSAVE("PSXDA")=""

 S ZTSAVE("PSXLION")="",ZTSAVE("PSXA")="",ZTSAVE("PSXE")=""

 S ZTSAVE("START")="",ZTSAVE("FINISH")=""

 S ZTIO=PSXLION D ^%ZTLOAD

 I $D(ZTSK)[0 W !!,"Job Canceled"

 E  W !!,"Job Queued"

 D HOME^%ZIS Q

 ;Called by Taskman to start the Rejected Messages Report

START ;

 U IO

 F  S PSXA=$O(^PSX(552.1,"AP",PSXA)) Q:(PSXA']""!(PSXA>PSXE))  D

 .S PSXB="" F  S PSXB=$O(^PSX(552.1,"AP",PSXA,PSXB)) Q:($G(PSXB)']"")  S PSXDA=$O(^PSX(552.1,"AP",PSXA,PSXB,0)) D REF

 I '$G(PSXFLAG) W !!,"There were no rejected messages for the date range selected: ",START," to ",FINISH

 G EXIT

REF ;

 I '$D(^PSX(552.2,"AR",PSXB)) Q

 Q:'$D(^PSX(552.1,PSXDA,0))

 S SITEN=+$P(^PSX(552.1,PSXDA,0),U,1)

 Q:$G(SITEN)']""

 ;S X=SITEN,DIC="4",DIC(0)="MOZX" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S ST=+Y,SITE=$P(Y,"^",2),PHAR=$P(^PSX(552.1,PSXDA,"P"),U,1) ;****DOD L1

 S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S ST=$$IEN^XUMF(4,AGNCY,X),SITE=$$GET1^DIQ(4,ST,.01),PHAR=$P(^PSX(552.1,PSXDA,"P"),U,1) ;****DOD L1

 S X=$P(^PSX(552.1,PSXDA,0),U,4),TDTM=$$FMTE^XLFDT(X,"1P")

 S TOTRX=$P($G(^PSX(552.1,PSXDA,1)),U,4)

 S TOTORD=$P($G(^PSX(552.1,PSXDA,1)),U,3)

 S OR1=0

 S (REC,CNT)=0 D SUB F  S REC=$O(^PSX(552.2,"AR",PSXB,REC)) Q:REC'>0  D GETDATA

 ;G EXIT

GETDATA ;

 S ORDER=$P($G(^PSX(552.2,REC,0)),"^") S ZZ=0

 K REASON S REASON=$P($P($G(^PSX(552.2,REC,"ACK")),"MSA|",2),"|",3)

 F  S ZZ=$O(^PSX(552.2,REC,"T",ZZ)) Q:ZZ'>0  S NODE=$G(^PSX(552.2,REC,"T",ZZ,0)) D

 .Q:$E(NODE,1,4)["MSH|"!($E(NODE,1,4)["NTE|")

 .I $E(NODE,1,4)["PID|" S NM=$P(NODE,"|",6),SS=$P($P(NODE,"|",4),"^",1),SSN=$E(SS,1,3)_"-"_$E(SS,4,5)_"-"_$E(SS,6,9),NAME=$P(NM,"^",1)_", "_$P(NM,"^",2)

 .I $E(NODE,1,4)["ORC|" S ZX=ZZ F  S ZX=$O(^PSX(552.2,REC,"T",ZX)) Q:ZX'>0  S TNODE=$G(^PSX(552.2,REC,"T",ZX,0)) D

 ..Q:$E(TNODE,1,4)["NTE|"

 ..I $E(TNODE,1,4)["ORC|" S ZZ=ZX Q

 ..I $E(TNODE,1,4)["RX1|" S DRUGNUM=$P($P(TNODE,"|",15),"^",1),DRUGNM=$P($P(TNODE,"|",15),"^",2),ISSDATE=$P(TNODE,"|",21),EXDATE=$P(TNODE,"|",25),RXNUM=$P(TNODE,"|",27),IDATE=$E(ISSDATE,5,6)_"/"_$E(ISSDATE,7,8)_"/"_$E(ISSDATE,3,4) D  Q

 ...S EDATE=$E(EXDATE,5,6)_"/"_$E(EXDATE,7,8)_"/"_$E(EXDATE,3,4)

 ..I $E(TNODE,1,4)["ZX1|" S BAR=$P(TNODE,"|",16) D LIST Q

 ..D LIST

EXIT K TTNODE,IDATE,EDATE,BAR,BRUGNUM,EXDATE,ISSDATE,TNODE,DRUGNM,RXNUM,NODE,NEXT,NEXT2,NM,SS,ZZ,BAT,PHAR,SITE,ST,TDTM,LINE,CNT,TOTORD,TOTRX,RECD,SITEN,X,BEG,END,PSOION,PSXLION,DIC,Y,PSXA,PSXE,PSX1

 K %ZIS,I,NAME,ORDER,PSXB,PSXDA,REC,SSN,ZTDESC,ZTIO,ZTSAVE,ZTSK,ZX,PSXFLAG,DIROUT,DIRUT,DTOUT,DUOUT,DIR,FINISH

 K %DT,%DT(0),%DT("A"),%DT("B")

 D ^%ZISC I $D(IO("Q")) K IO("Q")

 S:$D(ZTQUEUED) ZTREQ="@"

SUB W @IOF,?18,"CMOP Rejected Messages for Transmission # ",PSXB,!

 D NOW^%DTC S Y=% X ^DD("DD") W ?23,"Printed : ",Y,!! K Y,%

 W "Facility : ",SITE,?40,"Division:  ",PHAR

 W !,"Received on  ",$P(TDTM,":",1,2),?40,"Total Orders:  ",TOTORD,?60,"Total Rx's:  ",TOTRX,!

SUB1 W !,"ORDER",?15,"NAME",?28,"RX NUMBER",?39,"BAR CODE",?54,"DRUG NAME"

 W ! S LINE="-" F I=0:1:79 W LINE

 W ! S CNT=CNT+6

LIST I ORDER'=OR1 W !!,$P(ORDER,"-",3),"  REJECTED REASON:   ",REASON

 W !,?6,$S($G(NAME1)'=NAME:$E(NAME,1,20),1:"")

 W ?28,RXNUM,?39,BAR,?54,$E(DRUGNM,1,25)

 S NAME1=NAME

 S CNT=CNT+1,OR1=ORDER,PSXFLAG=1

 I CNT>56 D SUB1 S CNT=0

 K DRUGNUM,DRUGNM,RXNUM,ISSDATE,EXDATE,BAR,REASON

PSXREJ    ;BIR/BAB-Rejected Messages Report ;04/08/97  2:06 PM

 +1       ;;2.0;CMOP;**38**;11 Apr 97

EN        ;GET BEGIN DATE

 +1        SET %DT="AEX"

           SET %DT("A")="ENTER BEGINNING DATE:  "

           SET %DT("B")="NOW"

           SET %DT(0)="-NOW"

           DO ^%DT

           KILL %DT,%DT(0),%DT("A"),%DT("B")

           IF $GET(Y)<0!($DATA(DTOUT))

               GOTO EXIT

 +2        SET PSXA=$PIECE(Y,".",1)

           SET START=$$FMTE^XLFDT(Y,"1D")

ENDATE    ;GET ENDING DATE

 +1        SET %DT="AEX"

           SET %DT("A")="ENTER ENDING DATE:  "

           SET %DT("B")="NOW"

           SET %DT(0)="-NOW"

           DO ^%DT

           KILL %DT,%DT(0),%DT("A"),%DT("B")

           IF $GET(Y)<0!($DATA(DTOUT))

               GOTO EXIT

 +2        SET PSXE=$PIECE(Y,".",1)

           SET FINISH=$$FMTE^XLFDT(Y,"1D")

 +3        KILL X,Y

 +4        IF PSXE<PSXA

               WRITE !,"Ending date must follow beginning date!"

               GOTO ENDATE

 +5        SET PSXA=PSXA-.00001

           SET PSXE=PSXE+.99999

END        SET %ZIS="Q"

           DO ^%ZIS

           SET PSXLION=ION

           IF POP

               WRITE !,"No Device Selected"

               GOTO EXIT

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

               DO QUE

               GOTO EXIT

 +2        DO START

           DO EXIT

 +3        QUIT

QUE       ;

 +1        SET ZTRTN="START^PSXREJ"

           SET ZTDESC="CMOP Rejected Messages Report"

 +2        SET ZTSAVE("PSXB")=""

           SET ZTSAVE("PSXDA")=""

 +3        SET ZTSAVE("PSXLION")=""

           SET ZTSAVE("PSXA")=""

           SET ZTSAVE("PSXE")=""

 +4        SET ZTSAVE("START")=""

           SET ZTSAVE("FINISH")=""

 +5        SET ZTIO=PSXLION

           DO ^%ZTLOAD

 +6        IF $DATA(ZTSK)[0

               WRITE !!,"Job Canceled"

 +7       IF '$TEST

               WRITE !!,"Job Queued"

 +8        DO HOME^%ZIS

           QUIT

 +9       ;Called by Taskman to start the Rejected Messages Report

START     ;

 +1        USE IO

 +2        FOR

               SET PSXA=$ORDER(^PSX(552.1,"AP",PSXA))

               IF (PSXA']""!(PSXA>PSXE))

                   QUIT

               Begin DoDot:1

 +3                SET PSXB=""

FOR

                       SET PSXB=$ORDER(^PSX(552.1,"AP",PSXA,PSXB))

                       IF ($GET(PSXB)']"")

                           QUIT

                       SET PSXDA=$ORDER(^PSX(552.1,"AP",PSXA,PSXB,0))

                       DO REF

               End DoDot:1

 +4        IF '$GET(PSXFLAG)

               WRITE !!,"There were no rejected messages for the date range selected: ",START," to ",FINISH

 +5        GOTO EXIT

REF       ;

 +1        IF '$DATA(^PSX(552.2,"AR",PSXB))

               QUIT

 +2        IF '$DATA(^PSX(552.1,PSXDA,0))

               QUIT

 +3        SET SITEN=+$PIECE(^PSX(552.1,PSXDA,0),U,1)

 +4        IF $GET(SITEN)']""

               QUIT

 +5       ;S X=SITEN,DIC="4",DIC(0)="MOZX" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S ST=+Y,SITE=$P(Y,"^",2),PHAR=$P(^PSX(552.1,PSXDA,"P"),U,1) ;****DOD L1

 +6       ;****DOD L1

           SET X=SITEN

           SET AGNCY="VASTANUM"

           IF $DATA(^PSX(552,"D",X))

               SET X=$EXTRACT(X,2,99)

               SET AGNCY="DMIS"

           SET ST=$$IEN^XUMF(4,AGNCY,X)

           SET SITE=$$GET1^DIQ(4,ST,.01)

           SET PHAR=$PIECE(^PSX(552.1,PSXDA,"P"),U,1)

 +7        SET X=$PIECE(^PSX(552.1,PSXDA,0),U,4)

           SET TDTM=$$FMTE^XLFDT(X,"1P")

 +8        SET TOTRX=$PIECE($GET(^PSX(552.1,PSXDA,1)),U,4)

 +9        SET TOTORD=$PIECE($GET(^PSX(552.1,PSXDA,1)),U,3)

 +10      ;

 +11      ;

 +12       SET OR1=0

 +13       SET (REC,CNT)=0

           DO SUB

FOR

               SET REC=$ORDER(^PSX(552.2,"AR",PSXB,REC))

               IF REC'>0

                   QUIT

               DO GETDATA

 +14      ;G EXIT

 +15       QUIT

GETDATA   ;

 +1        SET ORDER=$PIECE($GET(^PSX(552.2,REC,0)),"^")

           SET ZZ=0

 +2        KILL REASON

           SET REASON=$PIECE($PIECE($GET(^PSX(552.2,REC,"ACK")),"MSA|",2),"|",3)

 +3        FOR

               SET ZZ=$ORDER(^PSX(552.2,REC,"T",ZZ))

               IF ZZ'>0

                   QUIT

               SET NODE=$GET(^PSX(552.2,REC,"T",ZZ,0))

               Begin DoDot:1

 +4                IF $EXTRACT(NODE,1,4)["MSH|"!($EXTRACT(NODE,1,4)["NTE|")

                       QUIT

 +5                IF $EXTRACT(NODE,1,4)["PID|"

                       SET NM=$PIECE(NODE,"|",6)

                       SET SS=$PIECE($PIECE(NODE,"|",4),"^",1)

                       SET SSN=$EXTRACT(SS,1,3)_"-"_$EXTRACT(SS,4,5)_"-"_$EXTRACT(SS,6,9)

                       SET NAME=$PIECE(NM,"^",1)_", "_$PIECE(NM,"^",2)

 +6                IF $EXTRACT(NODE,1,4)["ORC|"

                       SET ZX=ZZ

FOR

                           SET ZX=$ORDER(^PSX(552.2,REC,"T",ZX))

                           IF ZX'>0

                               QUIT

                           SET TNODE=$GET(^PSX(552.2,REC,"T",ZX,0))

                           Begin DoDot:2

 +7                            IF $EXTRACT(TNODE,1,4)["NTE|"

                                   QUIT

 +8                            IF $EXTRACT(TNODE,1,4)["ORC|"

                                   SET ZZ=ZX

                                   QUIT

 +9                            IF $EXTRACT(TNODE,1,4)["RX1|"

                                   SET DRUGNUM=$PIECE($PIECE(TNODE,"|",15),"^",1)

                                   SET DRUGNM=$PIECE($PIECE(TNODE,"|",15),"^",2)

                                   SET ISSDATE=$PIECE(TNODE,"|",21)

                                   SET EXDATE=$PIECE(TNODE,"|",25)

                                   SET RXNUM=$PIECE(TNODE,"|",27)

                                   SET IDATE=$EXTRACT(ISSDATE,5,6)_"/"_$EXTRACT(ISSDATE,7,8)_"/"_$EXTRACT(ISSDATE,3,4)

                                   Begin DoDot:3

 +10                                   SET EDATE=$EXTRACT(EXDATE,5,6)_"/"_$EXTRACT(EXDATE,7,8)_"/"_$EXTRACT(EXDATE,3,4)

                                   End DoDot:3

                                   QUIT

 +11                           IF $EXTRACT(TNODE,1,4)["ZX1|"

                                   SET BAR=$PIECE(TNODE,"|",16)

                                   DO LIST

                                   QUIT

 +12                           DO LIST

                           End DoDot:2

               End DoDot:1

 +13       QUIT

EXIT       KILL TTNODE,IDATE,EDATE,BAR,BRUGNUM,EXDATE,ISSDATE,TNODE,DRUGNM,RXNUM,NODE,NEXT,NEXT2,NM,SS,ZZ,BAT,PHAR,SITE,ST,TDTM,LINE,CNT,TOTORD,TOTRX,RECD,SITEN,X,BEG,END,PSOION,PSXLION,DIC,Y,PSXA,PSXE,PSX1

 +1        KILL %ZIS,I,NAME,ORDER,PSXB,PSXDA,REC,SSN,ZTDESC,ZTIO,ZTSAVE,ZTSK,ZX,PSXFLAG,DIROUT,DIRUT,DTOUT,DUOUT,DIR,FINISH

 +2        KILL %DT,%DT(0),%DT("A"),%DT("B")

 +3        DO ^%ZISC

           IF $DATA(IO("Q"))

               KILL IO("Q")

 +4        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +5        QUIT

SUB        WRITE @IOF,?18,"CMOP Rejected Messages for Transmission # ",PSXB,!

 +1        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

           WRITE ?23,"Printed : ",Y,!!

           KILL Y,%

 +2        WRITE "Facility : ",SITE,?40,"Division:  ",PHAR

 +3        WRITE !,"Received on  ",$PIECE(TDTM,":",1,2),?40,"Total Orders:  ",TOTORD,?60,"Total Rx's:  ",TOTRX,!

SUB1       WRITE !,"ORDER",?15,"NAME",?28,"RX NUMBER",?39,"BAR CODE",?54,"DRUG NAME"

 +1        WRITE !

           SET LINE="-"

           FOR I=0:1:79

               WRITE LINE

 +2        WRITE !

           SET CNT=CNT+6

 +3        QUIT

LIST       IF ORDER'=OR1

               WRITE !!,$PIECE(ORDER,"-",3),"  REJECTED REASON:   ",REASON

 +1        WRITE !,?6,$SELECT($GET(NAME1)'=NAME:$EXTRACT(NAME,1,20),1:"")

 +2        WRITE ?28,RXNUM,?39,BAR,?54,$EXTRACT(DRUGNM,1,25)

 +3        SET NAME1=NAME

 +4        SET CNT=CNT+1

           SET OR1=ORDER

           SET PSXFLAG=1

 +5        IF CNT>56

               DO SUB1

               SET CNT=0

 +6        KILL DRUGNUM,DRUGNM,RXNUM,ISSDATE,EXDATE,BAR,REASON

 +7        QUIT

PSXREJ.m