AZAXKEY ;IHS/PHXAO/AEF - PRINT SECURITY KEYS AND MENUS OF SELECTED EMPLOYEE
;;1.0;PHXAO LOCAL ROUTINES;;OCT 12, 2004
;
DESC ;----- ROUTINE DESCRIPTION
;;
;;This routine prints a form listing the selected employee's security
;;keys and the menu options that the employee has access to.
;;
;;$$END
;
N I,X
F I=1:1 S X=$T(DESC+I) Q:X["$$END" W !,$P(X,";;",2)
Q
EN ;EP -- MAIN ENTRY POINT
;
N Y
D ^XBKVAR
D HOME^%ZIS
;
D DESC
;
D SEL(.Y)
Q:+Y'>0
S AZAXDUZ=+Y
;
Q
SEL(Y) ;
;----- SELECT THE EMPLOYEE
;
N DIC,X
S DIC="^VA(200,"
S DIC(0)="AEMQ"
D ^DIC
Q Y
DQ ;EP -- QUEUED JOB STARTS HERE
;
N AZAXOUT,AZAXPAGE,AZAXTTL1
;
D ^XBKVAR
D HOME^%ZIS
;
S AZAXOUT=0
S AZAXPAGE=0
S AZAXTTL1=" RPMS COMPUTER ACCESS FORM"
S AZAXTTL2=""
;
D KEYS(AZAXDUZ)
D HDR(AZAXTTL1,AZAXTTL2,.AZAXPAGE,.AZAXOUT)
D PKEYS(AZAXDUZ,AZAXTTL1,.AZAXPAGE,.AZAXOUT)
;
D MENUS(AZAXDUZ)
Q
KEYS(AZAXDUZ) ;
;----- GET A USER'S KEYS AND STORE THEM ALPHABETICALLY IN ^TMP
;
S AZAXKEY=0
F S AZAXKEY=$O(^VA(200,AZAXDUZ,51,AZAXKEY)) Q:'AZAXKEY D
. S AZAXKEYN=$P($G(^DIC(19.1,AZAXKEY,0)),U)
. Q:AZAXKEYN']""
. S ^TMP("AZAX",$J,AZAXDUZ,"KEYS",AZAXKEYN,0)=AZAXKEY
Q
PKEYS(AZAXDUZ,AZAXTTL1,AZAXPAGE,AZAXOUT) ;
;----- PRINT A USER'S KEYS
;
S AZAXTTL2="SECURITY KEYS FOR "_$P($G(^VA(200,AZAXDUZ,0)),U)_":"
S AZAXPAGE=0
S AZAXOUT=0
S AZAXCNT=0
S AZAXCOL=0
S AZAXKEYN=""
F S AZAXKEYN=$O(^TMP("AZAX",$J,AZAXDUZ,"KEYS",AZAXKEYN)) Q:AZAXKEYN']"" D Q:AZAXOUT
. S AZAXCNT=AZAXCNT+1
. I AZAXCNT>3 S AZAXCNT=1
. S AZAXCOL=$P("1^28^55",U,AZAXCNT)
. I AZAXCOL=1 W !
. I $Y>(IOSL-5) D HDR(AZAXTTL1,AZAXTTL2,.AZAXPAGE,.AZAXOUT)
. Q:AZAXOUT
. W ?AZAXCOL,$E(AZAXKEYN,1,25)
I 'AZAXCNT D
. W !?5,"THIS USER POSSESSES NO SECURITY KEYS",!
Q
;----- GETS A USER'S MENU OPTIONS
;
Q
HDR(AZAXTTL1,AZAXTTL2,AZAXPAGE,AZAXOUT) ;
;----- WRITE HEADER
;
N DIR,X,Y
;
I $E(IOST)="C",$G(AZAXPAGE) D
. S DIR(0)="E"
. D ^DIR
. K DIR
. I 'Y S AZAXOUT=1
Q:$G(AZAXOUT)
;
S AZAXPAGE=$G(AZAXPAGE)+1
W @IOF
W !,AZAXTTL1
W ?(IOM-10),"PAGE ",AZAXPAGE
W !!,AZAXTTL2
W !
;F I=1:1:IOM W "-"
W !
Q
AZAXKEY ;IHS/PHXAO/AEF - PRINT SECURITY KEYS AND MENUS OF SELECTED EMPLOYEE
+1 ;;1.0;PHXAO LOCAL ROUTINES;;OCT 12, 2004
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This routine prints a form listing the selected employee's security
+3 ;;keys and the menu options that the employee has access to.
+4 ;;
+5 ;;$$END
+6 ;
+7 NEW I,X
+8 FOR I=1:1
SET X=$TEXT(DESC+I)
IF X["$$END"
QUIT
WRITE !,$PIECE(X,";;",2)
+9 QUIT
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW Y
+3 DO ^XBKVAR
+4 DO HOME^%ZIS
+5 ;
+6 DO DESC
+7 ;
+8 DO SEL(.Y)
+9 IF +Y'>0
QUIT
+10 SET AZAXDUZ=+Y
+11 ;
+12 QUIT
SEL(Y) ;
+1 ;----- SELECT THE EMPLOYEE
+2 ;
+3 NEW DIC,X
+4 SET DIC="^VA(200,"
+5 SET DIC(0)="AEMQ"
+6 DO ^DIC
+7 QUIT Y
DQ ;EP -- QUEUED JOB STARTS HERE
+1 ;
+2 NEW AZAXOUT,AZAXPAGE,AZAXTTL1
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 SET AZAXOUT=0
+8 SET AZAXPAGE=0
+9 SET AZAXTTL1=" RPMS COMPUTER ACCESS FORM"
+10 SET AZAXTTL2=""
+11 ;
+12 DO KEYS(AZAXDUZ)
+13 DO HDR(AZAXTTL1,AZAXTTL2,.AZAXPAGE,.AZAXOUT)
+14 DO PKEYS(AZAXDUZ,AZAXTTL1,.AZAXPAGE,.AZAXOUT)
+15 ;
+16 DO MENUS(AZAXDUZ)
+17 QUIT
KEYS(AZAXDUZ) ;
+1 ;----- GET A USER'S KEYS AND STORE THEM ALPHABETICALLY IN ^TMP
+2 ;
+3 SET AZAXKEY=0
+4 FOR
SET AZAXKEY=$ORDER(^VA(200,AZAXDUZ,51,AZAXKEY))
IF 'AZAXKEY
QUIT
Begin DoDot:1
+5 SET AZAXKEYN=$PIECE($GET(^DIC(19.1,AZAXKEY,0)),U)
+6 IF AZAXKEYN']""
QUIT
+7 SET ^TMP("AZAX",$JOB,AZAXDUZ,"KEYS",AZAXKEYN,0)=AZAXKEY
End DoDot:1
+8 QUIT
PKEYS(AZAXDUZ,AZAXTTL1,AZAXPAGE,AZAXOUT) ;
+1 ;----- PRINT A USER'S KEYS
+2 ;
+3 SET AZAXTTL2="SECURITY KEYS FOR "_$PIECE($GET(^VA(200,AZAXDUZ,0)),U)_":"
+4 SET AZAXPAGE=0
+5 SET AZAXOUT=0
+6 SET AZAXCNT=0
+7 SET AZAXCOL=0
+8 SET AZAXKEYN=""
+9 FOR
SET AZAXKEYN=$ORDER(^TMP("AZAX",$JOB,AZAXDUZ,"KEYS",AZAXKEYN))
IF AZAXKEYN']""
QUIT
Begin DoDot:1
+10 SET AZAXCNT=AZAXCNT+1
+11 IF AZAXCNT>3
SET AZAXCNT=1
+12 SET AZAXCOL=$PIECE("1^28^55",U,AZAXCNT)
+13 IF AZAXCOL=1
WRITE !
+14 IF $Y>(IOSL-5)
DO HDR(AZAXTTL1,AZAXTTL2,.AZAXPAGE,.AZAXOUT)
+15 IF AZAXOUT
QUIT
+16 WRITE ?AZAXCOL,$EXTRACT(AZAXKEYN,1,25)
End DoDot:1
IF AZAXOUT
QUIT
+17 IF 'AZAXCNT
Begin DoDot:1
+18 WRITE !?5,"THIS USER POSSESSES NO SECURITY KEYS",!
End DoDot:1
+19 QUIT
+1 ;----- GETS A USER'S MENU OPTIONS
+2 ;
+3 QUIT
HDR(AZAXTTL1,AZAXTTL2,AZAXPAGE,AZAXOUT) ;
+1 ;----- WRITE HEADER
+2 ;
+3 NEW DIR,X,Y
+4 ;
+5 IF $EXTRACT(IOST)="C"
IF $GET(AZAXPAGE)
Begin DoDot:1
+6 SET DIR(0)="E"
+7 DO ^DIR
+8 KILL DIR
+9 IF 'Y
SET AZAXOUT=1
End DoDot:1
+10 IF $GET(AZAXOUT)
QUIT
+11 ;
+12 SET AZAXPAGE=$GET(AZAXPAGE)+1
+13 WRITE @IOF
+14 WRITE !,AZAXTTL1
+15 WRITE ?(IOM-10),"PAGE ",AZAXPAGE
+16 WRITE !!,AZAXTTL2
+17 WRITE !
+18 ;F I=1:1:IOM W "-"
+19 WRITE !
+20 QUIT
