AQAOQT1 ; IHS/ORDC/LJF - BRAINSTORMING & MULTIVOTING ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn is main driver for brainstorming & multivoting tool.
;
D INTRO^AQAOHQIT
K DIR S DIR(0)="SO^1:GENERAL INFO;2:BRAINSTORMING SESSION;3:MULTIVOTING;4:REPORTS"
S DIR("?")="Select one the the FUNCTIONS listed or press RETURN to exit"
S DIR("A")=" Select Option" D ^DIR
G EXIT:$D(DIRUT),MENU:Y=-1
;
; >>> call rtn for user's selection
S AQAOPT=$S(Y=1:"MTG",Y=2:"BRAIN",Y=3:"MULTIV",1:"REPORT")
D @AQAOPT G MENU
;
;
EXIT ; >>> eoj
D ^%ZISC D KILL^AQAOUTIL Q
; >>>> END OF MAIN SECTION OF RTN <<<<
;
;
;
MTG ; >>> SUBRTN to enter mtg info <<<
W !! K DIC S DIC="^AQAO1(8,",DIC(0)="AEMQZL",DLAYGO=9002169
S DIC("S")=$$DICS D ^DIC K DLAYGO
Q:$D(DTOUT) Q:$D(DUOUT) Q:X="" Q:Y=-1 S AQAOMTG=+Y
W !! K DIE S DIE="^AQAO1(8,",DA=AQAOMTG,DR="[AQAO QIT MTG]"
D ^DIE
Q
;
;
BRAIN ;ENTRY POINT >>> SUBRTN for brainstorming session <<<
W !!?20,"*** BRAINSTORMING SESSION ***"
; >>> find meeting entry # and display team and date/time
I '$D(AQAOMTG) D
.W !! K DIC S DIC="^AQAO1(8,",DIC("A")="Select SESSION DATE/TIME: "
.S DIC(0)="AEMZQ",DIC("S")=$$DICS D ^DIC I Y>0 S AQAOMTG=+Y
I '$D(AQAOMTG) W !!,"NO SESSION SELECTED" D MTG Q:'$D(AQAOMTG)
W !!?2,"QI TEAM: ",$P(^AQAO1(1,$P(^AQAO1(8,AQAOMTG,0),U,2),0),U)
W !,"DATE/TIME: " S Y=$P(^AQAO1(8,AQAOMTG,0),U) X ^DD("DD") W Y
W !?4,"TOPIC: ",$P(^AQAO1(8,AQAOMTG,0),U,3)
;
; >>> choose next action; call SUBRTNS
CHOOSE K DIR S DIR("A")=" Select NEXT ACTION"
S DIR(0)="SO^1:ADD IDEAS;2:LIST IDEAS;3:CATEGORIZE IDEAS;4:EDIT/DELETE IDEAS"
D ^DIR Q:$D(DIRUT)
S AQAOPT1=$S(Y=1:"IDEAS",Y=2:"LIST",Y=3:"CATEGORY",1:"EDIT")
S AQAOPT1=AQAOPT1_"^AQAOQT11" D @AQAOPT1 G CHOOSE
;
;
MULTIV ; >>> SUBRTN to handle multivoting session <<<
K AQAOAR1 W !!?20,"*** MULTIVOTING SESSION ***"
; >>> find meeting entry # and display team and date/time
I '$D(AQAOMTG) D
.W !! K DIC S DIC="^AQAO1(8,",DIC("A")="Select SESSION DATE/TIME: "
.S DIC(0)="AEMZQ",DIC("S")=$$DICS D ^DIC I Y>0 S AQAOMTG=+Y
I '$D(AQAOMTG) D Q:'$D(AQAOMTG)
.W !!,"NO BRAINSTORMING SESSION SELECTED" D MTG
;
W !!?2,"QI TEAM: ",$P(^AQAO1(1,$P(^AQAO1(8,AQAOMTG,0),U,2),0),U)
W !,"DATE/TIME: " S Y=$P(^AQAO1(8,AQAOMTG,0),U) X ^DD("DD") W Y
W !?4,"TOPIC: ",$P(^AQAO1(8,AQAOMTG,0),U,3)
I '$O(^AQAO1(7,"AC",AQAOMTG,0)) W !!,"NO IDEAS ENTERED!",!! Q
;
; choose next action; call SUBRTNS
CHOOSE1 K DIR S DIR("A")=" Select NEXT ACTION"
S DIR(0)="SO^1:LIST CATEGORIES;2:VOTE;3:VIEW VOTING RESULTS"
D ^DIR Q:$D(DIRUT)
S AQAOPT1=$S(Y=1:"LIST",Y=2:"VOTE",1:"RESULTS")
S AQAOPT1=AQAOPT1_"^AQAOQT12" D @AQAOPT1 G CHOOSE1
;
;
REPORT ; >>> SUBRTN to print results of brainstorming session <<<
W @IOF,!?20,"*** REPORT RESULTS OF BRAINSTORMING SESSION ***"
; find meeting entry # and display team and date/time
I '$D(AQAOMTG) W !! K DIC S DIC="^AQAO1(8,",DIC("A")="Select SESSION DATE/TIME: ",DIC(0)="AEMZQ",DIC("S")=$$DICS D ^DIC I Y>0 S AQAOMTG=+Y
I '$D(AQAOMTG) W !!,"NO SESSION SELECTED" D MTG Q:'$D(AQAOMTG)
W !!?2,"QI TEAM: ",$P(^AQAO1(1,$P(^AQAO1(8,AQAOMTG,0),U,2),0),U)
W !,"DATE/TIME: " S Y=$P(^AQAO1(8,AQAOMTG,0),U) X ^DD("DD") W Y
W !?4,"TOPIC: ",$P(^AQAO1(8,AQAOMTG,0),U,3)
;
; choose next action; call SUBRTNS
CHOOSE2 K DIR S DIR("A")=" Select REPORT TYPE"
S DIR(0)="SO^1:MULTIVOTING RESULTS ONLY;2:FULL REPORT ON BRAINSTORMING SESSION"
D ^DIR Q:$D(DIRUT)
S AQAOPT1=$S(Y=1:"RESULTS",1:"FULL")_"^AQAOQT13"
;
DEV ;ENTRY POINT get print device
W !! S %ZIS="QP" D ^%ZIS Q:POP
I '$D(IO("Q")) U IO D @AQAOPT1 Q
K IO("Q") S ZTRTN=AQAOPT1,ZTDESC="QI TOOLS REPORT"
F I="AQAOPT1","AQAOMTG" S ZTSAVE(I)=""
D ^%ZTLOAD K ZTSK D ^%ZISC
Q
;
DICS() ;EXTR VAR to set dic(s) on brainstorm session lookup
;sessions are secured by membership in QI teams
N X
S X="I ($P(AQAOUA(""USER""),U,6)[""Q"")!($D(^AQAO(9,DUZ,""TM"",""B"",$P(^AQAO1(8,Y,0),U,2))))"
Q X
AQAOQT1 ; IHS/ORDC/LJF - BRAINSTORMING & MULTIVOTING ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn is main driver for brainstorming & multivoting tool.
+4 ;
+1 DO INTRO^AQAOHQIT
+2 KILL DIR
SET DIR(0)="SO^1:GENERAL INFO;2:BRAINSTORMING SESSION;3:MULTIVOTING;4:REPORTS"
+3 SET DIR("?")="Select one the the FUNCTIONS listed or press RETURN to exit"
+4 SET DIR("A")=" Select Option"
DO ^DIR
+5 IF $DATA(DIRUT)
GOTO EXIT
IF Y=-1
GOTO MENU
+6 ;
+7 ; >>> call rtn for user's selection
+8 SET AQAOPT=$SELECT(Y=1:"MTG",Y=2:"BRAIN",Y=3:"MULTIV",1:"REPORT")
+9 DO @AQAOPT
GOTO MENU
+10 ;
+11 ;
EXIT ; >>> eoj
+1 DO ^%ZISC
DO KILL^AQAOUTIL
QUIT
+2 ; >>>> END OF MAIN SECTION OF RTN <<<<
+3 ;
+4 ;
+5 ;
MTG ; >>> SUBRTN to enter mtg info <<<
+1 WRITE !!
KILL DIC
SET DIC="^AQAO1(8,"
SET DIC(0)="AEMQZL"
SET DLAYGO=9002169
+2 SET DIC("S")=$$DICS
DO ^DIC
KILL DLAYGO
+3 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
IF X=""
QUIT
IF Y=-1
QUIT
SET AQAOMTG=+Y
+4 WRITE !!
KILL DIE
SET DIE="^AQAO1(8,"
SET DA=AQAOMTG
SET DR="[AQAO QIT MTG]"
+5 DO ^DIE
+6 QUIT
+7 ;
+8 ;
BRAIN ;ENTRY POINT >>> SUBRTN for brainstorming session <<<
+1 WRITE !!?20,"*** BRAINSTORMING SESSION ***"
+2 ; >>> find meeting entry # and display team and date/time
+3 IF '$DATA(AQAOMTG)
Begin DoDot:1
+4 WRITE !!
KILL DIC
SET DIC="^AQAO1(8,"
SET DIC("A")="Select SESSION DATE/TIME: "
+5 SET DIC(0)="AEMZQ"
SET DIC("S")=$$DICS
DO ^DIC
IF Y>0
SET AQAOMTG=+Y
End DoDot:1
+6 IF '$DATA(AQAOMTG)
WRITE !!,"NO SESSION SELECTED"
DO MTG
IF '$DATA(AQAOMTG)
QUIT
+7 WRITE !!?2,"QI TEAM: ",$PIECE(^AQAO1(1,$PIECE(^AQAO1(8,AQAOMTG,0),U,2),0),U)
+8 WRITE !,"DATE/TIME: "
SET Y=$PIECE(^AQAO1(8,AQAOMTG,0),U)
XECUTE ^DD("DD")
WRITE Y
+9 WRITE !?4,"TOPIC: ",$PIECE(^AQAO1(8,AQAOMTG,0),U,3)
+10 ;
+11 ; >>> choose next action; call SUBRTNS
CHOOSE KILL DIR
SET DIR("A")=" Select NEXT ACTION"
+1 SET DIR(0)="SO^1:ADD IDEAS;2:LIST IDEAS;3:CATEGORIZE IDEAS;4:EDIT/DELETE IDEAS"
+2 DO ^DIR
IF $DATA(DIRUT)
QUIT
+3 SET AQAOPT1=$SELECT(Y=1:"IDEAS",Y=2:"LIST",Y=3:"CATEGORY",1:"EDIT")
+4 SET AQAOPT1=AQAOPT1_"^AQAOQT11"
DO @AQAOPT1
GOTO CHOOSE
+5 ;
+6 ;
MULTIV ; >>> SUBRTN to handle multivoting session <<<
+1 KILL AQAOAR1
WRITE !!?20,"*** MULTIVOTING SESSION ***"
+2 ; >>> find meeting entry # and display team and date/time
+3 IF '$DATA(AQAOMTG)
Begin DoDot:1
+4 WRITE !!
KILL DIC
SET DIC="^AQAO1(8,"
SET DIC("A")="Select SESSION DATE/TIME: "
+5 SET DIC(0)="AEMZQ"
SET DIC("S")=$$DICS
DO ^DIC
IF Y>0
SET AQAOMTG=+Y
End DoDot:1
+6 IF '$DATA(AQAOMTG)
Begin DoDot:1
+7 WRITE !!,"NO BRAINSTORMING SESSION SELECTED"
DO MTG
End DoDot:1
IF '$DATA(AQAOMTG)
QUIT
+8 ;
+9 WRITE !!?2,"QI TEAM: ",$PIECE(^AQAO1(1,$PIECE(^AQAO1(8,AQAOMTG,0),U,2),0),U)
+10 WRITE !,"DATE/TIME: "
SET Y=$PIECE(^AQAO1(8,AQAOMTG,0),U)
XECUTE ^DD("DD")
WRITE Y
+11 WRITE !?4,"TOPIC: ",$PIECE(^AQAO1(8,AQAOMTG,0),U,3)
+12 IF '$ORDER(^AQAO1(7,"AC",AQAOMTG,0))
WRITE !!,"NO IDEAS ENTERED!",!!
QUIT
+13 ;
+14 ; choose next action; call SUBRTNS
CHOOSE1 KILL DIR
SET DIR("A")=" Select NEXT ACTION"
+1 SET DIR(0)="SO^1:LIST CATEGORIES;2:VOTE;3:VIEW VOTING RESULTS"
+2 DO ^DIR
IF $DATA(DIRUT)
QUIT
+3 SET AQAOPT1=$SELECT(Y=1:"LIST",Y=2:"VOTE",1:"RESULTS")
+4 SET AQAOPT1=AQAOPT1_"^AQAOQT12"
DO @AQAOPT1
GOTO CHOOSE1
+5 ;
+6 ;
REPORT ; >>> SUBRTN to print results of brainstorming session <<<
+1 WRITE @IOF,!?20,"*** REPORT RESULTS OF BRAINSTORMING SESSION ***"
+2 ; find meeting entry # and display team and date/time
+3 IF '$DATA(AQAOMTG)
WRITE !!
KILL DIC
SET DIC="^AQAO1(8,"
SET DIC("A")="Select SESSION DATE/TIME: "
SET DIC(0)="AEMZQ"
SET DIC("S")=$$DICS
DO ^DIC
IF Y>0
SET AQAOMTG=+Y
+4 IF '$DATA(AQAOMTG)
WRITE !!,"NO SESSION SELECTED"
DO MTG
IF '$DATA(AQAOMTG)
QUIT
+5 WRITE !!?2,"QI TEAM: ",$PIECE(^AQAO1(1,$PIECE(^AQAO1(8,AQAOMTG,0),U,2),0),U)
+6 WRITE !,"DATE/TIME: "
SET Y=$PIECE(^AQAO1(8,AQAOMTG,0),U)
XECUTE ^DD("DD")
WRITE Y
+7 WRITE !?4,"TOPIC: ",$PIECE(^AQAO1(8,AQAOMTG,0),U,3)
+8 ;
+9 ; choose next action; call SUBRTNS
CHOOSE2 KILL DIR
SET DIR("A")=" Select REPORT TYPE"
+1 SET DIR(0)="SO^1:MULTIVOTING RESULTS ONLY;2:FULL REPORT ON BRAINSTORMING SESSION"
+2 DO ^DIR
IF $DATA(DIRUT)
QUIT
+3 SET AQAOPT1=$SELECT(Y=1:"RESULTS",1:"FULL")_"^AQAOQT13"
+4 ;
DEV ;ENTRY POINT get print device
+1 WRITE !!
SET %ZIS="QP"
DO ^%ZIS
IF POP
QUIT
+2 IF '$DATA(IO("Q"))
USE IO
DO @AQAOPT1
QUIT
+3 KILL IO("Q")
SET ZTRTN=AQAOPT1
SET ZTDESC="QI TOOLS REPORT"
+4 FOR I="AQAOPT1","AQAOMTG"
SET ZTSAVE(I)=""
+5 DO ^%ZTLOAD
KILL ZTSK
DO ^%ZISC
+6 QUIT
+7 ;
DICS() ;EXTR VAR to set dic(s) on brainstorm session lookup
+1 ;sessions are secured by membership in QI teams
+2 NEW X
+3 SET X="I ($P(AQAOUA(""USER""),U,6)[""Q"")!($D(^AQAO(9,DUZ,""TM"",""B"",$P(^AQAO1(8,Y,0),U,2))))"
+4 QUIT X
