BLRDSP ; IHS/HQT/MJL - DISPLAY QUEUE ENTRY AND TRANSACTION INFO ; [ 06/29/2001 1:38 PM ]
;;5.2;LR;**1010,1011**;MAR 01, 2001
S U="^",BLRLR=""
S BLRNPMT=1 D ENT^BLRPST W ! D MSG W !! K BLRNPMT,BLRCHLD
F D SEQ Q:R="" D DSPENT
Q
;
SEQ ;
R "ENTRY: ",R:DTIME Q:R=""
S BLRQSITE=$P(^AUTTSITE(1,0),U,1),BLRDH=$P(^BLRSITE(BLRQSITE,0),U,6)
S:R?1L R=$$UC(R)
K:"UB"'[R BLRCHLD
I R="D" D ENT^BLRPST W !! G SEQ
I R="C" D ^BLRPST W !! G SEQ
I R="I" S DIC=9009022,DIC(0)="AEMQ" W ! D ^DIC D:Y W ! G SEQ
.S DA=+Y,LTN=DA D EN^DIQ
I R="S" D ^%SS W !! G SEQ
I R="L" D ^%LOCKTAB W !! G SEQ
I R="E" D ^XTER W !! G SEQ
I R="M" W " " D MSG W ! G SEQ
I R="U" D PAR G SEQ
I R="B" D CHILD G SEQ
I R="P" S BLRDIR=-1 D NEXT G SEQ
I R="N" S BLRDIR=1 D NEXT G SEQ
I R="R" S R=$P(^BLRSITE(BLRQSITE,21,BLRDH,0),U,3) W *8,R D DSPENT G SEQ
I R="?" W ! D HELP W !! G SEQ
I R="H" G ^XUSCLEAN
I R="<" W *8 D G SEQ
.I 'BLRLR W ! Q
.S FND=0 F R=BLRLR-1:-1:1 I ^BLRSITE(BLRQSITE,21,BLRDH,R)=LTN,$D(^BLRSITE(BLRQSITE,21,BLRDH,R,0)) S FND=1 Q
.I FND W R D DSP Q
.W "NOT FOUND",!
I R'?.N W " INVALID ENTRY",! G SEQ
I '$D(^BLRSITE(BLRQSITE,21,BLRDH,R)) W " INVALID SEQ NO",! G SEQ
;W !
Q
;
DSPENT ;
S BLRLR=R
;S X=$G(^BLRSITE(BLRQSITE,21,BLRDH,R,0)) NO DATA STORED HERE NOW
;D:X'="" ENTRY
S DA=^BLRSITE(BLRQSITE,21,BLRDH,R) D DSP
Q
;
DSP ;
W !
S LTN=DA,DIC="^BLRTXLOG(" D EN^DIQ
W !
Q
;
ENTRY ;
W !,"OPTION: ",$P(X,U)
W:$P(X,U,3) !,"ENTERED BY: ",$P(^VA(200,$P(X,U,3),0),U)
W !,"TIME: ",$$TIME($P(X,U,2))
W:$P(X,U,4)'="" !,"ACTION ",$P(X,U,4)
Q
;
PAR ;
I $G(LTN) S BLRPAR=$P(^BLRTXLOG(LTN,1),U) I BLRPAR S DA=BLRPAR,BLRCHLD(BLRPAR)=LTN D DSP Q
W " ??",!
Q
;
CHILD ;
I $G(LTN),$G(BLRCHLD(LTN)) S DA=BLRCHLD(LTN) D DSP Q
W " ??",!
Q
;
NEXT ;
I $G(LTN) S DA=$O(^BLRTXLOG(LTN),BLRDIR) I DA D DSP Q
W " ??",!
Q
;
MSG ;
I $P(^XMB(3.7,DUZ,0),U,6) D ^XM W ! Q
W "NO MESSAGES"
Q
;
HELP ;
S BLROPT="D^C^I^S^L^E^M^U^B^P^N^R^(NUMBER)^?"
F BLRN=1:1:$L(BLROPT,U) W !,$P(BLROPT,U,BLRN),$E($TR($J("",10)," ","."),1,11-$L($P(BLROPT,U,BLRN))),$P("PROCESSOR STATUS^CONTINUOUS PROCESSOR STATUS^TRANSACTION INQUIRY^SYSTEM STATUS^LOCK TABLE^ERROR MESSAGES^MAIL MESSAGES^UP TO PARENT^BACK TO CHILD^PREVIOUS SEQUENCE NO^NEXT SEQUENCE NO^MOST RECENT ENTRY^ENTRY IN QUEUE^HELP MENU",U,BLRN)
K BLROPT
Q
;
TIME(X) ;
Q $E(X\3600*10000+(X#3600\60*100)+(X#60)+1000000,2,7)
;
UC(X) ;
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
BLRDSP ; IHS/HQT/MJL - DISPLAY QUEUE ENTRY AND TRANSACTION INFO ; [ 06/29/2001 1:38 PM ]
+1 ;;5.2;LR;**1010,1011**;MAR 01, 2001
+2 SET U="^"
SET BLRLR=""
+3 SET BLRNPMT=1
DO ENT^BLRPST
WRITE !
DO MSG
WRITE !!
KILL BLRNPMT,BLRCHLD
+4 FOR
DO SEQ
IF R=""
QUIT
DO DSPENT
+5 QUIT
+6 ;
SEQ ;
+1 READ "ENTRY: ",R:DTIME
IF R=""
QUIT
+2 SET BLRQSITE=$PIECE(^AUTTSITE(1,0),U,1)
SET BLRDH=$PIECE(^BLRSITE(BLRQSITE,0),U,6)
+3 IF R?1L
SET R=$$UC(R)
+4 IF "UB"'[R
KILL BLRCHLD
+5 IF R="D"
DO ENT^BLRPST
WRITE !!
GOTO SEQ
+6 IF R="C"
DO ^BLRPST
WRITE !!
GOTO SEQ
+7 IF R="I"
SET DIC=9009022
SET DIC(0)="AEMQ"
WRITE !
DO ^DIC
IF Y
Begin DoDot:1
+8 SET DA=+Y
SET LTN=DA
DO EN^DIQ
End DoDot:1
WRITE !
GOTO SEQ
+9 IF R="S"
DO ^%SS
WRITE !!
GOTO SEQ
+10 IF R="L"
DO ^%LOCKTAB
WRITE !!
GOTO SEQ
+11 IF R="E"
DO ^XTER
WRITE !!
GOTO SEQ
+12 IF R="M"
WRITE " "
DO MSG
WRITE !
GOTO SEQ
+13 IF R="U"
DO PAR
GOTO SEQ
+14 IF R="B"
DO CHILD
GOTO SEQ
+15 IF R="P"
SET BLRDIR=-1
DO NEXT
GOTO SEQ
+16 IF R="N"
SET BLRDIR=1
DO NEXT
GOTO SEQ
+17 IF R="R"
SET R=$PIECE(^BLRSITE(BLRQSITE,21,BLRDH,0),U,3)
WRITE *8,R
DO DSPENT
GOTO SEQ
+18 IF R="?"
WRITE !
DO HELP
WRITE !!
GOTO SEQ
+19 IF R="H"
GOTO ^XUSCLEAN
+20 IF R="<"
WRITE *8
Begin DoDot:1
+21 IF 'BLRLR
WRITE !
QUIT
+22 SET FND=0
FOR R=BLRLR-1:-1:1
IF ^BLRSITE(BLRQSITE,21,BLRDH,R)=LTN
IF $DATA(^BLRSITE(BLRQSITE,21,BLRDH,R,0))
SET FND=1
QUIT
+23 IF FND
WRITE R
DO DSP
QUIT
+24 WRITE "NOT FOUND",!
End DoDot:1
GOTO SEQ
+25 IF R'?.N
WRITE " INVALID ENTRY",!
GOTO SEQ
+26 IF '$DATA(^BLRSITE(BLRQSITE,21,BLRDH,R))
WRITE " INVALID SEQ NO",!
GOTO SEQ
+27 ;W !
+28 QUIT
+29 ;
DSPENT ;
+1 SET BLRLR=R
+2 ;S X=$G(^BLRSITE(BLRQSITE,21,BLRDH,R,0)) NO DATA STORED HERE NOW
+3 ;D:X'="" ENTRY
+4 SET DA=^BLRSITE(BLRQSITE,21,BLRDH,R)
DO DSP
+5 QUIT
+6 ;
DSP ;
+1 WRITE !
+2 SET LTN=DA
SET DIC="^BLRTXLOG("
DO EN^DIQ
+3 WRITE !
+4 QUIT
+5 ;
ENTRY ;
+1 WRITE !,"OPTION: ",$PIECE(X,U)
+2 IF $PIECE(X,U,3)
WRITE !,"ENTERED BY: ",$PIECE(^VA(200,$PIECE(X,U,3),0),U)
+3 WRITE !,"TIME: ",$$TIME($PIECE(X,U,2))
+4 IF $PIECE(X,U,4)'=""
WRITE !,"ACTION ",$PIECE(X,U,4)
+5 QUIT
+6 ;
PAR ;
+1 IF $GET(LTN)
SET BLRPAR=$PIECE(^BLRTXLOG(LTN,1),U)
IF BLRPAR
SET DA=BLRPAR
SET BLRCHLD(BLRPAR)=LTN
DO DSP
QUIT
+2 WRITE " ??",!
+3 QUIT
+4 ;
CHILD ;
+1 IF $GET(LTN)
IF $GET(BLRCHLD(LTN))
SET DA=BLRCHLD(LTN)
DO DSP
QUIT
+2 WRITE " ??",!
+3 QUIT
+4 ;
NEXT ;
+1 IF $GET(LTN)
SET DA=$ORDER(^BLRTXLOG(LTN),BLRDIR)
IF DA
DO DSP
QUIT
+2 WRITE " ??",!
+3 QUIT
+4 ;
MSG ;
+1 IF $PIECE(^XMB(3.7,DUZ,0),U,6)
DO ^XM
WRITE !
QUIT
+2 WRITE "NO MESSAGES"
+3 QUIT
+4 ;
HELP ;
+1 SET BLROPT="D^C^I^S^L^E^M^U^B^P^N^R^(NUMBER)^?"
+2 FOR BLRN=1:1:$LENGTH(BLROPT,U)
WRITE !,...
WRITE $PIECE(BLROPT,U,BLRN),...
WRITE $EXTRACT(...
WRITE $TRANSLATE(...
WRITE $JUSTIFY("",10)," ","."),1,11-...
WRITE $LENGTH(...
WRITE $PIECE(BLROPT,U,BLRN))),...
... $PIECE("PROCESSOR STATUS^CONTINUOUS PROCESSOR STATUS^TRANSACTION INQUIRY^SYSTEM STATUS^LOCK TABLE^ERROR MESSAGES^MAIL MESSAGES^UP TO PARENT^BACK TO CHILD^PREVIOUS SEQUENCE NO^NEXT SEQUENCE NO^MOST RECENT ENTRY^ENTRY IN QUEUE^HELP MENU",
U,BLRN)
+3 KILL BLROPT
+4 QUIT
+5 ;
TIME(X) ;
+1 QUIT $EXTRACT(X\3600*10000+(X#3600\60*100)+(X#60)+1000000,2,7)
+2 ;
UC(X) ;
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
