AQAOVAR.m

AQAOVAR ; IHS/ORDC/LJF - MENU ENTRY AND EXIT ACTIONS ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;

 ;This rtn contains the entry and exit actions for the main QAI menu

 ;as well as common subrtns for other menus and options.

 ;

 Q

ENTER ;ENTRY POINT entry actions for AQAOMENU

 S Y=0,Y=$O(^DIC(9.4,"C","AQAO",Y)),AQAO("VERS")=^DIC(9.4,Y,"VERSION")

 S Z=$O(^DIC(9.4,Y,22,"B",+AQAO("VERS"),0)) I Z="" S XQUIT=1 D XQUIT Q

 S Y=$P(^DIC(9.4,Y,22,Z,0),U,2) X ^DD("DD")

 S AQAO("VERDT")=Y

 ;

 D ^XBCLS W !?18 F AQAO("I")=1:1:41 W "*"

 W !?18,"*",?58,"*",!?18,"*        INDIAN HEALTH SERVICE          *"

 W !?18,"*   QUALITY ASSESSMENT & IMPROVEMENT    *"

 W !?18,"*          MANAGEMENT SYSTEM            *"

 W !?18,"*       VERSION ",AQAO("VERS"),", ",AQAO("VERDT"),?58,"*"

 W !?18,"*",?58,"*",!?18 F AQAO("I")=1:1:41 W "*"

 ;

 I '$D(DUZ(2))!('$D(DUZ(0))) D  G XQUIT

 .W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE THE QAI"

 .W " MANAGEMENT SYSTEM!" S XQUIT=1

 S X=$P($G(^DIC(4,DUZ(2),0)),U) W !!?80-$L(X)\2,X

 I X="" W !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!" S XQUIT=""

 ;

 ; >>> check user's access to package

 K AQAOPT I '$D(^AQAO(9,DUZ,0)) G NOTUSER ;not in qi user file

 S AQAOUA("USER")=^AQAO(9,DUZ,0)

 I $P(AQAOUA("USER"),U,2)="" K AQAOPT G NOTUSER ;not activated

 I $P(AQAOUA("USER"),U,4)'="" K AQAOPT G NOTUSER ;inactivated

 G XQUIT:($P(AQAOUA("USER"),U,6)["Q") ;qi staff

 ;

 ; >>> set user's access by qi team

 S X=0 F  S X=$O(^AQAO(9,DUZ,"TM",X)) Q:X'=+X  D

 .Q:'$D(^AQAO(9,DUZ,"TM",X,0))  S Y=^(0) Q:Y=""

 .I $P(Y,U,2)="" K AQAOPT Q

 .S AQAOUA("USER",$P(Y,U))=$P(Y,U,2)

 .I $P(Y,U,2)>$G(AQAOUA("USER","ACCESS")) S AQAOUA("USER","ACCESS")=$P(Y,U,2) ;set highest access level

 ;

NOTUSER I '$D(AQAOUA("USER")) D

 .S XQUIT=""

 .W *7,!!?10,"**** YOU ARE NOT LISTED AS AN AUTHORIZED QI USER! ****"

 .W !?15,"**** PLEASE SEE YOUR QI STAFF FOR ACCESS ****",!! H 5

 ;

XQUIT W ! K X,Y

 Q

 ;

 ;

MENU ;ENTRY POINT  >>> entry action for all submenus

 S AQAO("TITLE")=$P($G(XQY0),U,2)

 I $L(AQAO("TITLE"))>2 W @IOF,!!?80-$L(AQAO("TITLE"))/2,AQAO("TITLE")

 S X=$P($G(^DIC(4,DUZ(2),0)),U)

 W !!?80-$L(X)\2,"(",X,")"

 K AQAO

 Q

 ;

PRTOPT ;ENTRY POINT  >>> exit action for print options

 Q:IOST'["C-"  ;PATCH 2

 K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR W @IOF

 K DIR Q

 ;

EXIT ;ENTRY POINT  >>> exit actions for AQAOMENU

 K AQAOCHK,AQAOUA,AQAOXYZ,AQAOINAC,AQAOENTR K ^TMP("AQAOCHK",$J)

 Q

AQAOVAR   ; IHS/ORDC/LJF - MENU ENTRY AND EXIT ACTIONS ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +2       ;

 +3       ;This rtn contains the entry and exit actions for the main QAI menu

 +4       ;as well as common subrtns for other menus and options.

 +5       ;

 +6        QUIT 

ENTER     ;ENTRY POINT entry actions for AQAOMENU

 +1        SET Y=0

           SET Y=$ORDER(^DIC(9.4,"C","AQAO",Y))

           SET AQAO("VERS")=^DIC(9.4,Y,"VERSION")

 +2        SET Z=$ORDER(^DIC(9.4,Y,22,"B",+AQAO("VERS"),0))

           IF Z=""

               SET XQUIT=1

               DO XQUIT

               QUIT 

 +3        SET Y=$PIECE(^DIC(9.4,Y,22,Z,0),U,2)

           XECUTE ^DD("DD")

 +4        SET AQAO("VERDT")=Y

 +5       ;

 +6        DO ^XBCLS

           WRITE !?18

           FOR AQAO("I")=1:1:41

               WRITE "*"

 +7        WRITE !?18,"*",?58,"*",!?18,"*        INDIAN HEALTH SERVICE          *"

 +8        WRITE !?18,"*   QUALITY ASSESSMENT & IMPROVEMENT    *"

 +9        WRITE !?18,"*          MANAGEMENT SYSTEM            *"

 +10       WRITE !?18,"*       VERSION ",AQAO("VERS"),", ",AQAO("VERDT"),?58,"*"

 +11       WRITE !?18,"*",?58,"*",!?18

           FOR AQAO("I")=1:1:41

               WRITE "*"

 +12      ;

 +13       IF '$DATA(DUZ(2))!('$DATA(DUZ(0)))

               Begin DoDot:1

 +14               WRITE !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE THE QAI"

 +15               WRITE " MANAGEMENT SYSTEM!"

                   SET XQUIT=1

               End DoDot:1

               GOTO XQUIT

 +16       SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)

           WRITE !!?80-$LENGTH(X)\2,X

 +17       IF X=""

               WRITE !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!"

               SET XQUIT=""

 +18      ;

 +19      ; >>> check user's access to package

 +20      ;not in qi user file

           KILL AQAOPT

           IF '$DATA(^AQAO(9,DUZ,0))

               GOTO NOTUSER

 +21       SET AQAOUA("USER")=^AQAO(9,DUZ,0)

 +22      ;not activated

           IF $PIECE(AQAOUA("USER"),U,2)=""

               KILL AQAOPT

               GOTO NOTUSER

 +23      ;inactivated

           IF $PIECE(AQAOUA("USER"),U,4)'=""

               KILL AQAOPT

               GOTO NOTUSER

 +24      ;qi staff

           IF ($PIECE(AQAOUA("USER"),U,6)["Q")

               GOTO XQUIT

 +25      ;

 +26      ; >>> set user's access by qi team

 +27       SET X=0

           FOR 

               SET X=$ORDER(^AQAO(9,DUZ,"TM",X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +28               IF '$DATA(^AQAO(9,DUZ,"TM",X,0))

                       QUIT 

                   SET Y=^(0)

                   IF Y=""

                       QUIT 

 +29               IF $PIECE(Y,U,2)=""

                       KILL AQAOPT

                       QUIT 

 +30               SET AQAOUA("USER",$PIECE(Y,U))=$PIECE(Y,U,2)

 +31      ;set highest access level

                   IF $PIECE(Y,U,2)>$GET(AQAOUA("USER","ACCESS"))

                       SET AQAOUA("USER","ACCESS")=$PIECE(Y,U,2)

               End DoDot:1

 +32      ;

NOTUSER    IF '$DATA(AQAOUA("USER"))

               Begin DoDot:1

 +1                SET XQUIT=""

 +2                WRITE *7,!!?10,"**** YOU ARE NOT LISTED AS AN AUTHORIZED QI USER! ****"

 +3                WRITE !?15,"**** PLEASE SEE YOUR QI STAFF FOR ACCESS ****",!!

                   HANG 5

               End DoDot:1

 +4       ;

XQUIT      WRITE !

           KILL X,Y

 +1        QUIT 

 +2       ;

 +3       ;

MENU      ;ENTRY POINT  >>> entry action for all submenus

 +1        SET AQAO("TITLE")=$PIECE($GET(XQY0),U,2)

 +2        IF $LENGTH(AQAO("TITLE"))>2

               WRITE @IOF,!!?80-$LENGTH(AQAO("TITLE"))/2,AQAO("TITLE")

 +3        SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)

 +4        WRITE !!?80-$LENGTH(X)\2,"(",X,")"

 +5        KILL AQAO

 +6        QUIT 

 +7       ;

PRTOPT    ;ENTRY POINT  >>> exit action for print options

 +1       ;PATCH 2

           IF IOST'["C-"

               QUIT 

 +2        KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press RETURN to continue"

           DO ^DIR

           WRITE @IOF

 +3        KILL DIR

           QUIT 

 +4       ;

EXIT      ;ENTRY POINT  >>> exit actions for AQAOMENU

 +1        KILL AQAOCHK,AQAOUA,AQAOXYZ,AQAOINAC,AQAOENTR

           KILL ^TMP("AQAOCHK",$JOB)

 +2        QUIT