- 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 Jan 18, 2025@03:55:33 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