USRMEMBR ;SLC/JER,PWC - User Class Management actions ;Sep 04, 2019@16:18
;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,6,7,29,33,39**;Jun 20, 1997;Build 3
EDIT ; Edit user's class membership
;N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG,USRLST
N USRDA,USRDATA,USRI,DIROUT,USRCHNG,USRLST
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S (USRCHNG,USRI)=0
F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
. S USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI))
. W !!,"Editing #",+USRDATA,!
. S USRDA=+$P(USRDATA,U,2) D EDIT1
. I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI
. I $D(USRDATA) D UPDATE^USRM(USRDATA)
W !,"Refreshing the list."
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 S USRCHNG=0 Q
S DIE="^USR(8930.3,",DA=USRDA,DR="[USR MEMBERSHIP EDIT]"
D FULL^VALM1,^DIE S USRCHNG=1
Q
ADD ; Add a member to the class
N DA,DR,DIC,DLAYGO,X,Y,USRCLASS,USRUSER,USRQUIT,USRCNT D FULL^VALM1
S USRCNT=0
F D Q:+$G(USRQUIT)
. W !
. S DIC=200,DIC(0)="AEMQ"
. S DIC("A")="Select "_$S(USRCNT'>0:"",1:"Another ")_"MEMBER: "
. D ^DIC I +Y'>0 S USRQUIT=1 Q
. I $$ISAWM^USRLM(+Y,USRDA) Q
. I $$ISTERM^USRLM(+Y) D Q
.. S USRQUIT=1
.. W !,"The user you selected is terminated, cannot add them as a class member!"
.. H 2
. S (DIC,DLAYGO)=8930.3,DIC(0)="LM",X=""""_$P(Y,U,2)_""""
. S DIC("W")="D DICW^USRMEMBR"
. D ^DIC I +Y'>0 S USRQUIT=1 Q
. S USRCREAT=+$P(Y,U,3),USRCNT=USRCNT+1
. S DA=+Y,DIE=DIC,DIE("NO^")="BACK",DR="[USR CLASS EDIT]" D ^DIE
. I $D(Y) D Q
. . S DIK=DIC D ^DIK K DIK
. . S:+USRCNT'>1 VALMSG="** Nothing Added **"
. . S VALMBCK="R",USRQUIT=1
. I 'USRCREAT D Q
. . S:+USRCNT'>1 VALMSG="** Nothing Added **"
. . S VALMBCK="R",USRQUIT=1
W !,"Rebuilding membership list."
S USRCLASS=+$G(^TMP("USRM",$J,0))
D BUILD^USRMLST(USRCLASS)
I USRCNT'>1,+$G(DA) D
. S USRUSER=$$SIGNAME^USRLS(+$G(^USR(8930.3,+DA,0)))
. S VALMSG="** "_USRUSER_" Added **"
S VALMCNT=+$G(@VALMAR@(0))
S VALMBCK="R"
Q
DICW ; Write code for member look-up
N USRSIGNM,USRCLASS,USREFF,USREXP,USRMEM
S USRMEM=$G(^USR(8930.3,+Y,0))
S USRSIGNM=$$SIGNAME^USRLS(+USRMEM)
S USRCLASS=$E($$CLNAME^USRLM(+$P(USRMEM,U,2),1),1,24)
S USREFF=$$DATE^USRLS($P(USRMEM,U,3),"MM/DD/YY")
S USREXP=$$DATE^USRLS($P(USRMEM,U,4),"MM/DD/YY")
W USRSIGNM," ",USRCLASS,?60,USREFF," - ",USREXP
Q
DELETE ; Delete a member to the class
N DIE,X,Y,USRCLASS D FULL^VALM1
N USRCLASS,USRDA,USRCHNG,USRDATA,USRI,USRLST,DIROUT
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S USRI=0
F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
. S USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI))
. S USRDA=+$P(USRDATA,U,2) D DELETE1(USRDA)
. S:+$G(USRCHNG) USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRDATA
. I $D(USRDATA) D UPDATE^USRM(USRDATA)
W !,"Rebuilding the list."
S USRCLASS=+$G(^TMP("USRM",$J,0))
D BUILD^USRMLST(USRCLASS)
S VALMCNT=+$G(@VALMAR@(0))
K VALMY S VALMBCK="R"
S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" removed **"
Q
DELETE1(DA) ; Delete one member from a class
N DIE,DR,USER,CLASS,USRMEM0 S USRMEM0=$G(^USR(8930.3,+DA,0))
I USRMEM0']"" W !,"Record #",DA," NOT FOUND!" Q
;S USER=$P($G(^VA(200,+USRMEM,0)),U)
S USER=$$PERSNAME^USRLM1(+USRMEM0)
S CLASS=$P($G(^USR(8930,+$P(USRMEM0,U,2),0)),U)
W !,"Removing ",USER," from ",CLASS
I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,USER," NOT Removed from ",CLASS,"." Q
S USRCHNG=1
S DIK="^USR(8930.3," D ^DIK K DIK W "."
Q
SCHEDULE ; Schedule changes in class membership
N DIC,DLAYGO,X,Y
N USRCREAT,USRDUZ,USRUSER,USRMIN,USRMAX,USREFF,USREXP,USRCLASS
N USRCLNM
D FULL^VALM1
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S DIC=8930,DIC(0)="AEMQZ",DIC("A")="Select CLASS: "
S DIC("B")=$P($G(^TMP("USRMMBR",$J,0)),U,2)
D ^DIC Q:+Y'>0
S USRCLASS=+Y,USRCLNM=$$CLNAME^USRLM(USRCLASS,1)
S USRMIN=DT,USRMAX=$$FMADD^XLFDT(DT,365)
S USREFF=$$READ^USRU("D^"_USRMIN_":"_USRMAX_":EXFT"," Specify EFFECTIVE DATE/TIME","TODAY")
S USREXP=$$READ^USRU("D^"_USRMIN_":"_USRMAX_":EXFT","Specify EXPIRATION DATE/TIME","T+365")
S USRI=0
F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D
. N USRDATA,USRDUZ,USRMEM,USRUSER,DIC,DIE,DA,DR,X,Y
. S USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI))
. S USRMEM=$G(^USR(8930.3,+$P(USRDATA,U,2),0)),USRDUZ=+USRMEM
. S DIC=200,DIC(0)="NX",X="`"_USRDUZ
. D ^DIC Q:+Y'>0
. S (DIC,DLAYGO)=8930.3,DIC(0)="LM",X=""""_$P(Y,U,2)_""""
. D ^DIC Q:+Y'>0
. ; pwc (VSR) USR*1*39 changed //// to /// slashes (3)
. S USRCREAT=+$P(Y,U,3)
. S DA=+Y,DIE=DIC
. S DR=".02///"_USRCLASS_";.03///"_+USREFF_";.04///"_+USREXP
. D ^DIE
W !,"Rebuilding membership list."
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSRMEMBR 4925 printed Apr 09, 2024@20:43:51 Page 2
USRMEMBR ;SLC/JER,PWC - User Class Management actions ;Sep 04, 2019@16:18
+1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,6,7,29,33,39**;Jun 20, 1997;Build 3
EDIT ; Edit user's class membership
+1 ;N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG,USRLST
+2 NEW USRDA,USRDATA,USRI,DIROUT,USRCHNG,USRLST
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET (USRCHNG,USRI)=0
+5 FOR
SET USRI=$ORDER(VALMY(USRI))
if +USRI'>0
QUIT
Begin DoDot:1
+6 SET USRDATA=$GET(^TMP("USRMMBRIDX",$JOB,USRI))
+7 WRITE !!,"Editing #",+USRDATA,!
+8 SET USRDA=+$PIECE(USRDATA,U,2)
DO EDIT1
+9 IF +$GET(USRCHNG)
SET USRLST=$SELECT($LENGTH($GET(USRLST)):$GET(USRLST)_", ",1:"")_USRI
+10 IF $DATA(USRDATA)
DO UPDATE^USRM(USRDATA)
End DoDot:1
if $DATA(DIROUT)
QUIT
+11 WRITE !,"Refreshing the list."
+12 SET VALMSG="** "_$SELECT($LENGTH($GET(USRLST)):"Item"_$SELECT($LENGTH($GET(USRLST),",")>1:"s ",1:" ")_$GET(USRLST),1:"Nothing")_" Edited **"
+13 KILL VALMY
SET VALMBCK="R"
+14 QUIT
EDIT1 ; Single record edit
+1 ; Receives USRDA
+2 NEW DA,DIE,DR
+3 IF '+$GET(USRDA)
WRITE !,"No Classes selected."
HANG 2
SET USRCHNG=0
QUIT
+4 SET DIE="^USR(8930.3,"
SET DA=USRDA
SET DR="[USR MEMBERSHIP EDIT]"
+5 DO FULL^VALM1
DO ^DIE
SET USRCHNG=1
+6 QUIT
ADD ; Add a member to the class
+1 NEW DA,DR,DIC,DLAYGO,X,Y,USRCLASS,USRUSER,USRQUIT,USRCNT
DO FULL^VALM1
+2 SET USRCNT=0
+3 FOR
Begin DoDot:1
+4 WRITE !
+5 SET DIC=200
SET DIC(0)="AEMQ"
+6 SET DIC("A")="Select "_$SELECT(USRCNT'>0:"",1:"Another ")_"MEMBER: "
+7 DO ^DIC
IF +Y'>0
SET USRQUIT=1
QUIT
+8 IF $$ISAWM^USRLM(+Y,USRDA)
QUIT
+9 IF $$ISTERM^USRLM(+Y)
Begin DoDot:2
+10 SET USRQUIT=1
+11 WRITE !,"The user you selected is terminated, cannot add them as a class member!"
+12 HANG 2
End DoDot:2
QUIT
+13 SET (DIC,DLAYGO)=8930.3
SET DIC(0)="LM"
SET X=""""_$PIECE(Y,U,2)_""""
+14 SET DIC("W")="D DICW^USRMEMBR"
+15 DO ^DIC
IF +Y'>0
SET USRQUIT=1
QUIT
+16 SET USRCREAT=+$PIECE(Y,U,3)
SET USRCNT=USRCNT+1
+17 SET DA=+Y
SET DIE=DIC
SET DIE("NO^")="BACK"
SET DR="[USR CLASS EDIT]"
DO ^DIE
+18 IF $DATA(Y)
Begin DoDot:2
+19 SET DIK=DIC
DO ^DIK
KILL DIK
+20 if +USRCNT'>1
SET VALMSG="** Nothing Added **"
+21 SET VALMBCK="R"
SET USRQUIT=1
End DoDot:2
QUIT
+22 IF 'USRCREAT
Begin DoDot:2
+23 if +USRCNT'>1
SET VALMSG="** Nothing Added **"
+24 SET VALMBCK="R"
SET USRQUIT=1
End DoDot:2
QUIT
End DoDot:1
if +$GET(USRQUIT)
QUIT
+25 WRITE !,"Rebuilding membership list."
+26 SET USRCLASS=+$GET(^TMP("USRM",$JOB,0))
+27 DO BUILD^USRMLST(USRCLASS)
+28 IF USRCNT'>1
IF +$GET(DA)
Begin DoDot:1
+29 SET USRUSER=$$SIGNAME^USRLS(+$GET(^USR(8930.3,+DA,0)))
+30 SET VALMSG="** "_USRUSER_" Added **"
End DoDot:1
+31 SET VALMCNT=+$GET(@VALMAR@(0))
+32 SET VALMBCK="R"
+33 QUIT
DICW ; Write code for member look-up
+1 NEW USRSIGNM,USRCLASS,USREFF,USREXP,USRMEM
+2 SET USRMEM=$GET(^USR(8930.3,+Y,0))
+3 SET USRSIGNM=$$SIGNAME^USRLS(+USRMEM)
+4 SET USRCLASS=$EXTRACT($$CLNAME^USRLM(+$PIECE(USRMEM,U,2),1),1,24)
+5 SET USREFF=$$DATE^USRLS($PIECE(USRMEM,U,3),"MM/DD/YY")
+6 SET USREXP=$$DATE^USRLS($PIECE(USRMEM,U,4),"MM/DD/YY")
+7 WRITE USRSIGNM," ",USRCLASS,?60,USREFF," - ",USREXP
+8 QUIT
DELETE ; Delete a member to the class
+1 NEW DIE,X,Y,USRCLASS
DO FULL^VALM1
+2 NEW USRCLASS,USRDA,USRCHNG,USRDATA,USRI,USRLST,DIROUT
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET USRI=0
+5 FOR
SET USRI=$ORDER(VALMY(USRI))
if +USRI'>0
QUIT
Begin DoDot:1
+6 SET USRDATA=$GET(^TMP("USRMMBRIDX",$JOB,USRI))
+7 SET USRDA=+$PIECE(USRDATA,U,2)
DO DELETE1(USRDA)
+8 if +$GET(USRCHNG)
SET USRLST=$SELECT(+$GET(USRLST):USRLST_", ",1:"")_+USRDATA
+9 IF $DATA(USRDATA)
DO UPDATE^USRM(USRDATA)
End DoDot:1
if $DATA(DIROUT)
QUIT
+10 WRITE !,"Rebuilding the list."
+11 SET USRCLASS=+$GET(^TMP("USRM",$JOB,0))
+12 DO BUILD^USRMLST(USRCLASS)
+13 SET VALMCNT=+$GET(@VALMAR@(0))
+14 KILL VALMY
SET VALMBCK="R"
+15 SET VALMSG="** "_$SELECT($LENGTH($GET(USRLST)):"Item"_$SELECT($LENGTH($GET(USRLST),",")>1:"s ",1:" ")_$GET(USRLST),1:"Nothing")_" removed **"
+16 QUIT
DELETE1(DA) ; Delete one member from a class
+1 NEW DIE,DR,USER,CLASS,USRMEM0
SET USRMEM0=$GET(^USR(8930.3,+DA,0))
+2 IF USRMEM0']""
WRITE !,"Record #",DA," NOT FOUND!"
QUIT
+3 ;S USER=$P($G(^VA(200,+USRMEM,0)),U)
+4 SET USER=$$PERSNAME^USRLM1(+USRMEM0)
+5 SET CLASS=$PIECE($GET(^USR(8930,+$PIECE(USRMEM0,U,2),0)),U)
+6 WRITE !,"Removing ",USER," from ",CLASS
+7 IF '$$READ^USRU("Y","Are you SURE","NO")
SET USRCHNG=0
WRITE !,USER," NOT Removed from ",CLASS,"."
QUIT
+8 SET USRCHNG=1
+9 SET DIK="^USR(8930.3,"
DO ^DIK
KILL DIK
WRITE "."
+10 QUIT
SCHEDULE ; Schedule changes in class membership
+1 NEW DIC,DLAYGO,X,Y
+2 NEW USRCREAT,USRDUZ,USRUSER,USRMIN,USRMAX,USREFF,USREXP,USRCLASS
+3 NEW USRCLNM
+4 DO FULL^VALM1
+5 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+6 SET DIC=8930
SET DIC(0)="AEMQZ"
SET DIC("A")="Select CLASS: "
+7 SET DIC("B")=$PIECE($GET(^TMP("USRMMBR",$JOB,0)),U,2)
+8 DO ^DIC
if +Y'>0
QUIT
+9 SET USRCLASS=+Y
SET USRCLNM=$$CLNAME^USRLM(USRCLASS,1)
+10 SET USRMIN=DT
SET USRMAX=$$FMADD^XLFDT(DT,365)
+11 SET USREFF=$$READ^USRU("D^"_USRMIN_":"_USRMAX_":EXFT"," Specify EFFECTIVE DATE/TIME","TODAY")
+12 SET USREXP=$$READ^USRU("D^"_USRMIN_":"_USRMAX_":EXFT","Specify EXPIRATION DATE/TIME","T+365")
+13 SET USRI=0
+14 FOR
SET USRI=$ORDER(VALMY(USRI))
if +USRI'>0
QUIT
Begin DoDot:1
+15 NEW USRDATA,USRDUZ,USRMEM,USRUSER,DIC,DIE,DA,DR,X,Y
+16 SET USRDATA=$GET(^TMP("USRMMBRIDX",$JOB,USRI))
+17 SET USRMEM=$GET(^USR(8930.3,+$PIECE(USRDATA,U,2),0))
SET USRDUZ=+USRMEM
+18 SET DIC=200
SET DIC(0)="NX"
SET X="`"_USRDUZ
+19 DO ^DIC
if +Y'>0
QUIT
+20 SET (DIC,DLAYGO)=8930.3
SET DIC(0)="LM"
SET X=""""_$PIECE(Y,U,2)_""""
+21 DO ^DIC
if +Y'>0
QUIT
+22 ; pwc (VSR) USR*1*39 changed //// to /// slashes (3)
+23 SET USRCREAT=+$PIECE(Y,U,3)
+24 SET DA=+Y
SET DIE=DIC
+25 SET DR=".02///"_USRCLASS_";.03///"_+USREFF_";.04///"_+USREXP
+26 DO ^DIE
End DoDot:1
+27 WRITE !,"Rebuilding membership list."
+28 SET VALMBCK="R"
+29 QUIT
