USRCLASS ; SLC/JER - User Class Management actions ;11/25/09
;;1.0;AUTHORIZATION/SUBSCRIPTION;**7,11,33**;Jun 20, 1997;Build 5
EDIT ; Edit user classes
N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG
N USRLST,NAME,NAME1,NAME2,LINE,CANTMSG
D:'$D(VALMY) EN^VALM2(XQORNOD(0)) S USRI=0,USRCHNG=0
F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
. S USRDATA=$S(VALMAR="^TMP(""USRCLASS"",$J)":$G(^TMP("USRCLASSIDX",$J,USRI)),1:$G(^TMP("USREXPIDX",$J,USRI)))
. W !!,"Editing #",+USRDATA,!
. S USRDA=+$P(USRDATA,U,2)
. S NAME=$P(^USR(8930,USRDA,0),U),NAME1="|_ "_NAME,NAME2="-"_NAME
. S LINE=^TMP("USRCLASS",$J,USRI,0)
. D EDIT1
. I (LINE[NAME1)!(LINE[NAME2) D Q
. . S CANTMSG=1,VALMBCK="Q",USRCHNG=0
. I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI
. I $D(USRDATA) D UPDATE^USRL(USRDATA)
Q:$D(DIROUT)
I $D(CANTMSG) D K VALMY S VALMBCK="Q" Q
. W !!," Expanded entries cannot be refreshed; please re-enter the option"
. W !,"to see the result of your edits." H 3
W !," Refreshing the list. If expanded entries require refreshing please"
W !,"collapse and re-expand the entries." H 2
S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **"
K VALMY S VALMBCK="R"
Q
EDIT1 ; Single record edit
; Receives USRDA
N DA,DIE,DR
I '+$G(USRDA) W !,"No Classes selected." H 2 Q
S DIE="^USR(8930,",DA=USRDA,DR="[USR CLASS STRUCTURE EDIT]"
D FULL^VALM1,^DIE
S USRCHNG=1 ;Needs check if not really changed.
Q
EXPAND ; Expand/Collapse user class hierarchy display
N USRDNM,USRLNM,USRSTAT,USRVALMY
D:'$D(VALMY) EN^VALM2(XQORNOD(0))
I $D(VALMY) M USRVALMY=VALMY D EC^USRECCL(.USRVALMY)
W !,"Refreshing the list."
K VALMY S VALMBCK="R"
S USRSTAT=+$P($G(^TMP("USRCLASS",$J,0)),U,2)
S USRDNM=$P($G(^TMP("USRCLASS",$J,0)),U,3)
S USRLNM=$P($G(^TMP("USRCLASS",$J,0)),U,4)
S VALMCNT=+$G(@VALMAR@(0))
S VALMBCK="R"
Q
CREATE ; Class constructor
N USRCREAT
N DIC,DLAYGO,X,Y,USRSTAT,USRDNM,USRLNM D FULL^VALM1
S (DIC,DLAYGO)=8930,DIC(0)="AELMQ",DIC("A")="Select CLASS: "
D ^DIC Q:+Y'>0
S USRCREAT=+$P(Y,U,3)
S DA=+Y,DIE=DIC,DIE("NO^")="BACK",DR="[USR CLASS STRUCTURE EDIT]"
D ^DIE
S USRSTAT=+$P($G(^TMP("USRCLASS",$J,0)),U,2)
S USRDNM=$P($G(^TMP("USRCLASS",$J,0)),U,3)
S USRLNM=$P($G(^TMP("USRCLASS",$J,0)),U,4)
I 'USRCREAT Q ; Don't rebuild without cause
W !,"Rebuilding main class list."
D BUILD^USRCLST(USRSTAT,USRDNM,USRLNM)
S VALMCNT=+$G(@VALMAR@(0))
S VALMBCK="R"
Q
MEMBERS ; List Members of classes and their subclasses
N USRDA,USRDATA,USREXPND,USRI,USRSTAT,VALMCNT,DIROUT
D:'$D(VALMY) EN^VALM2(XQORNOD(0)) S USRI=0
F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
. S USRDATA=$S(VALMAR="^TMP(""USRCLASS"",$J)":$G(^TMP("USRCLASSIDX",$J,USRI)),1:$G(^TMP("USREXPIDX",$J,USRI)))
. W !!,"Listing Members of #",+USRDATA,!
. S USRDA=+$P(USRDATA,U,2) D EN^VALM("USR LIST MEMBERSHIP BY CLASS")
. I $D(USRDATA) D UPDATE^USRL(USRDATA)
W !,"Refreshing the list."
S VALMSG="Members listed"
K VALMY S VALMBCK="R"
Q
USRCLASS ; SLC/JER - User Class Management actions ;11/25/09
+1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**7,11,33**;Jun 20, 1997;Build 5
EDIT ; Edit user classes
+1 NEW USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG
+2 NEW USRLST,NAME,NAME1,NAME2,LINE,CANTMSG
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
SET USRI=0
SET USRCHNG=0
+4 FOR
SET USRI=$ORDER(VALMY(USRI))
IF +USRI'>0
QUIT
Begin DoDot:1
+5 SET USRDATA=$SELECT(VALMAR="^TMP(""USRCLASS"",$J)":$GET(^TMP("USRCLASSIDX",$JOB,USRI)),1:$GET(^TMP("USREXPIDX",$JOB,USRI)))
+6 WRITE !!,"Editing #",+USRDATA,!
+7 SET USRDA=+$PIECE(USRDATA,U,2)
+8 SET NAME=$PIECE(^USR(8930,USRDA,0),U)
SET NAME1="|_ "_NAME
SET NAME2="-"_NAME
+9 SET LINE=^TMP("USRCLASS",$JOB,USRI,0)
+10 DO EDIT1
+11 IF (LINE[NAME1)!(LINE[NAME2)
Begin DoDot:2
+12 SET CANTMSG=1
SET VALMBCK="Q"
SET USRCHNG=0
End DoDot:2
QUIT
+13 IF +$GET(USRCHNG)
SET USRLST=$SELECT($LENGTH($GET(USRLST)):$GET(USRLST)_", ",1:"")_USRI
+14 IF $DATA(USRDATA)
DO UPDATE^USRL(USRDATA)
End DoDot:1
IF $DATA(DIROUT)
QUIT
+15 IF $DATA(DIROUT)
QUIT
+16 IF $DATA(CANTMSG)
Begin DoDot:1
+17 WRITE !!," Expanded entries cannot be refreshed; please re-enter the option"
+18 WRITE !,"to see the result of your edits."
HANG 3
End DoDot:1
KILL VALMY
SET VALMBCK="Q"
QUIT
+19 WRITE !," Refreshing the list. If expanded entries require refreshing please"
+20 WRITE !,"collapse and re-expand the entries."
HANG 2
+21 SET VALMSG="** "_$SELECT($LENGTH($GET(USRLST)):"Item"_$SELECT($LENGTH($GET(USRLST),",")>1:"s ",1:" ")_$GET(USRLST),1:"Nothing")_" Edited **"
+22 KILL VALMY
SET VALMBCK="R"
+23 QUIT
EDIT1 ; Single record edit
+1 ; Receives USRDA
+2 NEW DA,DIE,DR
+3 IF '+$GET(USRDA)
WRITE !,"No Classes selected."
HANG 2
QUIT
+4 SET DIE="^USR(8930,"
SET DA=USRDA
SET DR="[USR CLASS STRUCTURE EDIT]"
+5 DO FULL^VALM1
DO ^DIE
+6 ;Needs check if not really changed.
SET USRCHNG=1
+7 QUIT
EXPAND ; Expand/Collapse user class hierarchy display
+1 NEW USRDNM,USRLNM,USRSTAT,USRVALMY
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+3 IF $DATA(VALMY)
MERGE USRVALMY=VALMY
DO EC^USRECCL(.USRVALMY)
+4 WRITE !,"Refreshing the list."
+5 KILL VALMY
SET VALMBCK="R"
+6 SET USRSTAT=+$PIECE($GET(^TMP("USRCLASS",$JOB,0)),U,2)
+7 SET USRDNM=$PIECE($GET(^TMP("USRCLASS",$JOB,0)),U,3)
+8 SET USRLNM=$PIECE($GET(^TMP("USRCLASS",$JOB,0)),U,4)
+9 SET VALMCNT=+$GET(@VALMAR@(0))
+10 SET VALMBCK="R"
+11 QUIT
CREATE ; Class constructor
+1 NEW USRCREAT
+2 NEW DIC,DLAYGO,X,Y,USRSTAT,USRDNM,USRLNM
DO FULL^VALM1
+3 SET (DIC,DLAYGO)=8930
SET DIC(0)="AELMQ"
SET DIC("A")="Select CLASS: "
+4 DO ^DIC
IF +Y'>0
QUIT
+5 SET USRCREAT=+$PIECE(Y,U,3)
+6 SET DA=+Y
SET DIE=DIC
SET DIE("NO^")="BACK"
SET DR="[USR CLASS STRUCTURE EDIT]"
+7 DO ^DIE
+8 SET USRSTAT=+$PIECE($GET(^TMP("USRCLASS",$JOB,0)),U,2)
+9 SET USRDNM=$PIECE($GET(^TMP("USRCLASS",$JOB,0)),U,3)
+10 SET USRLNM=$PIECE($GET(^TMP("USRCLASS",$JOB,0)),U,4)
+11 ; Don't rebuild without cause
IF 'USRCREAT
QUIT
+12 WRITE !,"Rebuilding main class list."
+13 DO BUILD^USRCLST(USRSTAT,USRDNM,USRLNM)
+14 SET VALMCNT=+$GET(@VALMAR@(0))
+15 SET VALMBCK="R"
+16 QUIT
MEMBERS ; List Members of classes and their subclasses
+1 NEW USRDA,USRDATA,USREXPND,USRI,USRSTAT,VALMCNT,DIROUT
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
SET USRI=0
+3 FOR
SET USRI=$ORDER(VALMY(USRI))
IF +USRI'>0
QUIT
Begin DoDot:1
+4 SET USRDATA=$SELECT(VALMAR="^TMP(""USRCLASS"",$J)":$GET(^TMP("USRCLASSIDX",$JOB,USRI)),1:$GET(^TMP("USREXPIDX",$JOB,USRI)))
+5 WRITE !!,"Listing Members of #",+USRDATA,!
+6 SET USRDA=+$PIECE(USRDATA,U,2)
DO EN^VALM("USR LIST MEMBERSHIP BY CLASS")
+7 IF $DATA(USRDATA)
DO UPDATE^USRL(USRDATA)
End DoDot:1
IF $DATA(DIROUT)
QUIT
+8 WRITE !,"Refreshing the list."
+9 SET VALMSG="Members listed"
+10 KILL VALMY
SET VALMBCK="R"
+11 QUIT