SDES2GETUSRPROF ;ALB/JAS - VISTA SCHEDULING SDES2 RPCS GET USER KEYS AND OPTIONS ; August 26, 2024@18:15
;;5.3;Scheduling;**890**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
; Reference to $$FIND1^DIC in ICR #2051
; Reference to NEW PERSON in ICR #10060
; Reference to $$ACTIVE^XUSER in ICR #2343
;
Q
;
GETUSRPROBYSECID(JSONRETURN,SDCONTEXT,SDINPUT) ;Called from RPC: SDES2 GET USER PROFILE BY SECID
; The SDCONTEXT array is controlled by the Acheron application and its fields are
; needed for the storage of the required auditing information.
;
; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
;
; SDINPUT("USER SECID") = The SECID of the user being queried.
;
; OUTPUT - SDRETURN
; List of a user's details from the NEW PERSON (#200) file that meets the search criteria.
;
N SDERRORS,SDRETURN,SDUSRIEN
;
; Validate SDCONTEXT
D VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("User",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
; Validate USER SECID
I $G(SDINPUT("USER SECID"))="" D Q
. D ERRLOG^SDES2JSON(.SDERRORS,130) M SDRETURN=SDERRORS
. S SDRETURN("User",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
D VALSECID^SDES2VAL200(.SDERRORS,SDINPUT("USER SECID"))
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("User",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
; Get and Validate DUZ
D GETUSRIEN(.SDERRORS,SDINPUT("USER SECID"),.SDUSRIEN)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("User",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
D VALUSERDUZ^SDES2VAL200(.SDERRORS,SDUSRIEN)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("User",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
D GETUSRINFO(.SDRETURN,SDUSRIEN)
D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
Q
;
GETUSRPROBYDUZ(JSONRETURN,SDCONTEXT,SDINPUT) ;Called from RPC: SDES2 GET USER PROFILE BY DUZ
; The SDCONTEXT array is controlled by the Acheron application and its fields are
; needed for the storage of the required auditing information.
;
; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
;
; SDINPUT("USER DUZ") = The DUZ of the user being queried.
;
; OUTPUT - SDRETURN
; List of a user's details from the NEW PERSON (#200) file that meets the search criteria.
;
N SDERRORS,SDRETURN,SDUSRIEN
;
; Validate SDCONTEXT
D VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("User",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
; Validate USER DUZ
D VALUSERDUZ^SDES2VAL200(.SDERRORS,SDINPUT("USER DUZ"),1)
I '$D(SDERRORS),'$$ACTIVE^XUSER(SDINPUT("USER DUZ")) D ERRLOG^SDES2JSON(.SDERRORS,458)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("User",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
D GETUSRINFO(.SDRETURN,SDINPUT("USER DUZ"))
D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
Q
;
GETUSRIEN(SDERRORS,SDSECID,SDUSRIEN) ;
N SCERR
S SDUSRIEN=$$FIND1^DIC(200,,"X",SDSECID,"ASECID",,"SCERR")
I $D(SCERR) D ERRLOG^SDES2JSON(.SDERRORS,156) Q
I '$$ACTIVE^XUSER(SDUSRIEN) D ERRLOG^SDES2JSON(.SDERRORS,458)
Q
;
GETUSRINFO(SDRETURN,SDUSRIEN) ; Get User Keys and Scheduling Options
N SDFIELDS,SDDATA,SDMSG,SDIEN,SDCNT,SDOPTION,SDKEY,SDDIV,SDDIVIEN,SDSTATNUM,SDDEFAULT
S SDFIELDS=".01;201;203*;51*;16*"
D GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
S SDRETURN("User","Name")=$G(SDDATA(200,SDUSRIEN_",",.01,"E")) ;User Name
S SDRETURN("User","IEN")=SDUSRIEN
S SDRETURN("User","StationID")=$$DEFAULTSTATION^SDECDUZ()
S SDOPTION=$G(SDDATA(200,SDUSRIEN_",",201,"E"))
S SDRETURN("User","PrimaryMenuOption")=SDOPTION ;Primary Menu Option
;
; Secondary Options Multiple
S SDIEN="",SDCNT=0
F S SDIEN=$O(SDDATA(200.03,SDIEN)) Q:SDIEN="" D
. S SDOPTION=$G(SDDATA(200.03,SDIEN,.01,"E"))
. S SDCNT=SDCNT+1 S SDRETURN("User","SecondaryMenu",SDCNT,"Option")=SDOPTION
;
; Security Keys Multiple
S SDIEN="",SDCNT=0
F S SDIEN=$O(SDDATA(200.051,SDIEN)) Q:SDIEN="" D
. S SDKEY=$G(SDDATA(200.051,SDIEN,.01,"E"))
. S SDCNT=SDCNT+1 S SDRETURN("User","SecurityKey",SDCNT,"Name")=SDKEY
;
; Divisions Multiple
S (SDIEN,SDSTATNUM,SDDEFAULT)="",SDCNT=0
F S SDIEN=$O(SDDATA(200.02,SDIEN)) Q:SDIEN="" D
. S SDDIVIEN=$G(SDDATA(200.02,SDIEN,.01,"I"))
. S SDSTATNUM=$$GET1^DIQ(4,SDDIVIEN,99,"I")
. S SDDIV=$G(SDDATA(200.02,SDIEN,.01,"E"))
. S SDDEFAULT=$G(SDDATA(200.02,SDIEN,1,"I"))
. S SDDEFAULT=$S(SDDEFAULT=1:"YES",1:"")
. S SDCNT=SDCNT+1
. S SDRETURN("User","Division",SDCNT,"Name")=SDDIV
. S SDRETURN("User","Division",SDCNT,"IEN")=SDDIVIEN
. S SDRETURN("User","Division",SDCNT,"Division")=SDSTATNUM
. S SDRETURN("User","Division",SDCNT,"Default")=SDDEFAULT
;
I SDCNT=0 D
. I $G(DUZ(2))'="" D
. . S SDCNT=SDCNT+1
. . S SDRETURN("User","Division",SDCNT,"Division")=$G(DUZ(2))
. . S SDRETURN("User","Division",SDCNT,"IEN")=$G(DUZ(2))
. . S SDRETURN("User","Division",SDCNT,"Name")=$$GET1^DIQ(4,$G(DUZ(2)),.01,"E")
. . S SDRETURN("User","Division",SDCNT,"Default")=""
;
I '$D(SDRETURN("User")) S SDRETURN("User",1)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETUSRPROF 6165 printed Sep 23, 2025@20:30:54 Page 2
SDES2GETUSRPROF ;ALB/JAS - VISTA SCHEDULING SDES2 RPCS GET USER KEYS AND OPTIONS ; August 26, 2024@18:15
+1 ;;5.3;Scheduling;**890**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;External References
+5 ;-------------------
+6 ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
+7 ; Reference to $$FIND1^DIC in ICR #2051
+8 ; Reference to NEW PERSON in ICR #10060
+9 ; Reference to $$ACTIVE^XUSER in ICR #2343
+10 ;
+11 QUIT
+12 ;
GETUSRPROBYSECID(JSONRETURN,SDCONTEXT,SDINPUT) ;Called from RPC: SDES2 GET USER PROFILE BY SECID
+1 ; The SDCONTEXT array is controlled by the Acheron application and its fields are
+2 ; needed for the storage of the required auditing information.
+3 ;
+4 ; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+5 ; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
+6 ; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
+7 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
+8 ; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
+9 ;
+10 ; SDINPUT("USER SECID") = The SECID of the user being queried.
+11 ;
+12 ; OUTPUT - SDRETURN
+13 ; List of a user's details from the NEW PERSON (#200) file that meets the search criteria.
+14 ;
+15 NEW SDERRORS,SDRETURN,SDUSRIEN
+16 ;
+17 ; Validate SDCONTEXT
+18 DO VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
+19 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("User",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+20 ;
+21 ; Validate USER SECID
+22 IF $GET(SDINPUT("USER SECID"))=""
Begin DoDot:1
+23 DO ERRLOG^SDES2JSON(.SDERRORS,130)
MERGE SDRETURN=SDERRORS
+24 SET SDRETURN("User",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
End DoDot:1
QUIT
+25 DO VALSECID^SDES2VAL200(.SDERRORS,SDINPUT("USER SECID"))
+26 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("User",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+27 ;
+28 ; Get and Validate DUZ
+29 DO GETUSRIEN(.SDERRORS,SDINPUT("USER SECID"),.SDUSRIEN)
+30 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("User",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+31 DO VALUSERDUZ^SDES2VAL200(.SDERRORS,SDUSRIEN)
+32 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("User",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+33 ;
+34 DO GETUSRINFO(.SDRETURN,SDUSRIEN)
+35 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
+36 QUIT
+37 ;
GETUSRPROBYDUZ(JSONRETURN,SDCONTEXT,SDINPUT) ;Called from RPC: SDES2 GET USER PROFILE BY DUZ
+1 ; The SDCONTEXT array is controlled by the Acheron application and its fields are
+2 ; needed for the storage of the required auditing information.
+3 ;
+4 ; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+5 ; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
+6 ; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
+7 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
+8 ; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
+9 ;
+10 ; SDINPUT("USER DUZ") = The DUZ of the user being queried.
+11 ;
+12 ; OUTPUT - SDRETURN
+13 ; List of a user's details from the NEW PERSON (#200) file that meets the search criteria.
+14 ;
+15 NEW SDERRORS,SDRETURN,SDUSRIEN
+16 ;
+17 ; Validate SDCONTEXT
+18 DO VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
+19 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("User",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+20 ;
+21 ; Validate USER DUZ
+22 DO VALUSERDUZ^SDES2VAL200(.SDERRORS,SDINPUT("USER DUZ"),1)
+23 IF '$DATA(SDERRORS)
IF '$$ACTIVE^XUSER(SDINPUT("USER DUZ"))
DO ERRLOG^SDES2JSON(.SDERRORS,458)
+24 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("User",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+25 ;
+26 DO GETUSRINFO(.SDRETURN,SDINPUT("USER DUZ"))
+27 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
+28 QUIT
+29 ;
GETUSRIEN(SDERRORS,SDSECID,SDUSRIEN) ;
+1 NEW SCERR
+2 SET SDUSRIEN=$$FIND1^DIC(200,,"X",SDSECID,"ASECID",,"SCERR")
+3 IF $DATA(SCERR)
DO ERRLOG^SDES2JSON(.SDERRORS,156)
QUIT
+4 IF '$$ACTIVE^XUSER(SDUSRIEN)
DO ERRLOG^SDES2JSON(.SDERRORS,458)
+5 QUIT
+6 ;
GETUSRINFO(SDRETURN,SDUSRIEN) ; Get User Keys and Scheduling Options
+1 NEW SDFIELDS,SDDATA,SDMSG,SDIEN,SDCNT,SDOPTION,SDKEY,SDDIV,SDDIVIEN,SDSTATNUM,SDDEFAULT
+2 SET SDFIELDS=".01;201;203*;51*;16*"
+3 DO GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+4 ;User Name
SET SDRETURN("User","Name")=$GET(SDDATA(200,SDUSRIEN_",",.01,"E"))
+5 SET SDRETURN("User","IEN")=SDUSRIEN
+6 SET SDRETURN("User","StationID")=$$DEFAULTSTATION^SDECDUZ()
+7 SET SDOPTION=$GET(SDDATA(200,SDUSRIEN_",",201,"E"))
+8 ;Primary Menu Option
SET SDRETURN("User","PrimaryMenuOption")=SDOPTION
+9 ;
+10 ; Secondary Options Multiple
+11 SET SDIEN=""
SET SDCNT=0
+12 FOR
SET SDIEN=$ORDER(SDDATA(200.03,SDIEN))
if SDIEN=""
QUIT
Begin DoDot:1
+13 SET SDOPTION=$GET(SDDATA(200.03,SDIEN,.01,"E"))
+14 SET SDCNT=SDCNT+1
SET SDRETURN("User","SecondaryMenu",SDCNT,"Option")=SDOPTION
End DoDot:1
+15 ;
+16 ; Security Keys Multiple
+17 SET SDIEN=""
SET SDCNT=0
+18 FOR
SET SDIEN=$ORDER(SDDATA(200.051,SDIEN))
if SDIEN=""
QUIT
Begin DoDot:1
+19 SET SDKEY=$GET(SDDATA(200.051,SDIEN,.01,"E"))
+20 SET SDCNT=SDCNT+1
SET SDRETURN("User","SecurityKey",SDCNT,"Name")=SDKEY
End DoDot:1
+21 ;
+22 ; Divisions Multiple
+23 SET (SDIEN,SDSTATNUM,SDDEFAULT)=""
SET SDCNT=0
+24 FOR
SET SDIEN=$ORDER(SDDATA(200.02,SDIEN))
if SDIEN=""
QUIT
Begin DoDot:1
+25 SET SDDIVIEN=$GET(SDDATA(200.02,SDIEN,.01,"I"))
+26 SET SDSTATNUM=$$GET1^DIQ(4,SDDIVIEN,99,"I")
+27 SET SDDIV=$GET(SDDATA(200.02,SDIEN,.01,"E"))
+28 SET SDDEFAULT=$GET(SDDATA(200.02,SDIEN,1,"I"))
+29 SET SDDEFAULT=$SELECT(SDDEFAULT=1:"YES",1:"")
+30 SET SDCNT=SDCNT+1
+31 SET SDRETURN("User","Division",SDCNT,"Name")=SDDIV
+32 SET SDRETURN("User","Division",SDCNT,"IEN")=SDDIVIEN
+33 SET SDRETURN("User","Division",SDCNT,"Division")=SDSTATNUM
+34 SET SDRETURN("User","Division",SDCNT,"Default")=SDDEFAULT
End DoDot:1
+35 ;
+36 IF SDCNT=0
Begin DoDot:1
+37 IF $GET(DUZ(2))'=""
Begin DoDot:2
+38 SET SDCNT=SDCNT+1
+39 SET SDRETURN("User","Division",SDCNT,"Division")=$GET(DUZ(2))
+40 SET SDRETURN("User","Division",SDCNT,"IEN")=$GET(DUZ(2))
+41 SET SDRETURN("User","Division",SDCNT,"Name")=$$GET1^DIQ(4,$GET(DUZ(2)),.01,"E")
+42 SET SDRETURN("User","Division",SDCNT,"Default")=""
End DoDot:2
End DoDot:1
+43 ;
+44 IF '$DATA(SDRETURN("User"))
SET SDRETURN("User",1)=""
+45 QUIT
