source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI3.m@ 1437

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

initial load of WorldVistAEHR

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