- 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 Feb 18, 2025@23:43:09 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