BLRAGUT2 ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPC UTILITIES 2;
;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
;
STCKRPTS ; EP - Show $STACK data in BLRENTRY global after an error
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,X,XPARSYS,XQXFLG)
;
S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"R"," ")
;
D ADDTMENU^BLRGMENU("SHOSTACK^BLRAGUT2","$STACK Report")
;
; Main Menu driver
D MENUDRVR^BLRGMENU("^BLRENTRY Routines",$$CJ^XLFSTR("$STACK Reports",IOM))
Q
;
SHOSTACK ; EP - SHOw $STACK report
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,X,XPARSYS,XQXFLG)
;
Q:$$SHOSTCKI()="Q"
;
D SHOSTCKP
;
K ^TMP("BLRAGUT2")
Q
;
SHOSTCKI() ; EP - Initialization
K ^TMP("BLRAGUT2")
S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"R"," ")
;
S HEADER(1)="^BLRENTRY $STACK Routines Report"
S HEADER(2)=" "
;
D HEADERDT^BLRGMENU
;
S X=$$GETDATE(.STACKDT)
Q:X<1 "Q"
;
S HEADER(2)="Compilation of Data"
D HEADERDT^BLRGMENU
;
D SHOSTCKC ; Compile Data
;
W !,?4,"Compilation complete."
D PRESSKEY^BLRGMENU(9)
;
K HEADER(2)
S HEADER(2)="Reverse Entry Number Order"
S HEADER(3)=" "
S HEADER(4)="STACKRTN"
S $E(HEADER(4),10)="USER"
S $E(HEADER(4),20)="DATE/TIME"
S $E(HEADER(4),35)="ENTRY #"
S $E(HEADER(4),45)="LABEL"
;
S QFLG="NO"
S MAXLINES=22,LINES=MAXLINES+10
S PG=0
;
Q "OK"
;
SHOSTCKC ; EP - SHOw $STaCK -- Compilation of data
S (CURDATE,USER,ENTRY,LABEL)=""
W !,?4
F S USER=$O(^BLRENTRY(USER)) Q:USER<1 D
. S CURDATE=STACKDT
. F S CURDATE=$O(^BLRENTRY(USER,CURDATE)) Q:CURDATE=""!($P(CURDATE,".")'=STACKDT) D
.. F S ENTRY=$O(^BLRENTRY(USER,CURDATE,ENTRY)) Q:ENTRY="" D
... F S LABEL=$O(^BLRENTRY(USER,CURDATE,ENTRY,LABEL)) Q:LABEL="" D
.... W "."
.... W:$X>75 !,?4
.... S STACK=0
.... F S STACK=$O(^BLRENTRY(USER,CURDATE,ENTRY,LABEL,"$STACK",STACK)) Q:STACK<1 D
..... S CURPLACE=$G(^BLRENTRY(USER,CURDATE,ENTRY,LABEL,"$STACK",STACK,3,"CURRENT PLACE"))
..... S STACKNUM=1+$G(STACK(-1))
..... S STACK(-1)=STACKNUM
..... S STACK(STACKNUM)=CURPLACE
..... S STACKRTN=$P($P(CURPLACE,"^",2)," ")
..... S:$L(STACKRTN) ^TMP("BLRAGUT2",$J,ENTRY)=STACKRTN_"^"_USER_"^"_CURDATE_"^"_LABEL
;
W !
;
Q
;
SHOSTCKP ; EP - Print the report
S ENTRY="A"
F S ENTRY=$O(^TMP("BLRAGUT2",$J,ENTRY),-1) Q:ENTRY<1!(QFLG="Q") D
. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO") Q:QFLG="Q"
. S STR=$G(^TMP("BLRAGUT2",$J,ENTRY))
. W $P(STR,"^")
. W ?9,$P(STR,"^",2)
. W ?19,$P(STR,"^",3)
. W ?34,ENTRY
. W ?44,$E($P(STR,"^",4,99),1,36),!
. S LINES=LINES+1
;
D:QFLG'="Q" PRESSKEY^BLRGMENU(9)
Q
;
GETDATE(DATER) ; EP -- Get Specific Date; Default entry is TODAY
D ^XBFMK
S DIR(0)="DO"
S DIR("A")="Specific Date"
S DIR("B")=$$HTE^XLFDT($H,"5DZ")
D ^DIR
I +$G(DUOUT)>0 D Q 0
. W !,?5,"FileMan Quit Entered. Routine Ends.",!
. D PRESSKEY^BLRGMENU(10)
;
S:+$G(Y)<1 DATER=$$DT^XLFDT
S:+$G(Y)>0 DATER=+$G(Y)
;
Q DATER
BLRAGUT2 ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPC UTILITIES 2;
+1 ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
+2 ;
STCKRPTS ; EP - Show $STACK data in BLRENTRY global after an error
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,X,XPARSYS,XQXFLG)
+2 ;
+3 SET BLRVERN=$$TRIM^XLFSTR($PIECE($TEXT(+1),";"),"R"," ")
+4 ;
+5 DO ADDTMENU^BLRGMENU("SHOSTACK^BLRAGUT2","$STACK Report")
+6 ;
+7 ; Main Menu driver
+8 DO MENUDRVR^BLRGMENU("^BLRENTRY Routines",$$CJ^XLFSTR("$STACK Reports",IOM))
+9 QUIT
+10 ;
SHOSTACK ; EP - SHOw $STACK report
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,X,XPARSYS,XQXFLG)
+2 ;
+3 IF $$SHOSTCKI()="Q"
QUIT
+4 ;
+5 DO SHOSTCKP
+6 ;
+7 KILL ^TMP("BLRAGUT2")
+8 QUIT
+9 ;
SHOSTCKI() ; EP - Initialization
+1 KILL ^TMP("BLRAGUT2")
+2 SET BLRVERN=$$TRIM^XLFSTR($PIECE($TEXT(+1),";"),"R"," ")
+3 ;
+4 SET HEADER(1)="^BLRENTRY $STACK Routines Report"
+5 SET HEADER(2)=" "
+6 ;
+7 DO HEADERDT^BLRGMENU
+8 ;
+9 SET X=$$GETDATE(.STACKDT)
+10 IF X<1
QUIT "Q"
+11 ;
+12 SET HEADER(2)="Compilation of Data"
+13 DO HEADERDT^BLRGMENU
+14 ;
+15 ; Compile Data
DO SHOSTCKC
+16 ;
+17 WRITE !,?4,"Compilation complete."
+18 DO PRESSKEY^BLRGMENU(9)
+19 ;
+20 KILL HEADER(2)
+21 SET HEADER(2)="Reverse Entry Number Order"
+22 SET HEADER(3)=" "
+23 SET HEADER(4)="STACKRTN"
+24 SET $EXTRACT(HEADER(4),10)="USER"
+25 SET $EXTRACT(HEADER(4),20)="DATE/TIME"
+26 SET $EXTRACT(HEADER(4),35)="ENTRY #"
+27 SET $EXTRACT(HEADER(4),45)="LABEL"
+28 ;
+29 SET QFLG="NO"
+30 SET MAXLINES=22
SET LINES=MAXLINES+10
+31 SET PG=0
+32 ;
+33 QUIT "OK"
+34 ;
SHOSTCKC ; EP - SHOw $STaCK -- Compilation of data
+1 SET (CURDATE,USER,ENTRY,LABEL)=""
+2 WRITE !,?4
+3 FOR
SET USER=$ORDER(^BLRENTRY(USER))
IF USER<1
QUIT
Begin DoDot:1
+4 SET CURDATE=STACKDT
+5 FOR
SET CURDATE=$ORDER(^BLRENTRY(USER,CURDATE))
IF CURDATE=""!($PIECE(CURDATE,".")'=STACKDT)
QUIT
Begin DoDot:2
+6 FOR
SET ENTRY=$ORDER(^BLRENTRY(USER,CURDATE,ENTRY))
IF ENTRY=""
QUIT
Begin DoDot:3
+7 FOR
SET LABEL=$ORDER(^BLRENTRY(USER,CURDATE,ENTRY,LABEL))
IF LABEL=""
QUIT
Begin DoDot:4
+8 WRITE "."
+9 IF $X>75
WRITE !,?4
+10 SET STACK=0
+11 FOR
SET STACK=$ORDER(^BLRENTRY(USER,CURDATE,ENTRY,LABEL,"$STACK",STACK))
IF STACK<1
QUIT
Begin DoDot:5
+12 SET CURPLACE=$GET(^BLRENTRY(USER,CURDATE,ENTRY,LABEL,"$STACK",STACK,3,"CURRENT PLACE"))
+13 SET STACKNUM=1+$GET(STACK(-1))
+14 SET STACK(-1)=STACKNUM
+15 SET STACK(STACKNUM)=CURPLACE
+16 SET STACKRTN=$PIECE($PIECE(CURPLACE,"^",2)," ")
+17 IF $LENGTH(STACKRTN)
SET ^TMP("BLRAGUT2",$JOB,ENTRY)=STACKRTN_"^"_USER_"^"_CURDATE_"^"_LABEL
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 WRITE !
+20 ;
+21 QUIT
+22 ;
SHOSTCKP ; EP - Print the report
+1 SET ENTRY="A"
+2 FOR
SET ENTRY=$ORDER(^TMP("BLRAGUT2",$JOB,ENTRY),-1)
IF ENTRY<1!(QFLG="Q")
QUIT
Begin DoDot:1
+3 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,"NO")
IF QFLG="Q"
QUIT
+4 SET STR=$GET(^TMP("BLRAGUT2",$JOB,ENTRY))
+5 WRITE $PIECE(STR,"^")
+6 WRITE ?9,$PIECE(STR,"^",2)
+7 WRITE ?19,$PIECE(STR,"^",3)
+8 WRITE ?34,ENTRY
+9 WRITE ?44,$EXTRACT($PIECE(STR,"^",4,99),1,36),!
+10 SET LINES=LINES+1
End DoDot:1
+11 ;
+12 IF QFLG'="Q"
DO PRESSKEY^BLRGMENU(9)
+13 QUIT
+14 ;
GETDATE(DATER) ; EP -- Get Specific Date; Default entry is TODAY
+1 DO ^XBFMK
+2 SET DIR(0)="DO"
+3 SET DIR("A")="Specific Date"
+4 SET DIR("B")=$$HTE^XLFDT($HOROLOG,"5DZ")
+5 DO ^DIR
+6 IF +$GET(DUOUT)>0
Begin DoDot:1
+7 WRITE !,?5,"FileMan Quit Entered. Routine Ends.",!
+8 DO PRESSKEY^BLRGMENU(10)
End DoDot:1
QUIT 0
+9 ;
+10 IF +$GET(Y)<1
SET DATER=$$DT^XLFDT
+11 IF +$GET(Y)>0
SET DATER=+$GET(Y)
+12 ;
+13 QUIT DATER
