YTAPI6 ;ALB/ASF PSYCH TEST API FLAT ITEMS ;8/16/01 15:12
;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
QUEST(YSDATA,YS) ;
;returns item information
N YSSONE,S,R,N,YSET,N1,YSN2,N4,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND
N IFN,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSTAFF,YSTYPE,YSQ
K ^TMP($J,"YSDATA")
K YSDATA
D PARSE^YTAPI(.YS)
S YSITEM=$G(YS("ITEM"),0)
I '$D(^YTT(601,"B",YSCODE)) S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="INCORRECT TEST CODE" Q
S YSET=$O(^YTT(601,"B",YSCODE,0))
I (YSITEM>0)&('$D(^YTT(601,YSET,"Q",YSITEM))) S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="item number not correct" Q
S N=0,YSQ=2
S ^TMP($J,"YSDATA",1)="[DATA]"
S ^TMP($J,"YSDATA",2)=YSCODE_U_$P($G(^YTT(601,YSET,"P")),U)_U_$S(YSITEM=0:"all Items",1:"item: "_YSITEM)
I YSITEM>0 D MAIN S $P(^TMP($J,"YSDATA",2),U,4)=1 Q ;--> OUT
;S N=$O(^YTT(601,YSET,"Q",599))
;I N>599 S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="too many questions" Q
S N=0
;Loop thru test for all items
S YSITEM=0
F S YSITEM=$O(^YTT(601,YSET,"Q",YSITEM)) Q:YSITEM'>0 D
. S $P(^TMP($J,"YSDATA",2),U,4)=YSITEM
. D MAIN
Q
MAIN ;
S YSNODE="I"
;[INTRO]
D GETTEXT
S YSNODE="T"
;[TEXT]
D GETTEXT
;[BOTTOM]
D BTM
;[RESPONSE]
D RESP
;[MOVE]
M YSDATA=^TMP($J,"YSDATA")
Q
GETTEXT ;pull text and intros
S N1=0 F S N1=$O(^YTT(601,YSET,"Q",YSITEM,YSNODE,N1)) Q:N1'>0 D
. S X=^YTT(601,YSET,"Q",YSITEM,YSNODE,N1,0)
. S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_YSNODE_U_X
Q
RESP ;get approp responses
I $G(^YTT(601,YSET,"Q",YSITEM,1))?1N.E D Q
. S G=^YTT(601,YSET,"Q",YSITEM,1)
. S G1=$E(G,1)
. S A=$S(G1=3:$E("123456789",1,$E(G,3,3))_"X",G1<3:"YNX",1:"")
. I A="" S YSDAT(1)="[ERROR]",YSDATA(2)="bad resp interview" Q
. S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"A"_U_A_U_G1_U_$P(G,U,2)
S A="",N1=YSITEM+.1
F S N1=$O(^YTT(601,YSET,"Q",N1),-1) Q:N1'>0 S A=$P(^YTT(601,YSET,"Q",N1,0),U,2) Q:A'=""
I A="" S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="no acceptable responses found for item "_YSITEM Q
S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"A"_U_A
Q
BTM ; get bottom of text
S B="",N1=YSITEM+.1
F S N1=$O(^YTT(601,YSET,"Q",N1),-1) Q:N1'>0 S B=$G(^YTT(601,YSET,"Q",N1,"B")) Q:$D(^YTT(601,YSET,"Q",N1,"B"))
Q:B=""
S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"T"_U
F I=2:2 S X=$P(B,",",I) Q:X="" D
. S X=$E(X,2,$L(X)-1)
. I (X'?1"Answer".E)&(X'?1"ANSWER".E) S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"T"_U_X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI6 2566 printed Oct 16, 2024@18:17:34 Page 2
YTAPI6 ;ALB/ASF PSYCH TEST API FLAT ITEMS ;8/16/01 15:12
+1 ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
QUEST(YSDATA,YS) ;
+1 ;returns item information
+2 NEW YSSONE,S,R,N,YSET,N1,YSN2,N4,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND
+3 NEW IFN,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSTAFF,YSTYPE,YSQ
+4 KILL ^TMP($JOB,"YSDATA")
+5 KILL YSDATA
+6 DO PARSE^YTAPI(.YS)
+7 SET YSITEM=$GET(YS("ITEM"),0)
+8 IF '$DATA(^YTT(601,"B",YSCODE))
SET ^TMP($JOB,"YSDATA",1)="[ERROR]"
SET ^TMP($JOB,"YSDATA",2)="INCORRECT TEST CODE"
QUIT
+9 SET YSET=$ORDER(^YTT(601,"B",YSCODE,0))
+10 IF (YSITEM>0)&('$DATA(^YTT(601,YSET,"Q",YSITEM)))
SET ^TMP($JOB,"YSDATA",1)="[ERROR]"
SET ^TMP($JOB,"YSDATA",2)="item number not correct"
QUIT
+11 SET N=0
SET YSQ=2
+12 SET ^TMP($JOB,"YSDATA",1)="[DATA]"
+13 SET ^TMP($JOB,"YSDATA",2)=YSCODE_U_$PIECE($GET(^YTT(601,YSET,"P")),U)_U_$SELECT(YSITEM=0:"all Items",1:"item: "_YSITEM)
+14 ;--> OUT
IF YSITEM>0
DO MAIN
SET $PIECE(^TMP($JOB,"YSDATA",2),U,4)=1
QUIT
+15 ;S N=$O(^YTT(601,YSET,"Q",599))
+16 ;I N>599 S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="too many questions" Q
+17 SET N=0
+18 ;Loop thru test for all items
+19 SET YSITEM=0
+20 FOR
SET YSITEM=$ORDER(^YTT(601,YSET,"Q",YSITEM))
if YSITEM'>0
QUIT
Begin DoDot:1
+21 SET $PIECE(^TMP($JOB,"YSDATA",2),U,4)=YSITEM
+22 DO MAIN
End DoDot:1
+23 QUIT
MAIN ;
+1 SET YSNODE="I"
+2 ;[INTRO]
+3 DO GETTEXT
+4 SET YSNODE="T"
+5 ;[TEXT]
+6 DO GETTEXT
+7 ;[BOTTOM]
+8 DO BTM
+9 ;[RESPONSE]
+10 DO RESP
+11 ;[MOVE]
+12 MERGE YSDATA=^TMP($JOB,"YSDATA")
+13 QUIT
GETTEXT ;pull text and intros
+1 SET N1=0
FOR
SET N1=$ORDER(^YTT(601,YSET,"Q",YSITEM,YSNODE,N1))
if N1'>0
QUIT
Begin DoDot:1
+2 SET X=^YTT(601,YSET,"Q",YSITEM,YSNODE,N1,0)
+3 SET YSQ=YSQ+1
SET ^TMP($JOB,"YSDATA",YSQ)=YSITEM_U_YSNODE_U_X
End DoDot:1
+4 QUIT
RESP ;get approp responses
+1 IF $GET(^YTT(601,YSET,"Q",YSITEM,1))?1N.E
Begin DoDot:1
+2 SET G=^YTT(601,YSET,"Q",YSITEM,1)
+3 SET G1=$EXTRACT(G,1)
+4 SET A=$SELECT(G1=3:$EXTRACT("123456789",1,$EXTRACT(G,3,3))_"X",G1<3:"YNX",1:"")
+5 IF A=""
SET YSDAT(1)="[ERROR]"
SET YSDATA(2)="bad resp interview"
QUIT
+6 SET YSQ=YSQ+1
SET ^TMP($JOB,"YSDATA",YSQ)=YSITEM_U_"A"_U_A_U_G1_U_$PIECE(G,U,2)
End DoDot:1
QUIT
+7 SET A=""
SET N1=YSITEM+.1
+8 FOR
SET N1=$ORDER(^YTT(601,YSET,"Q",N1),-1)
if N1'>0
QUIT
SET A=$PIECE(^YTT(601,YSET,"Q",N1,0),U,2)
if A'=""
QUIT
+9 IF A=""
SET ^TMP($JOB,"YSDATA",1)="[ERROR]"
SET ^TMP($JOB,"YSDATA",2)="no acceptable responses found for item "_YSITEM
QUIT
+10 SET YSQ=YSQ+1
SET ^TMP($JOB,"YSDATA",YSQ)=YSITEM_U_"A"_U_A
+11 QUIT
BTM ; get bottom of text
+1 SET B=""
SET N1=YSITEM+.1
+2 FOR
SET N1=$ORDER(^YTT(601,YSET,"Q",N1),-1)
if N1'>0
QUIT
SET B=$GET(^YTT(601,YSET,"Q",N1,"B"))
if $DATA(^YTT(601,YSET,"Q",N1,"B"))
QUIT
+3 if B=""
QUIT
+4 SET YSQ=YSQ+1
SET ^TMP($JOB,"YSDATA",YSQ)=YSITEM_U_"T"_U
+5 FOR I=2:2
SET X=$PIECE(B,",",I)
if X=""
QUIT
Begin DoDot:1
+6 SET X=$EXTRACT(X,2,$LENGTH(X)-1)
+7 IF (X'?1"Answer".E)&(X'?1"ANSWER".E)
SET YSQ=YSQ+1
SET ^TMP($JOB,"YSDATA",YSQ)=YSITEM_U_"T"_U_X
End DoDot:1
+8 QUIT
