YTWJSON ;SLC/KCM - Generate JSON Instrument Spec ; 7/20/2018
;;5.01;MENTAL HEALTH;**130,141,202**;Dec 30, 1994;Build 47
;
; Reference to %ZOSV in ICR #10097
; Reference to %ZTER in ICR #1621
;
GETSPEC(JSON,TEST) ; Get the JSON admin spec for instrument TEST
I TEST'=+TEST S TEST=$O(^YTT(601.71,"B",TEST,0)) Q:'TEST
;
N $ES,$ET S $ET="D ERRHND^YTWJSON" ; quit from ERRHND if error
N TREE,ERR
D CONTENT(TEST,.TREE)
D RULES(TEST,.TREE)
D FMTJSON^YTWJSONO(.TREE,.JSON) ;D ENCODE^VPRJSON("TREE","JSON","ERR")
Q
ERRHND ; Handle errors & clear stack
N ERROR S ERROR=$$EC^%ZOSV ; grab the error code
I ERROR["ZTER" D UNWIND^%ZTER ; ignore errors clearing stack
N $ET S $ET="D ^%ZTER,UNWIND^%ZTER" ; avoid looping on add'l error
D ^%ZTER ; record failure in error trap
K JSON ; delete the return value
D UNWIND^%ZTER ; clear the call stack
Q
CONTENT(TEST,TREE) ; build TEST spec as TREE for JSON conversion
S TREE("name")=$P(^YTT(601.71,TEST,0),U)
S TREE("printTitle")=$P(^YTT(601.71,TEST,0),U,3)
; TODO: replace Copyright (c) with \u00A9 ??
S TREE("copyright")=$$HTMLESC^YTWJSONU($G(^YTT(601.71,TEST,7)))
S TREE("restartDays")=$P($G(^YTT(601.71,TEST,8)),U,7)
I TREE("restartDays")="" S TREE("restartDays")=2
;
N SECTIONS D SECTIONS(TEST,.SECTIONS) ; build SECTIONS(questionId)
N CTNTIDX S CTNTIDX=0 ; content index - global scope
N LSTINTRO S LSTINTRO=0 ; last intro used
;
; loop thru content by sequence, then choices by sequence
N SEQ,CTNT,X0,X2,QSTN,DISP,RTYP,CTYP
S SEQ=0 F S SEQ=$O(^YTT(601.76,"AD",TEST,SEQ)) Q:'SEQ D
. S CTNT=0 F S CTNT=$O(^YTT(601.76,"AD",TEST,SEQ,CTNT)) Q:'CTNT D
. . S X0=^YTT(601.76,CTNT,0),QSTN=$P(X0,U,4),DISP=$P(X0,U,8)
. . S X2=^YTT(601.72,QSTN,2),RTYP=$P(X2,U,2),CTYP=$P(X2,U,3)
. . ; if section header and intro are both present, prepend section header
. . I +$P(X2,U)'=LSTINTRO S LSTINTRO=+$P(X2,U) D
. . . N SECTHDR S SECTHDR=""
. . . I $D(SECTIONS(QSTN)) S SECTHDR=$P(SECTIONS(QSTN),U,5)
. . . I $L(SECTHDR) S SECTHDR=SECTHDR_"<br />"
. . . D ADDINTRO(+$P(X2,U),$P(X0,U,7),SECTHDR)
. . E D
. . . I $D(SECTIONS(QSTN)) D ADDSECT(SECTIONS(QSTN))
. . D ADDQSTN(QSTN,$P(X0,U,5),$P(X0,U,6))
. . ;
. . ; add additional properties based on response type
. . ; DISP is the MH DISPLAY entry for MHCHOICEDISPLAYID
. . ; (the entries for question and intro don't appear to do much)
. . I RTYP=1 D RADIO(QSTN,DISP,CTYP)
. . I RTYP=2 D SPIN(QSTN,DISP)
. . I RTYP=3 D TEXT(QSTN,DISP)
. . I RTYP=4 D DATE(QSTN,DISP)
. . I RTYP=5 D MEMO(QSTN,DISP)
. . I RTYP=7 D RANGE(QSTN,DISP,CTYP)
. . I RTYP=11 D CHECK(QSTN,DISP,CTYP)
Q
;
; -- for the control type entry points below --
; expects CTNTIDX to be index of current question
; QSTN: question id (file 601.72 ien)
; CTYP: choice type (file 601.751 ien, multiple)
; DISP: choice display id (file 601.88 ien)
;
RADIO(QSTN,DISP,CTYP) ; add properties for radio group (1 MCHOICE)
; add choices, inline/columns
S TREE("content",CTNTIDX,"type")="ChoiceQuestion"
D CHLOOP(CTYP,1) ; 1=MCHOICE -- add choices
Q:'$G(DISP) ; no choice level MH DISPAY ENTRY
N X0 S X0=$G(^YTT(601.88,DISP,0))
; for now, make inline if columns > 1
S TREE("content",CTNTIDX,"inline")=$S($P(X0,U,11)>1:"true",1:"false")
I $P(X0,U,11) S TREE("content",CTNTIDX,"columns")=$P(X0,U,11)
; I $P(X0,U,11)>2 W !,"Test:",TEST," Qstn:",QSTN," Cols:",$P(X0,U,11)
Q
SPIN(QSTN,DISP) ; add properties for spin control (2 INTEGER)
; add inline, default value, max, min
S TREE("content",CTNTIDX,"type")="IntegerQuestion"
D MINMAX(QSTN)
D MASK(DISP)
Q
TEXT(QSTN,DISP) ; add properties for edit control (3 STRING)
;inline, width, default value (mask), max, min
S TREE("content",CTNTIDX,"type")="StringQuestion"
D MINMAX(QSTN)
D MASK(DISP)
Q
DATE(QSTN,DISP) ; add properties for date picker (4 DATE)
;add inline, default value
S TREE("content",CTNTIDX,"type")="DateQuestion"
D MASK(DISP)
Q
MEMO(QSTN,DISP) ; add properties for memo control (5 MEMO)
; add width, default value
S TREE("content",CTNTIDX,"type")="MemoQuestion"
D MASK(DISP)
Q
RANGE(QSTN,DISP,CTYP) ; add properties for range/slider (7 TRACK BAR)
;add min, max, legend (choices), {labels}
S TREE("content",CTNTIDX,"type")="SliderQuestion"
D MINMAX(QSTN)
D CHLOOP(CTYP,7) ; 7=TRACK BAR
Q
CHECK(QSTN,DISP,CTYP) ; add properties for check list (11 CHECKLIST)
; add choices, inline/columns
S TREE("content",CTNTIDX,"type")="CheckQuestion"
D CHLOOP(CTYP,11) ; 11=CHECKLIST
N X0 S X0=$G(^YTT(601.88,DISP,0))
; for now, make inline if columns > 1
S TREE("content",CTNTIDX,"inline")=$S($P(X0,U,11)>1:"true",1:"false")
I $P(X0,U,11) S TREE("content",CTNTIDX,"columns")=$P(X0,U,11)
Q
;
MINMAX(QSTN) ; set max/min properties
N X2 S X2=$G(^YTT(601.72,QSTN,2))
I +$P(X2,U,4)=$P(X2,U,4) S TREE("content",CTNTIDX,"min")=+$P(X2,U,4)
I +$P(X2,U,5)=$P(X2,U,5) S TREE("content",CTNTIDX,"max")=+$P(X2,U,5)
Q
MASK(DISP) ; set properties from |-delimited MASK field
Q:'DISP ; some instruments have no display pointer
Q:'$D(^YTT(601.88,DISP,0)) ; some instruments have broken pointers
N MASK S MASK=$P(^YTT(601.88,DISP,0),U,10)
I +MASK S TREE("content",CTNTIDX,"controlWidth")=+MASK
I $L($P(MASK,"|",2)) S TREE("content",CTNTIDX,"default")=$P(MASK,"|",2)
I $P(MASK,"|",3)="S" S TREE("content",CTNTIDX,"inline")="true"
Q
CHLOOP(CTYP,CALL) ; loop through choices for a choice type
; CTYP: Id for ChoiceTypes (601.751) and ChoiceIdentifier (601.89)
; CALL: Code to call for building appropriate type of node
N CIDF,CSEQ,CHID,CIEN,CIDX
S CIDX=0,CIDF=$O(^YTT(601.89,"B",CTYP,0)) ; choice identifier ien
S CSEQ=0 F S CSEQ=$O(^YTT(601.751,"AC",CTYP,CSEQ)) Q:'CSEQ D
. S CHID=0 F S CHID=$O(^YTT(601.751,"AC",CTYP,CSEQ,CHID)) Q:'CHID D
. . S CIDX=CIDX+1
. . I CALL=1 D ADDCH(CIDX,CIDF,CHID) Q ; radio buttons
. . I CALL=7 D ADDLGND(CIDX,CHID) Q ; range control
. . I CALL=11 D ADDCH(CIDX,CIDF,CHID) Q ; checklist
Q
SECTIONS(TEST,SECTIONS) ; build list of sections for TEST
; SECTIONS(questionIEN)=ID^TEST^Question^TabName^Header^Format
N IEN,X0
S IEN=0 F S IEN=$O(^YTT(601.81,"AC",TEST,IEN)) Q:'IEN D
. S X0=^YTT(601.81,IEN,0)
. S SECTIONS($P(X0,U,3))=X0
Q
ADDSECT(X0) ; add section node
; expects TREE, CTNTIDX from CONTENT
; X0: ID^TEST^Question^TabName^Header^Format
S CTNTIDX=CTNTIDX+1
; treat Section Header as Intro
I '$L($P(X0,U,5)) QUIT
S TREE("content",CTNTIDX,"id")="s"_+X0
S TREE("content",CTNTIDX,"type")="IntroText"
S TREE("content",CTNTIDX,"text")=$P(X0,U,5)
; code was:
; S TREE("content",CTNTIDX,"id")="s"_+X0
; S TREE("content",CTNTIDX,"type")="Section"
; I $L($P(X0,U,4)) S TREE("content",CTNTIDX,"tab")=$P(X0,U,4)
; I $L($P(X0,U,5)) S TREE("content",CTNTIDX,"text")=$P(X0,U,5)
Q
ADDINTRO(IEN,FORMAT,PREPEND) ; add intro node
; expects TREE, CTNTIDX from CONTENT
Q:'IEN
N TEXT
S CTNTIDX=CTNTIDX+1
S TREE("content",CTNTIDX,"id")="i"_+^YTT(601.73,IEN,0)
S TREE("content",CTNTIDX,"type")="IntroText"
D BLDTXT^YTWJSONU($NA(^YTT(601.73,IEN,1)),.TEXT)
S TEXT=PREPEND_$G(TEXT) ; TEMPORARY fix of section header
M TREE("content",CTNTIDX,"text")=TEXT
Q
ADDQSTN(IEN,DESIG,FORMAT) ; add question node
N TEXT,X0,X2,ITEXT
S CTNTIDX=CTNTIDX+1
S X0=^YTT(601.72,IEN,0),X2=$G(^(2))
I $L(DESIG),($E(DESIG,$L(DESIG))'=".") S DESIG=DESIG_"."
S TREE("content",CTNTIDX,"id")="q"_+X0
D BLDTXT^YTWJSONU($NA(^YTT(601.72,IEN,1)),.TEXT)
M TREE("content",CTNTIDX,"text")=TEXT
S TREE("content",CTNTIDX,"text")=DESIG_" "_TREE("content",CTNTIDX,"text")
S TREE("content",CTNTIDX,"required")=$S($P(X2,U,6)="Y":"true",1:"false")
I +X2 D
. D BLDTXT^YTWJSONU($NA(^YTT(601.73,+X2,1)),.ITEXT)
. M TREE("content",CTNTIDX,"intro")=ITEXT
; add HINT? -- not currently used by any of the active instruments
Q
ADDCH(INDEX,IDENTIEN,CHIEN) ; add choice node
; child of current question, use current CTNTIDX
N IDBASE,NUM,QUICK
S TREE("content",CTNTIDX,"choices",INDEX,"id")="c"_+^YTT(601.75,CHIEN,0)
; default IDBASE to 1 if no file entry for legacy tests
S IDBASE=$S('IDENTIEN:1,1:$P(^YTT(601.89,IDENTIEN,0),U,2))
S NUM=$S(IDBASE=0:INDEX-1,IDBASE=1:INDEX,1:"") S:$L(NUM) NUM=NUM_"."
S TREE("content",CTNTIDX,"choices",INDEX,"text")=NUM_" "_$$HTMLESC^YTWJSONU(^YTT(601.75,CHIEN,1))
S QUICK=$P(NUM,"."),QUICK=$S(+QUICK=QUICK:+QUICK,1:"") ;S:QUICK QUICK=QUICK+48
I $L(QUICK) S TREE("content",CTNTIDX,"choices",INDEX,"quickKey")=QUICK
Q
ADDLGND(INDEX,CHIEN) ; add legend based on choices
S TREE("content",CTNTIDX,"legend",INDEX)=^YTT(601.75,CHIEN,1)
Q
RULES(TEST,TREE) ; add RULES for TEST to spec TREE for JSON conversion
N IRID,RID,RIDX,X,X0,X1,QSTN1,QSTN2
S RIDX=0
S QSTN1=0 F S QSTN1=$O(^YTT(601.83,"AD",TEST,QSTN1)) Q:'QSTN1 D
. S IRID=0 F S IRID=$O(^YTT(601.83,"AD",TEST,QSTN1,IRID)) Q:'IRID D
. . S RID=$P(^YTT(601.83,IRID,0),U,4),RIDX=RIDX+1
. . S X0=^YTT(601.82,RID,0),X1=$G(^(1)),X=$P(X0,U,5)
. . S TREE("rules",RIDX,"question")="q"_QSTN1
. . S TREE("rules",RIDX,"operator")=$S(X="Does not equal":"NE",X="Equals":"EQ",1:X)
. . S TREE("rules",RIDX,"value")=$$TRUTHVAL(QSTN1,$P(X0,U,3))
. . I $L(X1),$P(X0,U,6)="AND" D
. . . S QSTN2=$P(X0,U,7),X=$P(X1,U,3) Q:'QSTN2
. . . S TREE("rules",RIDX,"conjunction")="and"
. . . S TREE("rules",RIDX,"question2")="q"_QSTN2
. . . S TREE("rules",RIDX,"operator2")=$S(X="Does not equal":"NE",X="Equals":"EQ",1:X)
. . . S TREE("rules",RIDX,"value2")=$$TRUTHVAL(QSTN2,$P(X1,U,1))
. . D SETSKIPS(RID,RIDX)
Q
TRUTHVAL(QSTN,VALUE) ; return the target value for the rule
; if MCHOICE, convert from Delphi itemIndex value to choice id
I $P($G(^YTT(601.72,QSTN,2)),U,2)'=1 Q VALUE ; not MCHOICE so return value
N CTYP,CSEQ,CHID,IDX,DONE ; otherwise, find choice id
S CTYP=$P($G(^YTT(601.72,QSTN,2)),U,3),(CSEQ,CHID,DONE,IDX)=0
F S CSEQ=$O(^YTT(601.751,"AC",CTYP,CSEQ)) Q:'CSEQ D Q:DONE
. I IDX=VALUE S CHID=$O(^YTT(601.751,"AC",CTYP,CSEQ,CHID)),DONE=1 Q
. S IDX=IDX+1
Q "c"_CHID
;
SETSKIPS(RID,RIDX) ; set skipped questions for rule RID at index RIDX
N SID,QID,SIDX
S SIDX=0
S SID=0 F S SID=$O(^YTT(601.79,"AE",RID,SID)) Q:'SID D
. S QID=$P(^YTT(601.79,SID,0),U,4) Q:'QID
. S SIDX=SIDX+1
. S TREE("rules",RIDX,"skips",SIDX)="q"_QID
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTWJSON 10548 printed Dec 13, 2024@02:21:57 Page 2
YTWJSON ;SLC/KCM - Generate JSON Instrument Spec ; 7/20/2018
+1 ;;5.01;MENTAL HEALTH;**130,141,202**;Dec 30, 1994;Build 47
+2 ;
+3 ; Reference to %ZOSV in ICR #10097
+4 ; Reference to %ZTER in ICR #1621
+5 ;
GETSPEC(JSON,TEST) ; Get the JSON admin spec for instrument TEST
+1 IF TEST'=+TEST
SET TEST=$ORDER(^YTT(601.71,"B",TEST,0))
if 'TEST
QUIT
+2 ;
+3 ; quit from ERRHND if error
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERRHND^YTWJSON"
+4 NEW TREE,ERR
+5 DO CONTENT(TEST,.TREE)
+6 DO RULES(TEST,.TREE)
+7 ;D ENCODE^VPRJSON("TREE","JSON","ERR")
DO FMTJSON^YTWJSONO(.TREE,.JSON)
+8 QUIT
ERRHND ; Handle errors & clear stack
+1 ; grab the error code
NEW ERROR
SET ERROR=$$EC^%ZOSV
+2 ; ignore errors clearing stack
IF ERROR["ZTER"
DO UNWIND^%ZTER
+3 ; avoid looping on add'l error
NEW $ETRAP
SET $ETRAP="D ^%ZTER,UNWIND^%ZTER"
+4 ; record failure in error trap
DO ^%ZTER
+5 ; delete the return value
KILL JSON
+6 ; clear the call stack
DO UNWIND^%ZTER
+7 QUIT
CONTENT(TEST,TREE) ; build TEST spec as TREE for JSON conversion
+1 SET TREE("name")=$PIECE(^YTT(601.71,TEST,0),U)
+2 SET TREE("printTitle")=$PIECE(^YTT(601.71,TEST,0),U,3)
+3 ; TODO: replace Copyright (c) with \u00A9 ??
+4 SET TREE("copyright")=$$HTMLESC^YTWJSONU($GET(^YTT(601.71,TEST,7)))
+5 SET TREE("restartDays")=$PIECE($GET(^YTT(601.71,TEST,8)),U,7)
+6 IF TREE("restartDays")=""
SET TREE("restartDays")=2
+7 ;
+8 ; build SECTIONS(questionId)
NEW SECTIONS
DO SECTIONS(TEST,.SECTIONS)
+9 ; content index - global scope
NEW CTNTIDX
SET CTNTIDX=0
+10 ; last intro used
NEW LSTINTRO
SET LSTINTRO=0
+11 ;
+12 ; loop thru content by sequence, then choices by sequence
+13 NEW SEQ,CTNT,X0,X2,QSTN,DISP,RTYP,CTYP
+14 SET SEQ=0
FOR
SET SEQ=$ORDER(^YTT(601.76,"AD",TEST,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+15 SET CTNT=0
FOR
SET CTNT=$ORDER(^YTT(601.76,"AD",TEST,SEQ,CTNT))
if 'CTNT
QUIT
Begin DoDot:2
+16 SET X0=^YTT(601.76,CTNT,0)
SET QSTN=$PIECE(X0,U,4)
SET DISP=$PIECE(X0,U,8)
+17 SET X2=^YTT(601.72,QSTN,2)
SET RTYP=$PIECE(X2,U,2)
SET CTYP=$PIECE(X2,U,3)
+18 ; if section header and intro are both present, prepend section header
+19 IF +$PIECE(X2,U)'=LSTINTRO
SET LSTINTRO=+$PIECE(X2,U)
Begin DoDot:3
+20 NEW SECTHDR
SET SECTHDR=""
+21 IF $DATA(SECTIONS(QSTN))
SET SECTHDR=$PIECE(SECTIONS(QSTN),U,5)
+22 IF $LENGTH(SECTHDR)
SET SECTHDR=SECTHDR_"<br />"
+23 DO ADDINTRO(+$PIECE(X2,U),$PIECE(X0,U,7),SECTHDR)
End DoDot:3
+24 IF '$TEST
Begin DoDot:3
+25 IF $DATA(SECTIONS(QSTN))
DO ADDSECT(SECTIONS(QSTN))
End DoDot:3
+26 DO ADDQSTN(QSTN,$PIECE(X0,U,5),$PIECE(X0,U,6))
+27 ;
+28 ; add additional properties based on response type
+29 ; DISP is the MH DISPLAY entry for MHCHOICEDISPLAYID
+30 ; (the entries for question and intro don't appear to do much)
+31 IF RTYP=1
DO RADIO(QSTN,DISP,CTYP)
+32 IF RTYP=2
DO SPIN(QSTN,DISP)
+33 IF RTYP=3
DO TEXT(QSTN,DISP)
+34 IF RTYP=4
DO DATE(QSTN,DISP)
+35 IF RTYP=5
DO MEMO(QSTN,DISP)
+36 IF RTYP=7
DO RANGE(QSTN,DISP,CTYP)
+37 IF RTYP=11
DO CHECK(QSTN,DISP,CTYP)
End DoDot:2
End DoDot:1
+38 QUIT
+39 ;
+40 ; -- for the control type entry points below --
+41 ; expects CTNTIDX to be index of current question
+42 ; QSTN: question id (file 601.72 ien)
+43 ; CTYP: choice type (file 601.751 ien, multiple)
+44 ; DISP: choice display id (file 601.88 ien)
+45 ;
RADIO(QSTN,DISP,CTYP) ; add properties for radio group (1 MCHOICE)
+1 ; add choices, inline/columns
+2 SET TREE("content",CTNTIDX,"type")="ChoiceQuestion"
+3 ; 1=MCHOICE -- add choices
DO CHLOOP(CTYP,1)
+4 ; no choice level MH DISPAY ENTRY
if '$GET(DISP)
QUIT
+5 NEW X0
SET X0=$GET(^YTT(601.88,DISP,0))
+6 ; for now, make inline if columns > 1
+7 SET TREE("content",CTNTIDX,"inline")=$SELECT($PIECE(X0,U,11)>1:"true",1:"false")
+8 IF $PIECE(X0,U,11)
SET TREE("content",CTNTIDX,"columns")=$PIECE(X0,U,11)
+9 ; I $P(X0,U,11)>2 W !,"Test:",TEST," Qstn:",QSTN," Cols:",$P(X0,U,11)
+10 QUIT
SPIN(QSTN,DISP) ; add properties for spin control (2 INTEGER)
+1 ; add inline, default value, max, min
+2 SET TREE("content",CTNTIDX,"type")="IntegerQuestion"
+3 DO MINMAX(QSTN)
+4 DO MASK(DISP)
+5 QUIT
TEXT(QSTN,DISP) ; add properties for edit control (3 STRING)
+1 ;inline, width, default value (mask), max, min
+2 SET TREE("content",CTNTIDX,"type")="StringQuestion"
+3 DO MINMAX(QSTN)
+4 DO MASK(DISP)
+5 QUIT
DATE(QSTN,DISP) ; add properties for date picker (4 DATE)
+1 ;add inline, default value
+2 SET TREE("content",CTNTIDX,"type")="DateQuestion"
+3 DO MASK(DISP)
+4 QUIT
MEMO(QSTN,DISP) ; add properties for memo control (5 MEMO)
+1 ; add width, default value
+2 SET TREE("content",CTNTIDX,"type")="MemoQuestion"
+3 DO MASK(DISP)
+4 QUIT
RANGE(QSTN,DISP,CTYP) ; add properties for range/slider (7 TRACK BAR)
+1 ;add min, max, legend (choices), {labels}
+2 SET TREE("content",CTNTIDX,"type")="SliderQuestion"
+3 DO MINMAX(QSTN)
+4 ; 7=TRACK BAR
DO CHLOOP(CTYP,7)
+5 QUIT
CHECK(QSTN,DISP,CTYP) ; add properties for check list (11 CHECKLIST)
+1 ; add choices, inline/columns
+2 SET TREE("content",CTNTIDX,"type")="CheckQuestion"
+3 ; 11=CHECKLIST
DO CHLOOP(CTYP,11)
+4 NEW X0
SET X0=$GET(^YTT(601.88,DISP,0))
+5 ; for now, make inline if columns > 1
+6 SET TREE("content",CTNTIDX,"inline")=$SELECT($PIECE(X0,U,11)>1:"true",1:"false")
+7 IF $PIECE(X0,U,11)
SET TREE("content",CTNTIDX,"columns")=$PIECE(X0,U,11)
+8 QUIT
+9 ;
MINMAX(QSTN) ; set max/min properties
+1 NEW X2
SET X2=$GET(^YTT(601.72,QSTN,2))
+2 IF +$PIECE(X2,U,4)=$PIECE(X2,U,4)
SET TREE("content",CTNTIDX,"min")=+$PIECE(X2,U,4)
+3 IF +$PIECE(X2,U,5)=$PIECE(X2,U,5)
SET TREE("content",CTNTIDX,"max")=+$PIECE(X2,U,5)
+4 QUIT
MASK(DISP) ; set properties from |-delimited MASK field
+1 ; some instruments have no display pointer
if 'DISP
QUIT
+2 ; some instruments have broken pointers
if '$DATA(^YTT(601.88,DISP,0))
QUIT
+3 NEW MASK
SET MASK=$PIECE(^YTT(601.88,DISP,0),U,10)
+4 IF +MASK
SET TREE("content",CTNTIDX,"controlWidth")=+MASK
+5 IF $LENGTH($PIECE(MASK,"|",2))
SET TREE("content",CTNTIDX,"default")=$PIECE(MASK,"|",2)
+6 IF $PIECE(MASK,"|",3)="S"
SET TREE("content",CTNTIDX,"inline")="true"
+7 QUIT
CHLOOP(CTYP,CALL) ; loop through choices for a choice type
+1 ; CTYP: Id for ChoiceTypes (601.751) and ChoiceIdentifier (601.89)
+2 ; CALL: Code to call for building appropriate type of node
+3 NEW CIDF,CSEQ,CHID,CIEN,CIDX
+4 ; choice identifier ien
SET CIDX=0
SET CIDF=$ORDER(^YTT(601.89,"B",CTYP,0))
+5 SET CSEQ=0
FOR
SET CSEQ=$ORDER(^YTT(601.751,"AC",CTYP,CSEQ))
if 'CSEQ
QUIT
Begin DoDot:1
+6 SET CHID=0
FOR
SET CHID=$ORDER(^YTT(601.751,"AC",CTYP,CSEQ,CHID))
if 'CHID
QUIT
Begin DoDot:2
+7 SET CIDX=CIDX+1
+8 ; radio buttons
IF CALL=1
DO ADDCH(CIDX,CIDF,CHID)
QUIT
+9 ; range control
IF CALL=7
DO ADDLGND(CIDX,CHID)
QUIT
+10 ; checklist
IF CALL=11
DO ADDCH(CIDX,CIDF,CHID)
QUIT
End DoDot:2
End DoDot:1
+11 QUIT
SECTIONS(TEST,SECTIONS) ; build list of sections for TEST
+1 ; SECTIONS(questionIEN)=ID^TEST^Question^TabName^Header^Format
+2 NEW IEN,X0
+3 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.81,"AC",TEST,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 SET X0=^YTT(601.81,IEN,0)
+5 SET SECTIONS($PIECE(X0,U,3))=X0
End DoDot:1
+6 QUIT
ADDSECT(X0) ; add section node
+1 ; expects TREE, CTNTIDX from CONTENT
+2 ; X0: ID^TEST^Question^TabName^Header^Format
+3 SET CTNTIDX=CTNTIDX+1
+4 ; treat Section Header as Intro
+5 IF '$LENGTH($PIECE(X0,U,5))
QUIT
+6 SET TREE("content",CTNTIDX,"id")="s"_+X0
+7 SET TREE("content",CTNTIDX,"type")="IntroText"
+8 SET TREE("content",CTNTIDX,"text")=$PIECE(X0,U,5)
+9 ; code was:
+10 ; S TREE("content",CTNTIDX,"id")="s"_+X0
+11 ; S TREE("content",CTNTIDX,"type")="Section"
+12 ; I $L($P(X0,U,4)) S TREE("content",CTNTIDX,"tab")=$P(X0,U,4)
+13 ; I $L($P(X0,U,5)) S TREE("content",CTNTIDX,"text")=$P(X0,U,5)
+14 QUIT
ADDINTRO(IEN,FORMAT,PREPEND) ; add intro node
+1 ; expects TREE, CTNTIDX from CONTENT
+2 if 'IEN
QUIT
+3 NEW TEXT
+4 SET CTNTIDX=CTNTIDX+1
+5 SET TREE("content",CTNTIDX,"id")="i"_+^YTT(601.73,IEN,0)
+6 SET TREE("content",CTNTIDX,"type")="IntroText"
+7 DO BLDTXT^YTWJSONU($NAME(^YTT(601.73,IEN,1)),.TEXT)
+8 ; TEMPORARY fix of section header
SET TEXT=PREPEND_$GET(TEXT)
+9 MERGE TREE("content",CTNTIDX,"text")=TEXT
+10 QUIT
ADDQSTN(IEN,DESIG,FORMAT) ; add question node
+1 NEW TEXT,X0,X2,ITEXT
+2 SET CTNTIDX=CTNTIDX+1
+3 SET X0=^YTT(601.72,IEN,0)
SET X2=$GET(^(2))
+4 IF $LENGTH(DESIG)
IF ($EXTRACT(DESIG,$LENGTH(DESIG))'=".")
SET DESIG=DESIG_"."
+5 SET TREE("content",CTNTIDX,"id")="q"_+X0
+6 DO BLDTXT^YTWJSONU($NAME(^YTT(601.72,IEN,1)),.TEXT)
+7 MERGE TREE("content",CTNTIDX,"text")=TEXT
+8 SET TREE("content",CTNTIDX,"text")=DESIG_" "_TREE("content",CTNTIDX,"text")
+9 SET TREE("content",CTNTIDX,"required")=$SELECT($PIECE(X2,U,6)="Y":"true",1:"false")
+10 IF +X2
Begin DoDot:1
+11 DO BLDTXT^YTWJSONU($NAME(^YTT(601.73,+X2,1)),.ITEXT)
+12 MERGE TREE("content",CTNTIDX,"intro")=ITEXT
End DoDot:1
+13 ; add HINT? -- not currently used by any of the active instruments
+14 QUIT
ADDCH(INDEX,IDENTIEN,CHIEN) ; add choice node
+1 ; child of current question, use current CTNTIDX
+2 NEW IDBASE,NUM,QUICK
+3 SET TREE("content",CTNTIDX,"choices",INDEX,"id")="c"_+^YTT(601.75,CHIEN,0)
+4 ; default IDBASE to 1 if no file entry for legacy tests
+5 SET IDBASE=$SELECT('IDENTIEN:1,1:$PIECE(^YTT(601.89,IDENTIEN,0),U,2))
+6 SET NUM=$SELECT(IDBASE=0:INDEX-1,IDBASE=1:INDEX,1:"")
if $LENGTH(NUM)
SET NUM=NUM_"."
+7 SET TREE("content",CTNTIDX,"choices",INDEX,"text")=NUM_" "_$$HTMLESC^YTWJSONU(^YTT(601.75,CHIEN,1))
+8 ;S:QUICK QUICK=QUICK+48
SET QUICK=$PIECE(NUM,".")
SET QUICK=$SELECT(+QUICK=QUICK:+QUICK,1:"")
+9 IF $LENGTH(QUICK)
SET TREE("content",CTNTIDX,"choices",INDEX,"quickKey")=QUICK
+10 QUIT
ADDLGND(INDEX,CHIEN) ; add legend based on choices
+1 SET TREE("content",CTNTIDX,"legend",INDEX)=^YTT(601.75,CHIEN,1)
+2 QUIT
RULES(TEST,TREE) ; add RULES for TEST to spec TREE for JSON conversion
+1 NEW IRID,RID,RIDX,X,X0,X1,QSTN1,QSTN2
+2 SET RIDX=0
+3 SET QSTN1=0
FOR
SET QSTN1=$ORDER(^YTT(601.83,"AD",TEST,QSTN1))
if 'QSTN1
QUIT
Begin DoDot:1
+4 SET IRID=0
FOR
SET IRID=$ORDER(^YTT(601.83,"AD",TEST,QSTN1,IRID))
if 'IRID
QUIT
Begin DoDot:2
+5 SET RID=$PIECE(^YTT(601.83,IRID,0),U,4)
SET RIDX=RIDX+1
+6 SET X0=^YTT(601.82,RID,0)
SET X1=$GET(^(1))
SET X=$PIECE(X0,U,5)
+7 SET TREE("rules",RIDX,"question")="q"_QSTN1
+8 SET TREE("rules",RIDX,"operator")=$SELECT(X="Does not equal":"NE",X="Equals":"EQ",1:X)
+9 SET TREE("rules",RIDX,"value")=$$TRUTHVAL(QSTN1,$PIECE(X0,U,3))
+10 IF $LENGTH(X1)
IF $PIECE(X0,U,6)="AND"
Begin DoDot:3
+11 SET QSTN2=$PIECE(X0,U,7)
SET X=$PIECE(X1,U,3)
if 'QSTN2
QUIT
+12 SET TREE("rules",RIDX,"conjunction")="and"
+13 SET TREE("rules",RIDX,"question2")="q"_QSTN2
+14 SET TREE("rules",RIDX,"operator2")=$SELECT(X="Does not equal":"NE",X="Equals":"EQ",1:X)
+15 SET TREE("rules",RIDX,"value2")=$$TRUTHVAL(QSTN2,$PIECE(X1,U,1))
End DoDot:3
+16 DO SETSKIPS(RID,RIDX)
End DoDot:2
End DoDot:1
+17 QUIT
TRUTHVAL(QSTN,VALUE) ; return the target value for the rule
+1 ; if MCHOICE, convert from Delphi itemIndex value to choice id
+2 ; not MCHOICE so return value
IF $PIECE($GET(^YTT(601.72,QSTN,2)),U,2)'=1
QUIT VALUE
+3 ; otherwise, find choice id
NEW CTYP,CSEQ,CHID,IDX,DONE
+4 SET CTYP=$PIECE($GET(^YTT(601.72,QSTN,2)),U,3)
SET (CSEQ,CHID,DONE,IDX)=0
+5 FOR
SET CSEQ=$ORDER(^YTT(601.751,"AC",CTYP,CSEQ))
if 'CSEQ
QUIT
Begin DoDot:1
+6 IF IDX=VALUE
SET CHID=$ORDER(^YTT(601.751,"AC",CTYP,CSEQ,CHID))
SET DONE=1
QUIT
+7 SET IDX=IDX+1
End DoDot:1
if DONE
QUIT
+8 QUIT "c"_CHID
+9 ;
SETSKIPS(RID,RIDX) ; set skipped questions for rule RID at index RIDX
+1 NEW SID,QID,SIDX
+2 SET SIDX=0
+3 SET SID=0
FOR
SET SID=$ORDER(^YTT(601.79,"AE",RID,SID))
if 'SID
QUIT
Begin DoDot:1
+4 SET QID=$PIECE(^YTT(601.79,SID,0),U,4)
if 'QID
QUIT
+5 SET SIDX=SIDX+1
+6 SET TREE("rules",RIDX,"skips",SIDX)="q"_QID
End DoDot:1
+7 QUIT
