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

YTAPI6.m

Go to the documentation of this file.
  1. YTAPI6 ;ALB/ASF PSYCH TEST API FLAT ITEMS ;8/16/01 15:12
  1. ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
  1. QUEST(YSDATA,YS) ;
  1. ;returns item information
  1. N YSSONE,S,R,N,YSET,N1,YSN2,N4,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND
  1. N IFN,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSTAFF,YSTYPE,YSQ
  1. K ^TMP($J,"YSDATA")
  1. K YSDATA
  1. D PARSE^YTAPI(.YS)
  1. S YSITEM=$G(YS("ITEM"),0)
  1. I '$D(^YTT(601,"B",YSCODE)) S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="INCORRECT TEST CODE" Q
  1. S YSET=$O(^YTT(601,"B",YSCODE,0))
  1. I (YSITEM>0)&('$D(^YTT(601,YSET,"Q",YSITEM))) S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="item number not correct" Q
  1. S N=0,YSQ=2
  1. S ^TMP($J,"YSDATA",1)="[DATA]"
  1. S ^TMP($J,"YSDATA",2)=YSCODE_U_$P($G(^YTT(601,YSET,"P")),U)_U_$S(YSITEM=0:"all Items",1:"item: "_YSITEM)
  1. I YSITEM>0 D MAIN S $P(^TMP($J,"YSDATA",2),U,4)=1 Q ;--> OUT
  1. ;S N=$O(^YTT(601,YSET,"Q",599))
  1. ;I N>599 S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="too many questions" Q
  1. S N=0
  1. ;Loop thru test for all items
  1. S YSITEM=0
  1. F S YSITEM=$O(^YTT(601,YSET,"Q",YSITEM)) Q:YSITEM'>0 D
  1. . S $P(^TMP($J,"YSDATA",2),U,4)=YSITEM
  1. . D MAIN
  1. Q
  1. MAIN ;
  1. S YSNODE="I"
  1. ;[INTRO]
  1. D GETTEXT
  1. S YSNODE="T"
  1. ;[TEXT]
  1. D GETTEXT
  1. ;[BOTTOM]
  1. D BTM
  1. ;[RESPONSE]
  1. D RESP
  1. ;[MOVE]
  1. M YSDATA=^TMP($J,"YSDATA")
  1. Q
  1. GETTEXT ;pull text and intros
  1. S N1=0 F S N1=$O(^YTT(601,YSET,"Q",YSITEM,YSNODE,N1)) Q:N1'>0 D
  1. . S X=^YTT(601,YSET,"Q",YSITEM,YSNODE,N1,0)
  1. . S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_YSNODE_U_X
  1. Q
  1. RESP ;get approp responses
  1. I $G(^YTT(601,YSET,"Q",YSITEM,1))?1N.E D Q
  1. . S G=^YTT(601,YSET,"Q",YSITEM,1)
  1. . S G1=$E(G,1)
  1. . S A=$S(G1=3:$E("123456789",1,$E(G,3,3))_"X",G1<3:"YNX",1:"")
  1. . I A="" S YSDAT(1)="[ERROR]",YSDATA(2)="bad resp interview" Q
  1. . S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"A"_U_A_U_G1_U_$P(G,U,2)
  1. S A="",N1=YSITEM+.1
  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'=""
  1. I A="" S ^TMP($J,"YSDATA",1)="[ERROR]",^TMP($J,"YSDATA",2)="no acceptable responses found for item "_YSITEM Q
  1. S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"A"_U_A
  1. Q
  1. BTM ; get bottom of text
  1. S B="",N1=YSITEM+.1
  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"))
  1. Q:B=""
  1. S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"T"_U
  1. F I=2:2 S X=$P(B,",",I) Q:X="" D
  1. . S X=$E(X,2,$L(X)-1)
  1. . I (X'?1"Answer".E)&(X'?1"ANSWER".E) S YSQ=YSQ+1,^TMP($J,"YSDATA",YSQ)=YSITEM_U_"T"_U_X
  1. Q