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

YTQAPI3.m

Go to the documentation of this file.
  1. YTQAPI3 ;ASF/ALB - MHQ REMOTE PROCEDURES CONT ; 4/3/07 11:53am
  1. ;;5.01;MENTAL HEALTH;**85,142**;DEC 30,1994;Build 14
  1. ;
  1. Q
  1. SCALEG(YSDATA,YS) ;returns all scale groups for an instrument
  1. ;input CODE
  1. ; output:SCALE NAME^ABBREVIATION^SCALE IEN^SCALE SEQUENCE^SCALE GROUP NAME^SCALE GRUOP IEN^GROUP SEQUENCE^ORD TITLE^MIN^INCREASE^MAX^GRID1^GRID2^GRID3
  1. ;
  1. N N,N1,G1,S1,G6,G7,YSCALEN,YSCN,YSCODE,YSGIEN,YSGN
  1. K ^TMP($J,"YSG") S YSDATA=$NA(^TMP($J,"YSG"))
  1. S YSCODE=$G(YS("CODE"))
  1. I '$D(^YTT(601.71,"B",YSCODE)) S ^TMP($J,"YSG",1)="[ERROR]",^TMP($J,"YSG",2)="BAD CODE" Q ;-->out
  1. S ^TMP($J,"YSG",1)="[DATA]",N=1,S1=0,G1=0
  1. S YSCN=$O(^YTT(601.71,"B",YSCODE,0))
  1. S YSGN=0 F S YSGN=$O(^YTT(601.86,"AC",YSCN,YSGN)) Q:YSGN'>0 D
  1. . S YSGIEN=0 F S YSGIEN=$O(^YTT(601.86,"AC",YSCN,YSGN,YSGIEN)) Q:YSGIEN'>0 D
  1. .. S N=N+1,G1=G1+1,^TMP($J,"YSG",N)="Group"_G1_"="_YSGIEN_U_$$GET1^DIQ(601.86,YSGIEN_",",1)_U_$P($G(^YTT(601.86,YSGIEN,0)),U,3,99)
  1. .. S N1=0 F S N1=$O(^YTT(601.87,"AC",YSGIEN,N1)) Q:N1'>0 D
  1. ... S YSCALEN=0 F S YSCALEN=$O(^YTT(601.87,"AC",YSGIEN,N1,YSCALEN)) Q:YSCALEN'>0 D
  1. .... S N=N+1,S1=S1+1,^TMP($J,"YSG",N)="Scale"_S1_"="_$G(^YTT(601.87,YSCALEN,0))
  1. Q
  1. BATTC(YSDATA,YS) ;battery content
  1. ; OUTPUT: BATTERY NAME ^ INSTRUMENT list sorted by BATTERY & SEQUENCE
  1. N N,N1,G7,YSBATS,YSBID,YSCONID,YSNAME,YSUB,YS1,YSBNAME
  1. S N=1,YSDATA(1)="[DATA]"
  1. S YSUB=0 F S YSUB=$O(^YTT(601.781,"AC",DUZ,YSUB)) Q:YSUB'>0 D
  1. . S YSBID=$P(^YTT(601.781,YSUB,0),U,3)
  1. . S YSBNAME=$P($G(^YTT(601.77,YSBID,0)),U,2)
  1. . S:$L(YSBNAME) YS1(YSBNAME)=YSBID
  1. S YSNAME="" F S YSNAME=$O(YS1(YSNAME)) Q:YSNAME="" S YSBID=YS1(YSNAME) D
  1. . S YSBATS=0 F S YSBATS=$O(^YTT(601.78,"AC",YSBID,YSBATS)) Q:YSBATS'>0 D
  1. .. S YSCONID=$O(^YTT(601.78,"AC",YSBID,YSBATS,0))
  1. ..S G7=$G(^YTT(601.78,YSCONID,0))
  1. .. S N=N+1,YSDATA(N)=$P(G7,U,2)_U_$P(^YTT(601.77,YSBID,0),U,2)_U_$P(G7,U,3,4)_U_$$GET1^DIQ(601.78,YSCONID_",",3)
  1. Q
  1. FIRSTWP(YSDATA,YS) ;first line of all intros
  1. ;returns the first line only of a WP field
  1. ;Input: FILEN(file number), FIELD (WP filed #)
  1. ;Ouput IEN^WP Text line 1
  1. N N,YSN,YSFILEN,YSFIELD
  1. S YSDATA=$NA(^TMP($J,"YSFWP")) K ^TMP($J,"YSFWP")
  1. S YSFILEN=$G(YS("FILEN"),0) I $$VFILE^DILFD(YSFILEN)<1 S ^TMP($J,"YSFWP",1)="[ERROR]",^TMP($J,"YSFWP",2)="BAD FILE N" Q ;--->out
  1. S YSFIELD=$G(YS("FIELD"),0) S N=$$VFIELD^DILFD(YSFILEN,YSFIELD) I N<1 S ^TMP($J,"YSFWP",1)="[ERROR]",^TMP($J,"YSFWP",2)="BAD field" Q ;--> out
  1. S YSN=0,N=1,^TMP($J,"YSFWP",1)="[DATA]"
  1. F S YSN=$O(^YTT(YSFILEN,YSN)) Q:YSN'>0 D
  1. . S N=N+1
  1. . S ^TMP($J,"YSFWP",N)=YSN_U_$G(^YTT(YSFILEN,YSN,YSFIELD,1,0))
  1. Q
  1. QUESTALL(YSDATA,YS) ;all questions for a test
  1. ;input: CODE as test name
  1. ;output: Field^Value
  1. N YSTESTN,YSTEST,YSF,YSV,N,N2,N3,YSEQX,YSIC,YSQN,G
  1. S YSDATA=$NA(^TMP($J,"YSQU")) K ^TMP($J,"YSQU")
  1. S YSTEST=$G(YS("CODE"))
  1. S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
  1. I YSTESTN'>0 S ^TMP($J,"YSQU",1)="[ERROR]",^TMP($J,"YSQU",2)="bad code" Q ;-->out
  1. S N=2,N3=0,^TMP($J,"YSQU",1)="[DATA]"
  1. ;
  1. S YSEQX=0
  1. F S YSEQX=$O(^YTT(601.76,"AD",YSTESTN,YSEQX)) Q:YSEQX'>0 D
  1. . S YSIC=0 F S YSIC=$O(^YTT(601.76,"AD",YSTESTN,YSEQX,YSIC)) Q:YSIC'>0 S YSQN=$P(^YTT(601.76,YSIC,0),U,4) D QUEST2
  1. S ^TMP($J,"YSQU",2)="NUMBER OF QUESTIONS="_N3
  1. Q
  1. QUEST2 ;
  1. S N=N+1,N3=N3+1
  1. S ^TMP($J,"YSQU",N)="QUESTION NUMBER"_N3_"="_YSQN_U_$P(^YTT(601.76,YSIC,0),U,3)_U_$P(^YTT(601.76,YSIC,0),U,5)_U_YSIC
  1. S N2=0 F S N2=$O(^YTT(601.72,YSQN,1,N2)) Q:N2'>0 S N=N+1,^TMP($J,"YSQU",N)=$S(N2=1:"QUESTION TEXT"_N3_"=",1:"")_$G(^YTT(601.72,YSQN,1,N2,0))
  1. S N=N+1,G=$G(^YTT(601.72,YSQN,2))
  1. S ^TMP($J,"YSQU",N)="INTRO TEXT"_N3_"="_$S(+G>0:+G,1:"")_U D:+G
  1. . S N2=0 F S N2=$O(^YTT(601.73,+G,1,N2)) Q:N2'>0 S:N2>1 N=N+1 S ^TMP($J,"YSQU",N)=$G(^TMP($J,"YSQU",N))_$G(^YTT(601.73,+G,1,N2,0))
  1. S N=N+1
  1. S ^TMP($J,"YSQU",N)="DESC"_N3_"="_$P($G(^YTT(601.74,+$P(G,U,2),0)),U,2)_U_$P(G,U,3)_U_$P(G,U,4)_U_$P(G,U,5)_U_$P(G,U,6)_U_$P(G,U,7)_U
  1. S G=+$P(G,U,3),G=$O(^YTT(601.89,"B",G,0)) S:G>0 ^TMP($J,"YSQU",N)=^TMP($J,"YSQU",N)_$P(^YTT(601.89,G,0),U,2)
  1. S G=^YTT(601.76,YSIC,0)
  1. S N=N+1
  1. S ^TMP($J,"YSQU",N)="QDISPLAY"_N3_"=" S:$P(G,U,6)?1N.N ^TMP($J,"YSQU",N)=^TMP($J,"YSQU",N)_$$DISPEXT^YTQAPI5($P(G,U,6))
  1. S N=N+1
  1. S ^TMP($J,"YSQU",N)="IDISPLAY"_N3_"=" S:$P(G,U,7)?1N.N ^TMP($J,"YSQU",N)=^TMP($J,"YSQU",N)_$$DISPEXT^YTQAPI5($P(G,U,7))
  1. S N=N+1
  1. S ^TMP($J,"YSQU",N)="CDISPLAY"_N3_"=" S:$P(G,U,8)?1N.N ^TMP($J,"YSQU",N)=^TMP($J,"YSQU",N)_$$DISPEXT^YTQAPI5($P(G,U,8))
  1. Q
  1. PURGE(YSDATA,YS) ; delete a record
  1. ;input: FILEN (FILE #)
  1. ; IEN (internal record #)
  1. ;Output :only conformation
  1. N YSFILEN,YSROOT,YSNODE,DIK,DA
  1. S DA=$G(YS("IEN"),0)
  1. S YSFILEN=$G(YS("FILEN"),0)
  1. Q:YSFILEN<601 Q:YSFILEN>605 ; restrict to Mental Health
  1. I $$VFILE^DILFD(YSFILEN)<1 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FILE N" Q ;--->out
  1. S YSROOT=$$ROOT^DILFD(YSFILEN)
  1. S YSNODE=YSROOT_DA_",0)"
  1. I $D(@YSNODE)'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="no such record" Q ;-->out
  1. S DIK=YSROOT D ^DIK
  1. S YSDATA(1)="[DATA]",YSDATA(2)="record "_DA_" of "_YSFILEN_" deleted"
  1. Q