SDES2JSON ;ALB/MGD - VISTA SCHEDULING JSON UTILITIES ;July 3, 2023
;;5.3;Scheduling;**853**;Aug 13, 1993;Build 9;Build 2
;;Per VHA Directive 6402, this routine should not be modified
Q
; This routine documents the entry points for the new ??? GUI.
;
BUILDJSON(SDRETURN,RETURN) ;
N JSONERROR
D ENCODE^XLFJSON("RETURN","SDRETURN","SDJSONERR")
Q
;
ENCODE(SDESINP,SDESOUT,SDESERR) ;
; Input: SDESINP = Required: Properly formatted input array to convert to JSON
; SDESOUT = Required: Name of string to return to Broker
; SDESERR = Optional: Name of string for error messages.
; Output:
; SDESOUT = JSON formatted string
; SDESERR = Still under development by Kernel
;
; Validate Input Parameters
I '$D(SDESINP) D ERRLOG(.SDESINP,52,"Input Data Required.")
D ENCODE^XLFJSON("SDESINP","SDESOUT","SDESERR")
Q
;
; Error codes are located in the SDES ERROR CODES file #409.93
; Please do not duplicate error text. Use due diligence and look for
; the appropriate error prior to adding new entries.
;
ERRLOG(SDESIN,SDESERRNUM,SDESOPTMSG,SDESRINFO) ;
; Input: SDESIN = Required: Array name with related data to be logged
; SDESERRNUM = Required: Error # to return
; SDESOPTMSG = Optional message string to append to existing error in table
; SDESRINFO = Optional message string with Routine^Tag info to append to existing error in table
N SDESCNT
S SDESOPTMSG=$G(SDESOPTMSG),SDESRINFO=$G(SDESRINFO)
I '$D(SDESIN) S SDESIN("Error",0)=""
S SDESERRNUM=$G(SDESERRNUM,0)
S SDESCNT=$O(SDESIN("Error",""),-1)+1
S SDESIN("Error",SDESCNT)=$$ERRLKUP(SDESERRNUM,SDESOPTMSG,SDESRINFO)
K SDESIN("Error",0)
Q
;
ERRLKUP(SDNUM,SDESOPTMSG,SDESRINFO) ;
N SDERRMSG,SDERRIEN
S SDERRIEN=$O(^SDEC(409.93,"B",SDNUM,0))
S SDERRMSG=$$GET1^DIQ(409.93,SDERRIEN,1,"E")
I SDERRMSG="" S SDERRMSG="Invalid Error Number."
I $G(SDESOPTMSG)'="" D
. ;Strip off $C(30) and $c(31) that are part of non JSON error text
. S SDESOPTMSG=$$CTRL^XMXUTIL1(SDESOPTMSG)
. I $E(SDERRMSG,$L(SDERRMSG))="." S SDERRMSG=$E(SDERRMSG,1,$L(SDERRMSG)-1)
. S SDERRMSG=SDERRMSG_": "_SDESOPTMSG
I $E(SDERRMSG,$L(SDERRMSG))'="." S SDERRMSG=SDERRMSG_"."
; Add optional Debug info
I SDESRINFO'="" S SDERRMSG=SDERRMSG_" Debug: "_SDESRINFO
Q SDERRMSG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2JSON 2339 printed Dec 13, 2024@02:54:24 Page 2
SDES2JSON ;ALB/MGD - VISTA SCHEDULING JSON UTILITIES ;July 3, 2023
+1 ;;5.3;Scheduling;**853**;Aug 13, 1993;Build 9;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ; This routine documents the entry points for the new ??? GUI.
+5 ;
BUILDJSON(SDRETURN,RETURN) ;
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","SDRETURN","SDJSONERR")
+3 QUIT
+4 ;
ENCODE(SDESINP,SDESOUT,SDESERR) ;
+1 ; Input: SDESINP = Required: Properly formatted input array to convert to JSON
+2 ; SDESOUT = Required: Name of string to return to Broker
+3 ; SDESERR = Optional: Name of string for error messages.
+4 ; Output:
+5 ; SDESOUT = JSON formatted string
+6 ; SDESERR = Still under development by Kernel
+7 ;
+8 ; Validate Input Parameters
+9 IF '$DATA(SDESINP)
DO ERRLOG(.SDESINP,52,"Input Data Required.")
+10 DO ENCODE^XLFJSON("SDESINP","SDESOUT","SDESERR")
+11 QUIT
+12 ;
+13 ; Error codes are located in the SDES ERROR CODES file #409.93
+14 ; Please do not duplicate error text. Use due diligence and look for
+15 ; the appropriate error prior to adding new entries.
+16 ;
ERRLOG(SDESIN,SDESERRNUM,SDESOPTMSG,SDESRINFO) ;
+1 ; Input: SDESIN = Required: Array name with related data to be logged
+2 ; SDESERRNUM = Required: Error # to return
+3 ; SDESOPTMSG = Optional message string to append to existing error in table
+4 ; SDESRINFO = Optional message string with Routine^Tag info to append to existing error in table
+5 NEW SDESCNT
+6 SET SDESOPTMSG=$GET(SDESOPTMSG)
SET SDESRINFO=$GET(SDESRINFO)
+7 IF '$DATA(SDESIN)
SET SDESIN("Error",0)=""
+8 SET SDESERRNUM=$GET(SDESERRNUM,0)
+9 SET SDESCNT=$ORDER(SDESIN("Error",""),-1)+1
+10 SET SDESIN("Error",SDESCNT)=$$ERRLKUP(SDESERRNUM,SDESOPTMSG,SDESRINFO)
+11 KILL SDESIN("Error",0)
+12 QUIT
+13 ;
ERRLKUP(SDNUM,SDESOPTMSG,SDESRINFO) ;
+1 NEW SDERRMSG,SDERRIEN
+2 SET SDERRIEN=$ORDER(^SDEC(409.93,"B",SDNUM,0))
+3 SET SDERRMSG=$$GET1^DIQ(409.93,SDERRIEN,1,"E")
+4 IF SDERRMSG=""
SET SDERRMSG="Invalid Error Number."
+5 IF $GET(SDESOPTMSG)'=""
Begin DoDot:1
+6 ;Strip off $C(30) and $c(31) that are part of non JSON error text
+7 SET SDESOPTMSG=$$CTRL^XMXUTIL1(SDESOPTMSG)
+8 IF $EXTRACT(SDERRMSG,$LENGTH(SDERRMSG))="."
SET SDERRMSG=$EXTRACT(SDERRMSG,1,$LENGTH(SDERRMSG)-1)
+9 SET SDERRMSG=SDERRMSG_": "_SDESOPTMSG
End DoDot:1
+10 IF $EXTRACT(SDERRMSG,$LENGTH(SDERRMSG))'="."
SET SDERRMSG=SDERRMSG_"."
+11 ; Add optional Debug info
+12 IF SDESRINFO'=""
SET SDERRMSG=SDERRMSG_" Debug: "_SDESRINFO
+13 QUIT SDERRMSG
