- 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
- ;
- ;
- 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 ;
- +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
