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