AQAOUST.m

AQAOUST ; IHS/ORDC/LJF - CHARTER QI TEAM ;

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

 ;

 ;This rtn contains the user interface for creating and editing a

 ;QI team entry.  This includes assigning membership to QAI users.

 ;

TEAM ; >>> ask user for team name

 I $D(AQAOCOM) L -^AQAO1(1,AQAOCOM)

 W !! K DIC S DIC="^AQAO1(1,",DIC(0)="ALEMQZ",DLAYGO=9002169.1

 S DIC("A")="Select QI TEAM:  "

 L +(^AQAO1(1,0)):0 I '$T D  G EXIT

 .W !?5,"File is locked while another user adds an entry"

 S AQAOINAC="" D ^DIC K AQAOINAC L -(^AQAO1(1,0))

 G EXIT:$D(DTOUT),EXIT:X="",EXIT:$D(DUOUT),TEAM:Y=-1

 S AQAOCOM=Y

 L +^AQAO1(1,AQAOCOM):0 I '$T D  G TEAM

 .W !?5,"Another user editing this entry"

 ;

TEAMEDIT ; >>> edit team attributes

 K DIE S DIE="^AQAO1(1,",DA=+AQAOCOM,DR="[AQAO CHARTER TEAM]"

 D ^DIE

 ;

CURRENT ; >>> find all current members

 W @IOF,!!?20,"CURRENT MEMBERS IN ",$P(AQAOCOM,U,2),!!

 K AQAOCUR S X=0 ;get user ifn

 F  S X=$O(^AQAO(9,"AB",+AQAOCOM,X)) Q:X=""  D

 .S Y=0 ;get multiple in qi user file

 .F  S Y=$O(^AQAO(9,"AB",+AQAOCOM,X,Y)) Q:Y=""  S AQAOCUR(X)=Y

 ;

 I '$D(AQAOCUR) W !!,"NO CURRENT MEMBERS",! G ADD

 ;

 W !! S X=0

 F  S X=$O(AQAOCUR(X)) Q:X=""  D

 .S Z=$P(^AQAO(9,X,"TM",AQAOCUR(X),0),U,3) ;membership level

 .W !?2,$S(Z="L":"LEADER",1:"MEMBER"),":"

 .W ?12,$P(^VA(200,X,0),U) ;print name

 .S Y=$P(^AQAO(9,X,"TM",AQAOCUR(X),0),U,2) ;get access level

 .W ?40,"ACCESS LEVEL:  ",$S(Y=1:"INQUIRY ONLY",Y=2:"CREATE/EDIT",1:"")

 ;

EDIT ; >>> ask if user wants to edit or delete any current members

 W !! K DIR S DIR(0)="YO",DIR("B")="NO"

 S DIR("A")="Do you want to EDIT or DELETE any current members"

 D ^DIR G EXIT:Y="",ADD:Y=0

 ;

 W !!!,">>> MODIFY/DELETE MODE . . ."

CHOOSE1 W !! K DIC,DIR S DIC="^AQAO(9,",DIC(0)="AEMQZ"

 S DIC("S")="I $D(AQAOCUR(Y))" D ^DIC

 G EXIT:X=U,EXIT:$D(DTOUT),ADD:X="",CHOOSE1:Y=-1

 K DIE S DIE="^AQAO(9,"_+Y_",""TM"",",DA=AQAOCUR(+Y),DA(1)=+Y

 D DELETE S DR=".01:.03" D ^DIE

 G CHOOSE1

 ;

 ;

ADD ; >>> ask if user wants to add new members

 W !! K DIR S DIR(0)="YO",DIR("B")="NO"

 S DIR("A")="Do you want to ADD any new members"

 D ^DIR G EXIT:Y="",TEAM:Y=0

 ;

 W !!!,">>> ADD MODE . . ."

CHOOSE2 W !! K DIC,DIR S DIC="^AQAO(9,",DIC(0)="AEMQZ" D ^DIC

 G EXIT:X=U,EXIT:$D(DTOUT),TEAM:X="",CHOOSE2:Y=-1

 I '$D(^AQAO(9,+Y,"TM",0)) S ^(0)="^9002168.91P"

 K DIC S DIC="^AQAO(9,"_+Y_",""TM"",",DIC(0)="EMZQL",X=$P(AQAOCOM,U,2)

 S DA(1)=+Y,DIC("DR")=".02:.03" D ^DIC

 G CHOOSE2

 ;

 ;

EXIT ; >>> eoj

 I $D(AQAOCOM) L -^AQAO1(1,AQAOCOM)

 D KILL^AQAOUTIL Q

 ;

 ;

DELETE ;SUBRTN called before DIE call in line CHOOSE1+4

 W !!,"Enter ""@"" to delete user from this team",! Q

AQAOUST   ; IHS/ORDC/LJF - CHARTER QI TEAM ;

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

 +2       ;

 +3       ;This rtn contains the user interface for creating and editing a

 +4       ;QI team entry.  This includes assigning membership to QAI users.

 +5       ;

