Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRAGUT2

BLRAGUT2.m

Go to the documentation of this file. 
  1. BLRAGUT2 ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPC UTILITIES 2;
  1.  ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
  1.  ;
  1. 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)
  1.  ;
  1.  S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"R"," ")
  1.  ;
  1.  D ADDTMENU^BLRGMENU("SHOSTACK^BLRAGUT2","$STACK Report")
  1.  ;
  1.  ; Main Menu driver
  1.  D MENUDRVR^BLRGMENU("^BLRENTRY Routines",$$CJ^XLFSTR("$STACK Reports",IOM))
  1.  Q
  1.  ;
  1. 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)
  1.  ;
  1.  Q:$$SHOSTCKI()="Q"
  1.  ;
  1.  D SHOSTCKP
  1.  ;	
  1.  K ^TMP("BLRAGUT2")
  1.  Q
  1.  ;
  1. SHOSTCKI() ; EP - Initialization
  1.  K ^TMP("BLRAGUT2")
  1.  S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"R"," ")
  1.  ;
  1.  S HEADER(1)="^BLRENTRY $STACK Routines Report"
  1.  S HEADER(2)=" "
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  S X=$$GETDATE(.STACKDT)
  1.  Q:X<1 "Q"
  1.  ;
  1.  S HEADER(2)="Compilation of Data"
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  D SHOSTCKC     ; Compile Data
  1.  ;
  1.  W !,?4,"Compilation complete."
  1.  D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  K HEADER(2)
  1.  S HEADER(2)="Reverse Entry Number Order"
  1.  S HEADER(3)=" "
  1.  S HEADER(4)="STACKRTN"
  1.  S $E(HEADER(4),10)="USER"
  1.  S $E(HEADER(4),20)="DATE/TIME"
  1.  S $E(HEADER(4),35)="ENTRY #"
  1.  S $E(HEADER(4),45)="LABEL"
  1.  ;
  1.  S QFLG="NO"
  1.  S MAXLINES=22,LINES=MAXLINES+10
  1.  S PG=0
  1.  ;
  1.  Q "OK"
  1.  ;
  1. SHOSTCKC ; EP - SHOw $STaCK -- Compilation of data
  1.  S (CURDATE,USER,ENTRY,LABEL)=""
  1.  W !,?4
  1.  F  S USER=$O(^BLRENTRY(USER))  Q:USER<1  D
  1.  . S CURDATE=STACKDT
  1.  . F  S CURDATE=$O(^BLRENTRY(USER,CURDATE))  Q:CURDATE=""!($P(CURDATE,".")'=STACKDT)  D
  1.  .. F  S ENTRY=$O(^BLRENTRY(USER,CURDATE,ENTRY))  Q:ENTRY=""  D
  1.  ... F  S LABEL=$O(^BLRENTRY(USER,CURDATE,ENTRY,LABEL)) Q:LABEL=""  D
  1.  .... W "."
  1.  .... W:$X>75 !,?4
  1.  .... S STACK=0
  1.  .... F  S STACK=$O(^BLRENTRY(USER,CURDATE,ENTRY,LABEL,"$STACK",STACK))  Q:STACK<1  D
  1.  ..... S CURPLACE=$G(^BLRENTRY(USER,CURDATE,ENTRY,LABEL,"$STACK",STACK,3,"CURRENT PLACE"))
  1.  ..... S STACKNUM=1+$G(STACK(-1))
  1.  ..... S STACK(-1)=STACKNUM
  1.  ..... S STACK(STACKNUM)=CURPLACE
  1.  ..... S STACKRTN=$P($P(CURPLACE,"^",2)," ")
  1.  ..... S:$L(STACKRTN) ^TMP("BLRAGUT2",$J,ENTRY)=STACKRTN_"^"_USER_"^"_CURDATE_"^"_LABEL
  1.  ;
  1.  W !
  1.  ;
  1.  Q
  1.  ;
  1. SHOSTCKP ; EP - Print the report
  1.  S ENTRY="A"
  1.  F  S ENTRY=$O(^TMP("BLRAGUT2",$J,ENTRY),-1)  Q:ENTRY<1!(QFLG="Q")  D
  1.  . I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO")  Q:QFLG="Q"
  1.  . S STR=$G(^TMP("BLRAGUT2",$J,ENTRY))
  1.  . W $P(STR,"^")
  1.  . W ?9,$P(STR,"^",2)
  1.  . W ?19,$P(STR,"^",3)
  1.  . W ?34,ENTRY
  1.  . W ?44,$E($P(STR,"^",4,99),1,36),!
  1.  . S LINES=LINES+1
  1.  ;
  1.  D:QFLG'="Q" PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. GETDATE(DATER) ; EP -- Get Specific Date; Default entry is TODAY
  1.  D ^XBFMK
  1.  S DIR(0)="DO"
  1.  S DIR("A")="Specific Date"
  1.  S DIR("B")=$$HTE^XLFDT($H,"5DZ")
  1.  D ^DIR
  1.  I +$G(DUOUT)>0 D  Q 0
  1.  . W !,?5,"FileMan Quit Entered. Routine Ends.",!
  1.  . D PRESSKEY^BLRGMENU(10)
  1.  ;
  1.  S:+$G(Y)<1 DATER=$$DT^XLFDT
  1.  S:+$G(Y)>0 DATER=+$G(Y)
  1.  ;
  1.  Q DATER