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

XUSEHRM1.m

Go to the documentation of this file.
  1. XUSEHRM1 ; BA/OAK - EHRM REVERSED LOCK -ASSIGN AND REMOVE; Jan 19, 2022@08:07:01
  1. ;;8.0;KERNEL;**758**;Jul 10, 1995;Build 17
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. Q
  1. 1 ; assign a Program Replacement Key to all users
  1. N XUSASK,XUSDVSION,XUSKEY,XUDUZ,XUANS,XUSER,DIR,XUEXIT,ZTSK
  1. S XUSDUZ=$G(DUZ,.5),XUSER="",XUSDVSION="",XUSKEY="",XUEXIT=""
  1. S XUSKEY=+$$ASKKEY("What Program Replacement Key do you want to assign to VistA users? ") I XUSKEY'>0 G END
  1. S XUSKEY=$P($G(^DIC(19.1,XUSKEY,0)),"^")
  1. SET DIR(0)="SA^U:User(s);D:Division(s);A:All users;Q:Quit",DIR("A")="Do you want to select (U)sers, (D)ivisions, (A)ll users, (Q)uit: ",DIR("B")="D"
  1. W ! D ^DIR S XUANS=Y
  1. K DIR
  1. IF XUANS="^" Q
  1. IF XUANS="Q" Q
  1. IF XUANS="U" D
  1. . S XUSER=$$U1("NULL") I +XUSER'>0 S XUEXIT=1 Q
  1. . W !
  1. . N Y,X,DIR
  1. . S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you ready to assign the Program Replacement Key <"_XUSKEY_"> to the users" D ^DIR
  1. . K DIR I +$G(Y)'>0 S XUEXIT=1 Q
  1. IF XUANS="D" D
  1. . S XUSDVSION=$$D1("NULL") I +XUSDVSION'>0 S XUEXIT=1 Q
  1. . W !!!,"Chosen Division(s):"
  1. . W !,"-------------------"
  1. . D LISTDVS(XUSDVSION)
  1. . W !
  1. . S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you ready to assign the Program Replacement Key <"_XUSKEY_"> to VistA users at above Division(s): " D ^DIR K DIR
  1. . I +Y'>0 S XUEXIT=1 Q
  1. . Q
  1. IF XUANS="A" S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you ready to assign the Program Replacement Key <"_XUSKEY_"> to ALL VistA users" D ^DIR K DIR I +Y'>0 S XUEXIT=1 Q
  1. I XUEXIT=1 Q
  1. ; Start Queue process
  1. S ZTRTN="ASSIGN^XUSEHRM1",ZTIO="" ;queue the process
  1. S ZTSAVE("XUSKEY")="",ZTSAVE("XUSDVSION")="",ZTSAVE("XUDUZ")="",ZTSAVE("XUSER")="",ZTSAVE("XUANS")=""
  1. S ZTDESC="Assign Keys for users."
  1. D ^%ZTLOAD
  1. I $D(ZTSK) W !!,"Task #: ",ZTSK,!
  1. Q
  1. ;-------------------------------------------------------------
  1. U1(XUS) ; select users
  1. N DIC,Y,X,XUTEXT,XUSER1U,XUC1U
  1. S XUTEXT="Select a user: ",XUSER1U="",XUC1U=0
  1. LOOP1U ;
  1. S DIC="^VA(200,",DIC(0)="AEQM" S DIC("A")=XUTEXT D ^DIC
  1. I Y=-1,$G(X)="^" S XUC1U=0
  1. I +Y>0 S XUTEXT="Select another user: ",XUSER1U=XUSER1U_";"_+Y,XUC1U=XUC1U+1 G LOOP1U
  1. Q XUC1U_"^"_$P(XUSER1U,";",2,99)
  1. ;------------------------------------------------------------
  1. D1(XUS) ; select Divisions
  1. N DIC,Y,X,XUTEXT,XUSER1D,XUC1D
  1. S XUTEXT="Select a division: ",XUSER1D="",XUC1D=0
  1. LOOP1D ;
  1. S DIC="^DIC(4,",DIC(0)="AEQM" S DIC("A")=XUTEXT D ^DIC
  1. I Y=-1,$G(X)="^" S XUC1D=0
  1. I +Y>0 S XUTEXT="Select another division: ",XUSER1D=XUSER1D_";"_+Y,XUC1D=XUC1D+1 G LOOP1D
  1. Q XUC1D_"^"_$P(XUSER1D,";",2,99)
  1. ;--------------------------------------------------------------
  1. 2 ; remove a Program Replacement Key from all users
  1. N XUSASK,XUSDVSION,XUSKEY,XUDUZ,XUANS,XUSER,DIR,XUEXIT,ZTSK
  1. S XUSDUZ=$G(DUZ,.5),XUSER="",XUSDVSION="",XUSKEY="",XUEXIT=""
  1. S XUSKEY=+$$ASKKEY("What Program Replacement Key do you want to remove from VistA users? ") I XUSKEY'>0 G END
  1. S XUSKEY=$P($G(^DIC(19.1,XUSKEY,0)),"^")
  1. SET DIR(0)="SA^U:User(s);D:Division(s);A:All users;Q:Quit",DIR("A")="Do you want to select (U)sers, (D)ivisions, (A)ll users, (Q)uit: ",DIR("B")="D"
  1. W ! D ^DIR S XUANS=Y
  1. K DIR
  1. IF XUANS="^" Q
  1. IF XUANS="Q" Q
  1. IF XUANS="U" D
  1. . S XUSER=$$U1("NULL") I +XUSER'>0 S XUEXIT=1 Q
  1. . W !
  1. . N Y,X,DIR
  1. . S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you ready to remove the Program Replacement Key <"_XUSKEY_"> from the users" D ^DIR
  1. . K DIR I +$G(Y)'>0 S XUEXIT=1 Q
  1. IF XUANS="D" D
  1. . S XUSDVSION=$$D1("NULL") I +XUSDVSION'>0 S XUEXIT=1 Q
  1. . W !!!,"Chosen Division(s):"
  1. . W !,"-------------------"
  1. . D LISTDVS(XUSDVSION)
  1. . W !
  1. . S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you ready to remove the Program Replacement Key <"_XUSKEY_"> from VistA users at above Division(s): " D ^DIR K DIR
  1. . I +Y'>0 S XUEXIT=1 Q
  1. . Q
  1. IF XUANS="A" S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you ready to remove the Program Replacement Key <"_XUSKEY_"> from ALL VistA users" D ^DIR K DIR I +Y'>0 S XUEXIT=1 Q
  1. ; Start Queue process
  1. I XUEXIT=1 Q
  1. S ZTRTN="REMOVE^XUSEHRM1",ZTIO="" ;queue the process
  1. S ZTSAVE("XUSKEY")="",ZTSAVE("XUSDVSION")="",ZTSAVE("XUDUZ")="",ZTSAVE("XUSER")="",ZTSAVE("XUANS")=""
  1. S ZTDESC="Remove Keys from users."
  1. D ^%ZTLOAD
  1. I $D(ZTSK) W !!,"Task #: ",ZTSK,!
  1. Q
  1. ;--------------------------------------------------
  1. 5 ; set REVERSE/NEGATIVE LOCK field
  1. N XUSKEY,XUSOPTN,XUSKEYN,DIR,XUANS,XUFLAG,ZTSK
  1. SET XUFLAG=0
  1. K ^XUBA758("ACTION758")
  1. SET XUSKEY=+$$ASKKEY("What Program Replacement Key do you want to assign to options? ") I XUSKEY'>0 Q
  1. SET XUSKEYN=$P($G(^DIC(19.1,XUSKEY,0)),"^")
  1. SET DIR(0)="SA^N:NameSpace;O:Option;Q:Quit",DIR("A")="Do you want to select (N)ameSpaces, (O)ptions, (Q)uit: ",DIR("B")="O"
  1. W ! D ^DIR S XUANS=Y
  1. IF XUANS="^" Q
  1. IF XUANS="N" D NAMESPACE
  1. IF XUANS="O" D OPTION
  1. IF XUANS="Q" Q
  1. I $D(^XUBA758("ACTION758"))'>0 Q
  1. SET ZTRTN="SETLOCKS^XUSEHRM1",ZTIO="" ;queue the process
  1. SET ZTSAVE("XUSKEYN")="",ZTSAVE("^XUBA758")="",ZTSAVE("XUFLAG")=""
  1. SET ZTDESC="Add REVERSE/NEGATIVE LOCK field."
  1. DO ^%ZTLOAD
  1. IF $D(ZTSK) W !!,"Task #: ",ZTSK,!
  1. Q
  1. ;----------------------------------------------------
  1. 6 ; remove REVERSE/NEGATIVE LOCK field
  1. N XUSKEY,XUSOPTN,XUSKEYN,DIR,XUANS,XUCOUNT,XUFLAG,ZTSK
  1. S XUFLAG=1
  1. K ^XUBA758("ACTION758")
  1. SET XUSKEY=+$$ASKKEY("What Program Replacement Key do you want to remove from options? ") I XUSKEY'>0 Q
  1. SET XUSKEYN=$P($G(^DIC(19.1,XUSKEY,0)),"^")
  1. SET DIR(0)="SA^N:NameSpace;O:Option;Q:Quit",DIR("A")="Do you want to select (N)ameSpaces, (O)ptions, (Q)uit: ",DIR("B")="O"
  1. W ! D ^DIR S XUANS=Y
  1. IF XUANS="^" Q
  1. IF XUANS="N" D NAMESPACE
  1. IF XUANS="O" D OPTION
  1. IF XUANS="Q" Q
  1. I $D(^XUBA758("ACTION758"))'>0 Q
  1. SET ZTRTN="DELOCKS^XUSEHRM1",ZTIO="" ;queue the process
  1. SET ZTSAVE("XUSKEYN")="",ZTSAVE("^XUBA758")="",ZTSAVE("XUFLAG")=""
  1. SET ZTDESC="Remove REVERSE/NEGATIVE LOCK field."
  1. DO ^%ZTLOAD
  1. IF $D(ZTSK) W !!,"Task #: ",ZTSK,!
  1. Q
  1. ;----------------------------------------------------------
  1. YN(XUSTEXT) ; ask yes no question
  1. N DIR,Y
  1. S DIR(0)="Y",DIR("B")="YES",DIR("A")=XUSTEXT D ^DIR K DIR
  1. Q Y
  1. ;------------------------------------------------------
  1. SELECOP(XUSTEXT,ACTION) ; select Option in the Option file
  1. ; ACTION is "ACTION758" or "NOACTION758"
  1. N DIC,Y,XUCOUNT
  1. K ^XUBA758(ACTION)
  1. S XUCOUNT=0
  1. LOOP1 ;
  1. S DIC="^DIC(19,",DIC(0)="AEQ" S DIC("A")=XUSTEXT D ^DIC
  1. I Y=-1,$G(X)="^" G END
  1. I Y>0 D
  1. . I ACTION="NOACTION758" S ^XUBA758(ACTION,$J,+Y)="" G LOOP1
  1. . I ACTION="ACTION758" S XUCOUNT=XUCOUNT+1,^XUBA758(ACTION,$J,XUCOUNT)=Y G LOOP1
  1. Q XUCOUNT
  1. ;-------------------------------------------------------
  1. LISTDVS(XUSDVSION) ; List the chosen DIVISIONS
  1. N XUS,XUS1,XUS2,XUS3
  1. S XUS=$P(XUSDVSION,"^")
  1. S XUS1=$P(XUSDVSION,"^",2,99)
  1. F XUS2=1:1:XUS D
  1. . S XUS3=$P(XUS1,";",XUS2) W !,$P($G(^DIC(4,XUS3,0)),"^")
  1. Q
  1. ;----------------------------------------------------------
  1. ASKKEY(XUSTEXT) ; select REPLACEMENT Keys
  1. N DIC,Y
  1. BACK ;
  1. S DIC="^DIC(19.1,",DIC(0)="AEQ" S DIC("A")=XUSTEXT D ^DIC I Y'>0 Q Y
  1. I Y'["REPLACEMENT" W !!,"Invalid Program Replacement Key, it must contain <REPLACEMENT>",! G BACK
  1. Q Y
  1. ;----------------------------------------------------------
  1. ASSDVS(XUSIEN4) ; set Key for user in specific one Division XUSIEN4 is the IEN in the INSTITUTION file.
  1. N XUS S XUS=0
  1. F S XUS=$O(^VA(200,"AH",XUSIEN4,XUS)) Q:XUS'>0 D
  1. . I $D(^VA(200,XUS,0))'>0 Q
  1. . I $D(^XUSEC(XUSKEY,XUS))>0 Q ; prevent a user has mutiple divisions
  1. . D SETKEY(XUS,XUSKEY)
  1. . I $D(^XUSEC(XUSKEY,XUS))>0 S XUCN=XUCN+1
  1. Q
  1. ;---------------------------------------------------------
  1. ASSIGN ; assign the Program Replacement Key to all users
  1. N XUS,XUCN,XUSD1,XUSD2,XUI,XUSIEN4,XUIEN
  1. S XUS=0,XUCN=0
  1. S XUDUZ=$G(XUDUZ,DUZ),XUANS=$G(XUANS),XUSDVSION=$G(XUSDVSION),XUSER=$G(XUSER)
  1. I XUANS="D" D
  1. . S XUSD1=$P(XUSDVSION,"^"),XUSD2=$P(XUSDVSION,"^",2)
  1. . F XUI=1:1:XUSD1 S XUSIEN4=$P(XUSD2,";",XUI) D ASSDVS(XUSIEN4)
  1. I XUANS="U" D
  1. . S XUSC1=$P(XUSER,"^"),XUSC2=$P(XUSER,"^",2)
  1. . F XUI=1:1:XUSC1 S XUIEN=$P(XUSC2,";",XUI) D SETKEY(XUIEN,XUSKEY)
  1. . S XUCN=XUSC1
  1. I XUANS="A" D
  1. . F S XUS=$O(^VA(200,XUS)) Q:XUS'>0 D
  1. .. I $D(^VA(200,XUS,0))'>0
  1. .. D SETKEY(XUS,XUSKEY)
  1. .. I $D(^XUSEC(XUSKEY,XUS))>0 S XUCN=XUCN+1
  1. D SENDALERT(XUDUZ,XUSKEY,"Assigned",XUCN)
  1. K XUDUZ,XUSKEY,XUSER,XUANS
  1. Q
  1. ;-----------------------------------------------------------
  1. SETKEY(XUS,XUSKEY) ;assign a Program Replacement Key for a user
  1. N IENS,XUSKEYN,ERR
  1. K FDA
  1. S IENS="?+2,"_XUS_","
  1. S FDA(200.051,IENS,.01)=XUSKEY
  1. D UPDATE^DIE("E","FDA",,"ERR")
  1. Q
  1. ;-----------------------------------------------------------
  1. DELKEY(XUIEN,KEY) ;delete a Program Replacement Key for a user
  1. N DIK,DA S DA(1)=XUIEN,DA=KEY,DIK="^VA(200,"_DA(1)_",51," D ^DIK
  1. Q
  1. ;-----------------------------------------------------------
  1. REMDVS(XUSIEN4) ; remove Program Replacement Key for users at specific one Division
  1. N XUS S XUS=0
  1. F S XUS=$O(^VA(200,"AH",XUSIEN4,XUS)) Q:XUS'>0 D
  1. . I +$D(^XUSEC(XUSKEY,XUS))>0 D DELKEY(XUS,XUSKEY1) S XUCN=XUCN+1
  1. Q
  1. ;-----------------------------------------------------------
  1. REMOVE ;remove a Program Replacement Key from all users
  1. N XUS,XUCN,XUSD1,XUSD2,XUI,XUSIEN4,XUIEN,XUSKEY1
  1. S XUS=0,XUCN=0
  1. S XUSKEY1=+$O(^DIC(19.1,"B",XUSKEY,0))
  1. I XUSKEY1'>0 Q
  1. S XUDUZ=$G(XUDUZ,DUZ),XUANS=$G(XUANS),XUSDVSION=$G(XUSDVSION),XUSER=$G(XUSER)
  1. I XUANS="D" D
  1. . S XUSD1=$P(XUSDVSION,"^"),XUSD2=$P(XUSDVSION,"^",2)
  1. . F XUI=1:1:XUSD1 S XUSIEN4=$P(XUSD2,";",XUI) D REMDVS(XUSIEN4)
  1. I XUANS="U" D
  1. . S XUSC1=$P(XUSER,"^"),XUSC2=$P(XUSER,"^",2)
  1. . F XUI=1:1:XUSC1 S XUIEN=$P(XUSC2,";",XUI) D DELKEY(XUIEN,XUSKEY1)
  1. . S XUCN=XUSC1
  1. I XUANS="A" D
  1. . F S XUS=$O(^XUSEC(XUSKEY,XUS)) Q:XUS'>0 D
  1. .. I $D(^VA(200,XUS,0))'>0
  1. .. D DELKEY(XUS,XUSKEY1) S XUCN=XUCN+1
  1. D SENDALERT(XUDUZ,XUSKEY,"Removed",XUCN)
  1. K XUDUZ,XUSKEY,XUSER,XUANS
  1. Q
  1. ;------------------------------------------------------------
  1. GETOPTION(XUSOPTN,XUCOUNT) ;
  1. N XUOPTIEN,XUOPTIEN1
  1. S XUOPTIEN=0
  1. K OUT758
  1. S XUSOPTN=$P($G(XUSOPTN),"*")
  1. ;I XUSOPTN="" Q XUCOUNT
  1. D LIST^DIC(19,"","","",,XUSOPTN,XUSOPTN,"","","","OUT758")
  1. S OUT758("DILIST",1,.1)=XUSOPTN
  1. F S XUOPTIEN=$O(OUT758("DILIST",1,XUOPTIEN)) Q:+XUOPTIEN'>0 D
  1. . S XUOPNAME=$G(OUT758("DILIST",1,XUOPTIEN)) Q:XUOPNAME=""
  1. . S XUOPTIEN1=$O(^DIC(19,"B",XUOPNAME,0)) Q:XUOPTIEN1'>0
  1. . S XUCOUNT=XUCOUNT+1,^XUBA758("ACTION758",$J,XUCOUNT)=XUOPTIEN1_"^"_XUOPNAME
  1. Q XUCOUNT
  1. ;------------------------------------------------------------
  1. NAMESPACE ; Set Reversed Lock for NameSpaces
  1. N XUCOUNT,XU3
  1. S XUCOUNT=0
  1. S XUCOUNT=$$ASKNAMESP("Please select a NameSpace") Q:XUCOUNT=0
  1. S XUS3=$$PRINTOPTION(XUCOUNT,XUFLAG)
  1. I XUS3=0 G END
  1. D EXCLUDE
  1. Q
  1. ;----------------------------------------------------------
  1. OPTION ;Set Reversed Lock for Options
  1. N XUCOUNT,XU3
  1. S XUCOUNT=$$SELECOP("Select an option: ","ACTION758")
  1. S XUS3=$$PRINTOPTION(XUCOUNT,XUFLAG)
  1. I XUS3=0 G END
  1. D EXCLUDE
  1. Q
  1. ;-----------------------------------------------------------
  1. ASKNAMESP(XUSTEXT) ; ask NameSpaces
  1. N DIR,Y,XUCOUNT,XUNEXT
  1. S XUCOUNT=0
  1. K ^XUBA758("ACTION758")
  1. LOOPN ;
  1. S DIR(0)="FO^1:30",DIR("A")=$G(XUNEXT,XUSTEXT),DIR("?")="You may select a NameSpace* such as TIU* or one or more option names such as TIU MAIN MENU MGR, TIU MAIN MENU MRT"
  1. D ^DIR K DIR
  1. I Y="*" S XUNEXT="Invalid NameSpace, please choose another NameSpace. For example TIU*" G LOOPN
  1. I Y'="^",Y'="" S XUCOUNT=$$GETOPTION(Y,XUCOUNT) S XUNEXT="Another NameSpace" G LOOPN
  1. W !
  1. Q XUCOUNT
  1. ;----------------------------------------------------------
  1. PRINTOPTION(XUCOUNT,XUFLAG) ; list options and ask users if they want to remove any options from the list.
  1. N XUI,XUY,XUZ,XU2,XU3
  1. S XUY="",XUZ=0,XU3=0
  1. K ^XUBA758("NOACTON758")
  1. W !,"Option list :"
  1. W !,"-----------------"
  1. F XUI=1:1:XUCOUNT D
  1. . S XUY=$P($G(^XUBA758("ACTION758",$J,XUI)),"^",2),XUY1=+$P($G(^XUBA758("ACTION758",$J,XUI)),"^")
  1. . I XUY1,XUFLAG=1,$P($G(^DIC(19,XUY1,3)),"^")'=XUSKEYN Q
  1. . S XUZ=XUZ+1,XU2=XUZ/2
  1. . I $P(XU2,".",2)=5 W !,XUY S XU3=XU3+1 Q
  1. . W ?40,XUY
  1. . S XU3=XU3+1
  1. . Q
  1. N XUOPTION,XUARE
  1. S XUOPTION="option",XUARE="is"
  1. IF XU3>1 S XUOPTION="options",XUARE="are"
  1. W !!,"There ",XUARE," ",XU3," ",XUOPTION," from the list above."
  1. Q XU3
  1. ;------------------------------------------------------------
  1. EXCLUDE ; remove options from the list
  1. N ANS,XUN
  1. S ANS=$$YN("Do you want to remove any options from the list above")
  1. I ANS=0 Q
  1. I ANS="^" G END
  1. W !
  1. S XUN=$$SELECOP("Select an option: ","NOACTION758")
  1. W !
  1. Q
  1. ;-----------------------------------------------------------
  1. END ;
  1. K ^XUBA758("ACTION758")
  1. K ^XUBA758("NOACTION758")
  1. Q
  1. END1 ;
  1. ;-----------------------------------------------------------
  1. SETLOCKS ; set REVERSE/NEGATIVE LOCK for options
  1. N XUOPTIEN,XUSECOND
  1. S XUI=0,XUSECOND=$O(^XUBA758("ACTION758",0)) I XUSECOND'>0 Q
  1. F S XUI=$O(^XUBA758("ACTION758",XUSECOND,XUI)) Q:XUI'>0 D
  1. . S XUOPTIEN=+$G(^XUBA758("ACTION758",XUSECOND,XUI))
  1. . I XUOPTIEN="" Q
  1. . I $D(^XUBA758("NOACTION758",XUSECOND,XUOPTIEN)) Q
  1. . D SETLOCK(XUOPTIEN) ;set REVERSE/NEGATIVE LOCK
  1. D END
  1. Q
  1. ;-------------------------------------------------------------
  1. SETLOCK(XUOPTIEN) ; set REVERSE/NEGATIVE LOCK for an option
  1. N DR,DIE
  1. S DIE="^DIC(19,",DA=XUOPTIEN
  1. S DR="3.01////^S X=XUSKEYN"
  1. D ^DIE
  1. Q
  1. ;--------------------------------------------------------------
  1. DELOCKS ;remove REVERSE/NEGATIVE LOCK for options
  1. N XUOPTIEN,XUSECOND
  1. S XUI=0,XUSECOND=$O(^XUBA758("ACTION758",0)) I XUSECOND'>0 Q
  1. F S XUI=$O(^XUBA758("ACTION758",XUSECOND,XUI)) Q:XUI'>0 D
  1. . S XUOPTIEN=+$G(^XUBA758("ACTION758",XUSECOND,XUI))
  1. . I XUOPTIEN'>0 Q
  1. . I $P($G(^DIC(19,XUOPTIEN,3)),"^")'=XUSKEYN Q
  1. . I $D(^XUBA758("NOACTION758",XUSECOND,XUOPTIEN)) Q
  1. . D DELOCK(XUOPTIEN) ;remove REVERSE/NEGATIVE LOCK
  1. D END
  1. Q
  1. ;--------------------------------------------------------------
  1. DELOCK(XUOPTIEN) ; remove REVERSE/NEGATIVE LOCK for an option
  1. N DR,DIE,XUSKEYN
  1. S XUSKEYN="@"
  1. S DIE="^DIC(19,",DA=XUOPTIEN
  1. S DR="3.01////^S X=XUSKEYN"
  1. D ^DIE
  1. Q
  1. ;--------------------------------------------------------------
  1. SENDALERT(XUDUZ,XUKEY,STATUS,XUCN) ; send alert to user
  1. ;XUDUZ is IEN of user
  1. ;XUKEY is Replacement Key
  1. ;STATUS is Assign or Remoe
  1. ;XUCN is number of users
  1. N XQA,XQAARCH,XQADATA,XQAFLG,XQAGUID,XQAID,XQAMSG,XQAOPT,XQAROU,XQASUPV,XQASURO,XQATEXT,XQALERR,XQVAR
  1. N XUDATE S XUDATE=$$NOW^XLFDT,XUDATE=$$FMTE^XLFDT(XUDATE,1)
  1. S XQA(XUDUZ)="" ; recipient is user
  1. S XQAMSG=XUCN_" users are "_STATUS_" the Program Replacement Key "_XUKEY_" on "_XUDATE_"."
  1. S XQVAR=$$SETUP1^XQALERT I $G(XQALERR)'="" W !,"ERROR IN ALERT: ",XQALERR
  1. Q
  1. ;---------------------------------------------------------------