USRMEMBR.m

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 ---USRMEMBR   4925     printed  Feb 18, 2025@23:05:16                                                                                                                                                                                                    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