YTAPI3 ;ALB/ASF PSYCH TEST API ITEMS ;9/24/99 10:54
;;5.01;MENTAL HEALTH;**53**;Dec 30, 1994
SHOWIT(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
K YSDATA
D PARSE^YTAPI(.YS)
;#### MOVE TO YTAPI???
S YSITEM=$G(YS("ITEM"))
I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q
S YSET=$O(^YTT(601,"B",YSCODE,0))
I YSITEM'?1N.N!('$D(^YTT(601,YSET,"Q",YSITEM))) S YSDATA(1)="[ERROR]",YSDATA(2)="item number not correct" Q
S N=0
S YSDATA(1)="[DATA]"
S YSDATA(2)=YSCODE_U_$P($G(^YTT(601,YSET,"P")),U)_U_YSITEM
D MAIN
Q
SHOWALL(YSDATA,YS) ;
;returns all item information for a specified test
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
K YSDATA
D PARSE^YTAPI(.YS)
I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q
S YSET=$O(^YTT(601,"B",YSCODE,0))
S N=$O(^YTT(601,YSET,"Q",599))
I N>599 S YSDATA(1)="[ERROR]",YSDATA(2)="too many questions" Q
S N=0
S YSDATA(1)="[DATA]"
S YSDATA(2)=YSCODE_U_$P($G(^YTT(601,YSET,"P")),U)
;Loop thru test for all items
S YSITEM=0
F S YSITEM=$O(^YTT(601,YSET,"Q",YSITEM)) Q:YSITEM'>0 D
. D MAIN
Q
MAIN ;
S YSNODE="I"
;[INTRO]
D GETTEXT
S YSNODE="T"
;[TEXT]
D GETTEXT
;[BOTTOM]
D BTM
;[RESPONSE]
D RESP
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 YSDATA(YSITEM,YSNODE,N1)=X
Q
RESP ;get approp responses
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 YSDATA(1)="[ERROR]",YSDATA(2)="no acceptable responses found" Q
S YSDATA(YSITEM,"R",0)=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 N1=0
F I=2:2 S X=$P(B,",",I) Q:X="" D
. S X=$E(X,2,$L(X)-1)
. S N1=N1+1,YSDATA(YSITEM,"R",N1)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI3 2314 printed Dec 13, 2024@02:16:49 Page 2
YTAPI3 ;ALB/ASF PSYCH TEST API ITEMS ;9/24/99 10:54
+1 ;;5.01;MENTAL HEALTH;**53**;Dec 30, 1994
SHOWIT(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
+4 KILL YSDATA
+5 DO PARSE^YTAPI(.YS)
+6 ;#### MOVE TO YTAPI???
+7 SET YSITEM=$GET(YS("ITEM"))
+8 IF '$DATA(^YTT(601,"B",YSCODE))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="INCORRECT TEST CODE"
QUIT
+9 SET YSET=$ORDER(^YTT(601,"B",YSCODE,0))
+10 IF YSITEM'?1N.N!('$DATA(^YTT(601,YSET,"Q",YSITEM)))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="item number not correct"
QUIT
+11 SET N=0
+12 SET YSDATA(1)="[DATA]"
+13 SET YSDATA(2)=YSCODE_U_$PIECE($GET(^YTT(601,YSET,"P")),U)_U_YSITEM
+14 DO MAIN
+15 QUIT
SHOWALL(YSDATA,YS) ;
+1 ;returns all item information for a specified test
+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
+4 KILL YSDATA
+5 DO PARSE^YTAPI(.YS)
+6 IF '$DATA(^YTT(601,"B",YSCODE))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="INCORRECT TEST CODE"
QUIT
+7 SET YSET=$ORDER(^YTT(601,"B",YSCODE,0))
+8 SET N=$ORDER(^YTT(601,YSET,"Q",599))
+9 IF N>599
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="too many questions"
QUIT
+10 SET N=0
+11 SET YSDATA(1)="[DATA]"
+12 SET YSDATA(2)=YSCODE_U_$PIECE($GET(^YTT(601,YSET,"P")),U)
+13 ;Loop thru test for all items
+14 SET YSITEM=0
+15 FOR
SET YSITEM=$ORDER(^YTT(601,YSET,"Q",YSITEM))
if YSITEM'>0
QUIT
Begin DoDot:1
+16 DO MAIN
End DoDot:1
+17 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 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 YSDATA(YSITEM,YSNODE,N1)=X
End DoDot:1
+4 QUIT
RESP ;get approp responses
+1 SET A=""
SET N1=YSITEM+.1
+2 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
+3 IF A=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no acceptable responses found"
QUIT
+4 SET YSDATA(YSITEM,"R",0)=A
+5 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 N1=0
+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 SET N1=N1+1
SET YSDATA(YSITEM,"R",N1)=X
End DoDot:1
+8 QUIT
