- 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 Mar 13, 2025@21:23:35 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 ;