YTQRQAD8 ;BAL/KTL - RESTful Calls to set/get MHA Note ; 1/25/2017
;;5.01;MENTAL HEALTH;**199,207,202,204,208,250,236**;Dec 30, 1994;Build 25
;
; Reference to TIUCNSLT in ICR #5546
; Reference to TIUPUTU in ICR #3351
; Reference to TIUSRVA in ICR #5541
;
Q
SAVPNOT(ASGN,ADMIN,CONSULT,COSIGNER,YS) ;Save Progress Note Text in XTMP until session complete
N NOD,LN,CNT,ADMCNT
S NOD="YTQASMT-SET-"_ASGN
I '$D(^XTMP(NOD)) D SETERROR^YTQRUTL(400,"Assignment Not Found") Q
S CNT=$O(^XTMP(NOD,2,"PNOTE","TXT",""),-1)
S ADMCNT=$O(^XTMP(NOD,2,"PNOTE","ADMINS",""),-1)
S ADMCNT=ADMCNT+1,^XTMP(NOD,2,"PNOTE","ADMINS",ADMCNT)=ADMIN_U_$G(CONSULT)_U_$G(COSIGNER)
I CNT'="" S CNT=CNT+1,$P(^XTMP(NOD,2,"PNOTE","TXT",CNT),"_",75)="" ;Add Note Divider
S LN=0 F S LN=$O(YS(LN)) Q:+LN=0 D
. S CNT=CNT+1,^XTMP(NOD,2,"PNOTE","TXT",CNT)=YS(LN)
Q
FILPNOT(ASGN,ADMIN,CONSULT,DATA,TMPYS,FRMDEL) ;File the aggregate Progress Note
;FRMDEL = If invoked from delete the last instrument and Aggregate Progress Note exists
N YSADMIN,YSCONSULT,YSCOSIGNER,NOD,REMAIN,I
N CNT,LN,YS,YSDATA
I +ASGN=0 S ASGN=$G(DATA("assignmentId"))
I +ASGN=0 D SETERROR^YTQRUTL(400,"No Assignment") Q 0
S COSIGNER=$G(DATA("cosigner"))
S FRMDEL=$G(FRMDEL)
S NOD="YTQASMT-SET-"_ASGN
I COSIGNER="",(+$G(^XTMP(NOD,1,"cosigner"))'=0) S COSIGNER=^XTMP(NOD,1,"cosigner")
;I '$D(^XTMP(NOD)) D SETERROR^YTQRUTL(400,"Assignment Not Found") Q 1 ;If no ^XTMP, must be only instrument
S YSADMIN=$G(^XTMP(NOD,2,"PNOTE","ADMINS",1))
I +YSADMIN'=0 D ;Previously filed first admin, override incoming parameters
. S CONSULT=$P(YSADMIN,U,2),ADMIN=$P(YSADMIN,U)
. I $P(YSADMIN,U,3)'="",(COSIGNER="") S COSIGNER=$P(YSADMIN,U,3) ;Only use if main assignment cosigner not set
I +ADMIN=0 D SETERROR^YTQRUTL(400,"No Admin for Note") Q 2
S CNT=$O(^XTMP(NOD,2,"PNOTE","TXT",""),-1)
M YS=^XTMP(NOD,2,"PNOTE","TXT")
I $D(TMPYS) D ;TMPYS is not sent if last action for Assignment was Save instrument Admin and not SAVE NOTE
. I CNT'="" S CNT=CNT+1,$P(YS(CNT),"_",75)="" ;Add Note Divider
. ; Add last instrument progress note text to previously saved Progress Note txt.
. S LN=0 F S LN=$O(TMPYS(LN)) Q:+LN=0 D
.. S CNT=CNT+1,YS(CNT)=TMPYS(LN)
I COSIGNER]"" S YS("COSIGNER")=COSIGNER
S YS("AD")=ADMIN
I CONSULT S YS("CON")=CONSULT D CCREATE^YTQCONS(.YSDATA,.YS) I 1
E D PCREATE^YTQTIU(.YSDATA,.YS)
I YSDATA(1)'="[DATA]" D SETERROR^YTQRUTL(500,"Note not saved") Q 3
;Mark ADMINS that contributed to the PNOTE with PROGRESS NOTE GENERATED=1
N ADMCNT,YSADD
S ADMCNT=0 F S ADMCNT=$O(^XTMP(NOD,2,"PNOTE","ADMINS",ADMCNT)) Q:ADMCNT="" D
. S YSADD=$P(^XTMP(NOD,2,"PNOTE","ADMINS",ADMCNT),U)
. I $$ALWNOTE^YTQRQAD3(YSADD)="true" S $P(^YTT(601.84,YSADD,0),U,18)=1 ;PROGRESS NOTE GENERATED
;Saved progress note for all completed instruments. If last instrument, Delete Assignment
K ^XTMP(NOD,2) ;Kill Aggregate Progress Note
S REMAIN=""
S I=0 F S I=$O(^XTMP(NOD,1,"instruments",I)) Q:'I D
. I $G(^XTMP(NOD,1,"instruments",I,"complete"))'="true" S REMAIN=1
I 'REMAIN,(FRMDEL'=1),$D(^XTMP(NOD,0)) D DELASMT1^YTQRQAD1(ASGN) ;Last instrument OK to Kill Assignment
K ^XTMP(NOD,2) ;KILL Filed progress note text
Q $G(YSDATA(2))
;
WEBGUSRP(ARGS,RESULTS) ;Get DB Col Pref
N YSWPARR,JSONOUT
K ^TMP("YTQ-JSON",$J)
D GETPARAM^YTQRQAD7("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 DB Col Pref
;Requires HTTPREQ from YTQREST
N YSRET
S YSRET=$$SETPARAM^YTQRQAD7("YSB USER COLUMN PREFERENCE","/api/mha/dashboard/userpref/",.HTTPREQ,,"DASH COLS")
Q YSRET
DFLTUP(XJSON) ;
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")
. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQRQAD8 4374 printed Aug 26, 2025@22:34:49 Page 2
YTQRQAD8 ;BAL/KTL - RESTful Calls to set/get MHA Note ; 1/25/2017
+1 ;;5.01;MENTAL HEALTH;**199,207,202,204,208,250,236**;Dec 30, 1994;Build 25
+2 ;
+3 ; Reference to TIUCNSLT in ICR #5546
+4 ; Reference to TIUPUTU in ICR #3351
+5 ; Reference to TIUSRVA in ICR #5541
+6 ;
+7 QUIT
SAVPNOT(ASGN,ADMIN,CONSULT,COSIGNER,YS) ;Save Progress Note Text in XTMP until session complete
+1 NEW NOD,LN,CNT,ADMCNT
+2 SET NOD="YTQASMT-SET-"_ASGN
+3 IF '$DATA(^XTMP(NOD))
DO SETERROR^YTQRUTL(400,"Assignment Not Found")
QUIT
+4 SET CNT=$ORDER(^XTMP(NOD,2,"PNOTE","TXT",""),-1)
+5 SET ADMCNT=$ORDER(^XTMP(NOD,2,"PNOTE","ADMINS",""),-1)
+6 SET ADMCNT=ADMCNT+1
SET ^XTMP(NOD,2,"PNOTE","ADMINS",ADMCNT)=ADMIN_U_$GET(CONSULT)_U_$GET(COSIGNER)
+7 ;Add Note Divider
IF CNT'=""
SET CNT=CNT+1
SET $PIECE(^XTMP(NOD,2,"PNOTE","TXT",CNT),"_",75)=""
+8 SET LN=0
FOR
SET LN=$ORDER(YS(LN))
if +LN=0
QUIT
Begin DoDot:1
+9 SET CNT=CNT+1
SET ^XTMP(NOD,2,"PNOTE","TXT",CNT)=YS(LN)
End DoDot:1
+10 QUIT
FILPNOT(ASGN,ADMIN,CONSULT,DATA,TMPYS,FRMDEL) ;File the aggregate Progress Note
+1 ;FRMDEL = If invoked from delete the last instrument and Aggregate Progress Note exists
+2 NEW YSADMIN,YSCONSULT,YSCOSIGNER,NOD,REMAIN,I
+3 NEW CNT,LN,YS,YSDATA
+4 IF +ASGN=0
SET ASGN=$GET(DATA("assignmentId"))
+5 IF +ASGN=0
DO SETERROR^YTQRUTL(400,"No Assignment")
QUIT 0
+6 SET COSIGNER=$GET(DATA("cosigner"))
+7 SET FRMDEL=$GET(FRMDEL)
+8 SET NOD="YTQASMT-SET-"_ASGN
+9 IF COSIGNER=""
IF (+$GET(^XTMP(NOD,1,"cosigner"))'=0)
SET COSIGNER=^XTMP(NOD,1,"cosigner")
+10 ;I '$D(^XTMP(NOD)) D SETERROR^YTQRUTL(400,"Assignment Not Found") Q 1 ;If no ^XTMP, must be only instrument
+11 SET YSADMIN=$GET(^XTMP(NOD,2,"PNOTE","ADMINS",1))
+12 ;Previously filed first admin, override incoming parameters
IF +YSADMIN'=0
Begin DoDot:1
+13 SET CONSULT=$PIECE(YSADMIN,U,2)
SET ADMIN=$PIECE(YSADMIN,U)
+14 ;Only use if main assignment cosigner not set
IF $PIECE(YSADMIN,U,3)'=""
IF (COSIGNER="")
SET COSIGNER=$PIECE(YSADMIN,U,3)
End DoDot:1
+15 IF +ADMIN=0
DO SETERROR^YTQRUTL(400,"No Admin for Note")
QUIT 2
+16 SET CNT=$ORDER(^XTMP(NOD,2,"PNOTE","TXT",""),-1)
+17 MERGE YS=^XTMP(NOD,2,"PNOTE","TXT")
+18 ;TMPYS is not sent if last action for Assignment was Save instrument Admin and not SAVE NOTE
IF $DATA(TMPYS)
Begin DoDot:1
+19 ;Add Note Divider
IF CNT'=""
SET CNT=CNT+1
SET $PIECE(YS(CNT),"_",75)=""
+20 ; Add last instrument progress note text to previously saved Progress Note txt.
+21 SET LN=0
FOR
SET LN=$ORDER(TMPYS(LN))
if +LN=0
QUIT
Begin DoDot:2
+22 SET CNT=CNT+1
SET YS(CNT)=TMPYS(LN)
End DoDot:2
End DoDot:1
+23 IF COSIGNER]""
SET YS("COSIGNER")=COSIGNER
+24 SET YS("AD")=ADMIN
+25 IF CONSULT
SET YS("CON")=CONSULT
DO CCREATE^YTQCONS(.YSDATA,.YS)
IF 1
+26 IF '$TEST
DO PCREATE^YTQTIU(.YSDATA,.YS)
+27 IF YSDATA(1)'="[DATA]"
DO SETERROR^YTQRUTL(500,"Note not saved")
QUIT 3
+28 ;Mark ADMINS that contributed to the PNOTE with PROGRESS NOTE GENERATED=1
+29 NEW ADMCNT,YSADD
+30 SET ADMCNT=0
FOR
SET ADMCNT=$ORDER(^XTMP(NOD,2,"PNOTE","ADMINS",ADMCNT))
if ADMCNT=""
QUIT
Begin DoDot:1
+31 SET YSADD=$PIECE(^XTMP(NOD,2,"PNOTE","ADMINS",ADMCNT),U)
+32 ;PROGRESS NOTE GENERATED
IF $$ALWNOTE^YTQRQAD3(YSADD)="true"
SET $PIECE(^YTT(601.84,YSADD,0),U,18)=1
End DoDot:1
+33 ;Saved progress note for all completed instruments. If last instrument, Delete Assignment
+34 ;Kill Aggregate Progress Note
KILL ^XTMP(NOD,2)
+35 SET REMAIN=""
+36 SET I=0
FOR
SET I=$ORDER(^XTMP(NOD,1,"instruments",I))
if 'I
QUIT
Begin DoDot:1
+37 IF $GET(^XTMP(NOD,1,"instruments",I,"complete"))'="true"
SET REMAIN=1
End DoDot:1
+38 ;Last instrument OK to Kill Assignment
IF 'REMAIN
IF (FRMDEL'=1)
IF $DATA(^XTMP(NOD,0))
DO DELASMT1^YTQRQAD1(ASGN)
+39 ;KILL Filed progress note text
KILL ^XTMP(NOD,2)
+40 QUIT $GET(YSDATA(2))
+41 ;
WEBGUSRP(ARGS,RESULTS) ;Get DB Col Pref
+1 NEW YSWPARR,JSONOUT
+2 KILL ^TMP("YTQ-JSON",$JOB)
+3 DO GETPARAM^YTQRQAD7("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 DB Col Pref
+1 ;Requires HTTPREQ from YTQREST
+2 NEW YSRET
+3 SET YSRET=$$SETPARAM^YTQRQAD7("YSB USER COLUMN PREFERENCE","/api/mha/dashboard/userpref/",.HTTPREQ,,"DASH COLS")
+4 QUIT YSRET
DFLTUP(XJSON) ;
+1 NEW II,XDATA,XNAM,XJ,SPC,XCNT,XTABC
+2 SET $PIECE(SPC," ",10)=""
+3 SET XCNT=1
SET XTABC=1
SET XJSON(XCNT)="{"
+4 DO GETWDGT^YSBRPC(.XDATA)
+5 SET II=0
FOR
SET II=$ORDER(XDATA("widgets",II))
if +II=0
QUIT
Begin DoDot:1
+6 SET XNAM=$GET(XDATA("widgets",II,"name"))
+7 SET XNAM=$SELECT(XNAM="HIGH RISK":"highRisk",XNAM="MBC":"measurementBased",1:XNAM)
+8 KILL XDATA("widgets",II,"instrumentList")
+9 KILL XDATA("widgets",II,"name")
+10 MERGE XJ(XNAM)=XDATA("widgets",II)
+11 SET XJ(XNAM,"display")="true"
+12 SET XJ(XNAM,"filterList","name")="name"
+13 SET XJ(XNAM,"filterList","value")=""
End DoDot:1
+14 DO ENCODE^YSBJSON("XJ","XJSON","ERRARY")
+15 QUIT
