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