Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AQAOQT12

AQAOQT12.m

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