PSXRPT ;BIR/WPB,HTW-Routine to Generate Reports at the CMOP Host Facility ;04/08/97  2:06 PM
 ;;2.0;CMOP;**38**;11 Apr 97
PRINT S FROM=$P($G(^PSX(552.1,REC,"P")),U,1),BB=$P($G(^PSX(552.1,REC,0)),U,1)
 S BAT=$P($G(BB),"-",2),RESP="",STA1=$P($G(BB),"-")
 ;I $G(STA1)]"" S X=STA1,DIC="4",DIC(0)="XMZO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC  S STA2=+Y,STATION=$P(Y,"^",2) K DIC,Y,X ;****DOD L1
 I $G(STA1)]"" S X=STA1,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S STA2=$$IEN^XUMF(4,AGNCY,X),STATION=$$NAME^XUAF4(STA2) K AGNCY,Y,X ;****DOD L1
 S ORDS=$P($G(^PSX(552.1,REC,1)),U,3),RXS=$P($G(^(1)),U,4)
 S SS=$P($G(^PSX(552.1,REC,0)),U,2)
 S STAT=$S(SS=2:"Queued",SS=3:"Processed",SS=4:"Closed",SS=5:"Hold",SS=6:"Printed",SS=99:"Rejected",1:"")
 S Y=RDTTM X ^DD("DD") S RDTTM=Y K Y S RDTTM=$P(RDTTM,":",1,2)
 W !,RDTTM,?19,FROM,?43,BB,?59,$J(ORDS,5),?68,$J(RXS,5),?75,$E(STAT,1,4) S LN=LN+1
 ;W !,RDTTM,?20,FROM,?44,BB,?54,$J(ORDS,5),?63,$J(RXS,5),?70,STAT S LN=LN+1
 I $G(IOST)["C-" D
 .Q:LN<22
 .I LN>21 S RESP="",LN=0,DIR(0)="E" D ^DIR S:(Y='1)!($D(DTOUT)) RESP="^" K DIR Q:Y'=1  K Y,X,DIRUT,DIROUT,DTOUT,DUOUT
 .S LN=0
 .W @IOF,!
 .W !,?29,"TRANSMISSIONS "_$S(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
 .W !,?30,RDATE,!! S LN=LN+3
 .;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
 .;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
 .W "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
 .W "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
 .S LL="-" F JJ=0:1:79 W LL
 .W ! S LN=LN+3
 I $G(IOST)'["C-"&(LN>60) D
 .S LN=0
 .W @IOF,!
 .W !,?29,"TRANSMISSIONS "_$S(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
 .W !,?30,RDATE,!! S LN=LN+3
 .;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
 .;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
 .W "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
 .W "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
 .S LL="-" F JJ=0:1:79 W LL
 .W ! S LN=LN+4
 Q:$G(RESP)="^"
 S NEXT=REC+1
 Q:'$D(^PSX(552.1,NEXT,0))
 Q
EXIT I '$G(POP) S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
EXIT1 W @IOF K RPT,XX,DATE,RDATE,Y,%,X,FROM,ORDS,RXS,BB,STAT,RESP,RDT,RDTTM,LL,BAT,REC,SS,SITE,JJ,LN,NEXT,STA1,STA2,STATION,COM,COM2,EE,END,ORD,REVD,SP,SP1,SP2,TBB,X1,XT,XY
 K ZTRTN,ZTIO,PSXLION,ZTDESC,ZTSAVE,ZTSK,%ZIS,DIR,DTOUT,DIROUT,DUOUT,DIRUT,^TMP($J,"PSXRPT")
 I $G(IOST)'["C-" W @IOF
 D ^%ZISC
 S:$D(ZTQUEUED) ZTREQ="@"
 Q
QUE S ZTRTN="RPT^PSXRPT",ZTIO=PSXLION,ZTSAVE("RDT")="",ZTSAVE("RPT")="",ZTSAVE("END")="",ZTSAVE("TBB")="",ZTSAVE("ORD")="",ZTDESC="CMOP Transmission Report Summary" D ^%ZTLOAD
 I $D(ZTSK)[0 W !!,"Job Canceled"
 E  W !!,"Job Queued"
 D HOME^%ZIS
 Q
EN S DIR(0)="SOM^S:Summary;Q:Queued;P:Processed;C:Closed;H:Hold;L:Labels Printed"
 S DIR("A")="Select",DIR("B")="Q",DIR("??")="^D HELP^PSXRPT"
 D ^DIR K DIR S RPT=Y G:Y=0 EXIT1 G:$D(DIRUT) EXIT1
 K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
 ;G:"HL"[RPT R1
 S DIR(0)="S^A:Ascending Order;D:Descending Order",DIR("B")="Ascending",DIR("??")="^D HELP1^PSXRPT"
 D ^DIR K DIR S ORD=Y Q:Y=""!($D(DIRUT))!($D(DUOUT))!($D(DIROUT))!($D(DTOUT))
 K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
 I "SQPCHL"'[RPT Q
R1 I "SCPLHQ"[RPT D  G:$G(Y)<0 EXIT
 .S:"HL"[RPT ORD="A"
 .W !! S %DT="AEX",%DT("A")="Enter Begin Date for Report:  ",%DT(0)="-NOW",%DT("B")="TODAY" D ^%DT Q:Y<0!($D(DTOUT))  S TBB=Y,RDT=$$FMADD^XLFDT(TBB,-1,0,0,0)_".9999"
 .W ! S %DT("A")="Enter End Date for Report:  " D ^%DT K %DT Q:Y<0!($D(DTOUT))  S EE=Y,END=EE_".9999"
 .K %DT("A"),%DT("B"),%DT(0),Y,X,DTOUT
 .I TBB>EE W !,"Beginning date must be before ending date." G R1
DEV S %ZIS="Q" D ^%ZIS S PSXLION=ION G:$G(IOST)["C-"&('POP) RPT I POP W !,"NO DEVICE SELECTED" G EXIT
 I $D(IO("Q")) D QUE,EXIT1 Q
 I '$D(IO("Q")) G RPT
 Q
 ;Taskman entry point to start the transmission summary report
RPT D NOW^%DTC S Y=% X ^DD("DD") S DATE=Y,RDATE=$P(DATE,"@",1)_"  "_$E($P(DATE,"@",2),1,5),LN=0
 I '$D(ZTSK) U IO
 W @IOF
HDR S COM="TRANSMISSIONS "_$S(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY"),COM2=$P($$FMTE^XLFDT(TBB,"2S"),"@",1)_" THRU "_$P($$FMTE^XLFDT(END,"2S"),"@",1)
 S SP2=(80-$L(COM2))/2,SP=(80-$L(COM))/2,SP1=(80-$L(RDATE))/2
 W !,?SP,COM,!,?SP2,COM2,!! S LN=LN+4
 ;W !,?SP1,RDATE,!! S LN=LN+5
 W "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
 W "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
 ;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
 ;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
 S LL="-" F JJ=0:1:79 W LL
 W ! S LN=LN+2
 I $G(ORD)="D" G DESC
 I (RPT="S")!(RPT="C")!(RPT="Q")!(RPT="P") G DATA
 I RPT="H"!(RPT="L") G QDATA
 W !!
 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Another report" D ^DIR K DIR G:Y=1 EN
 G EXIT1
 Q
DATA S XX=$S(RPT="Q":"AQ",RPT="S":"AR",RPT="C":"AC",RPT="P":"AP",1:"")
 S XT=0,XY=RDT F  S XY=$O(^PSX(552.1,XX,XY)) Q:XY=""!(XY>END)  S XT=XT+1
 I '$D(^PSX(552.1,XX))!($G(XT)'>0) W !!,"No data for the report." G EXIT
 ;S RDT="" F  S RDT=$O(^PSX(552.1,XX,RDT)) Q:(RDT="")  S SITE="" F  S SITE=$O(^PSX(552.1,XX,RDT,SITE)) Q:'SITE  F REC=0:0 S REC=$O(^PSX(552.1,XX,RDT,SITE,REC)) Q:REC'>0  S RDTTM=RDT K Y D PRINT G:RESP="^" EXIT1
 F  S RDT=$O(^PSX(552.1,XX,RDT)) Q:(RDT="")!(RDT>END)  S SITE="" F  S SITE=$O(^PSX(552.1,XX,RDT,SITE)) Q:'SITE  F REC=0:0 S REC=$O(^PSX(552.1,XX,RDT,SITE,REC)) Q:REC'>0  S RDTTM=RDT K Y D PRINT G:RESP="^" EXIT1
 G:$G(IOST)'["C-" EXIT1
 G EXIT
QDATA S XX=$S(RPT="H":"AH",RPT="L":"AE",1:"")
 I '$D(^PSX(552.1,XX)) W !!,"No data for the report." G EXIT
 S SITE="" F  S SITE=$O(^PSX(552.1,XX,SITE)) Q:'SITE  F REC=0:0 S REC=$O(^PSX(552.1,XX,SITE,REC)) Q:REC'>0  S RDTTM=$P($G(^PSX(552.1,REC,0)),U,4) Q:RDTTM<TBB!(RDTTM>END)  D PRINT G:RESP="^" EXIT1
 G:$G(IOST)'["C-" EXIT1
 G EXIT
DESC S XX=$S(RPT="Q":"AQ",RPT="S":"AR",RPT="C":"AC",RPT="P":"AP",1:"")
 S XT=0,XY=RDT F  S XY=$O(^PSX(552.1,XX,XY)) Q:XY=""!(XY>END)  S XT=XT+1
 I '$D(^PSX(552.1,XX))!($G(XT)'>0) W !!,"No data for the report." G EXIT
 F  S RDT=$O(^PSX(552.1,XX,RDT)) Q:(RDT="")!(RDT>END)  S SITE="" F  S SITE=$O(^PSX(552.1,XX,RDT,SITE)) Q:'SITE  F REC=0:0 S REC=$O(^PSX(552.1,XX,RDT,SITE,REC)) Q:REC'>0  S REVD=9999999.9999-RDT,^TMP($J,"PSXRPT",REVD,REC)=""
 D DESC1
 Q
DESC1 S X1="" F  S X1=$O(^TMP($J,"PSXRPT",X1)) Q:X1=""  S REC=0 F  S REC=$O(^TMP($J,"PSXRPT",X1,REC)) Q:REC'>0  S RDTTM=$P(^PSX(552.1,REC,0),"^",4) K Y D PRINT G:RESP="^" EXIT1
 K X1,Y1
 G:$G(IOST)'["C-" EXIT1
 G EXIT
HELP W !!,"S - Provides a report of all transmissions received for the date range entered."
 W !,"Q - Provides a report of all transmissions that are queued to download to the",!,"vendor for the date range entered."
 W !,"P - Provides a report of all transmissions that are processed for the date range",!,"entered."
 W !,"C - Provides a report of all transmissions that are closed for the date range",!,"entered."
 W !,"H - Provides a report of all transmissions that are on hold status for the date range entered."
 W !,"L - Provides a report of all transmissions that were printed for the date range entered."
 Q
HELP1 W !!,"Ascending order will order data starting with the earliest date.",!,"Descending order will order the data starting the latest date."
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXRPT   7505     printed  Sep 23, 2025@19:20:57                                                                                                                                                                                                      Page 2
PSXRPT    ;BIR/WPB,HTW-Routine to Generate Reports at the CMOP Host Facility ;04/08/97  2:06 PM
 +1       ;;2.0;CMOP;**38**;11 Apr 97
PRINT      SET FROM=$PIECE($GET(^PSX(552.1,REC,"P")),U,1)
           SET BB=$PIECE($GET(^PSX(552.1,REC,0)),U,1)
 +1        SET BAT=$PIECE($GET(BB),"-",2)
           SET RESP=""
           SET STA1=$PIECE($GET(BB),"-")
 +2       ;I $G(STA1)]"" S X=STA1,DIC="4",DIC(0)="XMZO" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC  S STA2=+Y,STATION=$P(Y,"^",2) K DIC,Y,X ;****DOD L1
 +3       ;****DOD L1
           IF $GET(STA1)]""
               SET X=STA1
               SET AGNCY="VASTANUM"
               if $DATA(^PSX(552,"D",X))
                   SET X=$EXTRACT(X,2,99)
                   SET AGNCY="DMIS"
               SET STA2=$$IEN^XUMF(4,AGNCY,X)
               SET STATION=$$NAME^XUAF4(STA2)
               KILL AGNCY,Y,X
 +4        SET ORDS=$PIECE($GET(^PSX(552.1,REC,1)),U,3)
           SET RXS=$PIECE($GET(^(1)),U,4)
 +5        SET SS=$PIECE($GET(^PSX(552.1,REC,0)),U,2)
 +6        SET STAT=$SELECT(SS=2:"Queued",SS=3:"Processed",SS=4:"Closed",SS=5:"Hold",SS=6:"Printed",SS=99:"Rejected",1:"")
 +7        SET Y=RDTTM
           XECUTE ^DD("DD")
           SET RDTTM=Y
           KILL Y
           SET RDTTM=$PIECE(RDTTM,":",1,2)
 +8        WRITE !,RDTTM,?19,FROM,?43,BB,?59,$JUSTIFY(ORDS,5),?68,$JUSTIFY(RXS,5),?75,$EXTRACT(STAT,1,4)
           SET LN=LN+1
 +9       ;W !,RDTTM,?20,FROM,?44,BB,?54,$J(ORDS,5),?63,$J(RXS,5),?70,STAT S LN=LN+1
 +10       IF $GET(IOST)["C-"
               Begin DoDot:1
 +11               if LN<22
                       QUIT 
 +12               IF LN>21
                       SET RESP=""
                       SET LN=0
                       SET DIR(0)="E"
                       DO ^DIR
                       if (Y='1)!($DATA(DTOUT))
                           SET RESP="^"
                       KILL DIR
                       if Y'=1
                           QUIT 
                       KILL Y,X,DIRUT,DIROUT,DTOUT,DUOUT
 +13               SET LN=0
 +14               WRITE @IOF,!
 +15               WRITE !,?29,"TRANSMISSIONS "_$SELECT(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
 +16               WRITE !,?30,RDATE,!!
                   SET LN=LN+3
 +17      ;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
 +18      ;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
 +19               WRITE "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
 +20               WRITE "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
 +21               SET LL="-"
                   FOR JJ=0:1:79
                       WRITE LL
 +22               WRITE !
                   SET LN=LN+3
               End DoDot:1
 +23       IF $GET(IOST)'["C-"&(LN>60)
               Begin DoDot:1
 +24               SET LN=0
 +25               WRITE @IOF,!
 +26               WRITE !,?29,"TRANSMISSIONS "_$SELECT(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
 +27               WRITE !,?30,RDATE,!!
                   SET LN=LN+3
 +28      ;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
 +29      ;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
 +30               WRITE "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
 +31               WRITE "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
 +32               SET LL="-"
                   FOR JJ=0:1:79
                       WRITE LL
 +33               WRITE !
                   SET LN=LN+4
               End DoDot:1
 +34       if $GET(RESP)="^"
               QUIT 
 +35       SET NEXT=REC+1
 +36       if '$DATA(^PSX(552.1,NEXT,0))
               QUIT 
 +37       QUIT 
EXIT       IF '$GET(POP)
               SET DIR(0)="E"
               SET DIR("A")="Press RETURN to continue"
               DO ^DIR
               KILL DIR
EXIT1      WRITE @IOF
           KILL RPT,XX,DATE,RDATE,Y,%,X,FROM,ORDS,RXS,BB,STAT,RESP,RDT,RDTTM,LL,BAT,REC,SS,SITE,JJ,LN,NEXT,STA1,STA2,STATION,COM,COM2,EE,END,ORD,REVD,SP,SP1,SP2,TBB,X1,XT,XY
 +1        KILL ZTRTN,ZTIO,PSXLION,ZTDESC,ZTSAVE,ZTSK,%ZIS,DIR,DTOUT,DIROUT,DUOUT,DIRUT,^TMP($JOB,"PSXRPT")
 +2        IF $GET(IOST)'["C-"
               WRITE @IOF
 +3        DO ^%ZISC
 +4        if $DATA(ZTQUEUED)
               SET ZTREQ="@"
 +5        QUIT 
QUE        SET ZTRTN="RPT^PSXRPT"
           SET ZTIO=PSXLION
           SET ZTSAVE("RDT")=""
           SET ZTSAVE("RPT")=""
           SET ZTSAVE("END")=""
           SET ZTSAVE("TBB")=""
           SET ZTSAVE("ORD")=""
           SET ZTDESC="CMOP Transmission Report Summary"
           DO ^%ZTLOAD
 +1        IF $DATA(ZTSK)[0
               WRITE !!,"Job Canceled"
 +2       IF '$TEST
               WRITE !!,"Job Queued"
 +3        DO HOME^%ZIS
 +4        QUIT 
EN         SET DIR(0)="SOM^S:Summary;Q:Queued;P:Processed;C:Closed;H:Hold;L:Labels Printed"
 +1        SET DIR("A")="Select"
           SET DIR("B")="Q"
           SET DIR("??")="^D HELP^PSXRPT"
 +2        DO ^DIR
           KILL DIR
           SET RPT=Y
           if Y=0
               GOTO EXIT1
           if $DATA(DIRUT)
               GOTO EXIT1
 +3        KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
 +4       ;G:"HL"[RPT R1
 +5        SET DIR(0)="S^A:Ascending Order;D:Descending Order"
           SET DIR("B")="Ascending"
           SET DIR("??")="^D HELP1^PSXRPT"
 +6        DO ^DIR
           KILL DIR
           SET ORD=Y
           if Y=""!($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DIROUT))!($DATA(DTOUT))
               QUIT 
 +7        KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
 +8        IF "SQPCHL"'[RPT
               QUIT 
R1         IF "SCPLHQ"[RPT
               Begin DoDot:1
 +1                if "HL"[RPT
                       SET ORD="A"
 +2                WRITE !!
                   SET %DT="AEX"
                   SET %DT("A")="Enter Begin Date for Report:  "
                   SET %DT(0)="-NOW"
                   SET %DT("B")="TODAY"
                   DO ^%DT
                   if Y<0!($DATA(DTOUT))
                       QUIT 
                   SET TBB=Y
                   SET RDT=$$FMADD^XLFDT(TBB,-1,0,0,0)_".9999"
 +3                WRITE !
                   SET %DT("A")="Enter End Date for Report:  "
                   DO ^%DT
                   KILL %DT
                   if Y<0!($DATA(DTOUT))
                       QUIT 
                   SET EE=Y
                   SET END=EE_".9999"
 +4                KILL %DT("A"),%DT("B"),%DT(0),Y,X,DTOUT
 +5                IF TBB>EE
                       WRITE !,"Beginning date must be before ending date."
                       GOTO R1
               End DoDot:1
               if $GET(Y)<0
                   GOTO EXIT
DEV        SET %ZIS="Q"
           DO ^%ZIS
           SET PSXLION=ION
           if $GET(IOST)["C-"&('POP)
               GOTO RPT
           IF POP
               WRITE !,"NO DEVICE SELECTED"
               GOTO EXIT
 +1        IF $DATA(IO("Q"))
               DO QUE
               DO EXIT1
               QUIT 
 +2        IF '$DATA(IO("Q"))
               GOTO RPT
 +3        QUIT 
 +4       ;Taskman entry point to start the transmission summary report
RPT        DO NOW^%DTC
           SET Y=%
           XECUTE ^DD("DD")
           SET DATE=Y
           SET RDATE=$PIECE(DATE,"@",1)_"  "_$EXTRACT($PIECE(DATE,"@",2),1,5)
           SET LN=0
 +1        IF '$DATA(ZTSK)
               USE IO
 +2        WRITE @IOF
HDR        SET COM="TRANSMISSIONS "_$SELECT(RPT="Q":"QUEUED",RPT="P":"PROCESSED",RPT="C":"CLOSED",RPT="H":"ON HOLD",RPT="L":"PRINTED",1:"SUMMARY")
           SET COM2=$PIECE($$FMTE^XLFDT(TBB,"2S"),"@",1)_" THRU "_$PIECE($$FMTE^XLFDT(END,"2S"),"@",1)
 +1        SET SP2=(80-$LENGTH(COM2))/2
           SET SP=(80-$LENGTH(COM))/2
           SET SP1=(80-$LENGTH(RDATE))/2
 +2        WRITE !,?SP,COM,!,?SP2,COM2,!!
           SET LN=LN+4
 +3       ;W !,?SP1,RDATE,!! S LN=LN+5
 +4        WRITE "RECEIVED",?19,"FROM",?43,"BATCH",?59,"TOTAL",?68,"TOTAL",?75,"STAT",!
 +5        WRITE "DATE/TIME",?43,"NUMBER",?59,"ORDERS",?68,"RXS",!
 +6       ;W "RECEIVED",?20,"FROM",?44,"BATCH",?55,"TOTAL",?64,"TOTAL",?72,"STATUS",!
 +7       ;W "DATE/TIME",?44,"NUMBER",?55,"ORDERS",?65,"RXS",!
 +8        SET LL="-"
           FOR JJ=0:1:79
               WRITE LL
 +9        WRITE !
           SET LN=LN+2
 +10       IF $GET(ORD)="D"
               GOTO DESC
 +11       IF (RPT="S")!(RPT="C")!(RPT="Q")!(RPT="P")
               GOTO DATA
 +12       IF RPT="H"!(RPT="L")
               GOTO QDATA
 +13       WRITE !!
 +14       SET DIR(0)="Y"
           SET DIR("B")="NO"
           SET DIR("A")="Another report"
           DO ^DIR
           KILL DIR
           if Y=1
               GOTO EN
 +15       GOTO EXIT1
 +16       QUIT 
DATA       SET XX=$SELECT(RPT="Q":"AQ",RPT="S":"AR",RPT="C":"AC",RPT="P":"AP",1:"")
 +1        SET XT=0
           SET XY=RDT
           FOR 
               SET XY=$ORDER(^PSX(552.1,XX,XY))
               if XY=""!(XY>END)
                   QUIT 
               SET XT=XT+1
 +2        IF '$DATA(^PSX(552.1,XX))!($GET(XT)'>0)
               WRITE !!,"No data for the report."
               GOTO EXIT
 +3       ;S RDT="" F  S RDT=$O(^PSX(552.1,XX,RDT)) Q:(RDT="")  S SITE="" F  S SITE=$O(^PSX(552.1,XX,RDT,SITE)) Q:'SITE  F REC=0:0 S REC=$O(^PSX(552.1,XX,RDT,SITE,REC)) Q:REC'>0  S RDTTM=RDT K Y D PRINT G:RESP="^" EXIT1
 +4        FOR 
               SET RDT=$ORDER(^PSX(552.1,XX,RDT))
               if (RDT="")!(RDT>END)
                   QUIT 
               SET SITE=""
               FOR 
                   SET SITE=$ORDER(^PSX(552.1,XX,RDT,SITE))
                   if 'SITE
                       QUIT 
                   FOR REC=0:0
                       SET REC=$ORDER(^PSX(552.1,XX,RDT,SITE,REC))
                       if REC'>0
                           QUIT 
                       SET RDTTM=RDT
                       KILL Y
                       DO PRINT
                       if RESP="^"
                           GOTO EXIT1
 +5        if $GET(IOST)'["C-"
               GOTO EXIT1
 +6        GOTO EXIT
QDATA      SET XX=$SELECT(RPT="H":"AH",RPT="L":"AE",1:"")
 +1        IF '$DATA(^PSX(552.1,XX))
               WRITE !!,"No data for the report."
               GOTO EXIT
 +2        SET SITE=""
           FOR 
               SET SITE=$ORDER(^PSX(552.1,XX,SITE))
               if 'SITE
                   QUIT 
               FOR REC=0:0
                   SET REC=$ORDER(^PSX(552.1,XX,SITE,REC))
                   if REC'>0
                       QUIT 
                   SET RDTTM=$PIECE($GET(^PSX(552.1,REC,0)),U,4)
                   if RDTTM<TBB!(RDTTM>END)
                       QUIT 
                   DO PRINT
                   if RESP="^"
                       GOTO EXIT1
 +3        if $GET(IOST)'["C-"
               GOTO EXIT1
 +4        GOTO EXIT
DESC       SET XX=$SELECT(RPT="Q":"AQ",RPT="S":"AR",RPT="C":"AC",RPT="P":"AP",1:"")
 +1        SET XT=0
           SET XY=RDT
           FOR 
               SET XY=$ORDER(^PSX(552.1,XX,XY))
               if XY=""!(XY>END)
                   QUIT 
               SET XT=XT+1
 +2        IF '$DATA(^PSX(552.1,XX))!($GET(XT)'>0)
               WRITE !!,"No data for the report."
               GOTO EXIT
 +3        FOR 
               SET RDT=$ORDER(^PSX(552.1,XX,RDT))
               if (RDT="")!(RDT>END)
                   QUIT 
               SET SITE=""
               FOR 
                   SET SITE=$ORDER(^PSX(552.1,XX,RDT,SITE))
                   if 'SITE
                       QUIT 
                   FOR REC=0:0
                       SET REC=$ORDER(^PSX(552.1,XX,RDT,SITE,REC))
                       if REC'>0
                           QUIT 
                       SET REVD=9999999.9999-RDT
                       SET ^TMP($JOB,"PSXRPT",REVD,REC)=""
 +4        DO DESC1
 +5        QUIT 
DESC1      SET X1=""
           FOR 
               SET X1=$ORDER(^TMP($JOB,"PSXRPT",X1))
               if X1=""
                   QUIT 
               SET REC=0
               FOR 
                   SET REC=$ORDER(^TMP($JOB,"PSXRPT",X1,REC))
                   if REC'>0
                       QUIT 
                   SET RDTTM=$PIECE(^PSX(552.1,REC,0),"^",4)
                   KILL Y
                   DO PRINT
                   if RESP="^"
                       GOTO EXIT1
 +1        KILL X1,Y1
 +2        if $GET(IOST)'["C-"
               GOTO EXIT1
 +3        GOTO EXIT
HELP       WRITE !!,"S - Provides a report of all transmissions received for the date range entered."
 +1        WRITE !,"Q - Provides a report of all transmissions that are queued to download to the",!,"vendor for the date range entered."
 +2        WRITE !,"P - Provides a report of all transmissions that are processed for the date range",!,"entered."
 +3        WRITE !,"C - Provides a report of all transmissions that are closed for the date range",!,"entered."
 +4        WRITE !,"H - Provides a report of all transmissions that are on hold status for the date range entered."
 +5        WRITE !,"L - Provides a report of all transmissions that were printed for the date range entered."
 +6        QUIT 
HELP1      WRITE !!,"Ascending order will order data starting with the earliest date.",!,"Descending order will order the data starting the latest date."
 +1        QUIT