SDESGETUDDUZ ;ALB/ANU/DJS - VISTA SCHEDULING RPCS GET USER KEYS AND OPTIONS ; Jan 07, 2022@15:
;;5.3;Scheduling;**807,809,814,818**;Aug 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
; Reference to ^%DT in ICR #10003
; Reference to $$FIND1^DIC in ICR #2051
;
; Global References Supported
; ----------------- ----------------- ----------
; ^TMP($J SACC 2.3.2.5.1
Q
;
GETUSRDTL(SDUSRJSON,SDUSRIEN,SDEAS) ;Called from RPC: SDES GET USER PROFILE
; This RPC gets User name, Keys and Scheduling Options for a given User.
; Input:
; SDCLNJSON - [required] - Successs or Error message
; SDDUZ - [required] - The IEN from the NEW PERSON File #200
; SDEAS - [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
;
N ERRPOP,ERR,ERRMSG,SDECI,SDUSRSREC
D INIT
D VALIDATE
I ERRPOP D BLDJSON Q
D GETUSRINF
D BLDJSON
Q
;
INIT ; initialize values needed
S SDECI=0
S ERR=""
S ERRPOP=0,ERRMSG=""
Q
;
VALIDATE ; validate incoming parameters
I SDUSRIEN="" D ERRLOG^SDESJSON(.SDUSRSREC,127) S ERRPOP=1 Q
I '$D(^VA(200,SDUSRIEN,0)) D ERRLOG^SDESJSON(.SDUSRSREC,44) S ERRPOP=1 Q
S SDEAS=$G(SDEAS,"")
I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
I +SDEAS=-1 D ERRLOG^SDESJSON(.SDUSRSREC,142) S ERRPOP=1
Q
;
BLDJSON ; Build JSON format
D ENCODE^SDESJSON(.SDUSRSREC,.SDUSRJSON,.ERR)
K SDUSRSREC
Q
;
GETUSRINF ; Get User Keys and Scheduling Options
N SDFIELDS,SDDATA,SDMSG,SDX,SDC,SDOPT,SDKEY,SDDIV,SDDIVIEN,SDSTN,SDDEF
S SDFIELDS=".01;201"
D GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
S SDECI=SDECI+1
S SDUSRSREC("User","Name")=$G(SDDATA(200,SDUSRIEN_",",.01,"E")) ;User Name
S SDUSRSREC("User","IEN")=SDUSRIEN
S SDUSRSREC("User","Station ID")=$$DEFAULTSTATION^SDECDUZ()
S SDOPT=$G(SDDATA(200,SDUSRIEN_",",201,"E"))
I (($E(SDOPT,1,2)="SD")!($E(SDOPT,1,2)="SC")) S SDUSRSREC("User","Primary Menu Option")=SDOPT ;Primary Menu Option
; Secondary Options Multiple
S SDX="",SDC=0
S SDFIELDS="203*"
K SDDATA,SDMSG
D GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
F S SDX=$O(SDDATA(200.03,SDX)) Q:SDX="" D
. S SDOPT=$G(SDDATA(200.03,SDX,.01,"E"))
. I (($E(SDOPT,1,2)="SD")!($E(SDOPT,1,2)="SC")) S SDC=SDC+1 S SDUSRSREC("User","Secondary Menu",SDC,"Option")=SDOPT
; Security Keys Multiple
S SDX="",SDC=0
S SDFIELDS="51*"
K SDDATA,SDMSG
D GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
F S SDX=$O(SDDATA(200.051,SDX)) Q:SDX="" D
. S SDKEY=$G(SDDATA(200.051,SDX,.01,"E"))
. I (($E(SDKEY,1,2)="SD")!($E(SDKEY,1,2)="SC")) S SDC=SDC+1 S SDUSRSREC("User","Security Key",SDC,"Name")=SDKEY
; Divisions Multiple
S (SDX,SDSTN,SDDEF)="",SDC=0
S SDFIELDS="16*"
K SDDATA,SDMSG
D GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
F S SDX=$O(SDDATA(200.02,SDX)) Q:SDX="" D
. S SDDIVIEN=$G(SDDATA(200.02,SDX,.01,"I"))
. S SDSTN=$$GET1^DIQ(4,SDDIVIEN,99,"I")
. S SDDIV=$G(SDDATA(200.02,SDX,.01,"E"))
. S SDDEF=$G(SDDATA(200.02,SDX,1,"I"))
. S SDDEF=$S(SDDEF=1:"YES",1:"")
. S SDC=SDC+1
. S SDUSRSREC("User","Division",SDC,"Division")=SDSTN
. S SDUSRSREC("User","Division",SDC,"IEN")=SDDIVIEN
. S SDUSRSREC("User","Division",SDC,"Name")=SDDIV
. S SDUSRSREC("User","Division",SDC,"Default")=SDDEF
I SDC=0 D
. I $G(DUZ(2))'="" D
. . S SDC=SDC+1
. . S SDUSRSREC("User","Division",SDC,"Division")=$G(DUZ(2))
. . S SDUSRSREC("User","Division",SDC,"IEN")=$G(DUZ(2))
. . S SDUSRSREC("User","Division",SDC,"Name")=$$GET1^DIQ(4,$G(DUZ(2)),.01,"E")
. . S SDUSRSREC("User","Division",SDC,"Default")=""
I '$D(SDUSRSREC("User")) S SDUSRSREC("User")=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESGETUDDUZ 3809 printed Sep 23, 2025@20:34:02 Page 2
SDESGETUDDUZ ;ALB/ANU/DJS - VISTA SCHEDULING RPCS GET USER KEYS AND OPTIONS ; Jan 07, 2022@15:
+1 ;;5.3;Scheduling;**807,809,814,818**;Aug 13, 1993;Build 9
+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 ^%DT in ICR #10003
+8 ; Reference to $$FIND1^DIC in ICR #2051
+9 ;
+10 ; Global References Supported
+11 ; ----------------- ----------------- ----------
+12 ; ^TMP($J SACC 2.3.2.5.1
+13 QUIT
+14 ;
GETUSRDTL(SDUSRJSON,SDUSRIEN,SDEAS) ;Called from RPC: SDES GET USER PROFILE
+1 ; This RPC gets User name, Keys and Scheduling Options for a given User.
+2 ; Input:
+3 ; SDCLNJSON - [required] - Successs or Error message
+4 ; SDDUZ - [required] - The IEN from the NEW PERSON File #200
+5 ; SDEAS - [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
+6 ;
+7 NEW ERRPOP,ERR,ERRMSG,SDECI,SDUSRSREC
+8 DO INIT
+9 DO VALIDATE
+10 IF ERRPOP
DO BLDJSON
QUIT
+11 DO GETUSRINF
+12 DO BLDJSON
+13 QUIT
+14 ;
INIT ; initialize values needed
+1 SET SDECI=0
+2 SET ERR=""
+3 SET ERRPOP=0
SET ERRMSG=""
+4 QUIT
+5 ;
VALIDATE ; validate incoming parameters
+1 IF SDUSRIEN=""
DO ERRLOG^SDESJSON(.SDUSRSREC,127)
SET ERRPOP=1
QUIT
+2 IF '$DATA(^VA(200,SDUSRIEN,0))
DO ERRLOG^SDESJSON(.SDUSRSREC,44)
SET ERRPOP=1
QUIT
+3 SET SDEAS=$GET(SDEAS,"")
+4 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
+5 IF +SDEAS=-1
DO ERRLOG^SDESJSON(.SDUSRSREC,142)
SET ERRPOP=1
+6 QUIT
+7 ;
BLDJSON ; Build JSON format
+1 DO ENCODE^SDESJSON(.SDUSRSREC,.SDUSRJSON,.ERR)
+2 KILL SDUSRSREC
+3 QUIT
+4 ;
GETUSRINF ; Get User Keys and Scheduling Options
+1 NEW SDFIELDS,SDDATA,SDMSG,SDX,SDC,SDOPT,SDKEY,SDDIV,SDDIVIEN,SDSTN,SDDEF
+2 SET SDFIELDS=".01;201"
+3 DO GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+4 SET SDECI=SDECI+1
+5 ;User Name
SET SDUSRSREC("User","Name")=$GET(SDDATA(200,SDUSRIEN_",",.01,"E"))
+6 SET SDUSRSREC("User","IEN")=SDUSRIEN
+7 SET SDUSRSREC("User","Station ID")=$$DEFAULTSTATION^SDECDUZ()
+8 SET SDOPT=$GET(SDDATA(200,SDUSRIEN_",",201,"E"))
+9 ;Primary Menu Option
IF (($EXTRACT(SDOPT,1,2)="SD")!($EXTRACT(SDOPT,1,2)="SC"))
SET SDUSRSREC("User","Primary Menu Option")=SDOPT
+10 ; Secondary Options Multiple
+11 SET SDX=""
SET SDC=0
+12 SET SDFIELDS="203*"
+13 KILL SDDATA,SDMSG
+14 DO GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
+15 FOR
SET SDX=$ORDER(SDDATA(200.03,SDX))
if SDX=""
QUIT
Begin DoDot:1
+16 SET SDOPT=$GET(SDDATA(200.03,SDX,.01,"E"))
+17 IF (($EXTRACT(SDOPT,1,2)="SD")!($EXTRACT(SDOPT,1,2)="SC"))
SET SDC=SDC+1
SET SDUSRSREC("User","Secondary Menu",SDC,"Option")=SDOPT
End DoDot:1
+18 ; Security Keys Multiple
+19 SET SDX=""
SET SDC=0
+20 SET SDFIELDS="51*"
+21 KILL SDDATA,SDMSG
+22 DO GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
+23 FOR
SET SDX=$ORDER(SDDATA(200.051,SDX))
if SDX=""
QUIT
Begin DoDot:1
+24 SET SDKEY=$GET(SDDATA(200.051,SDX,.01,"E"))
+25 IF (($EXTRACT(SDKEY,1,2)="SD")!($EXTRACT(SDKEY,1,2)="SC"))
SET SDC=SDC+1
SET SDUSRSREC("User","Security Key",SDC,"Name")=SDKEY
End DoDot:1
+26 ; Divisions Multiple
+27 SET (SDX,SDSTN,SDDEF)=""
SET SDC=0
+28 SET SDFIELDS="16*"
+29 KILL SDDATA,SDMSG
+30 DO GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+31 FOR
SET SDX=$ORDER(SDDATA(200.02,SDX))
if SDX=""
QUIT
Begin DoDot:1
+32 SET SDDIVIEN=$GET(SDDATA(200.02,SDX,.01,"I"))
+33 SET SDSTN=$$GET1^DIQ(4,SDDIVIEN,99,"I")
+34 SET SDDIV=$GET(SDDATA(200.02,SDX,.01,"E"))
+35 SET SDDEF=$GET(SDDATA(200.02,SDX,1,"I"))
+36 SET SDDEF=$SELECT(SDDEF=1:"YES",1:"")
+37 SET SDC=SDC+1
+38 SET SDUSRSREC("User","Division",SDC,"Division")=SDSTN
+39 SET SDUSRSREC("User","Division",SDC,"IEN")=SDDIVIEN
+40 SET SDUSRSREC("User","Division",SDC,"Name")=SDDIV
+41 SET SDUSRSREC("User","Division",SDC,"Default")=SDDEF
End DoDot:1
+42 IF SDC=0
Begin DoDot:1
+43 IF $GET(DUZ(2))'=""
Begin DoDot:2
+44 SET SDC=SDC+1
+45 SET SDUSRSREC("User","Division",SDC,"Division")=$GET(DUZ(2))
+46 SET SDUSRSREC("User","Division",SDC,"IEN")=$GET(DUZ(2))
+47 SET SDUSRSREC("User","Division",SDC,"Name")=$$GET1^DIQ(4,$GET(DUZ(2)),.01,"E")
+48 SET SDUSRSREC("User","Division",SDC,"Default")=""
End DoDot:2
End DoDot:1
+49 IF '$DATA(SDUSRSREC("User"))
SET SDUSRSREC("User")=""
+50 QUIT
