source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI6.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1YTAPI6 ;ALB/ASF PSYCH TEST API FLAT ITEMS ;8/16/01 15:12
2 ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
3QUEST(YSDATA,YS) ;
4 ;returns item information
5 N YSSONE,S,R,N,YSET,N1,YSN2,N4,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND
6 N IFN,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSTAFF,YSTYPE,YSQ
7 K ^TMP($J,"YSDATA")
8 K YSDATA
9 D PARSE^YTAPI(.YS)
10 S YSITEM=$G(YS("ITEM"),0)
11 I '$D(^YTT(601,"B",YSCODE)) S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="INCORRECT TEST CODE" Q
12 S YSET=$O(^YTT(601,"B",YSCODE,0))
13 I (YSITEM>0)&('$D(^YTT(601,YSET,"Q",YSITEM))) S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="item number not correct" Q
14 S N=0,YSQ=2
15 S ^TMP($J,"YSDATA",1)="[DATA]"
16 S ^TMP($J,"YSDATA",2)=YSCODE_U_$P($G(^YTT(601,YSET,"P")),U)_U_$S(YSITEM=0:"all Items",1:"item: "_YSITEM)
17 I YSITEM>0 D MAIN S $P(^TMP($J,"YSDATA",2),U,4)=1 Q ;--> OUT
18 ;S N=$O(^YTT(601,YSET,"Q",599))
19 ;I N>599 S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="too many questions" Q
20 S N=0
21 ;Loop thru test for all items
22 S YSITEM=0
23 F S YSITEM=$O(^YTT(601,YSET,"Q",YSITEM)) Q:YSITEM'>0 D
24 . S $P(^TMP($J,"YSDATA",2),U,4)=YSITEM
25 . D MAIN
26 Q
27MAIN ;
28 S YSNODE="I"
29 ;[INTRO]
30 D GETTEXT
31 S YSNODE="T"
32 ;[TEXT]
33 D GETTEXT
34 ;[BOTTOM]
35 D BTM
36 ;[RESPONSE]
37 D RESP
38 ;[MOVE]
39 M YSDATA=^TMP($J,"YSDATA")
40 Q
41GETTEXT ;pull text and intros
42 S N1=0 F S N1=$O(^YTT(601,YSET,"Q",YSITEM,YSNODE,N1)) Q:N1'>0 D
43 . S X=^YTT(601,YSET,"Q",YSITEM,YSNODE,N1,0)
44 . S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_YSNODE_U_X
45 Q
46RESP ;get approp responses
47 I $G(^YTT(601,YSET,"Q",YSITEM,1))?1N.E D Q
48 . S G=^YTT(601,YSET,"Q",YSITEM,1)
49 . S G1=$E(G,1)
50 . S A=$S(G1=3:$E("123456789",1,$E(G,3,3))_"X",G1<3:"YNX",1:"")
51 . I A="" S YSDAT(1)="[ERROR]",YSDATA(2)="bad resp interview" Q
52 . S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"A"_U_A_U_G1_U_$P(G,U,2)
53 S A="",N1=YSITEM+.1
54 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'=""
55 I A="" S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="no acceptable responses found for item "_YSITEM Q
56 S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"A"_U_A
57 Q
58BTM ; get bottom of text
59 S B="",N1=YSITEM+.1
60 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"))
61 Q:B=""
62 S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"T"_U
63 F I=2:2 S X=$P(B,",",I) Q:X="" D
64 . S X=$E(X,2,$L(X)-1)
65 . I (X'?1"Answer".E)&(X'?1"ANSWER".E) S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"T"_U_X
66 Q
Note: See TracBrowser for help on using the repository browser.