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

SDESPRIVUSRSRCH.m

Go to the documentation of this file.
  1. SDESPRIVUSRSRCH ;ALB/RRM,MGD - VISTA SCHEDULING PRIVILEGED USER SEARCH RPC; Sept 23, 2022@01:21
  1. ;;5.3;Scheduling;**819,826**;Aug 13, 1993;Build 18
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ;External References
  1. ;-------------------
  1. ; Reference to LIST^DIC is supported by IA #2051
  1. ; Reference to $$UP^XLFSTR is supported by IA #10104
  1. ; Reference to $$ACTIVE^XUSER is supported by IA #2343
  1. ;
  1. ;Global References
  1. ;-----------------
  1. ; Reference to LIST^DIC(200 is supported by IA #10060
  1. ;
  1. Q ;No Direct Call
  1. ;
  1. ; The parameter list for this RPC must be kept in sync.
  1. ; If you need to add or remove a parameter, ensure that the Remote Procedure File #8994 definition is also updated.
  1. ;
  1. SEARCHPRIVUSR(RETURNJSON,SEARCHSTRING) ;Called from the RPC: SDES SEARCH PRIVILEGED USER
  1. ; Input:
  1. ; SEARCHSTRING - (Required) Partial OR Full name text of at least 3-35 characters
  1. ;
  1. ;Output:
  1. ; Successful Return:
  1. ; RETURNJSON = Returns a JSON formatted string that match the search criteria that was supplied.
  1. ; Otherwise, JSON Errors will be returned for any invalid/missing parameters.
  1. ;
  1. N ERRORS,RETURNERROR ;temp data storage for input validation error
  1. N SDPRIVUSERINFO ;temp data storage of all the names that match the search criteria
  1. N HASSEARCHERROR
  1. ;Search String Validation
  1. S SEARCHSTRING=$$UP^XLFSTR($G(SEARCHSTRING)) ;convert the search string into all Uppercase
  1. S HASSEARCHERROR=$$VALIDATESRCHSTR(.ERRORS,SEARCHSTRING)
  1. I HASSEARCHERROR M RETURNERROR=ERRORS
  1. ;
  1. I $O(RETURNERROR("Error",""))'="" D EMPTYJSON(SEARCHSTRING),BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURNERROR) Q
  1. ;
  1. D GETPRIVUSER(SEARCHSTRING,.SDPRIVUSERINFO) ;retrieve all the names that matches the criteria from the New Person Fiel #200
  1. D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.SDPRIVUSERINFO)
  1. Q
  1. ;
  1. GETPRIVUSER(SEARCHSTRING,SDPRIVUSERINFO) ;seach and retrieve user
  1. N USERIEN,RECORDCNTR,USRISACTIVE,USERLIST,LISTERROR,RECNUM,SDERROR,SDMULTARY,FIELDS
  1. S RECORDCNTR=0
  1. S FIELDS="@;.01;1;8;.111;.112;.113;.114;.115;.116;.151;4;5;501.1"
  1. D LIST^DIC(200,,FIELDS,"PB","*",,SEARCHSTRING,"B",,,"USERLIST","LISTERROR")
  1. I $D(LISTERROR) S SDPRIVUSERINFO("Error",1)=LISTERROR("DIERR",1,"TEXT",1) D EMPTYJSON(SEARCHSTRING) Q
  1. S RECNUM=0 F S RECNUM=$O(USERLIST("DILIST",RECNUM)) Q:RECNUM="" D
  1. . Q:RECNUM<1
  1. . S USERIEN=$P(USERLIST("DILIST",RECNUM,0),"^")
  1. . S USRISACTIVE=$$ACTIVE^XUSER(USERIEN) ;check if user is not TERMINATED or DIUSER'ed or User cannot sign-on (no AC/VC assigned)
  1. . Q:$P(USRISACTIVE,"^")<1 ;Quit if User is TERMINATED or DIUSER'ed or User cannot sign-on (no AC/VC assigned)
  1. . S RECORDCNTR=RECORDCNTR+1
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserIEN")=USERIEN
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserName")=$P(USERLIST("DILIST",RECNUM,0),"^",2) ;Name
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserInitial")=$P(USERLIST("DILIST",RECNUM,0),"^",3) ;Initial
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserTitle")=$P(USERLIST("DILIST",RECNUM,0),"^",4) ;Title
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserStreetAddress1")=$P(USERLIST("DILIST",RECNUM,0),"^",5) ;Street Address 1
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserStreetAddress2")=$P(USERLIST("DILIST",RECNUM,0),"^",6) ;Street Address 2
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserStreetAddress3")=$P(USERLIST("DILIST",RECNUM,0),"^",7) ;Street Address 3
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserCity")=$P(USERLIST("DILIST",RECNUM,0),"^",8) ;City
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserState")=$P(USERLIST("DILIST",RECNUM,0),"^",9) ;State
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserZipCode")=$P(USERLIST("DILIST",RECNUM,0),"^",10) ;Zip Code
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserEmailAddress")=$P(USERLIST("DILIST",RECNUM,0),"^",11) ;Email Address
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserSex")=$P(USERLIST("DILIST",RECNUM,0),"^",12) ;Sex
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserDOB")=$P(USERLIST("DILIST",RECNUM,0),"^",13) ;DOB
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserNetworkID")=$P(USERLIST("DILIST",RECNUM,0),"^",14) ;Network Username
  1. . D GETUSERDIVISION(USERIEN,.SDPRIVUSERINFO) ;retrieve Division Multiple data
  1. . D GETUSERCLASS(USERIEN,.SDPRIVUSERINFO) ;retrieve User Class Multiple data
  1. . D GETPERSONCLASS(USERIEN,.SDPRIVUSERINFO) ;retrieve Person Class Multiple data
  1. ;if no record found,set the array into a NULL value
  1. D EMPTYJSON(SEARCHSTRING,.SDPRIVUSERINFO)
  1. Q
  1. ;
  1. GETUSERDIVISION(USERIEN,SDPRIVUSERINFO) ;retrieve Division Multiple data
  1. N SDERROR,SDMULTARY,II,ISDIVDEFAULT,RECNTR
  1. S RECNTR=0
  1. D LIST^DIC(200.02,","_USERIEN_",","@;.01I;.01E;1I;1E","PQ",,,,"#",,,"SDMULTARY","SDERROR")
  1. I $D(SDERROR) D EMPTYDIV(.SDPRIVUSERINFO,RECORDCNTR)
  1. S II=0 F S II=$O(SDMULTARY("DILIST",II)) Q:II="" D
  1. . Q:II<1
  1. . S RECNTR=RECNTR+1
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"Division",RECNTR,"DivisionIEN")=$P(SDMULTARY("DILIST",II,0),"^",2)
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"Division",RECNTR,"DivisionName")=$P(SDMULTARY("DILIST",II,0),"^",3)
  1. . S ISDIVDEFAULT=$P(SDMULTARY("DILIST",II,0),"^",5)
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"Division",RECNTR,"DivisionDefault")=$S(ISDIVDEFAULT'="":ISDIVDEFAULT,1:"NO")
  1. I $P(SDMULTARY("DILIST",0),"^")=0 D EMPTYDIV(.SDPRIVUSERINFO,RECORDCNTR) ;user does not have division set up
  1. Q
  1. ;
  1. GETUSERCLASS(USERIEN,SDPRIVUSERINFO) ;retrieve User Class Multiple data
  1. N SDERROR,SDMULTARY,II,ISUCPRIMARY,RECNTR
  1. S RECNTR=0
  1. D LIST^DIC(200.07,","_USERIEN_",","@;.01I;.01E;2I;2E","PQ",,,,"#",,,"SDMULTARY","SDERROR")
  1. I $D(SDERROR) D EMPTYUSC(.SDPRIVUSERINFO,RECORDCNTR)
  1. S II=0 F S II=$O(SDMULTARY("DILIST",II)) Q:II="" D
  1. . Q:II<1
  1. . S RECNTR=RECNTR+1
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserClass",RECNTR,"UserClassIEN")=$P(SDMULTARY("DILIST",II,0),"^",2)
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserClass",RECNTR,"UserClassName")=$P(SDMULTARY("DILIST",II,0),"^",3)
  1. . S ISUCPRIMARY=$P(SDMULTARY("DILIST",II,0),"^",5)
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserClass",RECNTR,"UserClassIsPrimary")=$S(ISUCPRIMARY'="":ISUCPRIMARY,1:"NO")
  1. I $P(SDMULTARY("DILIST",0),"^")=0 D EMPTYUSC(.SDPRIVUSERINFO,RECORDCNTR) ;user does not have USER CLASS set up
  1. Q
  1. ;
  1. GETPERSONCLASS(USERIEN,SDPRIVUSERINFO) ;retrieve Person Class Multiple data
  1. N SDERROR,SDMULTARY,RECNTR,II
  1. S RECNTR=0
  1. D LIST^DIC(200.05,","_USERIEN_",","@;.01I;.01E;2E;3E","PQ",,,,"#",,,"SDMULTARY","SDERROR")
  1. I $D(SDERROR) D EMPTYPC(.SDPRIVUSERINFO,RECORDCNTR)
  1. S II=0 F S II=$O(SDMULTARY("DILIST",II)) Q:II="" D
  1. . Q:II<1
  1. . S RECNTR=RECNTR+1
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"PersonClass",RECNTR,"PersonClassIEN")=$P(SDMULTARY("DILIST",II,0),"^",2)
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"PersonClass",RECNTR,"PersonClassName")=$P(SDMULTARY("DILIST",II,0),"^",3)
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"PersonClass",RECNTR,"EffectiveDate")=$P(SDMULTARY("DILIST",II,0),"^",4)
  1. . S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"PersonClass",RECNTR,"ExpirationDate")=$P(SDMULTARY("DILIST",II,0),"^",5)
  1. I $P(SDMULTARY("DILIST",0),"^")=0 D EMPTYPC(.SDPRIVUSERINFO,RECORDCNTR) ;user does not have PERSON CLASS set up
  1. Q
  1. ;
  1. VALIDATESRCHSTR(ERRORS,SEARCHSTRING) ;Validate Privileged user search string that was supplied
  1. N ERRORFLAG
  1. S ERRORFLAG=0
  1. I SEARCHSTRING="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,231) Q ERRORFLAG
  1. I $L(SEARCHSTRING)<3!($L(SEARCHSTRING)>35) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,230)
  1. Q ERRORFLAG
  1. ;
  1. EMPTYDIV(SDPRIVUSERINFO,RECORDCNTR) ;set Division subscript to NULL
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"Division",1,"DivisionIEN")=""
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"Division",1,"DivisionName")=""
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"Division",1,"DivisionDefault")=""
  1. Q
  1. ;
  1. EMPTYUSC(SDPRIVUSERINFO,RECORDCNTR) ;Set User Class subscript to Null
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserClass",1,"UserClassIEN")=""
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserClass",1,"UserClassName")=""
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"UserClass",1,"UserClassIsPrimary")=""
  1. Q
  1. ;
  1. EMPTYPC(SDPRIVUSERINFO,RECORDCNTR) ;Set Person Class subscript to Null
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"PersonClass",1,"PersonClassIEN")=""
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"PersonClass",1,"PersonClassName")=""
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"PersonClass",1,"EffectiveDate")=""
  1. S SDPRIVUSERINFO("NewPerson",RECORDCNTR,"PersonClass",1,"ExpirationDate")=""
  1. Q
  1. ;
  1. EMPTYJSON(SEARCHSTRING,SDPRIVUSERINFO) ;return an empty string JSON Format if an Error occur or no data found
  1. I $O(SDPRIVUSERINFO("NewPerson",""))="" D
  1. . I $O(RETURNERROR("Error",""))="" D Q
  1. . . S SDPRIVUSERINFO("NewPerson",1)=""
  1. . S RETURNERROR("NewPerson",1)=""
  1. Q
  1. ;