AQAOQT12 ; IHS/ORDC/LJF - MULTIVOTING SUBRTNS ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains entry point to handle the multivoting functions.
;
LIST ;ENTRY POINT: SUBRTN to list ideas entered for this meeting
;called by ^AQAOQT1
I '$D(AQAOAR1) D GETLIST ;gather categories & ideas not categorized
W @IOF
W !,"CATEGORIZED IDEAS ENTERED FOR ",$P(^AQAO1(8,AQAOMTG,0),U,3),":",!
S AQAOX=0,AQAOJ=1
MORE F AQAOI=AQAOJ:1:AQAOJ+12 S AQAOX=$O(AQAOAR1(AQAOX)) Q:AQAOX="" D
.W !?5,AQAOX_". "_$P(AQAOAR1(AQAOX),U)
S AQAOJ=AQAOI+1 Q:AQAOX="" ;end of list
K DIR S DIR("A")="Press RETURN to continue or ""^"" to exit"
S DIR(0)="E" D ^DIR G MORE:Y=1
Q
;
;
VOTE ;ENTRY POINT: SUBRTN to enter votes of each participant
;called by ^AQAOQT1
K AQAOAR2
I '$D(AQAOAR1) D GETLIST ;gather categories to vote on
W !!?20,"*** VOTING SESSION ***",!!
K DIR S DIR(0)="NO^1:99",DIR("A")="How many VOTES per person"
S DIR("?",1)="Please tell me how many VOTES each participant is "
S DIR("?",2)="allowed to cast in this voting session."
S DIR("?",3)="Each voter must cast ALL his/her votes for any of them"
S DIR("?",4)="to be counted.",DIR("?",5)=" "
S DIR("?")="Enter a number between 1 and 99." D ^DIR Q:$D(DIRUT)
Q:Y=-1 S AQAOCNT=Y
;
VOTER ; >> ask for each voter in turn
W !! K DIR S DIR(0)="FO^1:50",DIR("A")="Select VOTER"
D ^DIR Q:$D(DIRUT) G VOTER:Y=-1 S AQAOUSR=Y
D POLL ;ask for votes
G VOTER:'$D(AQAOAR2(AQAOUSR)) ;no votes to file
;
; >> file voting results for this voter
S AQAOX=0,DIE="^AQAO1(7,"
F S AQAOX=$O(AQAOAR2(AQAOUSR,AQAOX)) Q:AQAOX="" D
.S AQAOIFN=$P(AQAOAR1(AQAOX),U,2) ;get ifn from category list
.I '$D(^AQAO1(7,AQAOIFN,"MV",0)) S ^(0)="^9002169.71"
.I '$O(^AQAO1(7,AQAOIFN,"MV","B",AQAOUSR,0)) D ADDVTR Q:Y=-1 ;add votr multpl
.S DA=$O(^AQAO1(7,AQAOIFN,"MV","B",AQAOUSR,0)) Q:DA=""
.S DIE="^AQAO1(7,"_AQAOIFN_",""MV"",",DA(1)=AQAOIFN
.S DR=".02////"_AQAOAR2(AQAOUSR,AQAOX) D ^DIE ;file votes
W !!,"VOTES FOR USER ",AQAOUSR," FILED..." G VOTER
;
;
ADDVTR ; >> SUBRTN to add voter multiple to category
K DIC S DIC="^AQAO1(7,"_AQAOIFN_",""MV"",",DIC(0)="L",DA(1)=AQAOIFN
S X=AQAOUSR,DIC("P")=$P(^DD(9002169.7,1,0),U,2) D ^DIC
Q
;
;
GETLIST ; >> SUBRTN to gather categories and ideas not categorized
K AQAOARR S AQAOX=0
F S AQAOX=$O(^AQAO1(7,"AC",AQAOMTG,AQAOX)) Q:AQAOX="" D
.Q:'$D(^AQAO1(7,AQAOX,0)) S AQAOS=^(0)
.S AQAOY=$S($P(AQAOS,U,3)'="":$P(AQAOS,U,3),1:$P(AQAOS,U))
.S AQAOARR(AQAOY)=AQAOX
Q:'$D(AQAOARR) ;no ideas entered
S AQAOX=0
F I=1:1 S AQAOX=$O(AQAOARR(AQAOX)) Q:AQAOX="" D
.S AQAOAR1(I)=AQAOX_U_AQAOARR(AQAOX) ;number categories
Q
;
;
POLL ; >> SUBRTN to poll a participant
K AQAOAR2(AQAOUSR) ;ARRAY(user,category # in AQAOAR1)=votes
CATEGORY ; >> ask participant to choose category to vote on
W !!,"CHOICE OF CATEGORIES:",!
K DIR S AQAOI=0,AQAOJ=1
LOOP F AQAOI=AQAOJ:1:AQAOJ+12 Q:'$D(AQAOAR1(AQAOI)) D
.S DIR("A",AQAOI)=AQAOI_". "_$P(AQAOAR1(AQAOI),U)
S DIR(0)="NO^1:"_(AQAOI-1),DIR("A")="Select CATEGORY"
I $D(AQAOAR1(AQAOI+1)) S DIR("A")="Select CATEGORY (Press RETURN to see more)"
D ^DIR
I $D(AQAOAR1(AQAOI+1)) S AQAOJ=AQAOI+1 K DIR("A") G LOOP:X=""
G CHECK:$D(DIRUT),CHECK:Y=-1 S AQAOCAT=Y
;
; >> ask for number of votes for this category
W ! K DIR S DIR(0)="NO^0:"_AQAOCNT,DIR("A")="# OF VOTES" D ^DIR
I Y=0 K AQAOAR2(AQAOUSR,AQAOCAT) ;deleting vote
I Y>0 S AQAOAR2(AQAOUSR,AQAOCAT)=Y ;recording vote
G CATEGORY ;return to vote on another category
;
;
CHECK ; >> display votes for this user and give options
W @IOF,!!?20,"*** VOTING SUMMARY FOR ",AQAOUSR," ***",!
I '$D(AQAOAR2(AQAOUSR)) W !!,"NO VOTES TAKEN" S AQAOZ=0 G CHOICE
S (AQAOX,AQAOY)=0
F S AQAOX=$O(AQAOAR2(AQAOUSR,AQAOX)) Q:AQAOX="" D
.W !,$P(AQAOAR1(AQAOX),U),?40,AQAOAR2(AQAOUSR,AQAOX)
.S AQAOY=AQAOY+AQAOAR2(AQAOUSR,AQAOX) ;count total votes for person
W !?40,"____",!,"TOTAL VOTES CAST:",?40,AQAOY
W ?60,$S(AQAOY=AQAOCNT:"",AQAOY>AQAOCNT:"OVER VOTED",1:"UNDER VOTED")
;
CHOICE ; >> give participant choice to revote or quit
W !! K DIR S DIR("A")="Select CHOICE"
I AQAOY=AQAOCNT S DIR(0)="S^1:REVOTE;2:QUIT & FILE RESULTS"
E S DIR(0)="S^1:REVOTE;2:QUIT, NO RESULTS FILED"
S DIR("?",1)="You may now REVOTE or QUIT this round"
S DIR("?",2)="If the votes cast MATCH the number you had to cast,"
S DIR("?",3)="quitting will file your votes. But if you cast MORE"
S DIR("?",4)="than the allotted number or LESS than the allotted"
S DIR("?",5)="number of votes, your votes will not be filed. In those"
S DIR("?",6)="please REVOTE!",DIR("?")="Make your choice now."
D ^DIR G CATEGORY:$D(DIRUT),CHOICE:Y=-1,CATEGORY:Y=1
I AQAOY'=AQAOCNT K AQAOAR2(AQAOUSR)
Q
;
;
RESULTS ;ENTRY POINT: SUBRTN to pirnt multivoting results
S AQAOPT1="RESULTS^AQAOQT13" D DEV^AQAOQT1 Q ;set for results only
AQAOQT12 ; IHS/ORDC/LJF - MULTIVOTING SUBRTNS ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains entry point to handle the multivoting functions.
+4 ;
LIST ;ENTRY POINT: SUBRTN to list ideas entered for this meeting
+1 ;called by ^AQAOQT1
+2 ;gather categories & ideas not categorized
IF '$DATA(AQAOAR1)
DO GETLIST
+3 WRITE @IOF
+4 WRITE !,"CATEGORIZED IDEAS ENTERED FOR ",$PIECE(^AQAO1(8,AQAOMTG,0),U,3),":",!
+5 SET AQAOX=0
SET AQAOJ=1
MORE FOR AQAOI=AQAOJ:1:AQAOJ+12
SET AQAOX=$ORDER(AQAOAR1(AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+1 WRITE !?5,AQAOX_". "_$PIECE(AQAOAR1(AQAOX),U)
End DoDot:1
+2 ;end of list
SET AQAOJ=AQAOI+1
IF AQAOX=""
QUIT
+3 KILL DIR
SET DIR("A")="Press RETURN to continue or ""^"" to exit"
+4 SET DIR(0)="E"
DO ^DIR
IF Y=1
GOTO MORE
+5 QUIT
+6 ;
+7 ;
VOTE ;ENTRY POINT: SUBRTN to enter votes of each participant
+1 ;called by ^AQAOQT1
+2 KILL AQAOAR2
+3 ;gather categories to vote on
IF '$DATA(AQAOAR1)
DO GETLIST
+4 WRITE !!?20,"*** VOTING SESSION ***",!!
+5 KILL DIR
SET DIR(0)="NO^1:99"
SET DIR("A")="How many VOTES per person"
+6 SET DIR("?",1)="Please tell me how many VOTES each participant is "
+7 SET DIR("?",2)="allowed to cast in this voting session."
+8 SET DIR("?",3)="Each voter must cast ALL his/her votes for any of them"
+9 SET DIR("?",4)="to be counted."
SET DIR("?",5)=" "
+10 SET DIR("?")="Enter a number between 1 and 99."
DO ^DIR
IF $DATA(DIRUT)
QUIT
+11 IF Y=-1
QUIT
SET AQAOCNT=Y
+12 ;
VOTER ; >> ask for each voter in turn
+1 WRITE !!
KILL DIR
SET DIR(0)="FO^1:50"
SET DIR("A")="Select VOTER"
+2 DO ^DIR
IF $DATA(DIRUT)
QUIT
IF Y=-1
GOTO VOTER
SET AQAOUSR=Y
+3 ;ask for votes
DO POLL
+4 ;no votes to file
IF '$DATA(AQAOAR2(AQAOUSR))
GOTO VOTER
+5 ;
+6 ; >> file voting results for this voter
+7 SET AQAOX=0
SET DIE="^AQAO1(7,"
+8 FOR
SET AQAOX=$ORDER(AQAOAR2(AQAOUSR,AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+9 ;get ifn from category list
SET AQAOIFN=$PIECE(AQAOAR1(AQAOX),U,2)
+10 IF '$DATA(^AQAO1(7,AQAOIFN,"MV",0))
SET ^(0)="^9002169.71"
+11 ;add votr multpl
IF '$ORDER(^AQAO1(7,AQAOIFN,"MV","B",AQAOUSR,0))
DO ADDVTR
IF Y=-1
QUIT
+12 SET DA=$ORDER(^AQAO1(7,AQAOIFN,"MV","B",AQAOUSR,0))
IF DA=""
QUIT
+13 SET DIE="^AQAO1(7,"_AQAOIFN_",""MV"","
SET DA(1)=AQAOIFN
+14 ;file votes
SET DR=".02////"_AQAOAR2(AQAOUSR,AQAOX)
DO ^DIE
End DoDot:1
+15 WRITE !!,"VOTES FOR USER ",AQAOUSR," FILED..."
GOTO VOTER
+16 ;
+17 ;
ADDVTR ; >> SUBRTN to add voter multiple to category
+1 KILL DIC
SET DIC="^AQAO1(7,"_AQAOIFN_",""MV"","
SET DIC(0)="L"
SET DA(1)=AQAOIFN
+2 SET X=AQAOUSR
SET DIC("P")=$PIECE(^DD(9002169.7,1,0),U,2)
DO ^DIC
+3 QUIT
+4 ;
+5 ;
GETLIST ; >> SUBRTN to gather categories and ideas not categorized
+1 KILL AQAOARR
SET AQAOX=0
+2 FOR
SET AQAOX=$ORDER(^AQAO1(7,"AC",AQAOMTG,AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+3 IF '$DATA(^AQAO1(7,AQAOX,0))
QUIT
SET AQAOS=^(0)
+4 SET AQAOY=$SELECT($PIECE(AQAOS,U,3)'="":$PIECE(AQAOS,U,3),1:$PIECE(AQAOS,U))
+5 SET AQAOARR(AQAOY)=AQAOX
End DoDot:1
+6 ;no ideas entered
IF '$DATA(AQAOARR)
QUIT
+7 SET AQAOX=0
+8 FOR I=1:1
SET AQAOX=$ORDER(AQAOARR(AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+9 ;number categories
SET AQAOAR1(I)=AQAOX_U_AQAOARR(AQAOX)
End DoDot:1
+10 QUIT
+11 ;
+12 ;
POLL ; >> SUBRTN to poll a participant
+1 ;ARRAY(user,category # in AQAOAR1)=votes
KILL AQAOAR2(AQAOUSR)
CATEGORY ; >> ask participant to choose category to vote on
+1 WRITE !!,"CHOICE OF CATEGORIES:",!
+2 KILL DIR
SET AQAOI=0
SET AQAOJ=1
LOOP FOR AQAOI=AQAOJ:1:AQAOJ+12
IF '$DATA(AQAOAR1(AQAOI))
QUIT
Begin DoDot:1
+1 SET DIR("A",AQAOI)=AQAOI_". "_$PIECE(AQAOAR1(AQAOI),U)
End DoDot:1
+2 SET DIR(0)="NO^1:"_(AQAOI-1)
SET DIR("A")="Select CATEGORY"
+3 IF $DATA(AQAOAR1(AQAOI+1))
SET DIR("A")="Select CATEGORY (Press RETURN to see more)"
+4 DO ^DIR
+5 IF $DATA(AQAOAR1(AQAOI+1))
SET AQAOJ=AQAOI+1
KILL DIR("A")
IF X=""
GOTO LOOP
+6 IF $DATA(DIRUT)
GOTO CHECK
IF Y=-1
GOTO CHECK
SET AQAOCAT=Y
+7 ;
+8 ; >> ask for number of votes for this category
+9 WRITE !
KILL DIR
SET DIR(0)="NO^0:"_AQAOCNT
SET DIR("A")="# OF VOTES"
DO ^DIR
+10 ;deleting vote
IF Y=0
KILL AQAOAR2(AQAOUSR,AQAOCAT)
+11 ;recording vote
IF Y>0
SET AQAOAR2(AQAOUSR,AQAOCAT)=Y
+12 ;return to vote on another category
GOTO CATEGORY
+13 ;
+14 ;
CHECK ; >> display votes for this user and give options
+1 WRITE @IOF,!!?20,"*** VOTING SUMMARY FOR ",AQAOUSR," ***",!
+2 IF '$DATA(AQAOAR2(AQAOUSR))
WRITE !!,"NO VOTES TAKEN"
SET AQAOZ=0
GOTO CHOICE
+3 SET (AQAOX,AQAOY)=0
+4 FOR
SET AQAOX=$ORDER(AQAOAR2(AQAOUSR,AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+5 WRITE !,$PIECE(AQAOAR1(AQAOX),U),?40,AQAOAR2(AQAOUSR,AQAOX)
+6 ;count total votes for person
SET AQAOY=AQAOY+AQAOAR2(AQAOUSR,AQAOX)
End DoDot:1
+7 WRITE !?40,"____",!,"TOTAL VOTES CAST:",?40,AQAOY
+8 WRITE ?60,$SELECT(AQAOY=AQAOCNT:"",AQAOY>AQAOCNT:"OVER VOTED",1:"UNDER VOTED")
+9 ;
CHOICE ; >> give participant choice to revote or quit
+1 WRITE !!
KILL DIR
SET DIR("A")="Select CHOICE"
+2 IF AQAOY=AQAOCNT
SET DIR(0)="S^1:REVOTE;2:QUIT & FILE RESULTS"
+3 IF '$TEST
SET DIR(0)="S^1:REVOTE;2:QUIT, NO RESULTS FILED"
+4 SET DIR("?",1)="You may now REVOTE or QUIT this round"
+5 SET DIR("?",2)="If the votes cast MATCH the number you had to cast,"
+6 SET DIR("?",3)="quitting will file your votes. But if you cast MORE"
+7 SET DIR("?",4)="than the allotted number or LESS than the allotted"
+8 SET DIR("?",5)="number of votes, your votes will not be filed. In those"
+9 SET DIR("?",6)="please REVOTE!"
SET DIR("?")="Make your choice now."
+10 DO ^DIR
IF $DATA(DIRUT)
GOTO CATEGORY
IF Y=-1
GOTO CHOICE
IF Y=1
GOTO CATEGORY
+11 IF AQAOY'=AQAOCNT
KILL AQAOAR2(AQAOUSR)
+12 QUIT
+13 ;
+14 ;
RESULTS ;ENTRY POINT: SUBRTN to pirnt multivoting results
+1 ;set for results only
SET AQAOPT1="RESULTS^AQAOQT13"
DO DEV^AQAOQT1
QUIT
