YTQRQAD8 ;BAL/KTL - RESTful Calls to set/get MHA Note ; 1/25/2017
;;5.01;MENTAL HEALTH;**199,207,202,204,208**;Dec 30, 1994;Build 23
;
; 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))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQRQAD8 2928 printed Dec 13, 2024@02:19 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**;Dec 30, 1994;Build 23
+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 ;
