- 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")
