SDESJSON.m

SDESJSON ;ALB/MGD,ANU,TAW,KML,BLB,BWF - VISTA SCHEDULING JSON UTILITIES ;April 25, 2022

 ;;5.3;Scheduling;**788,794,797,799,800,801,803,805,807,809,813,814,815,816**;Aug 13, 1993;Build 3;Build 2

 ;;Per VHA Directive 6402, this routine should not be modified

 Q

 ; This routine documents the entry points for the new ??? GUI.

 ;

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 ---SDESJSON   2307     printed  Apr 09, 2024@21:58:18                                                                                                                                                                                                    Page 2

SDESJSON  ;ALB/MGD,ANU,TAW,KML,BLB,BWF - VISTA SCHEDULING JSON UTILITIES ;April 25, 2022

 +1       ;;5.3;Scheduling;**788,794,797,799,800,801,803,805,807,809,813,814,815,816**;Aug 13, 1993;Build 3;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       ;

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