Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTQRCDB3

YTQRCDB3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to ^DPT in ICR #10035
  1. ;
  1. Q
  1. PENOTE(ARGS,DATA) ;Patient Entry progress note
  1. N II,DFN,ADMERR,TXT,DARR,NOTERSL
  1. N TCNT,CCNT
  1. 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"
  1. S II=0 F S II=$O(DATA("notes",II)) Q:II="" D
  1. . S ADMIN=$G(DATA("notes",II,"adminId")) Q:+ADMIN=0
  1. . 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
  1. I $G(ADMERR) D SETERROR^YTQRUTL(404,"Administration IDs do not match patient "_ADMERR) W !,ADMERR
  1. I '$D(DATA("notes")) Q "/api/mha/cdb/instrument/note/0" ;No valid admins
  1. D PRSNOTE(.ARGS,.DATA,.TXT,"PE")
  1. S II=0 F S II=$O(TXT(II)) Q:II="" D
  1. . S TCNT=$G(TCNT)+1
  1. . I TCNT=1 S DARR("text")=TXT(II) Q
  1. . S CCNT=$G(CCNT)+1
  1. . S DARR("text","\",CCNT)=TXT(II)
  1. S II=$O(DATA("notes","")),DARR("adminId")=DATA("notes",II,"adminId")
  1. S NOTERSL=$$SETNOTE(.ARGS,.DARR)
  1. Q NOTERSL
  1. Q
  1. SENOTE(ARGS,DATA) ;Staff Entry progress note
  1. Q
  1. PRSNOTE(ARGS,DATA,TXT,YSTYPE) ;Parse the incoming note JSON and branch accordingly.
  1. N I,J,TXTARR,ADMIN,CONSULT,ALWNOTE,RESULTS,CNT
  1. N COSIGNER,HDR,NCNT
  1. S CNT=0
  1. S I=0 F S I=$O(DATA("notes",I)) Q:+I=0 D
  1. . S ADMIN=$G(DATA("notes",I,"adminId"))
  1. . S COSIGNER=$G(DATA("notes",I,"cosigner"))
  1. . I +ADMIN=0 D SETERROR^YTQRUTL(404,"Admin not sent: "_ADMIN) Q
  1. . I '$D(^YTT(601.84,ADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN) Q
  1. . K RESULTS
  1. . 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
  1. . I $D(DATA("notes",I,"text")),(DATA("notes",I,"text")'="null") D ;PE/SE and note body sent
  1. .. S NCNT=0
  1. .. I $G(YSTYPE)="PE" D ;PE needs patient header added
  1. ... D BLDHDR^YTQRCDB4(.HDR,ADMIN,79)
  1. ... S J=0 F S J=$O(HDR(J)) Q:J="" D
  1. .... S NCNT=NCNT+1,RESULTS("text","\",NCNT)=HDR(J)
  1. .. S J=0 F S J=$O(DATA("notes",I,"text",J)) Q:J="" D
  1. ... S NCNT=NCNT+1,RESULTS("text","\",NCNT)=DATA("notes",I,"text",J)
  1. . I $G(RESULTS("text"))="null" Q
  1. . ;Now text is normalized in RESULTS whether sent in or generated through VistA.
  1. . I CNT'=0 D
  1. .. S CNT=CNT+1,$P(TXTARR(CNT),"_",75)="" ;Add Note Divider
  1. . S J=0 F S J=$O(RESULTS("text","\",J)) Q:J="" D ;RESULTS format back into sequential TXTARR array
  1. .. S CNT=CNT+1,TXTARR(CNT)=RESULTS("text","\",J)
  1. ;At this point all Cloud generated and VistA generated PNOTE text in TXTARR
  1. M TXT=TXTARR
  1. Q
  1. GETNOTE(ADMIN,COSIGNER,RESULTS) ; build note object based on ARGS("adminId")
  1. I '$D(^YTT(601.84,ADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN) QUIT
  1. N CONSULT S CONSULT=$P(^YTT(601.84,ADMIN,0),U,15)
  1. S RESULTS("adminId")=ADMIN
  1. S RESULTS("consultId")=$S(+CONSULT:CONSULT,1:"null")
  1. S RESULTS("allowNote")=$$ALWNOTE^YTQRQAD3(ADMIN)
  1. S RESULTS("requireCosigner")=$$REQCSGN^YTQRQAD3(ADMIN)
  1. S RESULTS("cosigner")=$S(COSIGNER'="":COSIGNER,1:"null")
  1. I RESULTS("allowNote")="true" D REPORT1^YTQRQAD3(ADMIN,.RESULTS,"NOTE") I 1 ;ADMIN=Administration IEN, RESULTS array for report, NOTE=PROGRESS NOTE
  1. E S RESULTS("text")="null"
  1. D SPLTADM^YTQRCAT(ADMIN) ; separate out the admins if CAT
  1. Q
  1. SETNOTE(ARGS,DATA) ; save note in DATA("text") using ARGS("adminId")
  1. ;Expects DATA to be in the format returned from BLDRPT^YTQRRPT
  1. ;All instrument progress notes should be in DATA("text"), even for multiple instrument assignments
  1. N YS,YSDATA,ADMIN,CONSULT,WRP,ASGN,LSTASGN,PNOT,AGPROG
  1. S ADMIN=$G(DATA("adminId"))
  1. S ASGN=$G(DATA("assignmentId"))
  1. I ADMIN="" D SETERROR^YTQRUTL(404,"Admin not sent: "_ADMIN) QUIT ""
  1. I '$D(^YTT(601.84,ADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN) QUIT ""
  1. S CONSULT=$P(^YTT(601.84,ADMIN,0),U,15)
  1. S PNOT=0
  1. I '$D(^YTT(601.84,ADMIN,0)) D SETERROR^YTQRUTL(404,"Admin not found: "_ADMIN) QUIT ""
  1. D TXT2LN(.DATA,.YS) ; parse by CRLF and set YS(#) to note text
  1. D WRAP(.YS,79) ;reformat lines to 79 max chars
  1. S YS("AD")=ADMIN
  1. I $G(DATA("cosigner"))]"" S YS("COSIGNER")=DATA("cosigner")
  1. I CONSULT S YS("CON")=CONSULT D CCREATE^YTQCONS(.YSDATA,.YS) I 1
  1. E D PCREATE^YTQTIU(.YSDATA,.YS)
  1. I YSDATA(1)'="[DATA]" D SETERROR^YTQRUTL(500,"Note not saved") Q ""
  1. Q "/api/mha/cdb/instrument/note/"_$G(YSDATA(2))
  1. ;
  1. TXT2LN(SRC,DEST) ; Move CRLF delimited text from .SRC into WP lines in .DEST
  1. N IDEST,CRLF,REMAIN
  1. S IDEST=0,CRLF=$C(10)
  1. S REMAIN=$$PARSLN(SRC("text"))
  1. I '$D(SRC("text","\",1)),$L(REMAIN) D QUIT ; done since no continue nodes
  1. . S IDEST=IDEST+1,DEST(IDEST)=REMAIN
  1. N J ; handle continue nodes
  1. S J=0 F S J=$O(SRC("text","\",J)) Q:'J D
  1. . S REMAIN=$$PARSLN(REMAIN_SRC("text","\",J))
  1. I $L(REMAIN) S IDEST=IDEST+1,DEST(IDEST)=REMAIN
  1. Q
  1. PARSLN(TXT) ; Return remainder after parsing text into lines
  1. ; expects: CRLF, DEST, IDEST
  1. N X S X=TXT
  1. I '$L(X) Q ""
  1. ; 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
  1. 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
  1. Q $TR(X,$C(13))
  1. WRAP(OUT,MAX) ; Wrap text by space piece word MAX char width
  1. N TMP,STR,II,JJ,PCE,CNT
  1. I +$G(MAX)=0 S MAX=79
  1. M TMP=OUT Q:'$D(TMP)
  1. K OUT
  1. S (CNT,II)=0 F S II=$O(TMP(II)) Q:II="" D
  1. . S STR="" F JJ=1:1:$L(TMP(II)," ") D
  1. .. S PCE=$P(TMP(II)," ",JJ)
  1. .. I $L(STR_PCE_" ")>MAX D Q
  1. ... S CNT=CNT+1,OUT(CNT)=$E(STR,1,$L(STR)-1),STR=PCE_" "
  1. .. S STR=STR_PCE_" "
  1. . I STR]"" S CNT=CNT+1,OUT(CNT)=$E(STR,1,$L(STR)-1)
  1. Q
  1. ;