Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTAPI3

YTAPI3.m

Go to the documentation of this file.
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