XLFJSON ;SLC/KCM/TJB - Decode/Encode JSON ;26 Oct 2016
;;8.0;KERNEL;**680**;Jul 10, 1995;Build 4
;;Per VA Directive 6402, this routine should not be modified.
;
; Note: Since the routines use closed array references, XUROOT and XUERR
; are used to reduce risk of naming conflicts on the closed array.
;
DECODE(XUJSON,XUROOT,XUERR) ; Set JSON object into closed array ref XUROOT
; Examples: D DECODE^XLFJSON("MYJSON","LOCALVAR","LOCALERR")
; D DECODE^XLFJSON("^MYJSON(1)","^GLO(99)","^TMP($J)")
;
; XUJSON: Required; string/array containing serialized JSON object
; XUROOT: Required; closed array reference for M representation of object
; XUERR: Optional; closed array reference contains error messages, defaults to ^TMP("XLFJERR",$J)
;
; XUIDX: points to next character in JSON string to process
; XUSTACK: manages stack of subscripts
; XUPROP: true if next string is property name, otherwise treat as value
;
G DIRECT^XLFJSOND
;
ENCODE(XUROOT,XUJSON,XUERR) ; XUROOT (M structure) --> XUJSON (array of strings)
; Examples: D ENCODE^XLFJSON("^GLO(99,2)","^TMP($J)")
; D ENCODE^XLFJSON("LOCALVAR","MYJSON","LOCALERR")
;
; XUROOT: Required; closed array reference for M representation of object
; XUJSON: Required; destination variable for the string array formatted as JSON
; XUERR: Optional; closed array reference contains error messages, defaults to ^TMP("XLFJERR",$J)
;
G DIRECT^XLFJSONE
;
;
ESC(X) ; Escape string for JSON
; X: Required; String to be escaped
Q $$ESC^XLFJSONE(X)
;
UES(X) ; Unescape JSON string
; X: Required; String to be unescaped
Q $$UES^XLFJSOND(X)
;
ERRX(ID,VAL) ; Set the appropriate error message
; switch (ID) -- XERRX ends statement
N ERRMSG
;
; Decode Error Messages
;
I ID="STL{" S ERRMSG="Stack too large for new object." G XERRX
I ID="SUF}" S ERRMSG="Stack Underflow - extra } found" G XERRX
I ID="STL[" S ERRMSG="Stack too large for new array." G XERRX
I ID="SUF]" S ERRMSG="Stack Underflow - extra ] found." G XERRX
I ID="OBM" S ERRMSG="Array mismatch - expected ] got }." G XERRX
I ID="ARM" S ERRMSG="Object mismatch - expected } got ]." G XERRX
I ID="MPN" S ERRMSG="Missing property name." G XERRX
I ID="EXT" S ERRMSG="Expected true, got "_VAL G XERRX
I ID="EXF" S ERRMSG="Expected false, got "_VAL G XERRX
I ID="EXN" S ERRMSG="Expected null, got "_VAL G XERRX
I ID="TKN" S ERRMSG="Unable to identify type of token, value was "_VAL G XERRX
I ID="SCT" S ERRMSG="Stack mismatch - exit stack level was "_VAL G XERRX
I ID="EIQ" S ERRMSG="Close quote not found before end of input." G XERRX
I ID="EIU" S ERRMSG="Unexpected end of input while unescaping." G XERRX
I ID="RSB" S ERRMSG="Reverse search for \ past beginning of input." G XERRX
I ID="ORN" S ERRMSG="Overrun while scanning name." G XERRX
I ID="OR#" S ERRMSG="Overrun while scanning number." G XERRX
I ID="ORB" S ERRMSG="Overrun while scanning boolean." G XERRX
I ID="ESC" S ERRMSG="Escaped character not recognized"_VAL G XERRX
I ID="NOV" S ERRMSG="Expected value, got "_VAL G XERRX
;
; Encode Error Messages
;
I ID="SOB" S ERRMSG="Unable to serialize node as object, value was "_VAL G XERRX
I ID="SAR" S ERRMSG="Unable to serialize node as array, value was "_VAL G XERRX
S ERRMSG="Unspecified error "_ID_" "_$G(VAL)
XERRX ; end switch
S @XUERR@(0)=$G(@XUERR@(0))+1
S @XUERR@(@XUERR@(0))=ERRMSG
S XUERRORS=XUERRORS+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFJSON 3495 printed Oct 16, 2024@18:03:33 Page 2
XLFJSON ;SLC/KCM/TJB - Decode/Encode JSON ;26 Oct 2016
+1 ;;8.0;KERNEL;**680**;Jul 10, 1995;Build 4
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Note: Since the routines use closed array references, XUROOT and XUERR
+5 ; are used to reduce risk of naming conflicts on the closed array.
+6 ;
DECODE(XUJSON,XUROOT,XUERR) ; Set JSON object into closed array ref XUROOT
+1 ; Examples: D DECODE^XLFJSON("MYJSON","LOCALVAR","LOCALERR")
+2 ; D DECODE^XLFJSON("^MYJSON(1)","^GLO(99)","^TMP($J)")
+3 ;
+4 ; XUJSON: Required; string/array containing serialized JSON object
+5 ; XUROOT: Required; closed array reference for M representation of object
+6 ; XUERR: Optional; closed array reference contains error messages, defaults to ^TMP("XLFJERR",$J)
+7 ;
+8 ; XUIDX: points to next character in JSON string to process
+9 ; XUSTACK: manages stack of subscripts
+10 ; XUPROP: true if next string is property name, otherwise treat as value
+11 ;
+12 GOTO DIRECT^XLFJSOND
+13 ;
ENCODE(XUROOT,XUJSON,XUERR) ; XUROOT (M structure) --> XUJSON (array of strings)
+1 ; Examples: D ENCODE^XLFJSON("^GLO(99,2)","^TMP($J)")
+2 ; D ENCODE^XLFJSON("LOCALVAR","MYJSON","LOCALERR")
+3 ;
+4 ; XUROOT: Required; closed array reference for M representation of object
+5 ; XUJSON: Required; destination variable for the string array formatted as JSON
+6 ; XUERR: Optional; closed array reference contains error messages, defaults to ^TMP("XLFJERR",$J)
+7 ;
+8 GOTO DIRECT^XLFJSONE
+9 ;
+10 ;
ESC(X) ; Escape string for JSON
+1 ; X: Required; String to be escaped
+2 QUIT $$ESC^XLFJSONE(X)
+3 ;
UES(X) ; Unescape JSON string
+1 ; X: Required; String to be unescaped
+2 QUIT $$UES^XLFJSOND(X)
+3 ;
ERRX(ID,VAL) ; Set the appropriate error message
+1 ; switch (ID) -- XERRX ends statement
+2 NEW ERRMSG
+3 ;
+4 ; Decode Error Messages
+5 ;
+6 IF ID="STL{"
SET ERRMSG="Stack too large for new object."
GOTO XERRX
+7 IF ID="SUF}"
SET ERRMSG="Stack Underflow - extra } found"
GOTO XERRX
+8 IF ID="STL["
SET ERRMSG="Stack too large for new array."
GOTO XERRX
+9 IF ID="SUF]"
SET ERRMSG="Stack Underflow - extra ] found."
GOTO XERRX
+10 IF ID="OBM"
SET ERRMSG="Array mismatch - expected ] got }."
GOTO XERRX
+11 IF ID="ARM"
SET ERRMSG="Object mismatch - expected } got ]."
GOTO XERRX
+12 IF ID="MPN"
SET ERRMSG="Missing property name."
GOTO XERRX
+13 IF ID="EXT"
SET ERRMSG="Expected true, got "_VAL
GOTO XERRX
+14 IF ID="EXF"
SET ERRMSG="Expected false, got "_VAL
GOTO XERRX
+15 IF ID="EXN"
SET ERRMSG="Expected null, got "_VAL
GOTO XERRX
+16 IF ID="TKN"
SET ERRMSG="Unable to identify type of token, value was "_VAL
GOTO XERRX
+17 IF ID="SCT"
SET ERRMSG="Stack mismatch - exit stack level was "_VAL
GOTO XERRX
+18 IF ID="EIQ"
SET ERRMSG="Close quote not found before end of input."
GOTO XERRX
+19 IF ID="EIU"
SET ERRMSG="Unexpected end of input while unescaping."
GOTO XERRX
+20 IF ID="RSB"
SET ERRMSG="Reverse search for \ past beginning of input."
GOTO XERRX
+21 IF ID="ORN"
SET ERRMSG="Overrun while scanning name."
GOTO XERRX
+22 IF ID="OR#"
SET ERRMSG="Overrun while scanning number."
GOTO XERRX
+23 IF ID="ORB"
SET ERRMSG="Overrun while scanning boolean."
GOTO XERRX
+24 IF ID="ESC"
SET ERRMSG="Escaped character not recognized"_VAL
GOTO XERRX
+25 IF ID="NOV"
SET ERRMSG="Expected value, got "_VAL
GOTO XERRX
+26 ;
+27 ; Encode Error Messages
+28 ;
+29 IF ID="SOB"
SET ERRMSG="Unable to serialize node as object, value was "_VAL
GOTO XERRX
+30 IF ID="SAR"
SET ERRMSG="Unable to serialize node as array, value was "_VAL
GOTO XERRX
+31 SET ERRMSG="Unspecified error "_ID_" "_$GET(VAL)
XERRX ; end switch
+1 SET @XUERR@(0)=$GET(@XUERR@(0))+1
+2 SET @XUERR@(@XUERR@(0))=ERRMSG
+3 SET XUERRORS=XUERRORS+1
+4 QUIT
