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
