YTQRQAD7 ;BAL/KTL - RESTful Calls to handle MHA Web RPCs ; 7/19/2021
;;5.01;MENTAL HEALTH;**181,187,202,204**;Dec 30, 1994;Build 18
;
; Reference to EN^XPAR in ICR #2263
; Reference to ORQQCN in ICR #1671
; Reference to XLFJSON in ICR #6682
; Reference to TIU in ICR #7179
;
;User Preferences
;Instrument Admin COMMENT retrieval
Q
RBAC(ARGS,RESULTS) ;Get user Role properties
N MHTITL
S MHTITL=$$TITLE()
Q
IACTV(INAM) ; Return 1 if Instrument Active, 0 otherwise
N IEN,STAT,OP
S STAT=0
S IEN=$O(^YTT(601.71,"B",INAM,"")) I +IEN=0 Q STAT
S OP=$P($G(^YTT(601.71,IEN,2)),U,2) I OP="Y" S STAT=1
Q STAT
GETASMTP(ARGS,RESULTS) ; Given user DUZ get last Assignment Preferences
N YSWPARR
K ^TMP("YTQ-JSON",$J)
D GETPARAM("YS MHA_WEB LAST ASSIGN SET","{}",.YSWPARR)
M ^TMP("YTQ-JSON",$J)=YSWPARR
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
SETASMTP(ARGS,DATA) ; Set a User's last Assignment Preferences
; Requires HTTPREQ
N YSRET
S YSRET=$$SETPARAM("YS MHA_WEB LAST ASSIGN SET","/api/mha/assignmentparam/pref/",.HTTPREQ,,"LAST ASSIGNMENT")
Q YSRET
GETIFAV(ARGS,RESULTS) ; Given user DUZ get Instrument Favorites
N YSWPARR,INSTARR,TMPARR,I,INSTN,CHGF,DFLT
K ^TMP("YTQ-JSON",$J)
S DFLT="{""favlist"":[]}"
D GETPARAM("YS MHA_WEB FAV INST",DFLT,.YSWPARR)
I $G(YSWPARR(1,0))'["[]" D ;Was not the default empty list
. D CHKPRMI(.YSWPARR,DFLT,.CHGF)
M ^TMP("YTQ-JSON",$J)=YSWPARR
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
I $G(CHGF)=1 D RSTPARAM("YS MHA_WEB FAV INST","/api/mha/instrument/lists/fav/userfav/",.YSWPARR,,"INST FAVS")
Q
SETIFAV(ARGS,DATA) ; Set Instrument Favorites
; Requires HTTPREQ
N YSRET
N I,YSWPARR,CHGF,CNT,DFLT
S DFLT="{""favlist"":[]}"
S CNT=0,I=2 F S I=$O(HTTPREQ(I)) Q:+I=0 D
. S CNT=CNT+1,YSWPARR(CNT,0)=HTTPREQ(I)
D CHKPRMI(.YSWPARR,DFLT,.CHGF)
I $G(CHGF)=1 D
. K HTTPREQ
. S CNT=2,I=0 F S I=$O(YSWPARR(I)) Q:+I=0 D
.. S CNT=CNT+1,HTTPREQ(CNT)=YSWPARR(I,0)
S YSRET=$$SETPARAM("YS MHA_WEB FAV INST","/api/mha/instrument/lists/fav/userfav/",.HTTPREQ,,"INST FAVS")
Q YSRET
GETGRAPH(ARGS,RESULTS) ; Get Graphing Preferences
N YSWPARR
K ^TMP("YTQ-JSON",$J)
D GETPARAM("YS MHA_WEB GRAPH PREFS","{""graphprefs"":[]}",.YSWPARR)
M ^TMP("YTQ-JSON",$J)=YSWPARR
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
SETGRAPH(ARGS,DATA) ; Set a User's Graphing Preferences
; Requires HTTPREQ
N YSRET
S YSRET=$$SETPARAM("YS MHA_WEB GRAPH PREFS","/api/mha/instrumentgraph/prefs/",.HTTPREQ,,"GRAPH PREF")
Q YSRET
GETSPCLG(ARGS,RESULTS) ; Get Special Report Graph Report Preferences
N YSWPARR,INSTARR,TMPARR,I,INSTN,CHGF,DFLT
K ^TMP("YTQ-JSON",$J)
S DFLT="{""spclgraphprefs"":[]}"
D GETPARAM("YS MHA_WEB SPECIAL GRAPH RPT",DFLT,.YSWPARR)
I $G(YSWPARR(1,0))'["[]" D ;Was not the default empty list
. D CHKPRMI(.YSWPARR,DFLT,.CHGF)
M ^TMP("YTQ-JSON",$J)=YSWPARR
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
I $G(CHGF)=1 D RSTPARAM("YS MHA_WEB SPECIAL GRAPH RPT","/api/mha/specialgraph/rptpref/",.YSWPARR,,"SPCL RPT")
Q
SETSPCLG(ARGS,DATA) ; Set Special Report Graph Report Preferences
; Requires HTTPREQ
N YSRET
N I,YSWPARR,CHGF,CNT,DFLT
S DFLT="{""spclgraphprefs"":[]}"
S CNT=0,I=2 F S I=$O(HTTPREQ(I)) Q:+I=0 D
. S CNT=CNT+1,YSWPARR(CNT,0)=HTTPREQ(I)
D CHKPRMI(.YSWPARR,DFLT,.CHGF)
I $G(CHGF)=1 D
. K HTTPREQ
. S CNT=2,I=0 F S I=$O(YSWPARR(I)) Q:+I=0 D
.. S CNT=CNT+1,HTTPREQ(CNT)=YSWPARR(I,0)
S YSRET=$$SETPARAM("YS MHA_WEB SPECIAL GRAPH RPT","/api/mha/specialgraph/rptpref/",.HTTPREQ,,"SPCL RPT")
Q YSRET
GETRPT(ARGS,RESULTS) ; Get Report view Preferences
N YSWPARR
K ^TMP("YTQ-JSON",$J)
D GETPARAM("YS MHA_WEB REPORT PREFS","{""reportprefs"":[]}",.YSWPARR)
M ^TMP("YTQ-JSON",$J)=YSWPARR
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
SETRPT(ARGS,DATA) ; Set Report view Preferences
; Requires HTTPREQ
N YSRET
S YSRET=$$SETPARAM("YS MHA_WEB REPORT PREFS","/api/mha/reports/rptpref/",.HTTPREQ,,"RPT PREFS")
Q YSRET
GETNP(ARGS,RESULTS) ; Given user DUZ get Report Save Progress Note preference
N YSWPARR
K ^TMP("YTQ-JSON",$J)
D GETPARAM("YS MHA_WEB PROG NOTE PREFS","{""noteprefs"":[]}",.YSWPARR)
M ^TMP("YTQ-JSON",$J)=YSWPARR
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
SETNP(ARGS,DATA) ; Set Save Progress Note preference
; Requires HTTPREQ
N YSRET
S YSRET=$$SETPARAM("YS MHA_WEB PROG NOTE PREFS","/api/mha/notes/noteprefs/",.HTTPREQ,,"PROG NOTE PREF")
Q YSRET
WEBGUSRP(ARGS,RESULTS) ;Get Dashboard User Column Preferences
N YSWPARR,JSONOUT
K ^TMP("YTQ-JSON",$J)
D GETPARAM("YSB USER COLUMN PREFERENCE","",.YSWPARR)
I $G(YSWPARR(1,0))="" D
. K YSWPARR D DFLTUP(JSONOUT)
. D TOTMP^YSBRPC(.JSONOUT)
I $D(YSWPARR) M ^TMP("YTQ-JSON",$J)=YSWPARR
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
WEBPUSRP(ARGS,DATA) ; Set Dashboard Column Preferences
; Requires HTTPREQ
N YSRET
S YSRET=$$SETPARAM("YSB USER COLUMN PREFERENCE","/api/mha/dashboard/userpref/",.HTTPREQ,,"DASH COLS")
Q YSRET
DFLTUP(XJSON) ;
; Get the Default columns to display if 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
SETPARAM(YSPNAM,RETURL,HTTPREQ,YSWDGT,YSVAL) ;Set Parameter
; Assignment Parameters=YS MHA_WEB LAST ASSIGN SET
; Favorite Instruments=YS MHA_WEB FAV INST
; Batteries=YS MHA_WEB BATTERIES
; Requires HTTPREQ
; Return Success or Failure URL string
N II,CNT,YSDUZ
N FDA,IENS,FDAIEN,YSMSG,YSJSON
;I '$D(HTTPREQ) Q RETURL_"NODATA"
S CNT=0
;In the DATA array the body starts after the first line
S II=2 F S II=$O(HTTPREQ(II)) Q:II="" D
. Q:$TR(HTTPREQ(II)," ")=""
. S CNT=CNT+1,YSJSON(CNT)=HTTPREQ(II)
S YSJSON=$G(YSVAL)
I '$D(HTTPREQ) S YSJSON="@"
S:+$G(YSWDGT)=0 YSWDGT=1
S YSDUZ=DUZ_";VA(200,"
D EN^XPAR(YSDUZ,YSPNAM,YSWDGT,.YSJSON,.YSMSG)
I +YSMSG'=0 D SETERROR^YTQRUTL(404,"PARAMETER not found: "_YSPNAM) Q RETURL_"ERROR: "_$P(YSMSG,U,2)
Q RETURL_"OK"
GETPARAM(YSPNAM,DFLT,YSWPARR,YSWDGT) ;Get Parameter
N YSDUZ
K JSONOUT
S:$G(YSWDGT)="" YSWDGT=1 ;Parameter instance-default to 1
S YSDUZ=DUZ_";VA(200,"
D GETWP^XPAR(.YSWPARR,YSDUZ,YSPNAM,YSWDGT)
I '$D(YSWPARR) D
. S YSWPARR(1,0)=DFLT ;Need to define Default
I $D(YSWPARR)=1,($G(YSWPARR)="") D ;Parameter for User exists but it is empty
. S YSWPARR(1,0)=DFLT ;Need to define Default
Q
RSTPARAM(YSPNAM,RETURL,YSWPARR,YSWDGT,YSVAL) ;Rest Parameter
; This is used when during a GET Parameter an instrument is found to be inactive and the JSON
; payload is changed to remove the instrument. The parameter has to be reset with the new instrument list
; The JSON Array has to be set up in the format of HTTPREQ and there does not need to be any return value
N HTTPREQ,I,NORET
Q:$G(YSPNAM)=""
Q:'$D(YSWPARR)
S RETURL=$G(RETURL),YSWDGT=$G(YSWDGT),YSVAL=$G(YSVAL)
S I=0 F S I=$O(YSWPARR(I)) Q:+I=0 D
. S HTTPREQ(I+2)=YSWPARR(I,0) ;I+2 because the first line is the URL and the second line is blnk in HTTPREQ normally
S NORET=$$SETPARAM(YSPNAM,RETURL,.HTTPREQ,YSWDGT,YSVAL) ;Set Parameter
Q
GETBAT(ARGS,RESULTS) ; Given user DUZ get Instrument Batteries
N YSWPARR,INSTARR,TMPARR,I,INSTN,CHGF,DFLT
K ^TMP("YTQ-JSON",$J)
S DFLT="{""batteries"":[]}"
D GETPARAM("YS MHA_WEB BATTERIES",DFLT,.YSWPARR)
I $G(YSWPARR(1,0))'["[]" D ;Was not the default empty list
. D CHKPRMI(.YSWPARR,DFLT,.CHGF)
M ^TMP("YTQ-JSON",$J)=YSWPARR
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
I $G(CHGF)=1 D RSTPARAM("YS MHA_WEB BATTERIES","/api/mha/instrument/lists/batteries/userbat/",.YSWPARR,,"BATTERIES")
Q
SETBAT(ARGS,DATA) ; Set a User's Instrument Batteries
; Requires HTTPREQ
N YSRET
N I,YSWPARR,CHGF,CNT,DFLT
S DFLT="{""batteries"":[]}"
S CNT=0,I=2 F S I=$O(HTTPREQ(I)) Q:+I=0 D
. S CNT=CNT+1,YSWPARR(CNT,0)=HTTPREQ(I)
D CHKPRMI(.YSWPARR,DFLT,.CHGF)
I $G(CHGF)=1 D
. K HTTPREQ
. S CNT=2,I=0 F S I=$O(YSWPARR(I)) Q:+I=0 D
.. S CNT=CNT+1,HTTPREQ(CNT)=YSWPARR(I,0)
S YSRET=$$SETPARAM("YS MHA_WEB BATTERIES","/api/mha/instrument/lists/batteries/userbat/",.HTTPREQ,,"BATTERIES")
Q YSRET
CHKPRMI(YSWPARR,DFLT,CHGF) ;Check Parameter instrument list for inactive instruments
; Currently for "batteries" and "favlist"
; Input=array of JSON
; Output=array of JSON with inactive instruments removed and CHGF=1 if array has changed
; Both input array and CHGF passed by reference
N INSTARR,TMPARR,I,J,INSTN,ISTAT,ERR
D J2ARR(.YSWPARR,.TMPARR)
D DECODE^XLFJSON("TMPARR","INSTARR","ERR")
S CHGF=0
I '$D(ERR),(DFLT["batteries") D
. S J=0 F S J=$O(INSTARR("batteries",J)) Q:+J=0 D
.. S I=0 F S I=$O(INSTARR("batteries",J,"instruments",I)) Q:+I=0 D
... S INSTN=INSTARR("batteries",J,"instruments",I)
... S ISTAT=$$IACTV(INSTN)
... I +ISTAT=0 K INSTARR("batteries",J,"instruments",I) S CHGF=1 ;Instrument no longer active
... I '$D(INSTARR("batteries",J,"instruments")) K INSTARR("batteries",J) ;No instruments in battery
I '$D(ERR),(DFLT["favlist") D
. S I=0 F S I=$O(INSTARR("favlist",I)) Q:+I=0 D
.. S INSTN=$G(INSTARR("favlist",I,"instrumentName")) Q:INSTN=""
.. S ISTAT=$$IACTV(INSTN)
.. I +ISTAT=0 K INSTARR("favlist",I) S CHGF=1 ;Instrument no longer active
I '$D(ERR),(DFLT["spclgraphprefs") D
. S I=0 F S I=$O(INSTARR("selectedInstruments",I)) Q:+I=0 D
.. S INSTN=INSTARR("selectedInstruments",I) Q:INSTN=""
.. S ISTAT=$$IACTV(INSTN)
.. I +ISTAT=0 K INSTARR("selectedInstruments",I) S CHGF=1 ;Instrument no longer active
K YSWPARR,TMPARR
I '$D(INSTARR) S YSWPARR(1,0)=DFLT Q ;No batteries left
D ENCODE^XLFJSON("INSTARR","TMPARR","ERR")
I '$D(ERR) D
. S I=0 F S I=$O(TMPARR(I)) Q:+I=0 D
.. S YSWPARR(I,0)=TMPARR(I)
Q
LOADCOM(ARGS,RESULTS) ;Get Comments for an Instrument Admin and load them for display
N YSADMIN,YSARR,I,CRLF
S CRLF=$C(10)
S YSADMIN=$G(ARGS("adminId"))
I '$D(^YTT(601.84,YSADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_YSADMIN) QUIT
D GETCOM^YTQRQAD3(.YSARR,YSADMIN)
I '$D(YSARR) S RESULTS("text","\",1)="" Q
S I="" F S I=$O(YSARR(I)) Q:I="" D
. S RESULTS("text","\",I)=YSARR(I)_CRLF
Q
AINSTS(SETID,IARR) ; Assignment Instrument Status check for Deletion
; Pre-validated Assignment ID passed in
; Return IARR by Assignment Instrument Index (e.g. IARR(instnum)=0)
; 0=Complete
; 1=Incomplete
; 2=Not allowed
; Return IARR(instnum,"ADMINID")=MH ADMINISTRATION IEN for reference
; Overall Delete SETID status
; IARR("STAT")="OK","NOTOK","NOTALLOWED"
N ASSGN,INST,ISCMPLT,AOK,MGR,YSADMIN,X0
S MGR=$$ISMGR^YTQRQAD1()
S ASSGN="YTQASMT-SET-"_SETID,IARR("STAT")="OK"
S INST=0 F S INST=$O(^XTMP(ASSGN,1,"instruments",INST)) Q:+INST=0 D
. S YSADMIN=$G(^XTMP(ASSGN,1,"instruments",INST,"adminId"))
. I +YSADMIN=0 S IARR(INST)=1 Q
. S IARR(INST,"ADMINID")=YSADMIN
. S X0=$G(^YTT(601.84,YSADMIN,0)) I X0="" S IARR(INST)=1 Q
. S ISCMPLT=$P(X0,U,9)
. I ISCMPLT="Y" S IARR(INST)=0,IARR("STAT")="NOTOK" Q
. I MGR!(DUZ=$P(X0,U,6))!(DUZ=$P(X0,U,7)) S IARR(INST)=1 I 1
. E S IARR(INST)=2,IARR("STAT")="NOTALLOWED"
Q
GETCONS(ARGS,RESULTS) ; Get list of patient consults
N TYPE,RV,CONS,DT,STAT,LOC,TYPE,LOCA,YSSTAT,HIT,NOCONS,DFN,IEN
S YSSTAT="5,6,8,9,15" ;Pending, Active, Scheduled, Partial Results, Renewed
K ^TMP("ORQQCN",$J)
S DFN=+$G(ARGS("dfn")) D LIST^ORQQCN(.RV,DFN,,,,YSSTAT) ;DBIA 1671 ORQQCN LIST
K ^TMP("YTQ-JSON",$J) S CNT=0
D SETRES("{""consults"":[")
S HIT="",NOCONS=""
S IEN=0 F S IEN=$O(^TMP("ORQQCN",$J,"CS",IEN)) Q:'IEN!NOCONS D
.S DATA=^TMP("ORQQCN",$J,"CS",IEN,0)
.I DATA["PATIENT DOES NOT HAVE ANY" S NOCONS=1 Q
.S HIT=1
.S CONS=$P(DATA,U,1)
.S DT=$P(DATA,U,2)
.S STAT=$P(DATA,U,3)
.S LOC=$P(DATA,U,4)
.S TYPE=$P(DATA,U,5)
.S LOCA=$P(DATA,U,6)
.S STR="{""Consult"":"""_CONS_""", ""ConsultDate"":"""_$$FMTE^XLFDT($P(DT,"."))_""", ""Status"":"""_STAT_""", ""Clinic"":"""_LOC_""",""Type"":"""_TYPE_"""},"
.D SETRES(STR)
I HIT S STR=^TMP("YTQ-JSON",$J,CNT,0),STR=$E(STR,1,$L(STR)-1),^TMP("YTQ-JSON",$J,CNT,0)=STR ;Remove last trailing ","
D SETRES("]}")
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
GETCONS2(ARGS,RESULTS) ; Get list of patient consults
N TYPE,RV,CONS,DT,STAT,LOC,TYPE,LOCA,YSSTAT,HIT,NOCONS,DFN,IEN,YSARR,CNT,RESULTS
S YSSTAT="5,6,8,9,15" ;Pending, Active, Scheduled, Partial Results, Renewed
K ^TMP("ORQQCN",$J)
S DFN=+$G(ARGS("dfn")) D LIST^ORQQCN(.RV,DFN,,,,YSSTAT) ;DBIA 1671 ORQQCN LIST
K ^TMP("YTQ-JSON",$J) S CNT=0
S HIT="",NOCONS=""
S IEN=0 F S IEN=$O(^TMP("ORQQCN",$J,"CS",IEN)) Q:'IEN!NOCONS D
.S DATA=^TMP("ORQQCN",$J,"CS",IEN,0)
.I DATA["PATIENT DOES NOT HAVE ANY" S NOCONS=1 Q
.S HIT=1
.S CONS=$P(DATA,U,1)
.S DT=$P(DATA,U,2)
.S STAT=$P(DATA,U,3)
.S LOC=$P(DATA,U,4)
.S TYPE=$P(DATA,U,5)
.S LOCA=$P(DATA,U,6)
.S CNT=CNT+1,RESULTS("consults",CNT,"Consult")=CONS,RESULTS("consults",CNT,"ConsultDate")=$$FMTE^XLFDT($P(DT,".")),RESULTS("consults",CNT,"Status")=STAT
.S RESULTS("consults",CNT,"Clinic")=LOC,RESULTS("consults",CNT,"Type")=TYPE
D ENCODE^XLFJSON("RESULTS","YSARR")
S II=0 F S II=$O(YSARR(II)) Q:II="" D
. S ^TMP("YTQ-JSON",$J,II,0)=YSARR(II)
K RESULTS
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
;
ASMTSTAF(ARGS,RESULTS) ; get assignment identified by assignmentId
N ASMT,INTE,ORBY,LOCA,INTV,ORDBY,LOC,CON,DAT,CONTX,CONA,ADMINDT,IEN,DFN
N YSARR,II,DATA
S ASMT="YTQASMT-SET-"_$G(ARGS("assignmentId"))
I '$D(^XTMP(ASMT)) D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("assignmentId")) QUIT
M DATA=^XTMP("YTQASMT-SET-"_$G(ARGS("assignmentId")))
S INTE=$G(DATA(1,"interview"))
S ORBY=$G(DATA(1,"orderedBy"))
S LOCA=$G(DATA(1,"location"))
S CONA=$G(DATA(1,"consult"))
S DFN=$G(DATA(1,"patient","dfn"))
;Now XLAT pointers to JSON data var_"Name"
S INTV=$P($G(^VA(200,INTE,0)),U,1)
S ORDBY=$P($G(^VA(200,ORBY,0)),U,1)
S LOC=$P($G(^SC(LOCA,0)),U,1)
S ADMINDT=$G(DATA(1,"adminDate"))
S RESULTS("interviewName")=INTV
S RESULTS("orderedbyName")=ORDBY
S RESULTS("locationName")=LOC
S RESULTS("adminDate")=ADMINDT
S RESULTS("consultName")="" ;initialize consultName
D LIST^ORQQCN(.RV,DFN)
S IEN="" F S IEN=$O(^TMP("ORQQCN",$J,"CS",IEN)) Q:'IEN D
.S DAT=^TMP("ORQQCN",$J,"CS",IEN,0)
.S CON=$P(DAT,U,1) Q:CON'=CONA D I CON=CONA S CONTX=$P(DAT,U,7)
.S RESULTS("consultName")=CONTX
M RESULTS=^XTMP(ASMT,1)
K ^TMP("YTQ-JSON",$J)
D ENCODE^XLFJSON("RESULTS","YSARR")
S II=0 F S II=$O(YSARR(II)) Q:II="" D
. S ^TMP("YTQ-JSON",$J,II,0)=YSARR(II)
K RESULTS
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
;
SETRES(STR) ;
S CNT=CNT+1,^TMP("YTQ-JSON",$J,CNT,0)=STR
Q
;
GLIST(YSPAR,YSENT,YSLIST) ;Get the number of values for a particular parameter
D GETLST^XPAR(.YSLIST,YSENT,YSPAR)
Q
SRLST(SRARR) ;Special Reports Parameters List
; Find all instances of Special Reports and decode from JSON into array
N YSLIST,YSDUZ,YSPAR,I,JARR,ERR,TMPAR,II
S YSPAR="YS MHA_WEB SPECIAL GRAPH RPT"
S YSDUZ=DUZ_";VA(200,"
D GETLST^XPAR(.YSLIST,YSDUZ,YSPAR)
Q:+$G(YSLIST)=0
F I=1:1:YSLIST D
. D GETPARAM("YS MHA_WEB SPECIAL GRAPH RPT","{""spclgraphprefs"":[]}",.YSWPARR,I)
. K JARR,TMPAR
. S II=0 F S II=$O(YSWPARR(II)) Q:II="" D
.. S TMPAR(II)=YSWPARR(II,0)
. D DECODE^XLFJSON("TMPAR","JARR","ERR")
. I '$D(ERR) M SRARR(I)=JARR
Q
GETSRLST(ARGS,RESULTS) ;Get Special Reports Parameter(s)
N II,SRARR,YSARR,CNT,TMPAR
D SRLST(.SRARR)
S CNT=0
S II=0 F S II=$O(SRARR(II)) Q:II="" D
. S CNT=CNT+1
. M TMPAR("specialReports",CNT)=SRARR(II,"specialReports",1)
K ^TMP("YTQ-JSON",$J)
D ENCODE^XLFJSON("TMPAR","YSARR")
S II=0 F S II=$O(YSARR(II)) Q:II="" D
. S ^TMP("YTQ-JSON",$J,II,0)=YSARR(II)
K RESULTS
S RESULTS=$NA(^TMP("YTQ-JSON",$J))
Q
SAVSRLST(ARGS,RESULTS) ;Save Special Reports Parameter
N HTTPOBJ,II,CNT,YSJSON,JARR,ERR,INNAM,SRARR,MATCH,SRNAM
S CNT=0
S II=2 F S II=$O(HTTPREQ(II)) Q:II="" D
. Q:$TR(HTTPREQ(II)," ")=""
. S CNT=CNT+1,HTTPOBJ(CNT)=HTTPREQ(II)
D DECODE^XLFJSON("HTTPOBJ","JARR","ERR")
S INNAM=$G(JARR("specialReports",1,"name"))
I INNAM="" D SETERROR^YTQRUTL(404,"Special Report Name not sent") Q "/api/mha/specialgraph/rptpref/ERROR: Name not sent"
D SRLST(.SRARR)
S MATCH=""
S II=0 F S II=$O(SRARR(II)) Q:II="" D
. S SRNAM=$G(SRARR(II,"specialReports",1,"name"))
. I SRNAM=INNAM S MATCH=II
I MATCH="" S MATCH=$O(SRARR(""),-1)+1 ;No match, so new parameter. Find last instance and add one.
S YSRET=$$SETPARAM("YS MHA_WEB SPECIAL GRAPH RPT","/api/mha/specialgraph/rptpref/",.HTTPREQ,MATCH,"SPCL RPT")
Q YSRET
J2ARR(JARR,OUTARR) ;Move XLFJSON array contents to OUTARR
N I
S I=0 F S I=$O(JARR(I)) Q:+I=0 D
. S OUTARR(I)=JARR(I,0)
Q
TITLE() ; Get MENTAL HEALTH DIAGNOSTIC STUDY NOTE title
;
N TITL,ERR,RET
S ERR=""
D GETLOCT(.TITL,.ERR)
S RET=$G(TITL("MHA"))
Q RET
;
GETLOCT(TITL,ERR) ; Get the Local Title IENs
;
N CSRE,MHPRNT,PNCLS,NATTIT,MHA,MHAC,FDA,FDAIEN,TIUFPRIV
S TIUFPRIV=1
S MHA=$$CHKTIU("MENTAL HEALTH DIAGNOSTIC STUDY NOTE","DOC")
S MHAC=$$CHKTIU("MENTAL HEALTH CONSULT NOTE","DOC")
S TITL("MHA")=MHA
S TITL("MHAC")=MHAC
Q
;
CHKTIU(NAME,CLS) ;
N TIEN,SCR,MSG
S SCR="I $P(^(0),U,4)="""_CLS_""""
S TIEN=$$FIND1^DIC(8925.1,"","",NAME,"",SCR,"MSG")
Q TIEN
CHKTITLE(FILE,NAME) ;
N DIC,X,Y
S DIC=FILE,DIC(0)="X"
S X=NAME
D ^DIC
Q +Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQRQAD7 17892 printed Nov 22, 2024@17:29 Page 2
YTQRQAD7 ;BAL/KTL - RESTful Calls to handle MHA Web RPCs ; 7/19/2021
+1 ;;5.01;MENTAL HEALTH;**181,187,202,204**;Dec 30, 1994;Build 18
+2 ;
+3 ; Reference to EN^XPAR in ICR #2263
+4 ; Reference to ORQQCN in ICR #1671
+5 ; Reference to XLFJSON in ICR #6682
+6 ; Reference to TIU in ICR #7179
+7 ;
+8 ;User Preferences
+9 ;Instrument Admin COMMENT retrieval
+10 QUIT
RBAC(ARGS,RESULTS) ;Get user Role properties
+1 NEW MHTITL
+2 SET MHTITL=$$TITLE()
+3 QUIT
IACTV(INAM) ; Return 1 if Instrument Active, 0 otherwise
+1 NEW IEN,STAT,OP
+2 SET STAT=0
+3 SET IEN=$ORDER(^YTT(601.71,"B",INAM,""))
IF +IEN=0
QUIT STAT
+4 SET OP=$PIECE($GET(^YTT(601.71,IEN,2)),U,2)
IF OP="Y"
SET STAT=1
+5 QUIT STAT
GETASMTP(ARGS,RESULTS) ; Given user DUZ get last Assignment Preferences
+1 NEW YSWPARR
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 DO GETPARAM("YS MHA_WEB LAST ASSIGN SET","{}",.YSWPARR)
+4 MERGE ^TMP("YTQ-JSON",$JOB)=YSWPARR
+5 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+6 QUIT
SETASMTP(ARGS,DATA) ; Set a User's last Assignment Preferences
+1 ; Requires HTTPREQ
+2 NEW YSRET
+3 SET YSRET=$$SETPARAM("YS MHA_WEB LAST ASSIGN SET","/api/mha/assignmentparam/pref/",.HTTPREQ,,"LAST ASSIGNMENT")
+4 QUIT YSRET
GETIFAV(ARGS,RESULTS) ; Given user DUZ get Instrument Favorites
+1 NEW YSWPARR,INSTARR,TMPARR,I,INSTN,CHGF,DFLT
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 SET DFLT="{""favlist"":[]}"
+4 DO GETPARAM("YS MHA_WEB FAV INST",DFLT,.YSWPARR)
+5 ;Was not the default empty list
IF $GET(YSWPARR(1,0))'["[]"
Begin DoDot:1
+6 DO CHKPRMI(.YSWPARR,DFLT,.CHGF)
End DoDot:1
+7 MERGE ^TMP("YTQ-JSON",$JOB)=YSWPARR
+8 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+9 IF $GET(CHGF)=1
DO RSTPARAM("YS MHA_WEB FAV INST","/api/mha/instrument/lists/fav/userfav/",.YSWPARR,,"INST FAVS")
+10 QUIT
SETIFAV(ARGS,DATA) ; Set Instrument Favorites
+1 ; Requires HTTPREQ
+2 NEW YSRET
+3 NEW I,YSWPARR,CHGF,CNT,DFLT
+4 SET DFLT="{""favlist"":[]}"
+5 SET CNT=0
SET I=2
FOR
SET I=$ORDER(HTTPREQ(I))
if +I=0
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
SET YSWPARR(CNT,0)=HTTPREQ(I)
End DoDot:1
+7 DO CHKPRMI(.YSWPARR,DFLT,.CHGF)
+8 IF $GET(CHGF)=1
Begin DoDot:1
+9 KILL HTTPREQ
+10 SET CNT=2
SET I=0
FOR
SET I=$ORDER(YSWPARR(I))
if +I=0
QUIT
Begin DoDot:2
+11 SET CNT=CNT+1
SET HTTPREQ(CNT)=YSWPARR(I,0)
End DoDot:2
End DoDot:1
+12 SET YSRET=$$SETPARAM("YS MHA_WEB FAV INST","/api/mha/instrument/lists/fav/userfav/",.HTTPREQ,,"INST FAVS")
+13 QUIT YSRET
GETGRAPH(ARGS,RESULTS) ; Get Graphing Preferences
+1 NEW YSWPARR
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 DO GETPARAM("YS MHA_WEB GRAPH PREFS","{""graphprefs"":[]}",.YSWPARR)
+4 MERGE ^TMP("YTQ-JSON",$JOB)=YSWPARR
+5 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+6 QUIT
SETGRAPH(ARGS,DATA) ; Set a User's Graphing Preferences
+1 ; Requires HTTPREQ
+2 NEW YSRET
+3 SET YSRET=$$SETPARAM("YS MHA_WEB GRAPH PREFS","/api/mha/instrumentgraph/prefs/",.HTTPREQ,,"GRAPH PREF")
+4 QUIT YSRET
GETSPCLG(ARGS,RESULTS) ; Get Special Report Graph Report Preferences
+1 NEW YSWPARR,INSTARR,TMPARR,I,INSTN,CHGF,DFLT
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 SET DFLT="{""spclgraphprefs"":[]}"
+4 DO GETPARAM("YS MHA_WEB SPECIAL GRAPH RPT",DFLT,.YSWPARR)
+5 ;Was not the default empty list
IF $GET(YSWPARR(1,0))'["[]"
Begin DoDot:1
+6 DO CHKPRMI(.YSWPARR,DFLT,.CHGF)
End DoDot:1
+7 MERGE ^TMP("YTQ-JSON",$JOB)=YSWPARR
+8 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+9 IF $GET(CHGF)=1
DO RSTPARAM("YS MHA_WEB SPECIAL GRAPH RPT","/api/mha/specialgraph/rptpref/",.YSWPARR,,"SPCL RPT")
+10 QUIT
SETSPCLG(ARGS,DATA) ; Set Special Report Graph Report Preferences
+1 ; Requires HTTPREQ
+2 NEW YSRET
+3 NEW I,YSWPARR,CHGF,CNT,DFLT
+4 SET DFLT="{""spclgraphprefs"":[]}"
+5 SET CNT=0
SET I=2
FOR
SET I=$ORDER(HTTPREQ(I))
if +I=0
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
SET YSWPARR(CNT,0)=HTTPREQ(I)
End DoDot:1
+7 DO CHKPRMI(.YSWPARR,DFLT,.CHGF)
+8 IF $GET(CHGF)=1
Begin DoDot:1
+9 KILL HTTPREQ
+10 SET CNT=2
SET I=0
FOR
SET I=$ORDER(YSWPARR(I))
if +I=0
QUIT
Begin DoDot:2
+11 SET CNT=CNT+1
SET HTTPREQ(CNT)=YSWPARR(I,0)
End DoDot:2
End DoDot:1
+12 SET YSRET=$$SETPARAM("YS MHA_WEB SPECIAL GRAPH RPT","/api/mha/specialgraph/rptpref/",.HTTPREQ,,"SPCL RPT")
+13 QUIT YSRET
GETRPT(ARGS,RESULTS) ; Get Report view Preferences
+1 NEW YSWPARR
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 DO GETPARAM("YS MHA_WEB REPORT PREFS","{""reportprefs"":[]}",.YSWPARR)
+4 MERGE ^TMP("YTQ-JSON",$JOB)=YSWPARR
+5 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+6 QUIT
SETRPT(ARGS,DATA) ; Set Report view Preferences
+1 ; Requires HTTPREQ
+2 NEW YSRET
+3 SET YSRET=$$SETPARAM("YS MHA_WEB REPORT PREFS","/api/mha/reports/rptpref/",.HTTPREQ,,"RPT PREFS")
+4 QUIT YSRET
GETNP(ARGS,RESULTS) ; Given user DUZ get Report Save Progress Note preference
+1 NEW YSWPARR
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 DO GETPARAM("YS MHA_WEB PROG NOTE PREFS","{""noteprefs"":[]}",.YSWPARR)
+4 MERGE ^TMP("YTQ-JSON",$JOB)=YSWPARR
+5 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+6 QUIT
SETNP(ARGS,DATA) ; Set Save Progress Note preference
+1 ; Requires HTTPREQ
+2 NEW YSRET
+3 SET YSRET=$$SETPARAM("YS MHA_WEB PROG NOTE PREFS","/api/mha/notes/noteprefs/",.HTTPREQ,,"PROG NOTE PREF")
+4 QUIT YSRET
WEBGUSRP(ARGS,RESULTS) ;Get Dashboard User Column Preferences
+1 NEW YSWPARR,JSONOUT
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 DO GETPARAM("YSB USER COLUMN PREFERENCE","",.YSWPARR)
+4 IF $GET(YSWPARR(1,0))=""
Begin DoDot:1
+5 KILL YSWPARR
DO DFLTUP(JSONOUT)
+6 DO TOTMP^YSBRPC(.JSONOUT)
End DoDot:1
+7 IF $DATA(YSWPARR)
MERGE ^TMP("YTQ-JSON",$JOB)=YSWPARR
+8 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+9 QUIT
WEBPUSRP(ARGS,DATA) ; Set Dashboard Column Preferences
+1 ; Requires HTTPREQ
+2 NEW YSRET
+3 SET YSRET=$$SETPARAM("YSB USER COLUMN PREFERENCE","/api/mha/dashboard/userpref/",.HTTPREQ,,"DASH COLS")
+4 QUIT YSRET
DFLTUP(XJSON) ;
+1 ; Get the Default columns to display if 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
SETPARAM(YSPNAM,RETURL,HTTPREQ,YSWDGT,YSVAL) ;Set Parameter
+1 ; Assignment Parameters=YS MHA_WEB LAST ASSIGN SET
+2 ; Favorite Instruments=YS MHA_WEB FAV INST
+3 ; Batteries=YS MHA_WEB BATTERIES
+4 ; Requires HTTPREQ
+5 ; Return Success or Failure URL string
+6 NEW II,CNT,YSDUZ
+7 NEW FDA,IENS,FDAIEN,YSMSG,YSJSON
+8 ;I '$D(HTTPREQ) Q RETURL_"NODATA"
+9 SET CNT=0
+10 ;In the DATA array the body starts after the first line
+11 SET II=2
FOR
SET II=$ORDER(HTTPREQ(II))
if II=""
QUIT
Begin DoDot:1
+12 if $TRANSLATE(HTTPREQ(II)," ")=""
QUIT
+13 SET CNT=CNT+1
SET YSJSON(CNT)=HTTPREQ(II)
End DoDot:1
+14 SET YSJSON=$GET(YSVAL)
+15 IF '$DATA(HTTPREQ)
SET YSJSON="@"
+16 if +$GET(YSWDGT)=0
SET YSWDGT=1
+17 SET YSDUZ=DUZ_";VA(200,"
+18 DO EN^XPAR(YSDUZ,YSPNAM,YSWDGT,.YSJSON,.YSMSG)
+19 IF +YSMSG'=0
DO SETERROR^YTQRUTL(404,"PARAMETER not found: "_YSPNAM)
QUIT RETURL_"ERROR: "_$PIECE(YSMSG,U,2)
+20 QUIT RETURL_"OK"
GETPARAM(YSPNAM,DFLT,YSWPARR,YSWDGT) ;Get Parameter
+1 NEW YSDUZ
+2 KILL JSONOUT
+3 ;Parameter instance-default to 1
if $GET(YSWDGT)=""
SET YSWDGT=1
+4 SET YSDUZ=DUZ_";VA(200,"
+5 DO GETWP^XPAR(.YSWPARR,YSDUZ,YSPNAM,YSWDGT)
+6 IF '$DATA(YSWPARR)
Begin DoDot:1
+7 ;Need to define Default
SET YSWPARR(1,0)=DFLT
End DoDot:1
+8 ;Parameter for User exists but it is empty
IF $DATA(YSWPARR)=1
IF ($GET(YSWPARR)="")
Begin DoDot:1
+9 ;Need to define Default
SET YSWPARR(1,0)=DFLT
End DoDot:1
+10 QUIT
RSTPARAM(YSPNAM,RETURL,YSWPARR,YSWDGT,YSVAL) ;Rest Parameter
+1 ; This is used when during a GET Parameter an instrument is found to be inactive and the JSON
+2 ; payload is changed to remove the instrument. The parameter has to be reset with the new instrument list
+3 ; The JSON Array has to be set up in the format of HTTPREQ and there does not need to be any return value
+4 NEW HTTPREQ,I,NORET
+5 if $GET(YSPNAM)=""
QUIT
+6 if '$DATA(YSWPARR)
QUIT
+7 SET RETURL=$GET(RETURL)
SET YSWDGT=$GET(YSWDGT)
SET YSVAL=$GET(YSVAL)
+8 SET I=0
FOR
SET I=$ORDER(YSWPARR(I))
if +I=0
QUIT
Begin DoDot:1
+9 ;I+2 because the first line is the URL and the second line is blnk in HTTPREQ normally
SET HTTPREQ(I+2)=YSWPARR(I,0)
End DoDot:1
+10 ;Set Parameter
SET NORET=$$SETPARAM(YSPNAM,RETURL,.HTTPREQ,YSWDGT,YSVAL)
+11 QUIT
GETBAT(ARGS,RESULTS) ; Given user DUZ get Instrument Batteries
+1 NEW YSWPARR,INSTARR,TMPARR,I,INSTN,CHGF,DFLT
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 SET DFLT="{""batteries"":[]}"
+4 DO GETPARAM("YS MHA_WEB BATTERIES",DFLT,.YSWPARR)
+5 ;Was not the default empty list
IF $GET(YSWPARR(1,0))'["[]"
Begin DoDot:1
+6 DO CHKPRMI(.YSWPARR,DFLT,.CHGF)
End DoDot:1
+7 MERGE ^TMP("YTQ-JSON",$JOB)=YSWPARR
+8 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+9 IF $GET(CHGF)=1
DO RSTPARAM("YS MHA_WEB BATTERIES","/api/mha/instrument/lists/batteries/userbat/",.YSWPARR,,"BATTERIES")
+10 QUIT
SETBAT(ARGS,DATA) ; Set a User's Instrument Batteries
+1 ; Requires HTTPREQ
+2 NEW YSRET
+3 NEW I,YSWPARR,CHGF,CNT,DFLT
+4 SET DFLT="{""batteries"":[]}"
+5 SET CNT=0
SET I=2
FOR
SET I=$ORDER(HTTPREQ(I))
if +I=0
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
SET YSWPARR(CNT,0)=HTTPREQ(I)
End DoDot:1
+7 DO CHKPRMI(.YSWPARR,DFLT,.CHGF)
+8 IF $GET(CHGF)=1
Begin DoDot:1
+9 KILL HTTPREQ
+10 SET CNT=2
SET I=0
FOR
SET I=$ORDER(YSWPARR(I))
if +I=0
QUIT
Begin DoDot:2
+11 SET CNT=CNT+1
SET HTTPREQ(CNT)=YSWPARR(I,0)
End DoDot:2
End DoDot:1
+12 SET YSRET=$$SETPARAM("YS MHA_WEB BATTERIES","/api/mha/instrument/lists/batteries/userbat/",.HTTPREQ,,"BATTERIES")
+13 QUIT YSRET
CHKPRMI(YSWPARR,DFLT,CHGF) ;Check Parameter instrument list for inactive instruments
+1 ; Currently for "batteries" and "favlist"
+2 ; Input=array of JSON
+3 ; Output=array of JSON with inactive instruments removed and CHGF=1 if array has changed
+4 ; Both input array and CHGF passed by reference
+5 NEW INSTARR,TMPARR,I,J,INSTN,ISTAT,ERR
+6 DO J2ARR(.YSWPARR,.TMPARR)
+7 DO DECODE^XLFJSON("TMPARR","INSTARR","ERR")
+8 SET CHGF=0
+9 IF '$DATA(ERR)
IF (DFLT["batteries")
Begin DoDot:1
+10 SET J=0
FOR
SET J=$ORDER(INSTARR("batteries",J))
if +J=0
QUIT
Begin DoDot:2
+11 SET I=0
FOR
SET I=$ORDER(INSTARR("batteries",J,"instruments",I))
if +I=0
QUIT
Begin DoDot:3
+12 SET INSTN=INSTARR("batteries",J,"instruments",I)
+13 SET ISTAT=$$IACTV(INSTN)
+14 ;Instrument no longer active
IF +ISTAT=0
KILL INSTARR("batteries",J,"instruments",I)
SET CHGF=1
+15 ;No instruments in battery
IF '$DATA(INSTARR("batteries",J,"instruments"))
KILL INSTARR("batteries",J)
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF '$DATA(ERR)
IF (DFLT["favlist")
Begin DoDot:1
+17 SET I=0
FOR
SET I=$ORDER(INSTARR("favlist",I))
if +I=0
QUIT
Begin DoDot:2
+18 SET INSTN=$GET(INSTARR("favlist",I,"instrumentName"))
if INSTN=""
QUIT
+19 SET ISTAT=$$IACTV(INSTN)
+20 ;Instrument no longer active
IF +ISTAT=0
KILL INSTARR("favlist",I)
SET CHGF=1
End DoDot:2
End DoDot:1
+21 IF '$DATA(ERR)
IF (DFLT["spclgraphprefs")
Begin DoDot:1
+22 SET I=0
FOR
SET I=$ORDER(INSTARR("selectedInstruments",I))
if +I=0
QUIT
Begin DoDot:2
+23 SET INSTN=INSTARR("selectedInstruments",I)
if INSTN=""
QUIT
+24 SET ISTAT=$$IACTV(INSTN)
+25 ;Instrument no longer active
IF +ISTAT=0
KILL INSTARR("selectedInstruments",I)
SET CHGF=1
End DoDot:2
End DoDot:1
+26 KILL YSWPARR,TMPARR
+27 ;No batteries left
IF '$DATA(INSTARR)
SET YSWPARR(1,0)=DFLT
QUIT
+28 DO ENCODE^XLFJSON("INSTARR","TMPARR","ERR")
+29 IF '$DATA(ERR)
Begin DoDot:1
+30 SET I=0
FOR
SET I=$ORDER(TMPARR(I))
if +I=0
QUIT
Begin DoDot:2
+31 SET YSWPARR(I,0)=TMPARR(I)
End DoDot:2
End DoDot:1
+32 QUIT
LOADCOM(ARGS,RESULTS) ;Get Comments for an Instrument Admin and load them for display
+1 NEW YSADMIN,YSARR,I,CRLF
+2 SET CRLF=$CHAR(10)
+3 SET YSADMIN=$GET(ARGS("adminId"))
+4 IF '$DATA(^YTT(601.84,YSADMIN,0))
DO SETERROR^YTQRUTL(404,"Admin not found: "_YSADMIN)
QUIT
+5 DO GETCOM^YTQRQAD3(.YSARR,YSADMIN)
+6 IF '$DATA(YSARR)
SET RESULTS("text","\",1)=""
QUIT
+7 SET I=""
FOR
SET I=$ORDER(YSARR(I))
if I=""
QUIT
Begin DoDot:1
+8 SET RESULTS("text","\",I)=YSARR(I)_CRLF
End DoDot:1
+9 QUIT
AINSTS(SETID,IARR) ; Assignment Instrument Status check for Deletion
+1 ; Pre-validated Assignment ID passed in
+2 ; Return IARR by Assignment Instrument Index (e.g. IARR(instnum)=0)
+3 ; 0=Complete
+4 ; 1=Incomplete
+5 ; 2=Not allowed
+6 ; Return IARR(instnum,"ADMINID")=MH ADMINISTRATION IEN for reference
+7 ; Overall Delete SETID status
+8 ; IARR("STAT")="OK","NOTOK","NOTALLOWED"
+9 NEW ASSGN,INST,ISCMPLT,AOK,MGR,YSADMIN,X0
+10 SET MGR=$$ISMGR^YTQRQAD1()
+11 SET ASSGN="YTQASMT-SET-"_SETID
SET IARR("STAT")="OK"
+12 SET INST=0
FOR
SET INST=$ORDER(^XTMP(ASSGN,1,"instruments",INST))
if +INST=0
QUIT
Begin DoDot:1
+13 SET YSADMIN=$GET(^XTMP(ASSGN,1,"instruments",INST,"adminId"))
+14 IF +YSADMIN=0
SET IARR(INST)=1
QUIT
+15 SET IARR(INST,"ADMINID")=YSADMIN
+16 SET X0=$GET(^YTT(601.84,YSADMIN,0))
IF X0=""
SET IARR(INST)=1
QUIT
+17 SET ISCMPLT=$PIECE(X0,U,9)
+18 IF ISCMPLT="Y"
SET IARR(INST)=0
SET IARR("STAT")="NOTOK"
QUIT
+19 IF MGR!(DUZ=$PIECE(X0,U,6))!(DUZ=$PIECE(X0,U,7))
SET IARR(INST)=1
IF 1
+20 IF '$TEST
SET IARR(INST)=2
SET IARR("STAT")="NOTALLOWED"
End DoDot:1
+21 QUIT
GETCONS(ARGS,RESULTS) ; Get list of patient consults
+1 NEW TYPE,RV,CONS,DT,STAT,LOC,TYPE,LOCA,YSSTAT,HIT,NOCONS,DFN,IEN
+2 ;Pending, Active, Scheduled, Partial Results, Renewed
SET YSSTAT="5,6,8,9,15"
+3 KILL ^TMP("ORQQCN",$JOB)
+4 ;DBIA 1671 ORQQCN LIST
SET DFN=+$GET(ARGS("dfn"))
DO LIST^ORQQCN(.RV,DFN,,,,YSSTAT)
+5 KILL ^TMP("YTQ-JSON",$JOB)
SET CNT=0
+6 DO SETRES("{""consults"":[")
+7 SET HIT=""
SET NOCONS=""
+8 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORQQCN",$JOB,"CS",IEN))
if 'IEN!NOCONS
QUIT
Begin DoDot:1
+9 SET DATA=^TMP("ORQQCN",$JOB,"CS",IEN,0)
+10 IF DATA["PATIENT DOES NOT HAVE ANY"
SET NOCONS=1
QUIT
+11 SET HIT=1
+12 SET CONS=$PIECE(DATA,U,1)
+13 SET DT=$PIECE(DATA,U,2)
+14 SET STAT=$PIECE(DATA,U,3)
+15 SET LOC=$PIECE(DATA,U,4)
+16 SET TYPE=$PIECE(DATA,U,5)
+17 SET LOCA=$PIECE(DATA,U,6)
+18 SET STR="{""Consult"":"""_CONS_""", ""ConsultDate"":"""_$$FMTE^XLFDT($PIECE(DT,"."))_""", ""Status"":"""_STAT_""", ""Clinic"":"""_LOC_""",""Type"":"""_TYPE_"""},"
+19 DO SETRES(STR)
End DoDot:1
+20 ;Remove last trailing ","
IF HIT
SET STR=^TMP("YTQ-JSON",$JOB,CNT,0)
SET STR=$EXTRACT(STR,1,$LENGTH(STR)-1)
SET ^TMP("YTQ-JSON",$JOB,CNT,0)=STR
+21 DO SETRES("]}")
+22 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+23 QUIT
GETCONS2(ARGS,RESULTS) ; Get list of patient consults
+1 NEW TYPE,RV,CONS,DT,STAT,LOC,TYPE,LOCA,YSSTAT,HIT,NOCONS,DFN,IEN,YSARR,CNT,RESULTS
+2 ;Pending, Active, Scheduled, Partial Results, Renewed
SET YSSTAT="5,6,8,9,15"
+3 KILL ^TMP("ORQQCN",$JOB)
+4 ;DBIA 1671 ORQQCN LIST
SET DFN=+$GET(ARGS("dfn"))
DO LIST^ORQQCN(.RV,DFN,,,,YSSTAT)
+5 KILL ^TMP("YTQ-JSON",$JOB)
SET CNT=0
+6 SET HIT=""
SET NOCONS=""
+7 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORQQCN",$JOB,"CS",IEN))
if 'IEN!NOCONS
QUIT
Begin DoDot:1
+8 SET DATA=^TMP("ORQQCN",$JOB,"CS",IEN,0)
+9 IF DATA["PATIENT DOES NOT HAVE ANY"
SET NOCONS=1
QUIT
+10 SET HIT=1
+11 SET CONS=$PIECE(DATA,U,1)
+12 SET DT=$PIECE(DATA,U,2)
+13 SET STAT=$PIECE(DATA,U,3)
+14 SET LOC=$PIECE(DATA,U,4)
+15 SET TYPE=$PIECE(DATA,U,5)
+16 SET LOCA=$PIECE(DATA,U,6)
+17 SET CNT=CNT+1
SET RESULTS("consults",CNT,"Consult")=CONS
SET RESULTS("consults",CNT,"ConsultDate")=$$FMTE^XLFDT($PIECE(DT,"."))
SET RESULTS("consults",CNT,"Status")=STAT
+18 SET RESULTS("consults",CNT,"Clinic")=LOC
SET RESULTS("consults",CNT,"Type")=TYPE
End DoDot:1
+19 DO ENCODE^XLFJSON("RESULTS","YSARR")
+20 SET II=0
FOR
SET II=$ORDER(YSARR(II))
if II=""
QUIT
Begin DoDot:1
+21 SET ^TMP("YTQ-JSON",$JOB,II,0)=YSARR(II)
End DoDot:1
+22 KILL RESULTS
+23 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+24 QUIT
+25 ;
ASMTSTAF(ARGS,RESULTS) ; get assignment identified by assignmentId
+1 NEW ASMT,INTE,ORBY,LOCA,INTV,ORDBY,LOC,CON,DAT,CONTX,CONA,ADMINDT,IEN,DFN
+2 NEW YSARR,II,DATA
+3 SET ASMT="YTQASMT-SET-"_$GET(ARGS("assignmentId"))
+4 IF '$DATA(^XTMP(ASMT))
DO SETERROR^YTQRUTL(404,"Not Found: "_ARGS("assignmentId"))
QUIT
+5 MERGE DATA=^XTMP("YTQASMT-SET-"_$GET(ARGS("assignmentId")))
+6 SET INTE=$GET(DATA(1,"interview"))
+7 SET ORBY=$GET(DATA(1,"orderedBy"))
+8 SET LOCA=$GET(DATA(1,"location"))
+9 SET CONA=$GET(DATA(1,"consult"))
+10 SET DFN=$GET(DATA(1,"patient","dfn"))
+11 ;Now XLAT pointers to JSON data var_"Name"
+12 SET INTV=$PIECE($GET(^VA(200,INTE,0)),U,1)
+13 SET ORDBY=$PIECE($GET(^VA(200,ORBY,0)),U,1)
+14 SET LOC=$PIECE($GET(^SC(LOCA,0)),U,1)
+15 SET ADMINDT=$GET(DATA(1,"adminDate"))
+16 SET RESULTS("interviewName")=INTV
+17 SET RESULTS("orderedbyName")=ORDBY
+18 SET RESULTS("locationName")=LOC
+19 SET RESULTS("adminDate")=ADMINDT
+20 ;initialize consultName
SET RESULTS("consultName")=""
+21 DO LIST^ORQQCN(.RV,DFN)
+22 SET IEN=""
FOR
SET IEN=$ORDER(^TMP("ORQQCN",$JOB,"CS",IEN))
if 'IEN
QUIT
Begin DoDot:1
+23 SET DAT=^TMP("ORQQCN",$JOB,"CS",IEN,0)
+24 SET CON=$PIECE(DAT,U,1)
if CON'=CONA
QUIT
Begin DoDot:2
End DoDot:2
IF CON=CONA
SET CONTX=$PIECE(DAT,U,7)
+25 SET RESULTS("consultName")=CONTX
End DoDot:1
+26 MERGE RESULTS=^XTMP(ASMT,1)
+27 KILL ^TMP("YTQ-JSON",$JOB)
+28 DO ENCODE^XLFJSON("RESULTS","YSARR")
+29 SET II=0
FOR
SET II=$ORDER(YSARR(II))
if II=""
QUIT
Begin DoDot:1
+30 SET ^TMP("YTQ-JSON",$JOB,II,0)=YSARR(II)
End DoDot:1
+31 KILL RESULTS
+32 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+33 QUIT
+34 ;
SETRES(STR) ;
+1 SET CNT=CNT+1
SET ^TMP("YTQ-JSON",$JOB,CNT,0)=STR
+2 QUIT
+3 ;
GLIST(YSPAR,YSENT,YSLIST) ;Get the number of values for a particular parameter
+1 DO GETLST^XPAR(.YSLIST,YSENT,YSPAR)
+2 QUIT
SRLST(SRARR) ;Special Reports Parameters List
+1 ; Find all instances of Special Reports and decode from JSON into array
+2 NEW YSLIST,YSDUZ,YSPAR,I,JARR,ERR,TMPAR,II
+3 SET YSPAR="YS MHA_WEB SPECIAL GRAPH RPT"
+4 SET YSDUZ=DUZ_";VA(200,"
+5 DO GETLST^XPAR(.YSLIST,YSDUZ,YSPAR)
+6 if +$GET(YSLIST)=0
QUIT
+7 FOR I=1:1:YSLIST
Begin DoDot:1
+8 DO GETPARAM("YS MHA_WEB SPECIAL GRAPH RPT","{""spclgraphprefs"":[]}",.YSWPARR,I)
+9 KILL JARR,TMPAR
+10 SET II=0
FOR
SET II=$ORDER(YSWPARR(II))
if II=""
QUIT
Begin DoDot:2
+11 SET TMPAR(II)=YSWPARR(II,0)
End DoDot:2
+12 DO DECODE^XLFJSON("TMPAR","JARR","ERR")
+13 IF '$DATA(ERR)
MERGE SRARR(I)=JARR
End DoDot:1
+14 QUIT
GETSRLST(ARGS,RESULTS) ;Get Special Reports Parameter(s)
+1 NEW II,SRARR,YSARR,CNT,TMPAR
+2 DO SRLST(.SRARR)
+3 SET CNT=0
+4 SET II=0
FOR
SET II=$ORDER(SRARR(II))
if II=""
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 MERGE TMPAR("specialReports",CNT)=SRARR(II,"specialReports",1)
End DoDot:1
+7 KILL ^TMP("YTQ-JSON",$JOB)
+8 DO ENCODE^XLFJSON("TMPAR","YSARR")
+9 SET II=0
FOR
SET II=$ORDER(YSARR(II))
if II=""
QUIT
Begin DoDot:1
+10 SET ^TMP("YTQ-JSON",$JOB,II,0)=YSARR(II)
End DoDot:1
+11 KILL RESULTS
+12 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
+13 QUIT
SAVSRLST(ARGS,RESULTS) ;Save Special Reports Parameter
+1 NEW HTTPOBJ,II,CNT,YSJSON,JARR,ERR,INNAM,SRARR,MATCH,SRNAM
+2 SET CNT=0
+3 SET II=2
FOR
SET II=$ORDER(HTTPREQ(II))
if II=""
QUIT
Begin DoDot:1
+4 if $TRANSLATE(HTTPREQ(II)," ")=""
QUIT
+5 SET CNT=CNT+1
SET HTTPOBJ(CNT)=HTTPREQ(II)
End DoDot:1
+6 DO DECODE^XLFJSON("HTTPOBJ","JARR","ERR")
+7 SET INNAM=$GET(JARR("specialReports",1,"name"))
+8 IF INNAM=""
DO SETERROR^YTQRUTL(404,"Special Report Name not sent")
QUIT "/api/mha/specialgraph/rptpref/ERROR: Name not sent"
+9 DO SRLST(.SRARR)
+10 SET MATCH=""
+11 SET II=0
FOR
SET II=$ORDER(SRARR(II))
if II=""
QUIT
Begin DoDot:1
+12 SET SRNAM=$GET(SRARR(II,"specialReports",1,"name"))
+13 IF SRNAM=INNAM
SET MATCH=II
End DoDot:1
+14 ;No match, so new parameter. Find last instance and add one.
IF MATCH=""
SET MATCH=$ORDER(SRARR(""),-1)+1
+15 SET YSRET=$$SETPARAM("YS MHA_WEB SPECIAL GRAPH RPT","/api/mha/specialgraph/rptpref/",.HTTPREQ,MATCH,"SPCL RPT")
+16 QUIT YSRET
J2ARR(JARR,OUTARR) ;Move XLFJSON array contents to OUTARR
+1 NEW I
+2 SET I=0
FOR
SET I=$ORDER(JARR(I))
if +I=0
QUIT
Begin DoDot:1
+3 SET OUTARR(I)=JARR(I,0)
End DoDot:1
+4 QUIT
TITLE() ; Get MENTAL HEALTH DIAGNOSTIC STUDY NOTE title
+1 ;
+2 NEW TITL,ERR,RET
+3 SET ERR=""
+4 DO GETLOCT(.TITL,.ERR)
+5 SET RET=$GET(TITL("MHA"))
+6 QUIT RET
+7 ;
GETLOCT(TITL,ERR) ; Get the Local Title IENs
+1 ;
+2 NEW CSRE,MHPRNT,PNCLS,NATTIT,MHA,MHAC,FDA,FDAIEN,TIUFPRIV
+3 SET TIUFPRIV=1
+4 SET MHA=$$CHKTIU("MENTAL HEALTH DIAGNOSTIC STUDY NOTE","DOC")
+5 SET MHAC=$$CHKTIU("MENTAL HEALTH CONSULT NOTE","DOC")
+6 SET TITL("MHA")=MHA
+7 SET TITL("MHAC")=MHAC
+8 QUIT
+9 ;
CHKTIU(NAME,CLS) ;
+1 NEW TIEN,SCR,MSG
+2 SET SCR="I $P(^(0),U,4)="""_CLS_""""
+3 SET TIEN=$$FIND1^DIC(8925.1,"","",NAME,"",SCR,"MSG")
+4 QUIT TIEN
CHKTITLE(FILE,NAME) ;
+1 NEW DIC,X,Y
+2 SET DIC=FILE
SET DIC(0)="X"
+3 SET X=NAME
+4 DO ^DIC
+5 QUIT +Y
+6 ;
