YTQRCDB3 ;BAL/KTL - MHA CLOUD DATABASE REPORT/NOTE RPC CALLS; 1/25/2017
;;5.01;MENTAL HEALTH;**239,224**;Dec 30, 1994;Build 17
;
; Reference to ^DPT in ICR #10035
;
Q
PENOTE(ARGS,DATA) ;Patient Entry progress note
N II,DFN,ADMERR,TXT,DARR,NOTERSL
N TCNT,CCNT
S DFN=$G(DATA("dfn")) I +DFN=0!'$D(^DPT(DFN)) D SETERROR^YTQRUTL(404,"Invalid patient ID: "_DFN) Q "/api/mha/cdb/instrument/note/0"
S II=0 F S II=$O(DATA("notes",II)) Q:II="" D
. S ADMIN=$G(DATA("notes",II,"adminId")) Q:+ADMIN=0
. I $P($G(^YTT(601.84,ADMIN,0)),U,2)'=DFN S ADMERR=$G(ADMERR)_" : "_ADMIN K DATA("notes",II) ;Admin does not match passed in patient
I $G(ADMERR) D SETERROR^YTQRUTL(404,"Administration IDs do not match patient "_ADMERR) W !,ADMERR
I '$D(DATA("notes")) Q "/api/mha/cdb/instrument/note/0" ;No valid admins
D PRSNOTE(.ARGS,.DATA,.TXT,"PE")
S II=0 F S II=$O(TXT(II)) Q:II="" D
. S TCNT=$G(TCNT)+1
. I TCNT=1 S DARR("text")=TXT(II) Q
. S CCNT=$G(CCNT)+1
. S DARR("text","\",CCNT)=TXT(II)
S II=$O(DATA("notes","")),DARR("adminId")=DATA("notes",II,"adminId")
S NOTERSL=$$SETNOTE(.ARGS,.DARR)
Q NOTERSL
Q
SENOTE(ARGS,DATA) ;Staff Entry progress note
Q
PRSNOTE(ARGS,DATA,TXT,YSTYPE) ;Parse the incoming note JSON and branch accordingly.
N I,J,TXTARR,ADMIN,CONSULT,ALWNOTE,RESULTS,CNT
N COSIGNER,HDR,NCNT
S CNT=0
S I=0 F S I=$O(DATA("notes",I)) Q:+I=0 D
. S ADMIN=$G(DATA("notes",I,"adminId"))
. S COSIGNER=$G(DATA("notes",I,"cosigner"))
. I +ADMIN=0 D SETERROR^YTQRUTL(404,"Admin not sent: "_ADMIN) Q
. I '$D(^YTT(601.84,ADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN) Q
. K RESULTS
. I '$D(DATA("notes",I,"text"))!($G(DATA("notes",I,"text"))="null") D GETNOTE(ADMIN,COSIGNER,.RESULTS) ;No text passed in, generate from VistA MH REPORT template
. I $D(DATA("notes",I,"text")),(DATA("notes",I,"text")'="null") D ;PE/SE and note body sent
.. S NCNT=0
.. I $G(YSTYPE)="PE" D ;PE needs patient header added
... D BLDHDR^YTQRCDB4(.HDR,ADMIN,79)
... S J=0 F S J=$O(HDR(J)) Q:J="" D
.... S NCNT=NCNT+1,RESULTS("text","\",NCNT)=HDR(J)
.. S J=0 F S J=$O(DATA("notes",I,"text",J)) Q:J="" D
... S NCNT=NCNT+1,RESULTS("text","\",NCNT)=DATA("notes",I,"text",J)
. I $G(RESULTS("text"))="null" Q
. ;Now text is normalized in RESULTS whether sent in or generated through VistA.
. I CNT'=0 D
.. S CNT=CNT+1,$P(TXTARR(CNT),"_",75)="" ;Add Note Divider
. S J=0 F S J=$O(RESULTS("text","\",J)) Q:J="" D ;RESULTS format back into sequential TXTARR array
.. S CNT=CNT+1,TXTARR(CNT)=RESULTS("text","\",J)
;At this point all Cloud generated and VistA generated PNOTE text in TXTARR
M TXT=TXTARR
Q
GETNOTE(ADMIN,COSIGNER,RESULTS) ; build note object based on ARGS("adminId")
I '$D(^YTT(601.84,ADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN) QUIT
N CONSULT S CONSULT=$P(^YTT(601.84,ADMIN,0),U,15)
S RESULTS("adminId")=ADMIN
S RESULTS("consultId")=$S(+CONSULT:CONSULT,1:"null")
S RESULTS("allowNote")=$$ALWNOTE^YTQRQAD3(ADMIN)
S RESULTS("requireCosigner")=$$REQCSGN^YTQRQAD3(ADMIN)
S RESULTS("cosigner")=$S(COSIGNER'="":COSIGNER,1:"null")
I RESULTS("allowNote")="true" D REPORT1^YTQRQAD3(ADMIN,.RESULTS,"NOTE") I 1 ;ADMIN=Administration IEN, RESULTS array for report, NOTE=PROGRESS NOTE
E S RESULTS("text")="null"
D SPLTADM^YTQRCAT(ADMIN) ; separate out the admins if CAT
Q
SETNOTE(ARGS,DATA) ; save note in DATA("text") using ARGS("adminId")
;Expects DATA to be in the format returned from BLDRPT^YTQRRPT
;All instrument progress notes should be in DATA("text"), even for multiple instrument assignments
N YS,YSDATA,ADMIN,CONSULT,WRP,ASGN,LSTASGN,PNOT,AGPROG
S ADMIN=$G(DATA("adminId"))
S ASGN=$G(DATA("assignmentId"))
I ADMIN="" D SETERROR^YTQRUTL(404,"Admin not sent: "_ADMIN) QUIT ""
I '$D(^YTT(601.84,ADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN) QUIT ""
S CONSULT=$P(^YTT(601.84,ADMIN,0),U,15)
S PNOT=0
I '$D(^YTT(601.84,ADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN) QUIT ""
D TXT2LN(.DATA,.YS) ; parse by CRLF and set YS(#) to note text
D WRAP(.YS,79) ;reformat lines to 79 max chars
S YS("AD")=ADMIN
I $G(DATA("cosigner"))]"" S YS("COSIGNER")=DATA("cosigner")
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 ""
Q "/api/mha/cdb/instrument/note/"_$G(YSDATA(2))
;
TXT2LN(SRC,DEST) ; Move CRLF delimited text from .SRC into WP lines in .DEST
N IDEST,CRLF,REMAIN
S IDEST=0,CRLF=$C(10)
S REMAIN=$$PARSLN(SRC("text"))
I '$D(SRC("text","\",1)),$L(REMAIN) D QUIT ; done since no continue nodes
. S IDEST=IDEST+1,DEST(IDEST)=REMAIN
N J ; handle continue nodes
S J=0 F S J=$O(SRC("text","\",J)) Q:'J D
. S REMAIN=$$PARSLN(REMAIN_SRC("text","\",J))
I $L(REMAIN) S IDEST=IDEST+1,DEST(IDEST)=REMAIN
Q
PARSLN(TXT) ; Return remainder after parsing text into lines
; expects: CRLF, DEST, IDEST
N X S X=TXT
I '$L(X) Q ""
; Break lines by CRLF. Depending on source line delim could be $c(13) or $c(13,10). CRLF=$c(10) so $TR $c(13) in case it is embedded
F S IDEST=IDEST+1,DEST(IDEST)=$P(X,CRLF),X=$P(X,CRLF,2,99999),DEST(IDEST)=$TR(DEST(IDEST),$C(13)) Q:X'[CRLF
Q $TR(X,$C(13))
WRAP(OUT,MAX) ; Wrap text by space piece word MAX char width
N TMP,STR,II,JJ,PCE,CNT
I +$G(MAX)=0 S MAX=79
M TMP=OUT Q:'$D(TMP)
K OUT
S (CNT,II)=0 F S II=$O(TMP(II)) Q:II="" D
. S STR="" F JJ=1:1:$L(TMP(II)," ") D
.. S PCE=$P(TMP(II)," ",JJ)
.. I $L(STR_PCE_" ")>MAX D Q
... S CNT=CNT+1,OUT(CNT)=$E(STR,1,$L(STR)-1),STR=PCE_" "
.. S STR=STR_PCE_" "
. I STR]"" S CNT=CNT+1,OUT(CNT)=$E(STR,1,$L(STR)-1)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQRCDB3 5791 printed Dec 13, 2024@02:18:44 Page 2
YTQRCDB3 ;BAL/KTL - MHA CLOUD DATABASE REPORT/NOTE RPC CALLS; 1/25/2017
+1 ;;5.01;MENTAL HEALTH;**239,224**;Dec 30, 1994;Build 17
+2 ;
+3 ; Reference to ^DPT in ICR #10035
+4 ;
+5 QUIT
PENOTE(ARGS,DATA) ;Patient Entry progress note
+1 NEW II,DFN,ADMERR,TXT,DARR,NOTERSL
+2 NEW TCNT,CCNT
+3 SET DFN=$GET(DATA("dfn"))
IF +DFN=0!'$DATA(^DPT(DFN))
DO SETERROR^YTQRUTL(404,"Invalid patient ID: "_DFN)
QUIT "/api/mha/cdb/instrument/note/0"
+4 SET II=0
FOR
SET II=$ORDER(DATA("notes",II))
if II=""
QUIT
Begin DoDot:1
+5 SET ADMIN=$GET(DATA("notes",II,"adminId"))
if +ADMIN=0
QUIT
+6 ;Admin does not match passed in patient
IF $PIECE($GET(^YTT(601.84,ADMIN,0)),U,2)'=DFN
SET ADMERR=$GET(ADMERR)_" : "_ADMIN
KILL DATA("notes",II)
End DoDot:1
+7 IF $GET(ADMERR)
DO SETERROR^YTQRUTL(404,"Administration IDs do not match patient "_ADMERR)
WRITE !,ADMERR
+8 ;No valid admins
IF '$DATA(DATA("notes"))
QUIT "/api/mha/cdb/instrument/note/0"
+9 DO PRSNOTE(.ARGS,.DATA,.TXT,"PE")
+10 SET II=0
FOR
SET II=$ORDER(TXT(II))
if II=""
QUIT
Begin DoDot:1
+11 SET TCNT=$GET(TCNT)+1
+12 IF TCNT=1
SET DARR("text")=TXT(II)
QUIT
+13 SET CCNT=$GET(CCNT)+1
+14 SET DARR("text","\",CCNT)=TXT(II)
End DoDot:1
+15 SET II=$ORDER(DATA("notes",""))
SET DARR("adminId")=DATA("notes",II,"adminId")
+16 SET NOTERSL=$$SETNOTE(.ARGS,.DARR)
+17 QUIT NOTERSL
+18 QUIT
SENOTE(ARGS,DATA) ;Staff Entry progress note
+1 QUIT
PRSNOTE(ARGS,DATA,TXT,YSTYPE) ;Parse the incoming note JSON and branch accordingly.
+1 NEW I,J,TXTARR,ADMIN,CONSULT,ALWNOTE,RESULTS,CNT
+2 NEW COSIGNER,HDR,NCNT
+3 SET CNT=0
+4 SET I=0
FOR
SET I=$ORDER(DATA("notes",I))
if +I=0
QUIT
Begin DoDot:1
+5 SET ADMIN=$GET(DATA("notes",I,"adminId"))
+6 SET COSIGNER=$GET(DATA("notes",I,"cosigner"))
+7 IF +ADMIN=0
DO SETERROR^YTQRUTL(404,"Admin not sent: "_ADMIN)
QUIT
+8 IF '$DATA(^YTT(601.84,ADMIN,0))
DO SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN)
QUIT
+9 KILL RESULTS
+10 ;No text passed in, generate from VistA MH REPORT template
IF '$DATA(DATA("notes",I,"text"))!($GET(DATA("notes",I,"text"))="null")
DO GETNOTE(ADMIN,COSIGNER,.RESULTS)
+11 ;PE/SE and note body sent
IF $DATA(DATA("notes",I,"text"))
IF (DATA("notes",I,"text")'="null")
Begin DoDot:2
+12 SET NCNT=0
+13 ;PE needs patient header added
IF $GET(YSTYPE)="PE"
Begin DoDot:3
+14 DO BLDHDR^YTQRCDB4(.HDR,ADMIN,79)
+15 SET J=0
FOR
SET J=$ORDER(HDR(J))
if J=""
QUIT
Begin DoDot:4
+16 SET NCNT=NCNT+1
SET RESULTS("text","\",NCNT)=HDR(J)
End DoDot:4
End DoDot:3
+17 SET J=0
FOR
SET J=$ORDER(DATA("notes",I,"text",J))
if J=""
QUIT
Begin DoDot:3
+18 SET NCNT=NCNT+1
SET RESULTS("text","\",NCNT)=DATA("notes",I,"text",J)
End DoDot:3
End DoDot:2
+19 IF $GET(RESULTS("text"))="null"
QUIT
+20 ;Now text is normalized in RESULTS whether sent in or generated through VistA.
+21 IF CNT'=0
Begin DoDot:2
+22 ;Add Note Divider
SET CNT=CNT+1
SET $PIECE(TXTARR(CNT),"_",75)=""
End DoDot:2
+23 ;RESULTS format back into sequential TXTARR array
SET J=0
FOR
SET J=$ORDER(RESULTS("text","\",J))
if J=""
QUIT
Begin DoDot:2
+24 SET CNT=CNT+1
SET TXTARR(CNT)=RESULTS("text","\",J)
End DoDot:2
End DoDot:1
+25 ;At this point all Cloud generated and VistA generated PNOTE text in TXTARR
+26 MERGE TXT=TXTARR
+27 QUIT
GETNOTE(ADMIN,COSIGNER,RESULTS) ; build note object based on ARGS("adminId")
+1 IF '$DATA(^YTT(601.84,ADMIN,0))
DO SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN)
QUIT
+2 NEW CONSULT
SET CONSULT=$PIECE(^YTT(601.84,ADMIN,0),U,15)
+3 SET RESULTS("adminId")=ADMIN
+4 SET RESULTS("consultId")=$SELECT(+CONSULT:CONSULT,1:"null")
+5 SET RESULTS("allowNote")=$$ALWNOTE^YTQRQAD3(ADMIN)
+6 SET RESULTS("requireCosigner")=$$REQCSGN^YTQRQAD3(ADMIN)
+7 SET RESULTS("cosigner")=$SELECT(COSIGNER'="":COSIGNER,1:"null")
+8 ;ADMIN=Administration IEN, RESULTS array for report, NOTE=PROGRESS NOTE
IF RESULTS("allowNote")="true"
DO REPORT1^YTQRQAD3(ADMIN,.RESULTS,"NOTE")
IF 1
+9 IF '$TEST
SET RESULTS("text")="null"
+10 ; separate out the admins if CAT
DO SPLTADM^YTQRCAT(ADMIN)
+11 QUIT
SETNOTE(ARGS,DATA) ; save note in DATA("text") using ARGS("adminId")
+1 ;Expects DATA to be in the format returned from BLDRPT^YTQRRPT
+2 ;All instrument progress notes should be in DATA("text"), even for multiple instrument assignments
+3 NEW YS,YSDATA,ADMIN,CONSULT,WRP,ASGN,LSTASGN,PNOT,AGPROG
+4 SET ADMIN=$GET(DATA("adminId"))
+5 SET ASGN=$GET(DATA("assignmentId"))
+6 IF ADMIN=""
DO SETERROR^YTQRUTL(404,"Admin not sent: "_ADMIN)
QUIT ""
+7 IF '$DATA(^YTT(601.84,ADMIN,0))
DO SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN)
QUIT ""
+8 SET CONSULT=$PIECE(^YTT(601.84,ADMIN,0),U,15)
+9 SET PNOT=0
+10 IF '$DATA(^YTT(601.84,ADMIN,0))
DO SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN)
QUIT ""
+11 ; parse by CRLF and set YS(#) to note text
DO TXT2LN(.DATA,.YS)
+12 ;reformat lines to 79 max chars
DO WRAP(.YS,79)
+13 SET YS("AD")=ADMIN
+14 IF $GET(DATA("cosigner"))]""
SET YS("COSIGNER")=DATA("cosigner")
+15 IF CONSULT
SET YS("CON")=CONSULT
DO CCREATE^YTQCONS(.YSDATA,.YS)
IF 1
+16 IF '$TEST
DO PCREATE^YTQTIU(.YSDATA,.YS)
+17 IF YSDATA(1)'="[DATA]"
DO SETERROR^YTQRUTL(500,"Note not saved")
QUIT ""
+18 QUIT "/api/mha/cdb/instrument/note/"_$GET(YSDATA(2))
+19 ;
TXT2LN(SRC,DEST) ; Move CRLF delimited text from .SRC into WP lines in .DEST
+1 NEW IDEST,CRLF,REMAIN
+2 SET IDEST=0
SET CRLF=$CHAR(10)
+3 SET REMAIN=$$PARSLN(SRC("text"))
+4 ; done since no continue nodes
IF '$DATA(SRC("text","\",1))
IF $LENGTH(REMAIN)
Begin DoDot:1
+5 SET IDEST=IDEST+1
SET DEST(IDEST)=REMAIN
End DoDot:1
QUIT
+6 ; handle continue nodes
NEW J
+7 SET J=0
FOR
SET J=$ORDER(SRC("text","\",J))
if 'J
QUIT
Begin DoDot:1
+8 SET REMAIN=$$PARSLN(REMAIN_SRC("text","\",J))
End DoDot:1
+9 IF $LENGTH(REMAIN)
SET IDEST=IDEST+1
SET DEST(IDEST)=REMAIN
+10 QUIT
PARSLN(TXT) ; Return remainder after parsing text into lines
+1 ; expects: CRLF, DEST, IDEST
+2 NEW X
SET X=TXT
+3 IF '$LENGTH(X)
QUIT ""
+4 ; Break lines by CRLF. Depending on source line delim could be $c(13) or $c(13,10). CRLF=$c(10) so $TR $c(13) in case it is embedded
+5 FOR
SET IDEST=IDEST+1
SET DEST(IDEST)=$PIECE(X,CRLF)
SET X=$PIECE(X,CRLF,2,99999)
SET DEST(IDEST)=$TRANSLATE(DEST(IDEST),$CHAR(13))
if X'[CRLF
QUIT
+6 QUIT $TRANSLATE(X,$CHAR(13))
WRAP(OUT,MAX) ; Wrap text by space piece word MAX char width
+1 NEW TMP,STR,II,JJ,PCE,CNT
+2 IF +$GET(MAX)=0
SET MAX=79
+3 MERGE TMP=OUT
if '$DATA(TMP)
QUIT
+4 KILL OUT
+5 SET (CNT,II)=0
FOR
SET II=$ORDER(TMP(II))
if II=""
QUIT
Begin DoDot:1
+6 SET STR=""
FOR JJ=1:1:$LENGTH(TMP(II)," ")
Begin DoDot:2
+7 SET PCE=$PIECE(TMP(II)," ",JJ)
+8 IF $LENGTH(STR_PCE_" ")>MAX
Begin DoDot:3
+9 SET CNT=CNT+1
SET OUT(CNT)=$EXTRACT(STR,1,$LENGTH(STR)-1)
SET STR=PCE_" "
End DoDot:3
QUIT
+10 SET STR=STR_PCE_" "
End DoDot:2
+11 IF STR]""
SET CNT=CNT+1
SET OUT(CNT)=$EXTRACT(STR,1,$LENGTH(STR)-1)
End DoDot:1
+12 QUIT
+13 ;
