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