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