YSBPREFS ;BAL/KTL - MHA DASHBOARD USER PREFERENCES ; Apr 01, 2021@16:33
;;5.01;MENTAL HEALTH;**202**;Dec 30, 1994;Build 47
;
; Routine saves Settings, gets settings for User Preferences
; in JSON format.
;
; Reference to XPAR in ICR #2263
Q
;==============================
; Get User Preferences
;
GETHRSEL(JSONOUT,PARMS) ;
; Given user DUZ and Widget, get the High Risk Patient Selection Criteria
N DATAOUT,WPARR,DUZPAR,WDGT,YDUZ,II
K JSONOUT
S WDGT=1
S YDUZ=$G(DUZ)
S:WDGT="" WDGT=1 ;For first instance of this parameter. Most likely always 1
S DUZPAR=YDUZ_";VA(200,"
D GETWP^XPAR(.WPARR,DUZPAR,"YSB HR SELECTION CRITERIA",WDGT)
I '$D(WPARR) D Q
. S JSONOUT(1)="{}"
I $D(WPARR)=1,(WPARR="") D Q
. S JSONOUT(1)="{}"
S II="" F S II=$O(WPARR(II)) Q:II="" D
. S JSONOUT(II)=WPARR(II,0)
Q
GETMBSEL(JSONOUT) ;
; Given user DUZ and Widget, get the Measurement Based Care (MBC) Patient Selection Criteria
N DATAOUT,WPARR,DUZPAR,WDGT,YDUZ
K JSONOUT
S WDGT=1
S YDUZ=$G(DUZ)
S:WDGT="" WDGT=1 ;For first instance of this parameter. Most likely always 1
S DUZPAR=YDUZ_";VA(200,"
D GETWP^XPAR(.WPARR,DUZPAR,"YSB MBC SELECTION CRITERIA",WDGT)
I '$D(WPARR) D Q
. ;S JSONOUT(1)="{}" ;Need to define Default
. D MBSDFLT(.JSONOUT)
I $D(WPARR)=1,(WPARR="") D Q
. D MBSDFLT(.JSONOUT)
S II="" F S II=$O(WPARR(II)) Q:II="" D
. S JSONOUT(II)=WPARR(II,0)
Q
MBSDFLT(JSONOUT) ;Generate default Selection JSON
N LARR,ERRARR,CNT,XCNT
; Remove default list of all locations in UI, too cumbersome.
;N DUMDAT
;S CNT=0
;D GETLOCS^YSBWHIG2(.DUMDAT,1) ;Call to get standardized MH Locs list
;S XCNT=0 F S XCNT=$O(DUMDAT("widgets",1,"locationList",XCNT)) Q:XCNT="" D
;. S CNT=CNT+1
;. S LARR("data","clinics",CNT,"label")=DUMDAT("widgets",1,"locationList",XCNT,"name")
;. S LARR("data","clinics",CNT,"value")=DUMDAT("widgets",1,"locationList",XCNT,"id")
S LARR("data","date","label")="past year"
S LARR("data","date","value")="-365"
S LARR("data","sessionId")=""
D ENCODE^YSBJSON("LARR","JSONOUT","ERRARR")
Q
GETILST(JSONOUT,PARMS) ;
; Given user DUZ and Widget, get the Measurement Based Care (MBC) Patient Selection Criteria
N DATAOUT,WPARR,DUZPAR,WDGT,YDUZ
K JSONOUT
S WDGT=""
S YDUZ=$G(DUZ)
S:WDGT="" WDGT=1 ;For first instance of this parameter. Most likely always 1
S DUZPAR=YDUZ_";VA(200,"
D GETWP^XPAR(.WPARR,DUZPAR,"YSB MBC INSTRUMENT SELECTION",WDGT)
I '$D(WPARR) D Q
. S JSONOUT(1)="{}" ;Need to define Default
. ;D MBCIDFLT(.JSONOUT)
I ($D(WPARR)=1),(WPARR="") D Q
. S JSONOUT(1)="{}" ;Need to define Default
. ;D MBCIDFLT(.JSONOUT)
S II="" F S II=$O(WPARR(II)) Q:II="" D
. S JSONOUT(II)=WPARR(II,0)
Q
MBCIDFLT(JSONOUT) ;Generate Default MBC Instrument List
Q
GETUSRP(JSONOUT) ;
; Given user DUZ and Widget, get the Patient Selection Criteria
N DATAOUT,WPARR,DUZPAR,WDGT,YDUZ
;S YDUZ=$P(PARMS,"/"),WDGT=$P(PARMS,"/",2)
K JSONOUT
S WDGT=""
S YDUZ=$G(DUZ)
S:WDGT="" WDGT=1 ;For first instance of this parameter. Most likely always 1
S DUZPAR=YDUZ_";VA(200,"
D GETWP^XPAR(.WPARR,DUZPAR,"YSB USER COLUMN PREFERENCE",WDGT)
I '$D(WPARR) D Q
. D DFLTUP(.JSONOUT)
I ($D(WPARR)=1),(WPARR="") D Q
. D DFLTUP(.JSONOUT)
S II="" F S II=$O(WPARR(II)) Q:II="" D
. S JSONOUT(II)=WPARR(II,0)
Q
WEBGUSRP(ARGS,RESULTS) ;MHA Web call to get User Preferences
N JSONOUT
D GETUSRP(.JSONOUT)
D TOTMP^YSBRPC(.JSONOUT)
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
DFLTUP(XJSON) ;
; Get the Default columns to display if there are no set User Preferences
N II,XDATA,XNAM,XJ,SPC,XCNT,XTABC
S $P(SPC," ",10)=""
S XCNT=1,XTABC=1,XJSON(XCNT)="{"
D GETWDGT^YSBRPC(.XDATA)
S II=0 F S II=$O(XDATA("widgets",II)) Q:+II=0 D
. S XNAM=$G(XDATA("widgets",II,"name"))
. S XNAM=$S(XNAM="HIGH RISK":"highRisk",XNAM="MBC":"measurementBased",1:XNAM)
. K XDATA("widgets",II,"instrumentList") ;Don't include instrument list for now
. K XDATA("widgets",II,"name")
. M XJ(XNAM)=XDATA("widgets",II)
. S XJ(XNAM,"display")="true"
. S XJ(XNAM,"filterList","name")="name"
. S XJ(XNAM,"filterList","value")=""
D ENCODE^YSBJSON("XJ","XJSON","ERRARY")
Q
;=============================================
;Set User Preferences
;
HRWSEL(JSONOUT,IN) ;
; Save PATIENT SELECTION CRITERIA
; High Risk Widget
Q ;Not used yet
N WPARR,II,YDUZ,JSON,CNT,JSFLG,PDEF
N DATAOUT
N FDA,IENS,FDAIEN,MSG
N INSTANCE
S CNT=0,YDUZ=""
;In the IN array the body starts at line 4
S II=3 F S II=$O(IN(II)) Q:II="" D
. S CNT=CNT+1,JSON(CNT)=IN(II)
. ;I IN(II)["userId" S YDUZ=$$EXTPROP(STR,"""userId"":")
S YDUZ=$G(DUZ)
S PDEF=$O(^XTV(8989.51,"B","YSB HR SELECTION CRITERIA",""))
I PDEF="" D ERRHND("high_risk_selection","Parameter not defined") Q
S INSTANCE=1
S YDUZ=YDUZ_";VA(200,"
D EN^XPAR(YDUZ,PDEF,INSTANCE,.JSON,.MSG)
S DATAOUT("high_risk_selection",1,"status")="OK"
D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
Q
MBCWSEL(JSONOUT,IN) ;
; Save PATIENT SELECTION CRITERIA
; Measurement Based Care (MBC) widget
N WPARR,II,YDUZ,JSON,CNT,JSFLG,PDEF
N DATAOUT
N FDA,IENS,FDAIEN,MSG
N INSTANCE,STRT,DONE
S STRT="",DONE=""
S II=0 F S II=$O(IN(II)) Q:II=""!DONE D
. I IN(II)="" S STRT=II,DONE=1
I STRT="" D ERRHND("mbc_selection","Data not found") Q
S CNT=0,YDUZ=""
;In the IN array the body starts at line 4
S II=STRT F S II=$O(IN(II)) Q:II="" D
. S CNT=CNT+1,JSON(CNT)=IN(II)
S YDUZ=$G(DUZ)
S PDEF=$O(^XTV(8989.51,"B","YSB MBC SELECTION CRITERIA",""))
I PDEF="" D ERRHND("mbc_selection","Parameter not defined") Q
S INSTANCE=1
S YDUZ=YDUZ_";VA(200,"
D EN^XPAR(YDUZ,PDEF,INSTANCE,.JSON,.MSG)
S DATAOUT("mbc_selection",1,"status")="OK"
D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
Q
ILST(JSONOUT,IN) ;
; Save the MBC INSTRUMENT SELECTION LIST
; Measurement Based Care (MBC) widget
N WPARR,II,YDUZ,JSON,CNT,JSFLG,PDEF
N DATAOUT
N FDA,IENS,FDAIEN,MSG
N INSTANCE,STRT,DONE
S CNT=0,YDUZ="",STRT="",DONE=""
S II=0 F S II=$O(IN(II)) Q:II=""!DONE D
. I IN(II)="" S STRT=II,DONE=1
I STRT="" D ERRHND("mbc_instrument_selection","Data not found") Q
;In the IN array the body starts at line 4
S II=3 F S II=$O(IN(II)) Q:II="" D
. S CNT=CNT+1,JSON(CNT)=IN(II)
S YDUZ=$G(DUZ)
S PDEF=$O(^XTV(8989.51,"B","YSB MBC INSTRUMENT SELECTION",""))
I PDEF="" D ERRHND("mbc_instrument_selection","Parameter not defined") Q
S INSTANCE=1
S YDUZ=YDUZ_";VA(200,"
D EN^XPAR(YDUZ,PDEF,INSTANCE,.JSON,.MSG)
S DATAOUT("mbc_instrument_selection",1,"status")="OK"
D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
Q
USRP(JSONOUT,IN) ;
; Save PATIENT Column preference
; Column preference settings
N WPARR,II,YDUZ,JSON,CNT,JSFLG,PDEF
N DATAOUT
N FDA,IENS,FDAIEN,MSG
N INSTANCE
S CNT=0,YDUZ=""
;In the IN array the body starts at line 4
S II=2 F S II=$O(IN(II)) Q:II="" D
. S CNT=CNT+1,JSON(CNT)=IN(II)
S JSON="DASH COL PREF"
S YDUZ=$G(DUZ)
S PDEF=$O(^XTV(8989.51,"B","YSB USER COLUMN PREFERENCE",""))
I PDEF="" D ERRHND("user_preference","Parameter not defined") Q
S INSTANCE=1
S YDUZ=YDUZ_";VA(200,"
D EN^XPAR(YDUZ,PDEF,INSTANCE,.JSON,.MSG)
S DATAOUT("user_preference",1,"status")="OK"
D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
Q
EXTPROP(STR,PROP) ;
; Extract the VALUE from the string based on the PROPerty
N VAL
S VAL=$P(STR,PROP,2)
I $E(VAL)="""" S VAL=$E(VAL,2,$L(VAL))
I $E(VAL,$L(VAL))="""" S VAL=$E(VAL,1,$L(VAL)-1)
Q VAL
ERRHND(TYP,MSG) ;
K DATAOUT
S DATAOUT(TYP,1,"line")=MSG
D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSBPREFS 7667 printed Sep 23, 2025@19:49:33 Page 2
YSBPREFS ;BAL/KTL - MHA DASHBOARD USER PREFERENCES ; Apr 01, 2021@16:33
+1 ;;5.01;MENTAL HEALTH;**202**;Dec 30, 1994;Build 47
+2 ;
+3 ; Routine saves Settings, gets settings for User Preferences
+4 ; in JSON format.
+5 ;
+6 ; Reference to XPAR in ICR #2263
+7 QUIT
+8 ;==============================
+9 ; Get User Preferences
+10 ;
GETHRSEL(JSONOUT,PARMS) ;
+1 ; Given user DUZ and Widget, get the High Risk Patient Selection Criteria
+2 NEW DATAOUT,WPARR,DUZPAR,WDGT,YDUZ,II
+3 KILL JSONOUT
+4 SET WDGT=1
+5 SET YDUZ=$GET(DUZ)
+6 ;For first instance of this parameter. Most likely always 1
if WDGT=""
SET WDGT=1
+7 SET DUZPAR=YDUZ_";VA(200,"
+8 DO GETWP^XPAR(.WPARR,DUZPAR,"YSB HR SELECTION CRITERIA",WDGT)
+9 IF '$DATA(WPARR)
Begin DoDot:1
+10 SET JSONOUT(1)="{}"
End DoDot:1
QUIT
+11 IF $DATA(WPARR)=1
IF (WPARR="")
Begin DoDot:1
+12 SET JSONOUT(1)="{}"
End DoDot:1
QUIT
+13 SET II=""
FOR
SET II=$ORDER(WPARR(II))
if II=""
QUIT
Begin DoDot:1
+14 SET JSONOUT(II)=WPARR(II,0)
End DoDot:1
+15 QUIT
GETMBSEL(JSONOUT) ;
+1 ; Given user DUZ and Widget, get the Measurement Based Care (MBC) Patient Selection Criteria
+2 NEW DATAOUT,WPARR,DUZPAR,WDGT,YDUZ
+3 KILL JSONOUT
+4 SET WDGT=1
+5 SET YDUZ=$GET(DUZ)
+6 ;For first instance of this parameter. Most likely always 1
if WDGT=""
SET WDGT=1
+7 SET DUZPAR=YDUZ_";VA(200,"
+8 DO GETWP^XPAR(.WPARR,DUZPAR,"YSB MBC SELECTION CRITERIA",WDGT)
+9 IF '$DATA(WPARR)
Begin DoDot:1
+10 ;S JSONOUT(1)="{}" ;Need to define Default
+11 DO MBSDFLT(.JSONOUT)
End DoDot:1
QUIT
+12 IF $DATA(WPARR)=1
IF (WPARR="")
Begin DoDot:1
+13 DO MBSDFLT(.JSONOUT)
End DoDot:1
QUIT
+14 SET II=""
FOR
SET II=$ORDER(WPARR(II))
if II=""
QUIT
Begin DoDot:1
+15 SET JSONOUT(II)=WPARR(II,0)
End DoDot:1
+16 QUIT
MBSDFLT(JSONOUT) ;Generate default Selection JSON
+1 NEW LARR,ERRARR,CNT,XCNT
+2 ; Remove default list of all locations in UI, too cumbersome.
+3 ;N DUMDAT
+4 ;S CNT=0
+5 ;D GETLOCS^YSBWHIG2(.DUMDAT,1) ;Call to get standardized MH Locs list
+6 ;S XCNT=0 F S XCNT=$O(DUMDAT("widgets",1,"locationList",XCNT)) Q:XCNT="" D
+7 ;. S CNT=CNT+1
+8 ;. S LARR("data","clinics",CNT,"label")=DUMDAT("widgets",1,"locationList",XCNT,"name")
+9 ;. S LARR("data","clinics",CNT,"value")=DUMDAT("widgets",1,"locationList",XCNT,"id")
+10 SET LARR("data","date","label")="past year"
+11 SET LARR("data","date","value")="-365"
+12 SET LARR("data","sessionId")=""
+13 DO ENCODE^YSBJSON("LARR","JSONOUT","ERRARR")
+14 QUIT
GETILST(JSONOUT,PARMS) ;
+1 ; Given user DUZ and Widget, get the Measurement Based Care (MBC) Patient Selection Criteria
+2 NEW DATAOUT,WPARR,DUZPAR,WDGT,YDUZ
+3 KILL JSONOUT
+4 SET WDGT=""
+5 SET YDUZ=$GET(DUZ)
+6 ;For first instance of this parameter. Most likely always 1
if WDGT=""
SET WDGT=1
+7 SET DUZPAR=YDUZ_";VA(200,"
+8 DO GETWP^XPAR(.WPARR,DUZPAR,"YSB MBC INSTRUMENT SELECTION",WDGT)
+9 IF '$DATA(WPARR)
Begin DoDot:1
+10 ;Need to define Default
SET JSONOUT(1)="{}"
+11 ;D MBCIDFLT(.JSONOUT)
End DoDot:1
QUIT
+12 IF ($DATA(WPARR)=1)
IF (WPARR="")
Begin DoDot:1
+13 ;Need to define Default
SET JSONOUT(1)="{}"
+14 ;D MBCIDFLT(.JSONOUT)
End DoDot:1
QUIT
+15 SET II=""
FOR
SET II=$ORDER(WPARR(II))
if II=""
QUIT
Begin DoDot:1
+16 SET JSONOUT(II)=WPARR(II,0)
End DoDot:1
+17 QUIT
MBCIDFLT(JSONOUT) ;Generate Default MBC Instrument List
+1 QUIT
GETUSRP(JSONOUT) ;
+1 ; Given user DUZ and Widget, get the Patient Selection Criteria
+2 NEW DATAOUT,WPARR,DUZPAR,WDGT,YDUZ
+3 ;S YDUZ=$P(PARMS,"/"),WDGT=$P(PARMS,"/",2)
+4 KILL JSONOUT
+5 SET WDGT=""
+6 SET YDUZ=$GET(DUZ)
+7 ;For first instance of this parameter. Most likely always 1
if WDGT=""
SET WDGT=1
+8 SET DUZPAR=YDUZ_";VA(200,"
+9 DO GETWP^XPAR(.WPARR,DUZPAR,"YSB USER COLUMN PREFERENCE",WDGT)
+10 IF '$DATA(WPARR)
Begin DoDot:1
+11 DO DFLTUP(.JSONOUT)
End DoDot:1
QUIT
+12 IF ($DATA(WPARR)=1)
IF (WPARR="")
Begin DoDot:1
+13 DO DFLTUP(.JSONOUT)
End DoDot:1
QUIT
+14 SET II=""
FOR
SET II=$ORDER(WPARR(II))
if II=""
QUIT
Begin DoDot:1
+15 SET JSONOUT(II)=WPARR(II,0)
End DoDot:1
+16 QUIT
WEBGUSRP(ARGS,RESULTS) ;MHA Web call to get User Preferences
+1 NEW JSONOUT
+2 DO GETUSRP(.JSONOUT)
+3 DO TOTMP^YSBRPC(.JSONOUT)
+4 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+5 QUIT
DFLTUP(XJSON) ;
+1 ; Get the Default columns to display if there are no set User Preferences
+2 NEW II,XDATA,XNAM,XJ,SPC,XCNT,XTABC
+3 SET $PIECE(SPC," ",10)=""
+4 SET XCNT=1
SET XTABC=1
SET XJSON(XCNT)="{"
+5 DO GETWDGT^YSBRPC(.XDATA)
+6 SET II=0
FOR
SET II=$ORDER(XDATA("widgets",II))
if +II=0
QUIT
Begin DoDot:1
+7 SET XNAM=$GET(XDATA("widgets",II,"name"))
+8 SET XNAM=$SELECT(XNAM="HIGH RISK":"highRisk",XNAM="MBC":"measurementBased",1:XNAM)
+9 ;Don't include instrument list for now
KILL XDATA("widgets",II,"instrumentList")
+10 KILL XDATA("widgets",II,"name")
+11 MERGE XJ(XNAM)=XDATA("widgets",II)
+12 SET XJ(XNAM,"display")="true"
+13 SET XJ(XNAM,"filterList","name")="name"
+14 SET XJ(XNAM,"filterList","value")=""
End DoDot:1
+15 DO ENCODE^YSBJSON("XJ","XJSON","ERRARY")
+16 QUIT
+17 ;=============================================
+18 ;Set User Preferences
+19 ;
HRWSEL(JSONOUT,IN) ;
+1 ; Save PATIENT SELECTION CRITERIA
+2 ; High Risk Widget
+3 ;Not used yet
QUIT
+4 NEW WPARR,II,YDUZ,JSON,CNT,JSFLG,PDEF
+5 NEW DATAOUT
+6 NEW FDA,IENS,FDAIEN,MSG
+7 NEW INSTANCE
+8 SET CNT=0
SET YDUZ=""
+9 ;In the IN array the body starts at line 4
+10 SET II=3
FOR
SET II=$ORDER(IN(II))
if II=""
QUIT
Begin DoDot:1
+11 SET CNT=CNT+1
SET JSON(CNT)=IN(II)
+12 ;I IN(II)["userId" S YDUZ=$$EXTPROP(STR,"""userId"":")
End DoDot:1
+13 SET YDUZ=$GET(DUZ)
+14 SET PDEF=$ORDER(^XTV(8989.51,"B","YSB HR SELECTION CRITERIA",""))
+15 IF PDEF=""
DO ERRHND("high_risk_selection","Parameter not defined")
QUIT
+16 SET INSTANCE=1
+17 SET YDUZ=YDUZ_";VA(200,"
+18 DO EN^XPAR(YDUZ,PDEF,INSTANCE,.JSON,.MSG)
+19 SET DATAOUT("high_risk_selection",1,"status")="OK"
+20 DO ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
+21 QUIT
MBCWSEL(JSONOUT,IN) ;
+1 ; Save PATIENT SELECTION CRITERIA
+2 ; Measurement Based Care (MBC) widget
+3 NEW WPARR,II,YDUZ,JSON,CNT,JSFLG,PDEF
+4 NEW DATAOUT
+5 NEW FDA,IENS,FDAIEN,MSG
+6 NEW INSTANCE,STRT,DONE
+7 SET STRT=""
SET DONE=""
+8 SET II=0
FOR
SET II=$ORDER(IN(II))
if II=""!DONE
QUIT
Begin DoDot:1
+9 IF IN(II)=""
SET STRT=II
SET DONE=1
End DoDot:1
+10 IF STRT=""
DO ERRHND("mbc_selection","Data not found")
QUIT
+11 SET CNT=0
SET YDUZ=""
+12 ;In the IN array the body starts at line 4
+13 SET II=STRT
FOR
SET II=$ORDER(IN(II))
if II=""
QUIT
Begin DoDot:1
+14 SET CNT=CNT+1
SET JSON(CNT)=IN(II)
End DoDot:1
+15 SET YDUZ=$GET(DUZ)
+16 SET PDEF=$ORDER(^XTV(8989.51,"B","YSB MBC SELECTION CRITERIA",""))
+17 IF PDEF=""
DO ERRHND("mbc_selection","Parameter not defined")
QUIT
+18 SET INSTANCE=1
+19 SET YDUZ=YDUZ_";VA(200,"
+20 DO EN^XPAR(YDUZ,PDEF,INSTANCE,.JSON,.MSG)
+21 SET DATAOUT("mbc_selection",1,"status")="OK"
+22 DO ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
+23 QUIT
ILST(JSONOUT,IN) ;
+1 ; Save the MBC INSTRUMENT SELECTION LIST
+2 ; Measurement Based Care (MBC) widget
+3 NEW WPARR,II,YDUZ,JSON,CNT,JSFLG,PDEF
+4 NEW DATAOUT
+5 NEW FDA,IENS,FDAIEN,MSG
+6 NEW INSTANCE,STRT,DONE
+7 SET CNT=0
SET YDUZ=""
SET STRT=""
SET DONE=""
+8 SET II=0
FOR
SET II=$ORDER(IN(II))
if II=""!DONE
QUIT
Begin DoDot:1
+9 IF IN(II)=""
SET STRT=II
SET DONE=1
End DoDot:1
+10 IF STRT=""
DO ERRHND("mbc_instrument_selection","Data not found")
QUIT
+11 ;In the IN array the body starts at line 4
+12 SET II=3
FOR
SET II=$ORDER(IN(II))
if II=""
QUIT
Begin DoDot:1
+13 SET CNT=CNT+1
SET JSON(CNT)=IN(II)
End DoDot:1
+14 SET YDUZ=$GET(DUZ)
+15 SET PDEF=$ORDER(^XTV(8989.51,"B","YSB MBC INSTRUMENT SELECTION",""))
+16 IF PDEF=""
DO ERRHND("mbc_instrument_selection","Parameter not defined")
QUIT
+17 SET INSTANCE=1
+18 SET YDUZ=YDUZ_";VA(200,"
+19 DO EN^XPAR(YDUZ,PDEF,INSTANCE,.JSON,.MSG)
+20 SET DATAOUT("mbc_instrument_selection",1,"status")="OK"
+21 DO ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
+22 QUIT
USRP(JSONOUT,IN) ;
+1 ; Save PATIENT Column preference
+2 ; Column preference settings
+3 NEW WPARR,II,YDUZ,JSON,CNT,JSFLG,PDEF
+4 NEW DATAOUT
+5 NEW FDA,IENS,FDAIEN,MSG
+6 NEW INSTANCE
+7 SET CNT=0
SET YDUZ=""
+8 ;In the IN array the body starts at line 4
+9 SET II=2
FOR
SET II=$ORDER(IN(II))
if II=""
QUIT
Begin DoDot:1
+10 SET CNT=CNT+1
SET JSON(CNT)=IN(II)
End DoDot:1
+11 SET JSON="DASH COL PREF"
+12 SET YDUZ=$GET(DUZ)
+13 SET PDEF=$ORDER(^XTV(8989.51,"B","YSB USER COLUMN PREFERENCE",""))
+14 IF PDEF=""
DO ERRHND("user_preference","Parameter not defined")
QUIT
+15 SET INSTANCE=1
+16 SET YDUZ=YDUZ_";VA(200,"
+17 DO EN^XPAR(YDUZ,PDEF,INSTANCE,.JSON,.MSG)
+18 SET DATAOUT("user_preference",1,"status")="OK"
+19 DO ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
+20 QUIT
EXTPROP(STR,PROP) ;
+1 ; Extract the VALUE from the string based on the PROPerty
+2 NEW VAL
+3 SET VAL=$PIECE(STR,PROP,2)
+4 IF $EXTRACT(VAL)=""""
SET VAL=$EXTRACT(VAL,2,$LENGTH(VAL))
+5 IF $EXTRACT(VAL,$LENGTH(VAL))=""""
SET VAL=$EXTRACT(VAL,1,$LENGTH(VAL)-1)
+6 QUIT VAL
ERRHND(TYP,MSG) ;
+1 KILL DATAOUT
+2 SET DATAOUT(TYP,1,"line")=MSG
+3 DO ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
+4 QUIT
