YTWJSONU ;SLC/KCM - JSON Instrument Spec Utilities ; 7/20/2018
;;5.01;MENTAL HEALTH;**130,141**;Dec 30, 1994;Build 85
;
; External Reference ICR#
; ------------------ -----
; DIR 10026
; XLFDT 10103
; XLFSTR 10104
;
PROMPT(TEXT) ; prompt for text value and return, otherwise ""
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="F",DIR("A")=TEXT
I $D(^XTMP("YTWPROMPTS",TEXT)) S DIR("B")=^XTMP("YTWPROMPTS",TEXT)
D ^DIR I $G(DIRUT) S X=""
I $L(X) D
. S ^XTMP("YTWPROMPTS",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"MH Default Prompts"
. S ^XTMP("YTWPROMPTS",TEXT)=X
Q X
;W !,"X=",X,!,"Y=",Y,!,$G(DTOUT),?5,$G(DUOUT),?10,$G(DIRUT),?15,$G(DIROUT)
;
BLDTXT(WPREF,TEXT) ; build array of JSON text from WP field
N I,LN,LASTLN,IDX
S IDX=-1
S I=0 F S I=$O(@WPREF@(I)) Q:'I D
. S LN=@WPREF@(I,0),IDX=IDX+1
. S LN=$$HTMLESC(LN)
. I IDX=0 S TEXT=LN,LASTLN=LN Q
. I ($E(LASTLN,$L(LASTLN))'=" "),($E(LN)'=" ") S LN=" "_LN
. S TEXT("\",IDX)=LN,LASTLN=LN
Q
HTMLESC(X) ; return X HTML escaped
N SPEC
S SPEC("|")="<br />"
; use unicode character since JSX treats &char; as code injection
S SPEC("""")="\u0022" ; """
S SPEC(">")="\u003E" ; ">"
S SPEC("<")="\u003C" ; "<"
Q $$REPLACE^XLFSTR(X,.SPEC)
;
WRAPTXT(X,TEXT,MAX) ; Wrap X into MAX length strings in .TEXT
N I,LN,WORD
S MAX=$G(MAX,80),LN=1
F I=1:1:$L(X," ") S WORD=$P(X," ",I) D
. I $L(WORD)'<MAX S:$L($G(TEXT(LN))) LN=LN+1 I 1
. E I ($L($G(TEXT(LN)))+$L(WORD))>MAX S LN=LN+1
. S TEXT(LN)=$G(TEXT(LN))_$S(I=1:"",1:" ")_WORD
Q
;
NAMES(OUT) ; build JSON of all active test names
N LN,NAME,TEST,STAFF
S LN=1,OUT(LN)="{""instruments"":["
S NAME=0 F S NAME=$O(^YTT(601.71,"B",NAME)) Q:'$L(NAME) D
. S TEST=0 F S TEST=$O(^YTT(601.71,"B",NAME,TEST)) Q:'TEST D
. . I $P($G(^YTT(601.71,TEST,2)),U,2)'="Y" QUIT
. . D ADDPROP("name",NAME)
. . D ADDPROP("fullName",$P(^YTT(601.71,TEST,0),U,3))
. . D ADDPROP("isBattery","false")
. . S STAFF=($P($G(^YTT(601.71,TEST,1)),U,7)="Y")
. . D ADDPROP("staffOnly",$S(STAFF=1:"true",1:"false"))
S OUT(LN)=$E(OUT(LN),1,$L(OUT(LN))-1) ; remove last comma
S LN=LN+1,OUT(LN)="]}"
;N I S I=0 F S I=$O(OUT(I)) Q:'I W !,OUT(I)
Q
;
ADDPROP(NAME,VALUE) ; add property to test select object
; expects OUT,LN
N X
S X=""
I NAME="name" S X=X_"{",LN=LN+1,OUT(LN)=""
S X=X_""""_NAME_""":"
I NAME="staffOnly" D
. S X=X_VALUE_"},"
E S X=X_""""_VALUE_""","
S OUT(LN)=OUT(LN)_X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTWJSONU 2532 printed Apr 09, 2024@21:18:53 Page 2
YTWJSONU ;SLC/KCM - JSON Instrument Spec Utilities ; 7/20/2018
+1 ;;5.01;MENTAL HEALTH;**130,141**;Dec 30, 1994;Build 85
+2 ;
+3 ; External Reference ICR#
+4 ; ------------------ -----
+5 ; DIR 10026
+6 ; XLFDT 10103
+7 ; XLFSTR 10104
+8 ;
PROMPT(TEXT) ; prompt for text value and return, otherwise ""
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="F"
SET DIR("A")=TEXT
+3 IF $DATA(^XTMP("YTWPROMPTS",TEXT))
SET DIR("B")=^XTMP("YTWPROMPTS",TEXT)
+4 DO ^DIR
IF $GET(DIRUT)
SET X=""
+5 IF $LENGTH(X)
Begin DoDot:1
+6 SET ^XTMP("YTWPROMPTS",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"MH Default Prompts"
+7 SET ^XTMP("YTWPROMPTS",TEXT)=X
End DoDot:1
+8 QUIT X
+9 ;W !,"X=",X,!,"Y=",Y,!,$G(DTOUT),?5,$G(DUOUT),?10,$G(DIRUT),?15,$G(DIROUT)
+10 ;
BLDTXT(WPREF,TEXT) ; build array of JSON text from WP field
+1 NEW I,LN,LASTLN,IDX
+2 SET IDX=-1
+3 SET I=0
FOR
SET I=$ORDER(@WPREF@(I))
if 'I
QUIT
Begin DoDot:1
+4 SET LN=@WPREF@(I,0)
SET IDX=IDX+1
+5 SET LN=$$HTMLESC(LN)
+6 IF IDX=0
SET TEXT=LN
SET LASTLN=LN
QUIT
+7 IF ($EXTRACT(LASTLN,$LENGTH(LASTLN))'=" ")
IF ($EXTRACT(LN)'=" ")
SET LN=" "_LN
+8 SET TEXT("\",IDX)=LN
SET LASTLN=LN
End DoDot:1
+9 QUIT
HTMLESC(X) ; return X HTML escaped
+1 NEW SPEC
+2 SET SPEC("|")="<br />"
+3 ; use unicode character since JSX treats &char; as code injection
+4 ; """
SET SPEC("""")="\u0022"
+5 ; ">"
SET SPEC(">")="\u003E"
+6 ; "<"
SET SPEC("<")="\u003C"
+7 QUIT $$REPLACE^XLFSTR(X,.SPEC)
+8 ;
WRAPTXT(X,TEXT,MAX) ; Wrap X into MAX length strings in .TEXT
+1 NEW I,LN,WORD
+2 SET MAX=$GET(MAX,80)
SET LN=1
+3 FOR I=1:1:$LENGTH(X," ")
SET WORD=$PIECE(X," ",I)
Begin DoDot:1
+4 IF $LENGTH(WORD)'<MAX
if $LENGTH($GET(TEXT(LN)))
SET LN=LN+1
IF 1
+5 IF '$TEST
IF ($LENGTH($GET(TEXT(LN)))+$LENGTH(WORD))>MAX
SET LN=LN+1
+6 SET TEXT(LN)=$GET(TEXT(LN))_$SELECT(I=1:"",1:" ")_WORD
End DoDot:1
+7 QUIT
+8 ;
NAMES(OUT) ; build JSON of all active test names
+1 NEW LN,NAME,TEST,STAFF
+2 SET LN=1
SET OUT(LN)="{""instruments"":["
+3 SET NAME=0
FOR
SET NAME=$ORDER(^YTT(601.71,"B",NAME))
if '$LENGTH(NAME)
QUIT
Begin DoDot:1
+4 SET TEST=0
FOR
SET TEST=$ORDER(^YTT(601.71,"B",NAME,TEST))
if 'TEST
QUIT
Begin DoDot:2
+5 IF $PIECE($GET(^YTT(601.71,TEST,2)),U,2)'="Y"
QUIT
+6 DO ADDPROP("name",NAME)
+7 DO ADDPROP("fullName",$PIECE(^YTT(601.71,TEST,0),U,3))
+8 DO ADDPROP("isBattery","false")
+9 SET STAFF=($PIECE($GET(^YTT(601.71,TEST,1)),U,7)="Y")
+10 DO ADDPROP("staffOnly",$SELECT(STAFF=1:"true",1:"false"))
End DoDot:2
End DoDot:1
+11 ; remove last comma
SET OUT(LN)=$EXTRACT(OUT(LN),1,$LENGTH(OUT(LN))-1)
+12 SET LN=LN+1
SET OUT(LN)="]}"
+13 ;N I S I=0 F S I=$O(OUT(I)) Q:'I W !,OUT(I)
+14 QUIT
+15 ;
ADDPROP(NAME,VALUE) ; add property to test select object
+1 ; expects OUT,LN
+2 NEW X
+3 SET X=""
+4 IF NAME="name"
SET X=X_"{"
SET LN=LN+1
SET OUT(LN)=""
+5 SET X=X_""""_NAME_""":"
+6 IF NAME="staffOnly"
Begin DoDot:1
+7 SET X=X_VALUE_"},"
End DoDot:1
+8 IF '$TEST
SET X=X_""""_VALUE_""","
+9 SET OUT(LN)=OUT(LN)_X
+10 QUIT
