PSXPLOG.m

PSXPLOG ;BIR/BAB-Print Interface Log ;[ 04/08/97   2:06 PM ]

 ;;2.0;CMOP;;11 Apr 97

 S PSXSYS=1

ZIS S %ZIS="MQ",%ZIS("A")="Print Log on Device: " D ^%ZIS Q:POP

 I '$D(IO("Q")) U IO D EN,^%ZISC Q

 S ZTRTN="EN^PSXPLOG",ZTDTH=$H,ZTIO=ION,ZTSAVE("PSXSYS")="",ZTSAVE("ZTREQ")="@"

 D ^%ZTLOAD

 I '$D(ZTSK) D ^%ZISC U IO W "  not queued" G ZIS

 Q

 ;

 ;Called by Taskman to print the interface log

EN N PSXDT D HEAD S PSXPOP=0

 F K=0:0 S K=$O(^PSX(553,1,"X",K)) Q:'K  S Y=^(K,0) X ^DD("DD") W !,$P(Y,"@")," ",$P(Y,"@",2) D OUT,SCRN Q:PSXPOP

 K PSXMSG,PSXPOP,WORD,K,L,M

 Q

OUT F L=0:0 S L=$O(^PSX(553,1,"X",K,"X",L)) Q:'L  S PSXMSG=^(L,0) F M=1:1 S WORD=$P(PSXMSG," ",M) Q:WORD=""  W:$L(WORD)>(IOM-2-$X) ! W ?21," ",WORD

 Q

SCRN Q:($Y+3)<IOSL  G:IOST["P-" HEAD W !,"Enter ""^"" to quit"

 R X:DTIME E  S X="^"

 I X="^" S PSXPOP=1 Q

HEAD W @IOF,!!,?(IOM\2-9),"CMOP Interface Log",!!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSXPLOG   897     printed  Apr 09, 2024@20:49:17                                                                                                                                                                                                      Page 2

PSXPLOG   ;BIR/BAB-Print Interface Log ;[ 04/08/97   2:06 PM ]

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

 +2        SET PSXSYS=1

ZIS        SET %ZIS="MQ"

           SET %ZIS("A")="Print Log on Device: "

           DO ^%ZIS

           if POP

               QUIT 

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

               USE IO

               DO EN

               DO ^%ZISC

               QUIT 

 +2        SET ZTRTN="EN^PSXPLOG"

           SET ZTDTH=$HOROLOG

           SET ZTIO=ION

           SET ZTSAVE("PSXSYS")=""

           SET ZTSAVE("ZTREQ")="@"

 +3        DO ^%ZTLOAD

 +4        IF '$DATA(ZTSK)

               DO ^%ZISC

               USE IO

               WRITE "  not queued"

               GOTO ZIS

 +5        QUIT 

 +6       ;

 +7       ;Called by Taskman to print the interface log

EN         NEW PSXDT

           DO HEAD

           SET PSXPOP=0

 +1        FOR K=0:0

               SET K=$ORDER(^PSX(553,1,"X",K))

               if 'K

                   QUIT 

               SET Y=^(K,0)

               XECUTE ^DD("DD")

               WRITE !,$PIECE(Y,"@")," ",$PIECE(Y,"@",2)

               DO OUT

               DO SCRN

               if PSXPOP

                   QUIT 

 +2        KILL PSXMSG,PSXPOP,WORD,K,L,M

 +3        QUIT 

OUT        FOR L=0:0

               SET L=$ORDER(^PSX(553,1,"X",K,"X",L))

               if 'L

                   QUIT 

               SET PSXMSG=^(L,0)

               FOR M=1:1

                   SET WORD=$PIECE(PSXMSG," ",M)

                   if WORD=""

                       QUIT 

                   if $LENGTH(WORD)>(IOM-2-$X)

                       WRITE !

                   WRITE ?21," ",WORD

 +1        QUIT 

SCRN       if ($Y+3)<IOSL

               QUIT 

           if IOST["P-"

               GOTO HEAD

           WRITE !,"Enter ""^"" to quit"

 +1        READ X:DTIME

          IF '$TEST

               SET X="^"

 +2        IF X="^"

               SET PSXPOP=1

               QUIT 

HEAD       WRITE @IOF,!!,?(IOM\2-9),"CMOP Interface Log",!!

 +1        QUIT