BLRMSKEY.m

BLRMSKEY ;IHS/MSC/MKK - Laboratory Menus and Security KEYs Report ; 17-Oct-2014 09:22 ; MKK

 ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88

 ;

PEP ; EP

EP ; EP

 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 ;

 Q:$$INITVARS()="Q"

 ;

 ; Compile

 F SEED="BLR","LR"  D

 . S NAME=SEED,SEEDLEN=$L(SEED)

 . F  S NAME=$O(^DIC(19,"B",NAME))  Q:NAME=""!(QFLG="Q")!($E(NAME,1,SEEDLEN)'=SEED)  D

 .. S IEN=$O(^DIC(19,"B",NAME,0))

 .. S LOCK=$$GET1^DIQ(19,IEN,"LOCK")

 .. Q:$L(LOCK)<1     ; Skip if no Security Key

 .. ;

 .. S:$L(LOCK)>MAXLOCKL MAXLOCKL=$L(LOCK)_"^"_LOCK

 .. S:$L(NAME)>MAXNAME MAXNAME=$L(NAME)_"^"_NAME

 .. S MENUTEXT=$$GET1^DIQ(19,IEN,"MENU TEXT")

 .. S:$L(MENUTEXT)>MAXMENU MAXMENU=$L(MENUTEXT)_"^"_MENUTEXT

 .. S ^TMP(BLRVERN,$J,MENUTEXT)=LOCK_"~"_NAME

 ;

 S MENUTEXT=""

 F  S MENUTEXT=$O(^TMP(BLRVERN,$J,MENUTEXT))  Q:MENUTEXT=""!(QFLG="Q")  D	

 . I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)  Q:QFLG="Q"

 . ;

 . S STR=$G(^TMP(BLRVERN,$J,MENUTEXT))

 . S LOCK=$P(STR,"~")

 . S NAME=$P(STR,"~",2)

 . W LOCK

 . W ?14,$E(MENUTEXT,1,38)

 . I $L(NAME)<25  W ?54,NAME

 . E  D LINEWRAP^BLRGMENU(54,NAME,25)

 . W !

 . S LINES=LINES+1

 ;

 D ^%ZISC

 ;

 W !!,?4,"Longest Security KEY=",MAXLOCKL,!

 W ?9,"Longest Option Name=",MAXNAME,!

 W ?9,"Longest MENU TEXT=",MAXMENU

 D PRESSKEY^BLRGMENU(4)

 K ^TMP(BLRVERN,$J)

 Q

 ;

INITVARS() ; EP - Initialization

 S BLRVERN=$TR($P($T(+1),";")," ")

 ;

 S HEADER(1)="Option (#19) File"

 S HEADER(2)="RPMS Lab Security Keys Report"

 D HEADERDT^BLRGMENU

 D HEADONE^BLRGMENU(.HDRONE)

 ;

 S HEADER(3)=" "

 S HEADER(4)="Security Key"

 S $E(HEADER(4),15)="Menu Text"

 S $E(HEADER(4),55)="Option Name"

 ;

 D ^%ZIS

 U IO

 ;

 S MAXLINES=IOSL-4,LINES=MAXLINES+10

 S (CNT,MAXLOCKL,MAXMENU,MAXNAME,PG)=0

 S QFLG="NO"

 ;

 K ^TMP(BLRVERN,$J)

 Q "OK"

BLRMSKEY  ;IHS/MSC/MKK - Laboratory Menus and Security KEYs Report ; 17-Oct-2014 09:22 ; MKK

 +1       ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88

 +2       ;

PEP       ; EP

EP        ; EP

 +1        NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 +2       ;

 +3        IF $$INITVARS()="Q"

               QUIT 

 +4       ;

 +5       ; Compile

 +6        FOR SEED="BLR","LR"

               Begin DoDot:1

 +7                SET NAME=SEED

                   SET SEEDLEN=$LENGTH(SEED)

 +8                FOR 

                       SET NAME=$ORDER(^DIC(19,"B",NAME))

                       IF NAME=""!(QFLG="Q")!($EXTRACT(NAME,1,SEEDLEN)'=SEED)

                           QUIT 

                       Begin DoDot:2

 +9                        SET IEN=$ORDER(^DIC(19,"B",NAME,0))

 +10                       SET LOCK=$$GET1^DIQ(19,IEN,"LOCK")

 +11      ; Skip if no Security Key

                           IF $LENGTH(LOCK)<1

                               QUIT 

 +12      ;

 +13                       IF $LENGTH(LOCK)>MAXLOCKL

                               SET MAXLOCKL=$LENGTH(LOCK)_"^"_LOCK

 +14                       IF $LENGTH(NAME)>MAXNAME

                               SET MAXNAME=$LENGTH(NAME)_"^"_NAME

 +15                       SET MENUTEXT=$$GET1^DIQ(19,IEN,"MENU TEXT")

 +16                       IF $LENGTH(MENUTEXT)>MAXMENU

                               SET MAXMENU=$LENGTH(MENUTEXT)_"^"_MENUTEXT

 +17                       SET ^TMP(BLRVERN,$JOB,MENUTEXT)=LOCK_"~"_NAME

                       End DoDot:2

               End DoDot:1

 +18      ;

 +19       SET MENUTEXT=""

 +20       FOR 

               SET MENUTEXT=$ORDER(^TMP(BLRVERN,$JOB,MENUTEXT))

               IF MENUTEXT=""!(QFLG="Q")

                   QUIT