Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: USRUMMBR

USRUMMBR.m

Go to the documentation of this file.
  1. USRUMMBR ; SLC/JER,MA - User Class Membership by User actions ;2/2/10
  1. ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,5,6,7,8,14,16,33**;Jun 20, 1997;Build 7
  1. ; 14 Feb 00 MA - Added check for 0 USRDA in DELETE
  1. ; 19 Jun 00 MA - Added check for inactive class when adding user.
  1. EDIT ; Edit user's class membership
  1. ;N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG,USRLST
  1. N USRDA,USRDATA,USRI,DIROUT,USRCHNG,USRLST
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S (USRCHNG,USRI)=0
  1. F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
  1. . S USRDATA=$G(^TMP("USRUSERIDX",$J,USRI))
  1. . W !!,"Editing #",+USRDATA,!
  1. . S USRDA=+$P(USRDATA,U,2) D EDIT1
  1. . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI
  1. . I $D(USRDATA) D UPDATE^USRUM(USRDATA)
  1. W !,"Refreshing the list."
  1. S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **"
  1. K VALMY S VALMBCK="R"
  1. Q
  1. EDIT1 ; Single record edit
  1. ; Receives USRDA
  1. N DA,DIE,DR
  1. I '+$G(USRDA) W !,"No Member selected." H 2 S USRCHNG=0 Q
  1. S DIE="^USR(8930.3,",DA=USRDA,DR="[USR MEMBERSHIP EDIT]"
  1. D FULL^VALM1,^DIE S USRCHNG=1
  1. Q
  1. ADD ; Add a membership to selected classes for current user
  1. N CLASSADD,DIC,DLAYGO,FDA,MSG,X,Y
  1. N I2N,FDA,FDAIEN,MSG
  1. ;N USRCLASS,USRCREAT,USRUSER,USRCNT,USRQUIT
  1. N USRCLASS,USRUSER,USRCNT,USRQUIT
  1. D FULL^VALM1
  1. I $$ISTERM^USRLM(USRDUZ) D Q ;USRDUZ is newed and set in USRULST
  1. . W !,"You cannot add class memberships, this user is terminated!"
  1. . H 2
  1. S USRCNT=0
  1. F D Q:+$G(USRQUIT)
  1. . W !
  1. . S DIC=8930,DIC(0)="AEMQ"
  1. . S DIC("A")="Select "_$S(USRCNT'>0:"",1:"Another ")_"USER CLASS: "
  1. . D ^DIC I +Y'>0 S USRQUIT=1 Q
  1. . ;
  1. . I $P(^USR(8930,+Y,0),"^",3)=0 D Q
  1. .. W !,"You may not add a user to a inactive USER CLASS !!!"
  1. .. I $$READ^USRU("FAO","Press return to continue")
  1. .. S USRQUIT=1
  1. . S USRCLASS=+Y
  1. . S DIC=200,DIC(0)="NMX",X="`"_USRDUZ
  1. .;Make sure the user is not already a member of this class.
  1. . I $$ISAWM^USRLM(USRDUZ,USRCLASS) S USRQUIT=1 Q
  1. . K FDA,FDAIEN,MSG
  1. . S CLASSADD=0
  1. . S I2N="+1,"
  1. . S FDA(8930.3,I2N,.01)=USRDUZ
  1. . S FDA(8930.3,I2N,.02)=USRCLASS
  1. . D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1. . I +$G(FDAIEN(1))>0 D
  1. .. S CLASSADD=1
  1. .. S DA=+FDAIEN(1),DIE=8930.3,DIE("NO^")="BACK"
  1. .. S DR=".03;.04" D ^DIE
  1. .. I $D(Y) D
  1. ... S DIK=DIC D ^DIK K DIK
  1. ... S CLASSADD=0
  1. . I 'CLASSADD D Q
  1. .. W !,"Error adding ",$$CLNAME^USRLM(+$P($G(^USR(8930.3,+DA,0)),U,2),1)
  1. . E S USRCNT=USRCNT+1
  1. W !,"Rebuilding membership list."
  1. D BUILD^USRULST(USRDUZ)
  1. I USRCNT>0 D
  1. . S USRUSER=$$SIGNAME^USRLS(+$G(USRDUZ))
  1. . S VALMSG="** "_USRUSER_" added to "_USRCNT_" classes **"
  1. S VALMCNT=+$G(@VALMAR@(0))
  1. S VALMBCK="R"
  1. Q
  1. DELETE ; Delete a member of the class
  1. N DIE,X,Y,USRCLASS D FULL^VALM1
  1. N USRCLASS,USRDA,USRCHNG,USRDATA,USRI,USRLST,DIROUT
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S USRI=0
  1. F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
  1. . S USRDATA=$G(^TMP("USRUSERIDX",$J,USRI))
  1. . ;02/14/00 Been having trouble with USRDA=0
  1. . ;possible bad x-ref. Will check for USRDA=0
  1. . ;Changed USRLM to check for valid 0 node for x-ref AUC
  1. . S USRDA=+$P(USRDATA,U,2) Q:USRDA=0 D DELETE1(USRDA)
  1. . S:+$G(USRCHNG) USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRDATA
  1. . I $D(USRDATA) D UPDATE^USRUM(USRDATA)
  1. W !,"Rebuilding the list."
  1. S USRCLASS=+$G(^TMP("USRU",$J,0))
  1. D BUILD^USRULST(USRDUZ)
  1. S VALMCNT=+$G(@VALMAR@(0))
  1. K VALMY S VALMBCK="R"
  1. S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" removed **"
  1. Q
  1. DELETE1(DA) ; Delete one member from a class
  1. N DIE,DR,USER,CLASS,USRMEM0 S USRMEM0=$G(^USR(8930.3,+DA,0))
  1. I USRMEM0']"" W !,"Record #",DA," NOT FOUND!" H 2 D MAILMSG Q
  1. ;S USER=$P($G(^VA(200,+USRMEM0,0)),U)
  1. ;S USER=$$GET1^DIQ(200,+USRMEM0,.01) ; ICR 10060
  1. S USER=$$PERSNAME^USRLM1(+USRMEM0)
  1. S CLASS=$P($G(^USR(8930,+$P(USRMEM0,U,2),0)),U)
  1. W !,"Removing ",USER," from ",CLASS
  1. I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,USER," NOT Removed from ",CLASS,"." H 2 Q
  1. S USRCHNG=1
  1. S DIK="^USR(8930.3," D ^DIK W "."
  1. Q
  1. MAILMSG ; This section will mail an error message to DUZ
  1. ;W " A mail message is being sent to ",$P($G(^VA(200,DUZ,0)),"^",1) H 1
  1. W " A mail message is being sent to ",$$GET1^DIQ(200,USER,.01) H 1
  1. N XMY,XMSUB,USRTEXT,XMTEXT,XMDUZ
  1. S XMDUZ=0.5
  1. S XMY(DUZ)=""
  1. S XMSUB="ERROR MESSAGE FROM AUTHORIZED/SUBSCRIPTION (USRUMMBR)"
  1. S USRTEXT(1)="This message is being generated due to a bad x-ref (AUC)"
  1. S USRTEXT(2)="in ^USR(8930.3) pointing to a IEN on the 0 node that"
  1. S USRTEXT(3)="does not exist."
  1. S USRTEXT(4)=""
  1. S USRTEXT(5)="Please forward this message to your IRM representative"
  1. S USRTEXT(6)="asking them to verify the Global ^USR(8930.3) x-ref"
  1. S USRTEXT(7)="on AUC & ACU."
  1. S USRTEXT(8)=""
  1. S USRTEXT(9)="IRM will need to verify that the x-ref AUC & ACU for"
  1. S USRTEXT(10)=$$GET1^DIQ(200,USRDUZ,.01)_" is pointing to a valid 0 node."
  1. S USRTEXT(11)=""
  1. S USRTEXT(12)="DO NOT CONTINUE WITH THIS USER UNTIL IRM VERIFIES!!"
  1. S USRTEXT(13)=""
  1. S USRTEXT(14)="IRM please check ^USR(8930.3,""AUC"","_USRDUZ_") to"
  1. S USRTEXT(15)="verify it is pointing to a valid 0 node IEN."
  1. S USRTEXT(16)="Also do the same for x-ref ACU"
  1. S XMTEXT="USRTEXT("
  1. D ^XMD
  1. Q