BDGSECU1.m

BDGSECU1 ; IHS/ANMC/LJF - LIST HOLDERS OF SENSITIVE KEYS ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

EN ; -- main entry point for BDG SECURITY KEYS

 NEW VALMCNT

 D TERM^VALM0

 D EN^VALM("BDG SECURITY KEYS")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 NEW X S X="Listing of Users with keys important to this module"

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

 Q

 ;

INIT ; -- init variables and list array

 NEW DGKEY,USER,X,LINE

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

 ;

 ; loop by keys in this module

 F DGKEY="DG SECURITY OFFICER","DG SENSITIVITY","DG RECORD ACCESS" D

 . I DGKEY'["OFFICER" D SET("",.VALMCNT)   ;add blank line between keys

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

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

 . ;

 . ; find each user holding that key

 . S USER=0 F  S USER=$O(^XUSEC(DGKEY,USER)) Q:'USER  D

 .. S LINE=$$SP(5)_$$GET1^DIQ(200,USER,.01)        ;user's name

 .. S LINE=$$PAD(LINE,35)_$$GET1^DIQ(200,USER,29)  ;service/section

 .. D SET(LINE,.VALMCNT)

 ;

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

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

 S COUNT=COUNT+1

 S ^TMP("BDGSECU",$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)

BDGSECU1  ; IHS/ANMC/LJF - LIST HOLDERS OF SENSITIVE KEYS ; 

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

 +2       ;

EN        ; -- main entry point for BDG SECURITY KEYS

 +1        NEW VALMCNT

 +2        DO TERM^VALM0

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

 +4        DO CLEAR^VALM1

 +5        QUIT 

 +6       ;

HDR       ; -- header code

 +1        NEW X

           SET X="Listing of Users with keys important to this module"

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

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1        NEW DGKEY,USER,X,LINE

 +2        SET VALMCNT=0

           KILL ^TMP("BDGSECU",$JOB)

 +3       ;

 +4       ; loop by keys in this module

 +5        FOR DGKEY="DG SECURITY OFFICER","DG SENSITIVITY","DG RECORD ACCESS"

               Begin DoDot:1

 +6       ;add blank line between keys

                   IF DGKEY'["OFFICER"

                       DO SET("",.VALMCNT)

 +7       ;subheading for key

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

 +8       ;put into display global

                   DO SET(X,.VALMCNT)

 +9       ;

 +10      ; find each user holding that key

 +11               SET USER=0

                   FOR 

                       SET USER=$ORDER(^XUSEC(DGKEY,USER))

                       IF 'USER

                           QUIT 

                       Begin DoDot:2

 +12      ;user's name

                           SET LINE=$$SP(5)_$$GET1^DIQ(200,USER,.01)

 +13      ;service/section

                           SET LINE=$$PAD(LINE,35)_$$GET1^DIQ(200,USER,29)

 +14                       DO SET(LINE,.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        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

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

 +1        SET COUNT=COUNT+1

 +2        SET ^TMP("BDGSECU",$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)