Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTWJSONO

YTWJSONO.m

Go to the documentation of this file. 
  1. YTWJSONO ;SLC/KCM - Instrument Admin Spec Output ; 1/25/2017
  1.  ;;5.01;MENTAL HEALTH;**130,141,202**;Dec 30, 1994;Build 47
  1.  ;
  1.  ; Reference to XLFSTR in ICR #10104
  1.  ;
  1. TEST ;
  1.  N TEST,TREE,OUT
  1.  S TEST=7 ;144 ; CSI |153 ; CDR |162 ; BAM
  1.  D CONTENT^YTWJSON(TEST,.TREE)
  1.  D FMTJSON(.TREE,.OUT)
  1.  N I S I=0 F  S I=$O(OUT(I)) Q:'I  W !,OUT(I)
  1.  Q
  1. FMTJSON(TREE,OUT) ; format instrument spec in TREE as readable lines
  1.  N LN,ROOT,SLOT,IDX
  1.  S LN=1,ROOT="TREE"
  1.  D TEXT("{")
  1.  D PROP("name"),LF(1)
  1.  I $L(@ROOT@("copyright")) D PROP("copyright"),LF(1)
  1.  D PROP("restartDays"),LF(1)
  1.  D PROP("printTitle"),LF(1)
  1.  D COMMA,TEXT("""content"":[")
  1.  S SLOT=0 F  S SLOT=$O(TREE("content",SLOT)) Q:'SLOT  D
  1.  . S ROOT=$NA(TREE("content",SLOT))
  1.  . D COMMA,LF(3)
  1.  . D TEXT("{")
  1.  . D PROP("id"),PROP("type"),PROP("required"),PROP("inline"),PROP("tab")
  1.  . D LF(4)
  1.  . D PROP("text")
  1.  . D LF(4)
  1.  . I $D(@ROOT@("intro")) D PROP("intro"),LF(4)
  1.  . D PROP("columns"),PROP("left"),PROP("controlWidth"),PROP("min"),PROP("max")
  1.  . ; output choices, if present
  1.  . I $D(TREE("content",SLOT,"choices"))>1 D
  1.  . . D COMMA,LF(4),TEXT("""choices"":[")
  1.  . . S IDX=0 F  S IDX=$O(TREE("content",SLOT,"choices",IDX)) Q:'IDX  D
  1.  . . . S ROOT=$NA(TREE("content",SLOT,"choices",IDX))
  1.  . . . D COMMA,LF(5)
  1.  . . . D TEXT("{"),PROP("id"),PROP("text"),PROP("quickKey"),TEXT("}")
  1.  . . D LF(3),TEXT("]")                           ; end of choices array
  1.  . ; output legend, if present
  1.  . I $D(TREE("content",SLOT,"legend"))>1 D
  1.  . . N LEGEND
  1.  . . D COMMA,LF(4),TEXT("""legend"":[")
  1.  . . S IDX=0 F  S IDX=$O(TREE("content",SLOT,"legend",IDX)) Q:'IDX  D
  1.  . . . S LEGEND=TREE("content",SLOT,"legend",IDX)
  1.  . . . D COMMA,TEXT(""""_LEGEND_"""")
  1.  . . D TEXT("]")                                 ; end of legend array
  1.  . D TEXT("}")                                   ; end of content object
  1.  D TEXT("]")                                     ; end of content array
  1.  I $D(TREE("rules"))>1 D
  1.  . N RIDX,SIDX
  1.  . D COMMA,LF(1),TEXT("""rules"":[")
  1.  . S RIDX=0 F  S RIDX=$O(TREE("rules",RIDX)) Q:'RIDX  D
  1.  . . S ROOT=$NA(TREE("rules",RIDX))
  1.  . . D COMMA,LF(3),TEXT("{")
  1.  . . D PROP("question"),PROP("operator"),PROP("value")
  1.  . . I $D(TREE("rules",RIDX,"conjunction")) D
  1.  . . . D LF(4)
  1.  . . . D PROP("conjunction"),PROP("question2"),PROP("operator2"),PROP("value2")
  1.  . . I $D(TREE("rules",RIDX,"skips"))>1 D
  1.  . . . D COMMA,LF(4),TEXT("""skips"":[")
  1.  . . . S SIDX=0 F  S SIDX=$O(TREE("rules",RIDX,"skips",SIDX)) Q:'SIDX  D
  1.  . . . . I SIDX>1 D TEXT(",")
  1.  . . . . D TEXT(""""_TREE("rules",RIDX,"skips",SIDX)_"""")
  1.  . . . D TEXT("]")                               ; end of skips array
  1.  . . D TEXT("}")                                 ; end of single rule object
  1.  . D TEXT("]")                                   ; end of rules
  1.  D LF(0),TEXT("}")                              ; end of spec
  1.  Q
  1. TEXT(X) ; Add text to output
  1.  ; expects OUT,LN
  1.  S OUT(LN)=$G(OUT(LN))_X
  1.  Q
  1. PROP(NAME) ; Add property to output, using JSON data types
  1.  ; expects OUT,LN,ROOT
  1.  N X,VALUE
  1.  I '$D(@ROOT@(NAME)) QUIT                      ; property absent
  1.  ;
  1.  ; The "\n", "\s" qualifiers included for completeness but likely not needed
  1.  ; for MH instruments. See VPRJSONE for more complete encoding of JSON
  1.  ;
  1.  S X=@ROOT@(NAME) Q:'$L(X)                      ; empty value so quit
  1.  I $D(@ROOT@(NAME,"\n")) S VALUE=X              ; forced numeric
  1.  I '$D(@ROOT@(NAME,"\s")) D                     ; if not forced string
  1.  . I X']]$C(1) S VALUE=X                        ; collates as numeric
  1.  . I X="true"!(X="false")!(X="null") S VALUE=X  ; boolean/null
  1.  I '$D(VALUE),'$D(@ROOT@(NAME,"\")),($L(X)<80) S VALUE=""""_X_"""" ; string
  1.  I $D(VALUE) D  QUIT                            ; finish up unless word proc
  1.  . D COMMA                                      ; prepend comma if not first
  1.  . S OUT(LN)=OUT(LN)_""""_NAME_""": "_VALUE     ; add to output line
  1.  ;
  1.  ; fall through here for handling word processing and longer strings
  1.  ; (to keep lines short enough for MailMan to transport them
  1.  N IDX,TEXT
  1.  S IDX=0 F  S IDX=$O(@ROOT@(NAME,"\",IDX)) Q:'IDX  S X=X_@ROOT@(NAME,"\",IDX)
  1.  D WRAPTXT^YTWJSONU(X,.TEXT)
  1.  D COMMA
  1.  S OUT(LN)=OUT(LN)_""""_NAME_""": """_TEXT(1)   ; first WP line
  1.  S IDX=1 F  S IDX=$O(TEXT(IDX)) Q:'IDX  S LN=LN+1,OUT(LN)=TEXT(IDX)
  1.  S OUT(LN)=OUT(LN)_""""                         ; closing quote
  1.  Q
  1. COMMA ; Add comma, if needed, before adding property
  1.  ; expects OUT,LN
  1.  N LAST S LAST=$$LAST
  1.  I "{["'[LAST D  ; see if we need a comma based on the last character
  1.  . I $L($TR($G(OUT(LN))," ","")) S OUT(LN)=OUT(LN)_", " Q  ; use this line
  1.  . S OUT(LN-1)=OUT(LN-1)_", "                              ; use last line
  1.  Q
  1. LAST() ; Return the last non-space character
  1.  ; expects OUT,LN
  1.  N X
  1.  S X=$TR($G(OUT(LN))," ","")
  1.  I '$L(X) S X=$TR($G(OUT(LN-1))," ","")
  1.  Q $E(X,$L(X))
  1.  ;
  1. LF(SPACES) ; advance to next line, using indent level in SPACES
  1.  ; expects OUT,LN
  1.  S LN=+$G(LN)+1                                 ; line number
  1.  S OUT(LN)=$$REPEAT^XLFSTR(" ",SPACES)
  1.  Q