| 1 | XUSERNEW ;SF/RWF - ADD NEW USER ;6/27/07
|
|---|
| 2 | ;;8.0;KERNEL;**16,49,134,208,157,313,351,419,467**;Jul 10, 1995;Build 12
|
|---|
| 3 | ;In the call to NEW^XM for new users the variable XMZ must be undef.
|
|---|
| 4 | ;on a reactivation XMZ should be set to the current max message number.
|
|---|
| 5 | EN ;Add
|
|---|
| 6 | N Y,XUN,DR,DIE,DA,DTOUT,DIWF,XMDT,XMM,XMZ
|
|---|
| 7 | S Y=$$ADD("","",1) G EXIT:Y'>0,RE:$P(Y,U,3)'=1
|
|---|
| 8 | S XUN=+Y ;XU USER ADD called in $$ADD
|
|---|
| 9 | S DR="["_$$GET^XUPARAM("XUNEW USER","N")_"]"
|
|---|
| 10 | S DIE=200,DA=XUN D XUDIE^XUS5 G:$D(DTOUT) EXIT
|
|---|
| 11 | I $$GET1^DIQ(200,XUN_",",11,"I")="" W !,"Without a VERIFY code the user will not be able to sign-on!",$C(7),!
|
|---|
| 12 | S Y=XUN K XMZ D NEW^XM K XMDT,XMM,XMZ
|
|---|
| 13 | ;ACCESS LETTER, Also see XUSERBLK
|
|---|
| 14 | W ! D LETTER(XUN,1)
|
|---|
| 15 | K DIR,DIWF,XUTEXT
|
|---|
| 16 | ;
|
|---|
| 17 | ;Fall in from above, called from REACT
|
|---|
| 18 | KEYS N DIR,XQHOLD,XQKEY,XQDA,XQAL,XQ6,XQFL
|
|---|
| 19 | S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to allocate security keys" D ^DIR G:$D(DIRUT) EXIT
|
|---|
| 20 | I Y=1 S XQHOLD(XUN)="",XQKEY(0)=0,XQDA=0,XQAL=1,XQ6="",XQFL="" D KEY^XQ6
|
|---|
| 21 | ;
|
|---|
| 22 | ;Check on adding this user to user groups
|
|---|
| 23 | I $P(^VA(200,XUN,0),U,3)'="" D ;Must have access code & mailbox
|
|---|
| 24 | .N DIR,Y
|
|---|
| 25 | .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to add this user to mail groups" D ^DIR Q:$D(DIRUT)
|
|---|
| 26 | .I Y=1 D ENLOCAL1^XMVGRP(XUN)
|
|---|
| 27 | .K XMDUN,XMDUZ,XMV
|
|---|
| 28 | .Q
|
|---|
| 29 | ;
|
|---|
| 30 | EXIT K D0,DA,DDER,DDSFILE,DIE,DIC,DIR,DI,DICR,DIG,DIH,DISYS,DIU,DIV,DIWT,DLAYGO,DR,DQ,K,I,X,X1,XQHOLD,XQKEY,XUN,XUSOLD,XMB,XMZ,Y,Z,XQ6,XQFL,DTOUT
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | RE ;Jump from new user to reactivate
|
|---|
| 34 | S XUN=+Y,DIR("A")="This isn't a new user, Want to reactivate?",DIR(0)="Y",DIR("B")="NO"
|
|---|
| 35 | D ^DIR
|
|---|
| 36 | G EXIT:$D(DIRUT)!(Y'=1),RE2
|
|---|
| 37 | ;Reactivate a user
|
|---|
| 38 | REACT ;SEA/WDE-REACTIVATE A USER
|
|---|
| 39 | N XUN,XUSOLD,DIE,DIC,DA,DR,FDA
|
|---|
| 40 | S XUN=+$$LOOKUP^XUSER G EXIT:XUN<0
|
|---|
| 41 | RE2 S XUSOLD=^VA(200,XUN,0)
|
|---|
| 42 | S FDA(200,XUN_",",9.2)="@" ;Clear the Termination date
|
|---|
| 43 | D UPDATE^DIE("E","FDA")
|
|---|
| 44 | ;Show the screanman form
|
|---|
| 45 | S DIE=200,DR="["_$$GET^XUPARAM("XUREACT USER","N")_"]",DA=XUN
|
|---|
| 46 | D XUDIE^XUS5 G:$D(DTOUT) EXIT
|
|---|
| 47 | I $P(^VA(200,XUN,0),U,3)="" W !!,"No ACCESS CODE has been entered.",$C(7),!
|
|---|
| 48 | I $P(^VA(200,XUN,0),U,11)>0,$P(^(0),U,11)'>DT W !!,"User is still TERMINATED.",$C(7),!
|
|---|
| 49 | I $$GET1^DIQ(200,XUN_",",11,"I")="" W !,"Without a VERIFY code the user will not be able to sign-on!",$C(7),!
|
|---|
| 50 | N DIR
|
|---|
| 51 | S DIR(0)="Y",DIR("A")="Deny access to old mail messages",DIR("B")="NO",DIR("?")="Enter a 'YES' to restrict access to old mail messages."
|
|---|
| 52 | D ^DIR G:$D(DIRUT) EXIT
|
|---|
| 53 | K XMZ S:Y=1 XMZ=+$P(^XMB(3.9,0),"^",3) S Y=XUN D NEW^XM K XMDT,XMM,XMZ
|
|---|
| 54 | D REACT^XQ84(XUN) ;See if this user's menu trees need to be rebuilt
|
|---|
| 55 | G KEYS
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ADD(NP1,KEYS,NONC) ;Common point to do DIC call for adding a new person.
|
|---|
| 59 | ;NP1 will be added to the default or what comes from the NPI field of the KSP.
|
|---|
| 60 | ;KEYS is a list of Keys to give the new person
|
|---|
| 61 | N DA,DR,DLAYGO,XUITNAME,XUS1,XUS2,DIC,DIE,DIK,NP2,Y
|
|---|
| 62 | I $G(^XTV(8989.3,1,"NPI"))]"" X ^("NPI") S NP2=DR
|
|---|
| 63 | S:'$D(NP2) NP2="1;"_$S($D(^XUSEC("XUSPF200",DUZ)):9,1:"9R~")_";4;41.99"
|
|---|
| 64 | ;";41.99" is for adding National Provider Identifier
|
|---|
| 65 | S DIC="^VA(200,",DIC(0)="AELMQ",DLAYGO=200,DIC("A")="Enter NEW PERSON's name (Family,Given Middle Suffix): ",DIC("DR")="",XUITNAME=1
|
|---|
| 66 | D ^DIC S XUS1=Y G AX:(Y'>0)!($P(Y,U,3)'>0)
|
|---|
| 67 | S DA=+$G(^VA(200,+XUS1,3.1)) I DA,'$G(NONC) D
|
|---|
| 68 | . W !,"Name components."
|
|---|
| 69 | . S DIE="^VA(20,",DR="1;2;3;5"
|
|---|
| 70 | . L +^VA(20,DA,0):60 D ^DIE L -^VA(20,DA,0)
|
|---|
| 71 | . I $D(Y)!$D(DTOUT) S DA=+XUS1,XUS1=-1
|
|---|
| 72 | . E S $P(XUS1,U,2)=$P(^VA(200,+XUS1,0),U)
|
|---|
| 73 | D:XUS1>0
|
|---|
| 74 | . W !,"Now for the Identifiers."
|
|---|
| 75 | . S DA=+XUS1,DIE="^VA(200,",DR=NP2_$S($D(NP1):";"_NP1,1:""),DIE("NO^")="OUTOK"
|
|---|
| 76 | . L +^VA(200,DA,0):60 D ^DIE L -^VA(200,DA,0)
|
|---|
| 77 | . S:$D(Y)!$D(DTOUT) XUS1=-1
|
|---|
| 78 | I XUS1<0 D S XUS1=-1
|
|---|
| 79 | . W !?5,"<'",$P(^VA(200,DA,0),U),"' DELETED>"
|
|---|
| 80 | . S DIK="^VA(200," D ^DIK
|
|---|
| 81 | . Q:$P($G(^DIC(3,0)),U)'="USER"!'$D(^DD(3,0))
|
|---|
| 82 | . S DIK="^DIC(3,",XUS1=$P($G(^DIC(3,DA,0)),U,16) D ^DIK
|
|---|
| 83 | . Q:'XUS1!($P($G(^DIC(16,0)),U)'="PERSON")!'$D(^DD(16,0))
|
|---|
| 84 | . S DIK="^DIC(16,",DA=XUS1 D ^DIK
|
|---|
| 85 | N XUSNPI S XUSNPI=$P($G(^VA(200,DA,"NPI")),"^")
|
|---|
| 86 | I XUS1>0,+XUSNPI>0 S XUSNPI=$$ADDNPI^XUSNPI("Individual_ID",DA,XUSNPI,$$NOW^XLFDT(),1) ;add NPI
|
|---|
| 87 | I XUS1>0,$D(KEYS) F XUS2=1:1 S Y=$P(KEYS,",",XUS2) Q:'$L(Y) D
|
|---|
| 88 | . S %=$$ADD^XQKEY(XUS1,Y) I '% W !,"Key '",Y,"' not allocated"
|
|---|
| 89 | I XUS1>0 D CALL^XUSERP(+XUS1,1) ;XQOR add
|
|---|
| 90 | AX Q XUS1
|
|---|
| 91 | ;
|
|---|
| 92 | REPRINT ;Reprint letter
|
|---|
| 93 | S DA=+$$LOOKUP^XUSER G EXIT:DA'>0
|
|---|
| 94 | D LETTER(DA)
|
|---|
| 95 | G EXIT
|
|---|
| 96 | ;
|
|---|
| 97 | LETTER(XUN,ASK) ;Print access letter
|
|---|
| 98 | Q:'$G(XUN)
|
|---|
| 99 | N DIWF,FR,TO,BY,DIR,XUTEXT
|
|---|
| 100 | S XUTEXT=$$GET^XUPARAM("XUSER COMPUTER ACCOUNT","N"),XUTEXT=$O(^DIC(9.2,"B",XUTEXT,0))
|
|---|
| 101 | S DIR(0)="Y",DIR("A")="Print User Account Access Letter"
|
|---|
| 102 | I XUTEXT>0 S Y=1 D:$G(ASK) ^DIR I Y=1 D
|
|---|
| 103 | . S (XUU,XUU2)="________",DIWF="^DIC(9.2,XUTEXT,1,",DIWF(1)=200,FR=XUN,TO=XUN,BY="NUMBER" D EN2^DIWF
|
|---|
| 104 | . Q
|
|---|
| 105 | Q
|
|---|
