- YTQRQAD8 ;BAL/KTL - RESTful Calls to set/get MHA Note ; 1/25/2017
- ;;5.01;MENTAL HEALTH;**199,207,202,204,208,250**;Dec 30, 1994;Build 26
- ;
- ; 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
- ;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 4042 printed Jan 18, 2025@03:20:08 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**;Dec 30, 1994;Build 26
- +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 ;Saved progress note for all completed instruments. If last instrument, Delete Assignment
- +29 ;Kill Aggregate Progress Note
- KILL ^XTMP(NOD,2)
- +30 SET REMAIN=""
- +31 SET I=0
- FOR
- SET I=$ORDER(^XTMP(NOD,1,"instruments",I))
- if 'I
- QUIT
- Begin DoDot:1
- +32 IF $GET(^XTMP(NOD,1,"instruments",I,"complete"))'="true"
- SET REMAIN=1
- End DoDot:1
- +33 ;Last instrument OK to Kill Assignment
- IF 'REMAIN
- IF (FRMDEL'=1)
- IF $DATA(^XTMP(NOD,0))
- DO DELASMT1^YTQRQAD1(ASGN)
- +34 ;KILL Filed progress note text
- KILL ^XTMP(NOD,2)
- +35 QUIT $GET(YSDATA(2))
- +36 ;
- 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