- HMPJSON ;SLC/KCM,ASMR/RRB - Decode/Encode JSON;9/25/2015 10:15
- ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- ; Note: Since the routines use closed array references, VVROOT and VVERR
- ; are used to reduce risk of naming conflicts on the closed array.
- ;
- DECODE(VVJSON,VVROOT,VVERR) ; Set JSON object into closed array ref VVROOT
- ; Examples: D DECODE^HMPJSON("MYJSON","LOCALVAR","LOCALERR")
- ; D DECODE^HMPJSON("^MYJSON(1)","^GLO(99)","^TMP($J)")
- ;
- ; VVJSON: string/array containing serialized JSON object
- ; VVROOT: closed array reference for M representation of object
- ; VVERR: contains error messages, defaults to ^TMP("HMPJERR",$J)
- ;
- ; VVIDX: points to next character in JSON string to process
- ; VVSTACK: manages stack of subscripts
- ; VHMPOP: true if next string is property name, otherwise treat as value
- ;
- G DIRECT^HMPJSOND
- ;
- ENCODE(VVROOT,VVJSON,VVERR) ; VVROOT (M structure) --> VVJSON (array of strings)
- ; Examples: D ENCODE^HMPJSON("^GLO(99,2)","^TMP($J)")
- ; D ENCODE^HMPJSON("LOCALVAR","MYJSON","LOCALERR")
- ;
- ; VVROOT: closed array reference for M representation of object
- ; VVJSON: destination variable for the string array formatted as JSON
- ; VVERR: contains error messages, defaults to ^TMP("HMPJERR",$J)
- ;
- G DIRECT^HMPJSONE
- ;
- ;
- ESC(X) ; Escape string for JSON
- Q $$ESC^HMPJSONE(X)
- ;
- UES(X) ; Unescape JSON string
- Q $$UES^HMPJSOND(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
- ;
- ; 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 @VVERR@(0)=$G(@VVERR@(0))+1
- S @VVERR@(@VVERR@(0))=ERRMSG
- S VVERRORS=VVERRORS+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPJSON 3296 printed Feb 18, 2025@23:20:25 Page 2
- HMPJSON ;SLC/KCM,ASMR/RRB - Decode/Encode JSON;9/25/2015 10:15
- +1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- +6 ; Note: Since the routines use closed array references, VVROOT and VVERR
- +7 ; are used to reduce risk of naming conflicts on the closed array.
- +8 ;
- DECODE(VVJSON,VVROOT,VVERR) ; Set JSON object into closed array ref VVROOT
- +1 ; Examples: D DECODE^HMPJSON("MYJSON","LOCALVAR","LOCALERR")
- +2 ; D DECODE^HMPJSON("^MYJSON(1)","^GLO(99)","^TMP($J)")
- +3 ;
- +4 ; VVJSON: string/array containing serialized JSON object
- +5 ; VVROOT: closed array reference for M representation of object
- +6 ; VVERR: contains error messages, defaults to ^TMP("HMPJERR",$J)
- +7 ;
- +8 ; VVIDX: points to next character in JSON string to process
- +9 ; VVSTACK: manages stack of subscripts
- +10 ; VHMPOP: true if next string is property name, otherwise treat as value
- +11 ;
- +12 GOTO DIRECT^HMPJSOND
- +13 ;
- ENCODE(VVROOT,VVJSON,VVERR) ; VVROOT (M structure) --> VVJSON (array of strings)
- +1 ; Examples: D ENCODE^HMPJSON("^GLO(99,2)","^TMP($J)")
- +2 ; D ENCODE^HMPJSON("LOCALVAR","MYJSON","LOCALERR")
- +3 ;
- +4 ; VVROOT: closed array reference for M representation of object
- +5 ; VVJSON: destination variable for the string array formatted as JSON
- +6 ; VVERR: contains error messages, defaults to ^TMP("HMPJERR",$J)
- +7 ;
- +8 GOTO DIRECT^HMPJSONE
- +9 ;
- +10 ;
- ESC(X) ; Escape string for JSON
- +1 QUIT $$ESC^HMPJSONE(X)
- +2 ;
- UES(X) ; Unescape JSON string
- +1 QUIT $$UES^HMPJSOND(X)
- +2 ;
- 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 ;
- +26 ; Encode Error Messages
- +27 ;
- +28 IF ID="SOB"
- SET ERRMSG="Unable to serialize node as object, value was "_VAL
- GOTO XERRX
- +29 IF ID="SAR"
- SET ERRMSG="Unable to serialize node as array, value was "_VAL
- GOTO XERRX
- +30 SET ERRMSG="Unspecified error "_ID_" "_$GET(VAL)
- XERRX ; end switch
- +1 SET @VVERR@(0)=$GET(@VVERR@(0))+1
- +2 SET @VVERR@(@VVERR@(0))=ERRMSG
- +3 SET VVERRORS=VVERRORS+1
- +4 QUIT