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

YTQRQAD5.m

Go to the documentation of this file. 
  1. YTQRQAD5 ;SLC/LLB - RESTful Calls to handle MHA assignments ; 10/07/2019
  1.  ;;5.01;MENTAL HEALTH;**158,178,182,181,187,199,202,204,228,238**;Dec 30, 1994;Build 25
  1.  ;
  1.  ; Reference to VADPT in ICR #10061
  1.  ; Reference to XLFDT in ICR #10103
  1.  ; Reference to XLFSTR in ICR #10104
  1.  ;
  1. EDITASMT(ARGS,DATA) ; save assignment, return /api/mha/assignment/edit/{assignmentId}
  1.  ;YTQRERRS NEWed in YTQRUTL
  1.  N EDITFLG,MSG
  1.  S EDITFLG="SUCCESS",MSG=""
  1.  N I,DFN,ORDBY,VA,VADM,VAERR,I,PREFIX,SETID,FOUND,PID,PTNAME,SSN,EXPIRE,RETSTAT
  1.  S SETID=+$G(ARGS("assignmentId"))
  1.  I '$D(^XTMP("YTQASMT-SET-"_SETID)) Q $$DONE(400,"Assignment Not Found",1)
  1.  S DFN=$G(^XTMP("YTQASMT-SET-"_SETID,1,"patient","dfn")) ; get pat info from existing assignment
  1.  ; get Patient DFN from assignment and compare with that sent in. Create error if no match
  1.  I DFN'=+$G(DATA("patient","dfn")) Q $$DONE(400,"Patient Mismatch",1)
  1.  S PTNAME=$G(^XTMP("YTQASMT-SET-"_SETID,1,"patient","name"))
  1.  S PID=$G(^XTMP("YTQASMT-SET-"_SETID,1,"patient","pid"))
  1.  S SSN=$G(^XTMP("YTQASMT-SET-"_SETID,1,"patient","ssn"))
  1.  S ORDBY=+$G(DATA("orderedBy"))
  1.  I $G(DATA("consult"))=""!($G(DATA("consult"))="null") K DATA("consult")
  1.  I $G(DATA("adminDate"))=""!($G(DATA("adminDate"))="null")!(+$G(DATA("adminDate"))=0) K DATA("adminDate")
  1.  I $G(DATA("cosigner"))=""!($G(DATA("cosigner"))="null") K DATA("cosigner")
  1.  S DATA("appSrc")=$G(DATA("appSrc"))
  1.  I 'DFN!'ORDBY Q $$DONE(400,"FAIL - Missing Reqd Fields",1)
  1.  D DEM^VADPT I $G(VAERR) Q $$DONE(400,"Missing Pt Info",1)
  1.  ; Loop through instruments in assignment and test if any progress in assignments and quit if assignment  progress is not 0.
  1.  S I=0 F  S I=$O(^XTMP("YTQASMT-SET-"_SETID,1,"instruments",I)) Q:I=""  D
  1.  . I $G(^XTMP("YTQASMT-SET-"_SETID,1,"instruments",I,"progress"))>0 S YTQRERRS=1
  1.  . I $G(^XTMP("YTQASMT-SET-"_SETID,1,"instruments",I,"adminId"))>0 S YTQRERRS=1  ;238 update
  1.  I $D(YTQRERRS) Q $$DONE(400,"Cannot edit, Instrument in progress",1)
  1.  I $D(^XTMP("YTQASMT-SET-"_SETID,2,"PNOTE")) M DATA(2,"PNOTE")=^XTMP("YTQASMT-SET-"_SETID,2,"PNOTE")
  1.  S RETSTAT=$$FILASGN^YTQRQAD1(.ARGS,.DATA,SETID,"EDIT")
  1.  Q "/api/mha/assignment/edit/"_RETSTAT
  1.  ;
  1. DONE(CODE,MSG,FAIL) ;
  1.  S DATA=CODE_" - "_MSG
  1.  I $G(FAIL)=1 S YTQRERRS=1 D SETERROR^YTQRUTL(CODE,MSG) Q ""
  1.  Q DATA
  1.  ;
  1. GETGRAPH(ARGS,RESULT) ; Retrieve completed instrument score graphing data for a patient
  1.  ; Report all scores for one patient/Instrument combination
  1.  N YS,PAT,INSTID,DFN,ADMID,YSCORES,YSGRPS,XSTR,CNT,RCNT,YSDATA
  1.  N RPRIV
  1.  S YSDATA=""
  1.  S (CNT,RCNT)=1
  1.  K RESULT
  1.  S YS("CODE")=ARGS("instrument")
  1.  S INSTID=$O(^YTT(601.71,"B",YS("CODE"),0))
  1.  S DFN=ARGS("dfn")
  1.  S PAT=$P(^DPT(DFN,0),"^",1)
  1.  S RPRIV=1
  1.  S RESULT(RCNT)="{""patient"":"""_PAT_""",""instrument"":"""_YS("CODE")_""",""adminDate"":["
  1.  S ADMID=0 F  S ADMID=$O(^YTT(601.84,"C",DFN,ADMID)) Q:ADMID'>0  D
  1.  . I $P(^YTT(601.84,ADMID,0),"^",3)'=INSTID Q  ;Exclude all but selected instrument
  1.  . I $P(^YTT(601.84,ADMID,0),"^",9)'="Y" Q  ;Exclude incomplete instruments
  1.  . S RPRIV=$$IPRIV(ARGS("instrument")) Q:'RPRIV
  1.  . S YS("AD")=$P(^YTT(601.84,ADMID,0),"^",1)
  1.  . S YS("ADATE")=$P(^YTT(601.84,ADMID,0),"^",4)
  1.  . K ^TMP($J,"YSCOR"),^TMP($J,"YSG") ;Kill temporary file before storing results
  1.  . D GETSCORE^YTQAPI8(.YSDATA,.YS) ;gets scores and ScaleGroups Scores are in ^TMP($J,"YSCOR") and ScaleGroups are in ^TMP($J,"YSG")
  1.  . I '$D(^TMP($J,"YSG")) D LCOLL ;Collect groups and scores for an single patient/LegacyInstrument/date
  1.  . I $D(^TMP($J,"YSG")) D COLL ;Collate groups and scores for an single patient/instrument/date
  1.  . K YSDATA
  1.  I RCNT'=1 S RESULT(RCNT)=$E(RESULT(RCNT),1,$L(RESULT(RCNT))-1)_"]"
  1.  I RCNT=1 S RESULT(RCNT)=$E(RESULT(RCNT),1,$L(RESULT(RCNT))-1)_"[]"
  1.  S RCNT=RCNT+1 S RESULT(RCNT)="}" ; close out entire object
  1.  K ^TMP("YTQ-JSON",$J)
  1.  S CNT=0 F  S CNT=$O(RESULT(CNT)) Q:CNT=""  S ^TMP("YTQ-JSON",$J,CNT,0)=RESULT(CNT)
  1.  K RESULT S RESULT=$NA(^TMP("YTQ-JSON",$J))
  1.  Q
  1. IPRIV(TSTNM)  ;Can user see results for instrument
  1.  N YS,YSDATA,IPRIV
  1.  S IPRIV=1
  1.  S YS("CODE")=TSTNM D PRIVL^YTAPI5(.YSDATA,.YS)
  1.  I $G(YSDATA(1))["[DATA]" I $P($G(YSDATA(2)),U)=0 S IPRIV=0
  1.  Q IPRIV
  1.  ;
  1. COLL ; Collect groups & scores for non-legacy instruments 
  1.  N CNT,TYPE,YSCALENM,YSTSCORE,GCNT,GCNTMAX,YSRSCORE,FRSTYP
  1.  N SCLRES,SDAT,YSCIND
  1.  S (CNT,GCNT,GCNTMAX)=0
  1.  S FRSTYP=$G(^TMP($J,"YSG",1)),FRSTYP=$P(FRSTYP,U)
  1.  I FRSTYP["ERROR" Q  ;No graph data
  1.  F  S CNT=$O(^TMP($J,"YSG",CNT)) Q:CNT=""  D
  1.  .  S TYPE=$P(^TMP($J,"YSG",CNT),"=",1) I $E($P(TYPE,"=",1),1,5)="Group" S GCNTMAX=GCNTMAX+1
  1.  S CNT=1 F  S CNT=$O(^TMP($J,"YSCOR",CNT)) Q:+CNT=0  D
  1.  . S SDAT=^TMP($J,"YSCOR",CNT),YSCALENM=$P(SDAT,"=") Q:YSCALENM=""
  1.  . S SCLRES(YSCALENM,CNT)=^TMP($J,"YSCOR",CNT)
  1.  S CNT=0
  1.  F  S CNT=$O(^TMP($J,"YSG",CNT)) Q:CNT=""  D
  1.  . S TYPE=$P(^TMP($J,"YSG",CNT),"=",1)
  1.  . I CNT=1&(TYPE="[DATA]") D  ; set date into RESULT
  1.  . . S RCNT=RCNT+1
  1.  . . S RESULT(RCNT)="   {""date"":"""_$$FMTE^XLFDT(YS("ADATE"),"7DZ")_""",""scores"":["
  1.  . I $E($P(TYPE,"=",1),1,5)="Group" D
  1.  . . S GCNT=GCNT+1
  1.  . . I GCNT>1 D
  1.  . . . S RESULT(RCNT)=$E(RESULT(RCNT),1,$L(RESULT(RCNT))-1)_"]" ;Close out scales array
  1.  . . . S RCNT=RCNT+1 S RESULT(RCNT)="      },"
  1.  . . S RCNT=RCNT+1
  1.  . . S RESULT(RCNT)="      {""group"":"""_$P(^TMP($J,"YSG",CNT),"^",3)_""",""scales"":["
  1.  . I $E($P(TYPE,"=",1),1,5)="Scale" D
  1.  . . S RCNT=RCNT+1
  1.  . . S YSCALENM=$P(^TMP($J,"YSG",CNT),"^",4)
  1.  . . Q:'$D(SCLRES(YSCALENM))
  1.  . . S YSCIND=$O(SCLRES(YSCALENM,""))
  1.  . . S YSRSCORE=$P($P($G(^TMP($J,"YSCOR",YSCIND)),"=",2),"^",1)
  1.  . . S YSTSCORE=$P($P($G(^TMP($J,"YSCOR",YSCIND)),"=",2),"^",2)
  1.  . . K SCLRES(YSCALENM,YSCIND)
  1.  . . ;S YSRSCORE=$P($P($G(^TMP($J,"YSCOR",($E(TYPE,6,8)+1))),"=",2),"^",1)
  1.  . . ;S YSTSCORE=$P($P($G(^TMP($J,"YSCOR",($E(TYPE,6,8)+1))),"=",2),"^",2)
  1.  . . S RESULT(RCNT)="         {""scale"":"""_YSCALENM_""",""rawScore"":"""_YSRSCORE
  1.  . . I YSTSCORE'="" S RESULT(RCNT)=RESULT(RCNT)_""",""tScore"":"""_YSTSCORE
  1.  . . S RESULT(RCNT)=RESULT(RCNT)_"""},"
  1.  S RESULT(RCNT)=$E(RESULT(RCNT),1,$L(RESULT(RCNT))-1)_"]" ;Close out last scales array
  1.  I GCNT=GCNTMAX S RCNT=RCNT+1 S RESULT(RCNT)="      }]" ;Close scores (group) array
  1.  S RCNT=RCNT+1 S RESULT(RCNT)="   },"
  1.  Q
  1.  ;
  1. LCOLL ; Collect scores from Legacy Instruments
  1.  N CNT,TYPE,YSCALENM,YSTSCORE,YSEND,YSRSCORE,FRSTYP
  1.  N YSRSL,INST,INSTD,YSR,YSCALE
  1.  S CNT=0
  1.  D INSTDEF
  1.  I '$D(INSTD) Q  ;No proper instrument definition
  1.  S YSEND=$O(^TMP($J,"YSCOR",""),-1)
  1.  S FRSTYP=$G(^TMP($J,"YSCOR",1)),FRSTYP=$P(FRSTYP,U)
  1.  I FRSTYP["ERROR" Q  ;No graph data
  1.  F  S CNT=$O(^TMP($J,"YSCOR",CNT)) Q:CNT=""  D
  1.  . S TYPE=$P(^TMP($J,"YSCOR",CNT),"=",1)
  1.  . I TYPE'="[DATA]" D
  1.  . . S YSCALENM=$P(^TMP($J,"YSCOR",CNT),"=",1)
  1.  . . S YSRSCORE=$P($P(^TMP($J,"YSCOR",CNT),"=",2),"^",1)
  1.  . . S YSTSCORE=$P($P(^TMP($J,"YSCOR",CNT),"=",2),"^",2)
  1.  . . S YSRSL($$TRIM^XLFSTR($$UP^XLFSTR(YSCALENM)))=YSRSCORE_U_YSTSCORE_U_YSCALENM  ;By Scale Name, added TRIM and UP to match INSTD
  1.  . . ;S YSRSL(CNT-1)=YSRSCORE_U_YSTSCORE_U_YSCALENM  ;CNT-1 for [DATA] offset in scale sequence number
  1.  N GCNTMAX,SCNT,YSCALENAM,YSRSCORE,YSTSCORE,YSGNAM,GCNT
  1.  S GCNTMAX=$O(INSTD(999),-1),GCNT=0
  1.  F  S CNT=$O(^TMP($J,"YSG",CNT)) Q:CNT=""  D
  1.  .  S TYPE=$P(^TMP($J,"YSG",CNT),"=",1) I $E($P(TYPE,"=",1),1,5)="Group" S GCNTMAX=GCNTMAX+1
  1.  S CNT=0
  1.  F  S CNT=$O(INSTD(CNT)) Q:+CNT=0  D
  1.  . S GCNT=GCNT+1
  1.  . I CNT=1 D  ; set date into RESULT
  1.  . . S RCNT=RCNT+1
  1.  . . S RESULT(RCNT)="   {""date"":"""_$$FMTE^XLFDT(YS("ADATE"),"7DZ")_""",""scores"":["
  1.  . I CNT>1 D
  1.  . . S RESULT(RCNT)=$E(RESULT(RCNT),1,$L(RESULT(RCNT))-1)_"]" ;Close out scales array
  1.  . . S RCNT=RCNT+1 S RESULT(RCNT)="      },"
  1.  . S YSGNAM=$O(INSTD(CNT,""))
  1.  . S RCNT=RCNT+1
  1.  . S RESULT(RCNT)="      {""group"":"""_YSGNAM_""",""scales"":["
  1.  . S SCNT=0 F  S SCNT=$O(INSTD(CNT,YSGNAM,SCNT)) Q:SCNT=""  D
  1.  . . S RCNT=RCNT+1
  1.  . . S YSCALE=$O(INSTD(CNT,YSGNAM,SCNT,""))
  1.  . . S YSR=$G(YSRSL(YSCALE))
  1.  . . S YSRSCORE=$P(YSR,U)
  1.  . . S YSTSCORE=$P(YSR,U,2)
  1.  . . S YSCALENM=$P(YSR,U,3) S:YSCALENM="" YSCALENM=YSCALE
  1.  . . S RESULT(RCNT)="         {""scale"":"""_YSCALENM_""",""rawScore"":"""_YSRSCORE
  1.  . . I YSTSCORE'="" S RESULT(RCNT)=RESULT(RCNT)_""",""tScore"":"""_YSTSCORE
  1.  . . S RESULT(RCNT)=RESULT(RCNT)_"""},"
  1.  S RESULT(RCNT)=$E(RESULT(RCNT),1,$L(RESULT(RCNT))-1)_"]" ;Close out last scales array
  1.  I GCNT=GCNTMAX S RCNT=RCNT+1 S RESULT(RCNT)="      }]" ;Close scores (group) array
  1.  S RCNT=RCNT+1 S RESULT(RCNT)="   },"
  1.  Q
  1. INSTDEF ;Get the Instrument Definition of ScaleGroups/Scales
  1.  N I,SEQ,SG,SGNAM,SCL0,SCLNAM,SCLSEQ,SCL
  1.  S I=INSTID
  1.  S SEQ=0 F  S SEQ=$O(^YTT(601.86,"AC",I,SEQ)) Q:SEQ=""  D
  1.  . S SG=$O(^YTT(601.86,"AC",I,SEQ,""))
  1.  . S SGNAM=$P(^YTT(601.86,SG,0),U,3)
  1.  . S INST("SCALEGROUP",SEQ)=SGNAM_U_SG
  1.  . S SCL="" F  S SCL=$O(^YTT(601.87,"AD",SG,SCL)) Q:SCL=""  D
  1.  .. S SCL0=^YTT(601.87,SCL,0)
  1.  .. S SCLNAM=$$UP^XLFSTR($P(SCL0,U,4))
  1.  .. S SCLSEQ=$P(SCL0,U,3)
  1.  .. S INST("SCALEGROUP",SEQ,"SCALE",SCLSEQ)=SCLNAM_U_SCL
  1.  .. S INSTD(SEQ,SGNAM,SCLSEQ,SCLNAM)=""
  1.  Q
  1.  ;