- 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
