SDESGETUD ;ALB/ANU,LAB,MGD,JAS - VISTA SCHEDULING RPCS GET USER KEYS AND OPTIONS ; August 26, 2024@12:10
;;5.3;Scheduling;**801,805,809,814,819,820,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 ^%DT in ICR #10003
; Reference to $$FIND1^DIC in ICR #2051
; Reference to NEW PERSON in ICR #10060
; Reference to $$ACTIVE^XUSER in ICR #2343
;
; Global References Supported
; ----------------- ----------------- ----------
; ^TMP($J SACC 2.3.2.5.1
Q
;
GETUSRDTL(SDUSRJSON,SDSECID,SDEAS) ;Called from RPC: SDES GET USRPROFILE
; This RPC gets User name, Keys and Scheduling Options for a given User.
; Input:
; SDCLNJSON - [required] - Successs or Error message
; SDSECID - [required] - The SECID from the NEW PERSON File #200
; SDEAS - [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
;
N SDUSRSREC,SDUSRIEN,SDDIV,SDDIVIENC,HASSDERRORS
D VALIDATESECID(.HASSDERRORS,SDSECID)
D VALIDATEEAS(.HASSDERRORS,.SDEAS)
I $D(HASSDERRORS) D
. S HASSDERRORS("User",1)=""
. M SDUSRSREC=HASSDERRORS
I '$D(HASSDERRORS) D
. D GETUSRINFO(.SDUSRSREC,SDUSRIEN)
D BUILDJSON^SDESBUILDJSON(.SDUSRJSON,.SDUSRSREC)
Q
;
GETUSRDTLDUZ(SDUSRJSON,SDUSRIEN,SDEAS) ;Called from RPC: SDES GET USER PROFILE BY DUZ
N SDUSRSREC,HASSDERRORS
D VALIDATEUSRIEN(.HASSDERRORS,SDUSRIEN)
D VALIDATEEAS(.HASSDERRORS,.SDEAS)
I $D(HASSDERRORS) D
. S HASSDERRORS("User",1)=""
. M SDUSRSREC=HASSDERRORS
I '$D(HASSDERRORS) D
. D GETUSRINFO(.SDUSRSREC,SDUSRIEN)
D BUILDJSON^SDESBUILDJSON(.SDUSRJSON,.SDUSRSREC)
Q
;
VALIDATESECID(HASSDERRORS,SDSECID) ;
I $G(SDSECID)="" D ERRLOG^SDESJSON(.HASSDERRORS,130) Q
I '$D(HASSDERRORS) D
. D GETUSRIEN(.HASSDERRORS,SDSECID,.SDUSRIEN)
. I '$D(HASSDERRORS) D
. . D VALIDATEUSRIEN(.HASSDERRORS,SDUSRIEN)
Q
;
VALIDATEEAS(HASSDERRORS,SDEAS) ;
S SDEAS=$G(SDEAS,"")
I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
I SDEAS=-1 D ERRLOG^SDESJSON(.HASSDERRORS,142)
Q
;
GETUSRIEN(HASSDERRORS,SDSECID,SDUSRIEN) ;
N SCERR
S SDUSRIEN=$$FIND1^DIC(200,,"X",SDSECID,"ASECID",,"SCERR")
I $D(SCERR) D ERRLOG^SDESJSON(.HASSDERRORS,156)
Q
;
VALIDATEUSRIEN(HASSDERRORS,SDUSRIEN) ;
I SDUSRIEN="" D ERRLOG^SDESJSON(.HASSDERRORS,127) Q
I '$D(^VA(200,SDUSRIEN,0)) D ERRLOG^SDESJSON(.HASSDERRORS,44) Q
I '$$ACTIVE^XUSER(SDUSRIEN) D ERRLOG^SDESJSON(.HASSDERRORS,458) Q
Q
;
GETUSRINFO(SDUSRSREC,SDUSRIEN) ; Get User Keys and Scheduling Options
N SDFIELDS,SDDATA,SDMSG,SDX,SDC,SDOPT,SDKEY,SDDIV,SDDIVIEN,SDSTN,SDDEF
S SDFIELDS=".01;201;203*;51*;16*"
D GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
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"))
S SDUSRSREC("User","Primary Menu Option")=SDOPT ;Primary Menu Option
; Secondary Options Multiple
S SDX="",SDC=0
F S SDX=$O(SDDATA(200.03,SDX)) Q:SDX="" D
. S SDOPT=$G(SDDATA(200.03,SDX,.01,"E"))
. S SDC=SDC+1 S SDUSRSREC("User","Secondary Menu",SDC,"Option")=SDOPT
; Security Keys Multiple
S SDX="",SDC=0
F S SDX=$O(SDDATA(200.051,SDX)) Q:SDX="" D
. S SDKEY=$G(SDDATA(200.051,SDX,.01,"E"))
. S SDC=SDC+1 S SDUSRSREC("User","Security Key",SDC,"Name")=SDKEY
; Divisions Multiple
S (SDX,SDSTN,SDDEF)="",SDC=0
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,"Name")=SDDIV
. S SDUSRSREC("User","Division",SDC,"IEN")=SDDIVIEN
. S SDUSRSREC("User","Division",SDC,"Division")=SDSTN
. 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",1)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESGETUD 4425 printed Dec 13, 2024@02:57:12 Page 2
SDESGETUD ;ALB/ANU,LAB,MGD,JAS - VISTA SCHEDULING RPCS GET USER KEYS AND OPTIONS ; August 26, 2024@12:10
+1 ;;5.3;Scheduling;**801,805,809,814,819,820,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 ^%DT in ICR #10003
+8 ; Reference to $$FIND1^DIC in ICR #2051
+9 ; Reference to NEW PERSON in ICR #10060
+10 ; Reference to $$ACTIVE^XUSER in ICR #2343
+11 ;
+12 ; Global References Supported
+13 ; ----------------- ----------------- ----------
+14 ; ^TMP($J SACC 2.3.2.5.1
+15 QUIT
+16 ;
GETUSRDTL(SDUSRJSON,SDSECID,SDEAS) ;Called from RPC: SDES GET USRPROFILE
+1 ; This RPC gets User name, Keys and Scheduling Options for a given User.
+2 ; Input:
+3 ; SDCLNJSON - [required] - Successs or Error message
+4 ; SDSECID - [required] - The SECID from the NEW PERSON File #200
+5 ; SDEAS - [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
+6 ;
+7 NEW SDUSRSREC,SDUSRIEN,SDDIV,SDDIVIENC,HASSDERRORS
+8 DO VALIDATESECID(.HASSDERRORS,SDSECID)
+9 DO VALIDATEEAS(.HASSDERRORS,.SDEAS)
+10 IF $DATA(HASSDERRORS)
Begin DoDot:1
+11 SET HASSDERRORS("User",1)=""
+12 MERGE SDUSRSREC=HASSDERRORS
End DoDot:1
+13 IF '$DATA(HASSDERRORS)
Begin DoDot:1
+14 DO GETUSRINFO(.SDUSRSREC,SDUSRIEN)
End DoDot:1
+15 DO BUILDJSON^SDESBUILDJSON(.SDUSRJSON,.SDUSRSREC)
+16 QUIT
+17 ;
GETUSRDTLDUZ(SDUSRJSON,SDUSRIEN,SDEAS) ;Called from RPC: SDES GET USER PROFILE BY DUZ
+1 NEW SDUSRSREC,HASSDERRORS
+2 DO VALIDATEUSRIEN(.HASSDERRORS,SDUSRIEN)
+3 DO VALIDATEEAS(.HASSDERRORS,.SDEAS)
+4 IF $DATA(HASSDERRORS)
Begin DoDot:1
+5 SET HASSDERRORS("User",1)=""
+6 MERGE SDUSRSREC=HASSDERRORS
End DoDot:1
+7 IF '$DATA(HASSDERRORS)
Begin DoDot:1
+8 DO GETUSRINFO(.SDUSRSREC,SDUSRIEN)
End DoDot:1
+9 DO BUILDJSON^SDESBUILDJSON(.SDUSRJSON,.SDUSRSREC)
+10 QUIT
+11 ;
VALIDATESECID(HASSDERRORS,SDSECID) ;
+1 IF $GET(SDSECID)=""
DO ERRLOG^SDESJSON(.HASSDERRORS,130)
QUIT
+2 IF '$DATA(HASSDERRORS)
Begin DoDot:1
+3 DO GETUSRIEN(.HASSDERRORS,SDSECID,.SDUSRIEN)
+4 IF '$DATA(HASSDERRORS)
Begin DoDot:2
+5 DO VALIDATEUSRIEN(.HASSDERRORS,SDUSRIEN)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
VALIDATEEAS(HASSDERRORS,SDEAS) ;
+1 SET SDEAS=$GET(SDEAS,"")
+2 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
+3 IF SDEAS=-1
DO ERRLOG^SDESJSON(.HASSDERRORS,142)
+4 QUIT
+5 ;
GETUSRIEN(HASSDERRORS,SDSECID,SDUSRIEN) ;
+1 NEW SCERR
+2 SET SDUSRIEN=$$FIND1^DIC(200,,"X",SDSECID,"ASECID",,"SCERR")
+3 IF $DATA(SCERR)
DO ERRLOG^SDESJSON(.HASSDERRORS,156)
+4 QUIT
+5 ;
VALIDATEUSRIEN(HASSDERRORS,SDUSRIEN) ;
+1 IF SDUSRIEN=""
DO ERRLOG^SDESJSON(.HASSDERRORS,127)
QUIT
+2 IF '$DATA(^VA(200,SDUSRIEN,0))
DO ERRLOG^SDESJSON(.HASSDERRORS,44)
QUIT
+3 IF '$$ACTIVE^XUSER(SDUSRIEN)
DO ERRLOG^SDESJSON(.HASSDERRORS,458)
QUIT
+4 QUIT
+5 ;
GETUSRINFO(SDUSRSREC,SDUSRIEN) ; Get User Keys and Scheduling Options
+1 NEW SDFIELDS,SDDATA,SDMSG,SDX,SDC,SDOPT,SDKEY,SDDIV,SDDIVIEN,SDSTN,SDDEF
+2 SET SDFIELDS=".01;201;203*;51*;16*"
+3 DO GETS^DIQ(200,SDUSRIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+4 ;User Name
SET SDUSRSREC("User","Name")=$GET(SDDATA(200,SDUSRIEN_",",.01,"E"))
+5 SET SDUSRSREC("User","IEN")=SDUSRIEN
+6 SET SDUSRSREC("User","Station ID")=$$DEFAULTSTATION^SDECDUZ()
+7 SET SDOPT=$GET(SDDATA(200,SDUSRIEN_",",201,"E"))
+8 ;Primary Menu Option
SET SDUSRSREC("User","Primary Menu Option")=SDOPT
+9 ; Secondary Options Multiple
+10 SET SDX=""
SET SDC=0
+11 FOR
SET SDX=$ORDER(SDDATA(200.03,SDX))
if SDX=""
QUIT
Begin DoDot:1
+12 SET SDOPT=$GET(SDDATA(200.03,SDX,.01,"E"))
+13 SET SDC=SDC+1
SET SDUSRSREC("User","Secondary Menu",SDC,"Option")=SDOPT
End DoDot:1
+14 ; Security Keys Multiple
+15 SET SDX=""
SET SDC=0
+16 FOR
SET SDX=$ORDER(SDDATA(200.051,SDX))
if SDX=""
QUIT
Begin DoDot:1
+17 SET SDKEY=$GET(SDDATA(200.051,SDX,.01,"E"))
+18 SET SDC=SDC+1
SET SDUSRSREC("User","Security Key",SDC,"Name")=SDKEY
End DoDot:1
+19 ; Divisions Multiple
+20 SET (SDX,SDSTN,SDDEF)=""
SET SDC=0
+21 FOR
SET SDX=$ORDER(SDDATA(200.02,SDX))
if SDX=""
QUIT
Begin DoDot:1
+22 SET SDDIVIEN=$GET(SDDATA(200.02,SDX,.01,"I"))
+23 SET SDSTN=$$GET1^DIQ(4,SDDIVIEN,99,"I")
+24 SET SDDIV=$GET(SDDATA(200.02,SDX,.01,"E"))
+25 SET SDDEF=$GET(SDDATA(200.02,SDX,1,"I"))
+26 SET SDDEF=$SELECT(SDDEF=1:"YES",1:"")
+27 SET SDC=SDC+1
+28 SET SDUSRSREC("User","Division",SDC,"Name")=SDDIV
+29 SET SDUSRSREC("User","Division",SDC,"IEN")=SDDIVIEN
+30 SET SDUSRSREC("User","Division",SDC,"Division")=SDSTN
+31 SET SDUSRSREC("User","Division",SDC,"Default")=SDDEF
End DoDot:1
+32 IF SDC=0
Begin DoDot:1
+33 IF $GET(DUZ(2))'=""
Begin DoDot:2
+34 SET SDC=SDC+1
+35 SET SDUSRSREC("User","Division",SDC,"Division")=$GET(DUZ(2))
+36 SET SDUSRSREC("User","Division",SDC,"IEN")=$GET(DUZ(2))
+37 SET SDUSRSREC("User","Division",SDC,"Name")=$$GET1^DIQ(4,$GET(DUZ(2)),.01,"E")
+38 SET SDUSRSREC("User","Division",SDC,"Default")=""
End DoDot:2
End DoDot:1
+39 IF '$DATA(SDUSRSREC("User"))
SET SDUSRSREC("User",1)=""
+40 QUIT