TEAM      ; >>> ask user for team name

 +1        IF $DATA(AQAOCOM)

               LOCK -^AQAO1(1,AQAOCOM)

 +2        WRITE !!

           KILL DIC

           SET DIC="^AQAO1(1,"

           SET DIC(0)="ALEMQZ"

           SET DLAYGO=9002169.1

 +3        SET DIC("A")="Select QI TEAM:  "

 +4        LOCK +(^AQAO1(1,0)):0

           IF '$TEST

               Begin DoDot:1

 +5                WRITE !?5,"File is locked while another user adds an entry"

               End DoDot:1

               GOTO EXIT

 +6        SET AQAOINAC=""

           DO ^DIC

           KILL AQAOINAC

           LOCK -(^AQAO1(1,0))

 +7        IF $DATA(DTOUT)

               GOTO EXIT

           IF X=""

               GOTO EXIT

           IF $DATA(DUOUT)

               GOTO EXIT

           IF Y=-1

               GOTO TEAM

 +8        SET AQAOCOM=Y

 +9        LOCK +^AQAO1(1,AQAOCOM):0

           IF '$TEST

               Begin DoDot:1

 +10               WRITE !?5,"Another user editing this entry"

               End DoDot:1

               GOTO TEAM

 +11      ;

TEAMEDIT  ; >>> edit team attributes

 +1        KILL DIE

           SET DIE="^AQAO1(1,"

           SET DA=+AQAOCOM

           SET DR="[AQAO CHARTER TEAM]"

 +2        DO ^DIE

 +3       ;

CURRENT   ; >>> find all current members

 +1        WRITE @IOF,!!?20,"CURRENT MEMBERS IN ",$PIECE(AQAOCOM,U,2),!!

 +2       ;get user ifn

           KILL AQAOCUR

           SET X=0

 +3        FOR 

               SET X=$ORDER(^AQAO(9,"AB",+AQAOCOM,X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +4       ;get multiple in qi user file

                   SET Y=0

 +5                FOR 

                       SET Y=$ORDER(^AQAO(9,"AB",+AQAOCOM,X,Y))

                       IF Y=""

                           QUIT 

                       SET AQAOCUR(X)=Y

               End DoDot:1

 +6       ;

 +7        IF '$DATA(AQAOCUR)

               WRITE !!,"NO CURRENT MEMBERS",!

               GOTO ADD

 +8       ;

 +9        WRITE !!

           SET X=0

 +10       FOR 

               SET X=$ORDER(AQAOCUR(X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +11      ;membership level

                   SET Z=$PIECE(^AQAO(9,X,"TM",AQAOCUR(X),0),U,3)

 +12               WRITE !?2,$SELECT(Z="L":"LEADER",1:"MEMBER"),":"

 +13      ;print name

                   WRITE ?12,$PIECE(^VA(200,X,0),U)

 +14      ;get access level

                   SET Y=$PIECE(^AQAO(9,X,"TM",AQAOCUR(X),0),U,2)

 +15               WRITE ?40,"ACCESS LEVEL:  ",$SELECT(Y=1:"INQUIRY ONLY",Y=2:"CREATE/EDIT",1:"")

               End DoDot:1

 +16      ;

EDIT      ; >>> ask if user wants to edit or delete any current members

 +1        WRITE !!

           KILL DIR

           SET DIR(0)="YO"

           SET DIR("B")="NO"

 +2        SET DIR("A")="Do you want to EDIT or DELETE any current members"

 +3        DO ^DIR

           IF Y=""

               GOTO EXIT

           IF Y=0

               GOTO ADD

 +4       ;

 +5        WRITE !!!,">>> MODIFY/DELETE MODE . . ."

CHOOSE1    WRITE !!

           KILL DIC,DIR

           SET DIC="^AQAO(9,"

           SET DIC(0)="AEMQZ"

 +1        SET DIC("S")="I $D(AQAOCUR(Y))"

           DO ^DIC

 +2        IF X=U

               GOTO EXIT

           IF $DATA(DTOUT)

               GOTO EXIT

           IF X=""

               GOTO ADD

           IF Y=-1

               GOTO CHOOSE1

 +3        KILL DIE

           SET DIE="^AQAO(9,"_+Y_",""TM"","

           SET DA=AQAOCUR(+Y)

           SET DA(1)=+Y

 +4        DO DELETE

           SET DR=".01:.03"

           DO ^DIE

 +5        GOTO CHOOSE1

 +6       ;

 +7       ;

ADD       ; >>> ask if user wants to add new members

 +1        WRITE !!

           KILL DIR

           SET DIR(0)="YO"

           SET DIR("B")="NO"

 +2        SET DIR("A")="Do you want to ADD any new members"

 +3        DO ^DIR

           IF Y=""

               GOTO EXIT

           IF Y=0

               GOTO TEAM

 +4       ;

 +5        WRITE !!!,">>> ADD MODE . . ."

CHOOSE2    WRITE !!

           KILL DIC,DIR

           SET DIC="^AQAO(9,"

           SET DIC(0)="AEMQZ"

           DO ^DIC

 +1        IF X=U

               GOTO EXIT

           IF $DATA(DTOUT)

               GOTO EXIT

           IF X=""

               GOTO TEAM

           IF Y=-1

               GOTO CHOOSE2

 +2        IF '$DATA(^AQAO(9,+Y,"TM",0))

               SET ^(0)="^9002168.91P"

 +3        KILL DIC

           SET DIC="^AQAO(9,"_+Y_",""TM"","

           SET DIC(0)="EMZQL"

           SET X=$PIECE(AQAOCOM,U,2)

 +4        SET DA(1)=+Y

           SET DIC("DR")=".02:.03"

           DO ^DIC

 +5        GOTO CHOOSE2

 +6       ;

 +7       ;

EXIT      ; >>> eoj

 +1        IF $DATA(AQAOCOM)

               LOCK -^AQAO1(1,AQAOCOM)

 +2        DO KILL^AQAOUTIL

           QUIT 

 +3       ;

 +4       ;

DELETE    ;SUBRTN called before DIE call in line CHOOSE1+4

 +1        WRITE !!,"Enter ""@"" to delete user from this team",!

           QUIT