XBTM3.m

XBTM3 ; IHS/ADC/GTH - TECH MANUAL : SECURITY KEYS ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 NEW A,B,C

 F A=1:1 S X=$P($T(PR+A),";;",2) Q:X="###"  D PR(X) Q:$D(DUOUT)

 Q:$D(DUOUT)

 D ^DIWW

 F A="XAz","ZIBz" D SK(A) Q:$D(DUOUT)

 Q

 ;

SK(A) ; Print info on security keys for namespace A.

 F  S A=$O(^DIC(19.1,"B",A)) Q:'($E(A,1,4)="XB")  S B=$O(^(A,0)) D

 . S DIWF="WN"

 . D PR("|_|"_$P(^DIC(19.1,B,0),U)_"|_|")

 . Q:$D(DUOUT)

 . I '$O(^DIC(19,"AOL",A,0)) D PR("   --> KEY NOT USED <--") I 1

 . E  S C=0 F  S C=$O(^DIC(19,"AOL",A,C)) Q:'C  D PR("Locks "_$P(^DIC(19,C,0),U)_", '"_$P(^DIC(19,C,0),U,2)_"'.")

 . Q:$D(DUOUT)

 . S DIWF="W"

 . D PR("DESCRIPTION: ")

 . Q:$D(DUOUT)

 . S C=0

 . F  S C=$O(^DIC(19.1,B,1,C)) Q:'C  D PR(^(C,0))

 . Q:$D(DUOUT)

 . D ^DIWW

 . W !

 .Q

 D ^DIWW

 Q

 ;

PR(X) NEW A,B,C D PR^XBTM(X) Q

 ;;|SETTAB("C")||TAB| 

 ;;|SETTAB("C")||TAB| 

 ;;###

XBTM3     ; IHS/ADC/GTH - TECH MANUAL : SECURITY KEYS ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3        NEW A,B,C

 +4        FOR A=1:1

               SET X=$PIECE($TEXT(PR+A),";;",2)

               IF X="###"

                   QUIT 

               DO PR(X)

               IF $DATA(DUOUT)

                   QUIT 

 +5        IF $DATA(DUOUT)

               QUIT 

 +6        DO ^DIWW

 +7        FOR A="XAz","ZIBz"

               DO SK(A)

               IF $DATA(DUOUT)

                   QUIT 

 +8        QUIT 

 +9       ;

SK(A)     ; Print info on security keys for namespace A.

 +1        FOR 

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

               IF '($EXTRACT(A,1,4)="XB")

                   QUIT 

               SET B=$ORDER(^(A,0))

               Begin DoDot:1

 +2                SET DIWF="WN"

 +3                DO PR("|_|"_$PIECE(^DIC(19.1,B,0),U)_"|_|")

 +4                IF $DATA(DUOUT)

                       QUIT 

 +5                IF '$ORDER(^DIC(19,"AOL",A,0))

                       DO PR("   --> KEY NOT USED <--")

                       IF 1

 +6               IF '$TEST

                       SET C=0

                       FOR 

                           SET C=$ORDER(^DIC(19,"AOL",A,C))

                           IF 'C

                               QUIT 

                           DO PR("Locks "_$PIECE(^DIC(19,C,0),U)_", '"_$PIECE(^DIC(19,C,0),U,2)_"'.")

 +7                IF $DATA(DUOUT)

                       QUIT 

 +8                SET DIWF="W"

 +9                DO PR("DESCRIPTION: ")

 +10               IF $DATA(DUOUT)

                       QUIT 

 +11               SET C=0

 +12               FOR 

                       SET C=$ORDER(^DIC(19.1,B,1,C))

                       IF 'C

                           QUIT 

                       DO PR(^(C,0))

 +13               IF $DATA(DUOUT)

                       QUIT 

 +14               DO ^DIWW

 +15               WRITE !

 +16               QUIT 

               End DoDot:1

 +17       DO ^DIWW

 +18       QUIT 

 +19      ;

PR(X)      NEW A,B,C

           DO PR^XBTM(X)

           QUIT 

 +1       ;;|SETTAB("C")||TAB| 

 +2       ;;|SETTAB("C")||TAB| 

 +3       ;;###