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

YTQRCAT.m

Go to the documentation of this file. 
  1. YTQRCAT ;SLC/KCM - Calls to manage CAT instruments ; 1/25/2017
  1.  ;;5.01;MENTAL HEALTH;**182,199,202,218,240**;Dec 30, 1994;Build 10
  1.  ;
  1. SPLTADM(ADMIN) ; split CAT interview into multiple admins
  1.  N X0 S X0=$G(^YTT(601.84,ADMIN,0))
  1.  Q:$P(X0,U,9)'="Y"        ; quit if admin not complete
  1.  N NM S NM=$P(^YTT(601.71,+$P(X0,U,3),0),U)
  1.  Q:$E(NM,1,7)'="CAT-CAD"  ; quit if admin not CAT/CAD
  1.  ;
  1.  N TREE,ITEST,TTYP,CNT
  1.  D LOADTREE(ADMIN,.TREE)  ; turn JSON in answer into TREE
  1.  S ITEST=0,CNT=0
  1.  F  S ITEST=$O(TREE("report","tests",ITEST)) Q:'ITEST  S CNT=CNT+1
  1.  I CNT=1 D  QUIT          ; just re-point if only one test
  1.  . S TTYP=$G(TREE("report","tests",1,"type"))
  1.  . D REPOINT(ADMIN,$$NMINST(TTYP))
  1.  . D SETSCORE(ADMIN)
  1.  ;
  1.  ; continue here if multiple tests in interview
  1.  ; reverse $O on ITEST so we change the original last
  1.  S ITEST="" F  S ITEST=$O(TREE("report","tests",ITEST),-1) Q:'ITEST  D
  1.  . N NEWTREE,NEWADM,JSON,CATANS
  1.  . S TTYP=TREE("report","tests",ITEST,"type")
  1.  . M NEWTREE("report","tests",1)=TREE("report","tests",ITEST)
  1.  . M NEWTREE("answers")=TREE("answers")
  1.  . M NEWTREE("status")=TREE("status")
  1.  . D ENCODE^XLFJSON("NEWTREE","JSON") K NEWTREE
  1.  . D BLDANS(.JSON,.CATANS) K JSON
  1.  . I ITEST>1 D
  1.  . . S NEWADM=$$NEWADM(ADMIN,$$NMINST(TTYP))  ; create new admin
  1.  . . S CATANS("AD")=NEWADM
  1.  . E  S CATANS("AD")=ADMIN
  1.  . S CATANS(1)=8650    ; question id of CAT interview
  1.  . D SAVEANS(.CATANS)  ; adminId already in CATANS("AD")
  1.  . I ITEST=1 D REPOINT(ADMIN,$$NMINST(TTYP))  ; use original admin
  1.  . D SETSCORE(CATANS("AD"))
  1.  Q
  1. LOADTREE(ADMIN,TREE) ; load interview document into TREE
  1.  N YSDATA,YS
  1.  S YS("AD")=ADMIN
  1.  D LOADANSW^YTSCORE(.YSDATA,.YS)
  1.  D WP2JSON^YTSCAT(.YSDATA,.TREE)
  1.  Q
  1. BLDANS(JSON,CATANS) ; split JSON into FM WP chunks
  1.  N I,X,LN
  1.  S I=0,LN=0 F  S I=$O(JSON(I)) Q:'I  D
  1.  . F  S X=$E(JSON(I),1,200) D  Q:'$L(JSON(I))
  1.  . . S LN=LN+1,CATANS(1,LN)="|"_X
  1.  . . S JSON(I)=$E(JSON(I),201,$L(JSON(I)))
  1.  Q
  1. SETSCORE(ADMIN) ; score the admin
  1.  N YSDATA,YS
  1.  S YS("AD")=ADMIN
  1.  D SCORSAVE^YTQAPI11(.YSDATA,.YS)
  1.  K ^TMP($J,"YSCOR"),^TMP($J,"YSG")
  1.  Q
  1.  ;
  1. NEWADM(SRCADM,NAME) ; return a new admin for instrument NAME based on another
  1.  N YSDATA,YS,X0,IEN71
  1.  S X0=$G(^YTT(601.84,SRCADM,0)) I '$L(X0) Q 0
  1.  S IEN71=$O(^YTT(601.71,"B",NAME,0)) Q:'IEN71
  1.  S YS("FILEN")=601.84
  1.  S YS(1)=".01^NEW^1"
  1.  S YS(2)="1^`"_$P(X0,U,2)
  1.  S YS(3)="2^`"_IEN71
  1.  S YS(4)="3^"_$P(X0,U,4)
  1.  S YS(5)="4^"_$P(X0,U,5)
  1.  S YS(6)="5^`"_$P(X0,U,6)
  1.  S YS(7)="6^`"_$P(X0,U,7)
  1.  S YS(8)="7^"_$P(X0,U,8)
  1.  S YS(9)="8^"_$P(X0,U,9)
  1.  S YS(10)="9^"_$P(X0,U,10)
  1.  S YS(11)="13^`"_$P(X0,U,11)
  1.  S YS(12)="15^`"_$P(X0,U,13)
  1.  I $P(X0,U,15) S YS(13)="17^"_$P(X0,U,15)
  1.  D EDAD^YTQAPI1(.YSDATA,.YS)
  1.  Q $P(YSDATA(2),U,2)
  1.  ;
  1. REPOINT(ADMIN,NAME) ; re-point the instrument in ADMIN to NAME
  1.  N REC,IEN71
  1.  S IEN71=$O(^YTT(601.71,"B",NAME,0)) Q:'IEN71
  1.  S REC(2)=IEN71
  1.  D FMUPD^YTXCHGU(601.84,.REC,ADMIN)
  1.  D UPADM^YTQEVNT(ADMIN,"cat") ; publish admin update event
  1.  Q
  1. SAVEANS(CATANS) ; save/update CAT interview answer
  1.  N YSDATA,YSAD,IEN85
  1.  S YSAD=CATANS("AD")
  1.  I $D(^YTT(601.85,"AC",YSAD,8650)) D
  1.  . S IEN85=$O(^YTT(601.85,"AC",YSAD,8650,0))
  1.  . I IEN85 K ^YTT(601.85,IEN85,1) ; clear WP value
  1.  D SAVEALL^YTQAPI17(.YSDATA,.CATANS)
  1.  Q
  1. NMINST(TTYP) ; return name of instrument
  1.  S TTYP=$$LOW^XLFSTR(TTYP)
  1.  I TTYP="mdd" Q "CAD-MDD"
  1.  I TTYP="dep" Q "CAT-DEP"
  1.  I TTYP="anx" Q "CAT-ANX"
  1.  I TTYP="m/hm" Q "CAT-MANIA-HYPOMANIA"
  1.  I TTYP="sud" Q "CAT-SUD"
  1.  I TTYP="sa" Q "CAT-SUD"
  1.  I TTYP="ptsd" Q "CAT-PTSD"
  1.  I TTYP="a/adhd" Q "CAT-ADHD"
  1.  I TTYP="sdoh" Q "CAT-SDOH"
  1.  I TTYP="ss" Q "CAT-SS"
  1.  I TTYP="ptsd-dx" Q "CAD-PTSD-DX"
  1.  I TTYP="ptsd-e" Q "CAT-PTSD-E"
  1.  I TTYP="psy-c" Q "CAT-PSYCHOSIS"
  1.  I TTYP="psy-s" Q "CAT-PSYCHOSIS"
  1.  Q ""
  1.  ;
  1. QSPLT(YTADMIN) ; queue the splitting if this is a CAT interview
  1.  N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
  1.  S ZTIO=""
  1.  S ZTRTN="DQSPLT^YTQRCAT"
  1.  S ZTDESC="Create individual CAT administrations"
  1.  S ZTDTH=$H
  1.  S ZTSAVE("YTADMIN")=""
  1.  D ^%ZTLOAD
  1.  Q
  1. DQSPLT ; de-queue the admin and split into separate admins
  1.  S ZTREQ="@"
  1.  D SPLTADM(YTADMIN)
  1.  Q
  1. GCATINFO(ARGS,RESULTS) ; return catInfo object by assignmentId
  1.  N ASMT,ASMTID
  1.  S ASMTID=$G(ARGS("assignmentId"))
  1.  S ASMT="YTQASMT-SET-"_ASMTID
  1.  I 'ASMTID D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("assignmentId")) QUIT
  1.  I '$D(^XTMP(ASMT)) D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("assignmentId")) QUIT
  1.  I $D(^XTMP(ASMT,1,"catInfo"))>1 M RESULTS("catInfo")=^XTMP(ASMT,1,"catInfo") I 1
  1.  E  S RESULTS("catInfo")="null"
  1.  ; also get the answers
  1.  I $D(^XTMP("YTQCATSV-"_ASMTID,"answers"))>1 D
  1.  . M RESULTS("answers")=^XTMP("YTQCATSV-"_ASMTID,"answers")
  1.  I $D(^XTMP("YTQCATSV-"_ASMTID,"report"))>1 D
  1.  . M RESULTS("report")=^XTMP("YTQCATSV-"_ASMTID,"report")
  1.  S RESULTS("status")=$G(^XTMP("YTQCATSV-"_ASMTID,"status"))
  1.  Q
  1. PCATINFO(ARGS,DATA) ; save updated catInfo into assignment
  1.  N ASMT
  1.  S ASMT="YTQASMT-SET-"_$G(ARGS("assignmentId"))
  1.  I '$D(^XTMP(ASMT)) D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("assignmentId")) QUIT
  1.  I $D(DATA("catInfo"))>1 D
  1.  . K ^XTMP(ASMT,1,"catInfo")
  1.  . M ^XTMP(ASMT,1,"catInfo")=DATA("catInfo")
  1.  N ASMTID S ASMTID=ARGS("assignmentId")
  1.  N EXPIRE S EXPIRE=$$FMADD^XLFDT(DT,7)
  1.  S ^XTMP("YTQCATSV-"_ASMTID,0)=EXPIRE_U_DT_U_"MH CAT Interview Autosave"
  1.  I $D(DATA("answers"))>1 D
  1.  . K ^XTMP("YTQCATSV-"_ASMTID,"answers")
  1.  . M ^XTMP("YTQCATSV-"_ASMTID,"answers")=DATA("answers")
  1.  I $D(DATA("report"))>1 D
  1.  . K ^XTMP("YTQCATSV-"_ASMTID,"report")
  1.  . M ^XTMP("YTQCATSV-"_ASMTID,"report")=DATA("report")
  1.  I $D(DATA("status")) D
  1.  . S ^XTMP("YTQCATSV-"_ASMTID,"status")=$G(DATA("status"))
  1.  Q "/api/mha/assignment/cat/"_ARGS("assignmentId")
  1.  ;
  1. GETCATI(ARGS,RESULTS) ; return saved CAT object (by interviewID)
  1.  N CATID S CATID=ARGS("interviewId")
  1.  I '$D(^XTMP("YTQCAT-"_CATID,"data")) D  Q
  1.  . D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("interviewId"))
  1.  M RESULTS=^XTMP("YTQCAT-"_CATID,"data")
  1.  Q
  1. SETCATI(ARGS,DATA) ; save CAT object (by interviewID)
  1.  N CATID S CATID=ARGS("interviewId")
  1.  N EXPIRE S EXPIRE=$$FMADD^XLFDT(DT,7)
  1.  K ^XTMP("YTQCAT-"_CATID,"data")
  1.  S ^XTMP("YTQCAT-"_CATID,0)=EXPIRE_U_DT_U_"MH CAT Interview Cookies"
  1.  M ^XTMP("YTQCAT-"_CATID,"data")=DATA
  1.  Q "/api/mha/cat/interview/"_CATID
  1.  ;
  1. CHKPROG(ADMIN) ; if CAT return progress, otherwise -1
  1.  Q:'$G(ADMIN) -1
  1.  N CATPROG S CATPROG=-1
  1.  N TESTNM S TESTNM=$P(^YTT(601.71,$P(^YTT(601.84,ADMIN,0),U,3),0),U)
  1.  I $E(TESTNM,1,4)="CAT-"!($E(TESTNM,1,4)="CAD-") D
  1.  . S CATPROG=10
  1.  . I $P(^YTT(601.84,ADMIN,0),U,9)="Y" S CATPROG=100
  1.  Q CATPROG
  1.  ;
  1. MVAUTOSV(OLDSET,SETID) ; move the auto-save cache when assignment changes
  1.  I +$G(OLDSET),$D(^XTMP("YTQCATSV-"_OLDSET)) D
  1.  . K ^XTMP("YTQCATSV-"_SETID)
  1.  . M ^XTMP("YTQCATSV-"_SETID)=^XTMP("YTQCATSV-"_OLDSET)
  1.  . K ^XTMP("YTQCATSV-"_OLDSET)
  1.  Q
  1. ANYCAT(ASMT) ; return 1 if any CAT/CAD interviews in assignment
  1.  N I,FND,NODE
  1.  S FND=0,NODE="YTQASMT-SET-"_ASMT
  1.  S I=0 F  S I=$O(^XTMP(NODE,1,"instruments",I)) Q:'I  D
  1.  . I $E($G(^XTMP(NODE,1,"instruments",I,"name")),1,7)="CAT-CAD" S FND=1
  1.  Q FND
  1.  ;