BDGKEYS.m

BDGKEYS ; IHS/ANMC/LJF - LIST HOLDERS OF ADT KEYS ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

EN ; -- main entry point for BDG ADT KEYS

 NEW VALMCNT

 D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BDG ADT KEYS")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 NEW X S X="Listing of security keys used by this module"

 S VALMHDR(1)=$$SP(10)_X

 Q

 ;

INIT ; -- init variables and list array

 NEW DGKEY,USER,X,LINE,FIRST,N

 S VALMCNT=0 K ^TMP("BDGKEYS",$J)

 ;

 ; loop by keys in this module

 S DGKEY="DGZ",FIRST=1

 F  S DGKEY=$O(^DIC(19.1,"B",DGKEY)) Q:$E(DGKEY,1,3)'="DGZ"  D

 . D:'FIRST SET("",.VALMCNT) S FIRST=0   ;add blank line between keys

 . S X=$$PAD(DGKEY,25)_"("_$$DESCR(DGKEY)_")"    ;subheading for key

 . D SET(X,.VALMCNT)                       ;put into display global

 . ;

 . ; now display full description

 . S X=$O(^DIC(19.1,"B",DGKEY,0)) I 'X Q "??"

 . S N=0 F  S N=$O(^DIC(19.1,X,1,N)) Q:'N  D

 .. D SET($$SP(5)_$G(^DIC(19.1,X,1,N,0)),.VALMCNT)

 ;

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BDGKEYS",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

SET(LINE,COUNT) ; -- sets line into display global

 S COUNT=COUNT+1

 S ^TMP("BDGKEYS",$J,COUNT,0)=LINE

 Q

 ;

DESCR(KEY) ; -- returns description of security key

 NEW X

 S X=$O(^DIC(19.1,"B",KEY,0)) I 'X Q "??"

 Q $E($$GET1^DIQ(19.1,X,.02),1,40)

 ;

PAD(D,L) ;EP -- SUBRTN to pad length of data

 ; -- D=data L=length

 Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)

 ;

SP(N) ; -- SUBRTN to pad N number of spaces

 Q $$PAD(" ",N)

BDGKEYS   ; IHS/ANMC/LJF - LIST HOLDERS OF ADT KEYS ; 

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

EN        ; -- main entry point for BDG ADT KEYS

 +1        NEW VALMCNT

 +2        DO TERM^VALM0

           DO CLEAR^VALM1

 +3        DO EN^VALM("BDG ADT KEYS")

 +4        DO CLEAR^VALM1

 +5        QUIT 

 +6       ;

HDR       ; -- header code

 +1        NEW X

           SET X="Listing of security keys used by this module"

 +2        SET VALMHDR(1)=$$SP(10)_X

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1        NEW DGKEY,USER,X,LINE,FIRST,N

 +2        SET VALMCNT=0

           KILL ^TMP("BDGKEYS",$JOB)

 +3       ;

 +4       ; loop by keys in this module

 +5        SET DGKEY="DGZ"

           SET FIRST=1

 +6        FOR 

               SET DGKEY=$ORDER(^DIC(19.1,"B",DGKEY))

               IF $EXTRACT(DGKEY,1,3)'="DGZ"

                   QUIT 

               Begin DoDot:1

 +7       ;add blank line between keys

                   IF 'FIRST

                       DO SET("",.VALMCNT)

                   SET FIRST=0

 +8       ;subheading for key

                   SET X=$$PAD(DGKEY,25)_"("_$$DESCR(DGKEY)_")"

 +9       ;put into display global

                   DO SET(X,.VALMCNT)

 +10      ;

 +11      ; now display full description

 +12               SET X=$ORDER(^DIC(19.1,"B",DGKEY,0))

                   IF 'X

                       QUIT "??"

 +13               SET N=0

                   FOR 

                       SET N=$ORDER(^DIC(19.1,X,1,N))

                       IF 'N

                           QUIT 

                       Begin DoDot:2

 +14                       DO SET($$SP(5)_$GET(^DIC(19.1,X,1,N,0)),.VALMCNT)

                       End DoDot:2

               End DoDot:1

 +15      ;

 +16       QUIT 

 +17      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BDGKEYS",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

SET(LINE,COUNT) ; -- sets line into display global

 +1        SET COUNT=COUNT+1

 +2        SET ^TMP("BDGKEYS",$JOB,COUNT,0)=LINE

 +3        QUIT 

 +4       ;

DESCR(KEY) ; -- returns description of security key

 +1        NEW X

 +2        SET X=$ORDER(^DIC(19.1,"B",KEY,0))

           IF 'X

               QUIT "??"

 +3        QUIT $EXTRACT($$GET1^DIQ(19.1,X,.02),1,40)

 +4       ;

PAD(D,L)  ;EP -- SUBRTN to pad length of data

 +1       ; -- D=data L=length

 +2        QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)

 +3       ;

SP(N)     ; -- SUBRTN to pad N number of spaces

 +1        QUIT $$PAD(" ",N)