122 lines
3.7 KiB
Mathematica
122 lines
3.7 KiB
Mathematica
YTQAPI13 ;ASF/ALB MHQ EXPORT PROCEEDURES ; 4/3/07 11:21am
|
|
;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
|
|
Q
|
|
EXPORT(YSDATA,YS) ;export instrument
|
|
N %X,%Y,G,I,N,N1,N2,YSCALE,YSCI,YSCNT,YSDI,YSEQ,YSERR,YSFILE,YSKEY,YSN,YSNAM,YSNUM,YSQ,YSQN,YSR,YSCT
|
|
K ^TMP($J,"YSE"),^TMP($J,"YSQ")
|
|
S YSCNT=0
|
|
S YSERR=0
|
|
D PARSE Q:YSERR ; set/check inputs
|
|
S YSFILE=601.71 D SET(YSNUM) ; test entry
|
|
D CONTENT ;inst content
|
|
D QUES ;questions
|
|
D INTRO
|
|
D DISPLAY ; q<i>c displays
|
|
D CHOICE ;types & choices
|
|
D SKIP ;skipped questions
|
|
D RULES ;instrument rules and rules
|
|
D SECTION
|
|
D SCALES ;scale grps,scales,keys
|
|
D MAIL ;export mailman
|
|
Q
|
|
CHOICE ;
|
|
;choice type
|
|
S YSQ=0 F S YSQ=$O(^TMP($J,"YSQ",YSQ)) Q:YSQ="" D
|
|
. S YSCT=$P($G(^YTT(601.72,YSQ,2)),U,3)
|
|
. Q:YSCT'?1N.N
|
|
. S ^TMP($J,"YSCT",YSCT)=""
|
|
. S YSFILE=601.751 D SET(YSCT)
|
|
S YSCT=0 F S YSCT=$O(^TMP($J,"YSCT",YSCT)) Q:YSCT'>0 D
|
|
. S YSCI=$P($G(^YTT(601.751,0)),U,3)
|
|
. S YSFILE=601.75 D:YSCI?1N.N SET(YSCI)
|
|
Q
|
|
SCALES ;
|
|
;scale grp
|
|
S YSFILE=601.86
|
|
S YSN=0 F S N=$O(^YTT(601.86,"AD",YSNUM,YSN)) Q:YSN'>0 D
|
|
. S YSFILE=601.86 D SET(YSN)
|
|
. ;scales
|
|
. S YSCALE=0 F S YSCALE=$O(^YTT(601.87,"AD",YSN,YSCALE)) Q:YSCALE'>0 D
|
|
.. S YSFILE=601.87 D SET(YSCALE)
|
|
.. S YSKEY=0 F S YSKEY=$O(^YTT(601.91,"AC",YSCALE,YSKEY)) Q:YSKEY'>0 S YSFILE=601.91 D SET(YSKEY)
|
|
Q
|
|
RULES ;ins rules-rules
|
|
S YSFILE=601.83
|
|
S YSN=0 F S YSN=$O(^YTT(601.83,"C",YSNUM,YSN)) Q:YSN'>0 D
|
|
. D SET(YSN)
|
|
S YSFILE=601.82
|
|
S YSN=0 F S YSN=$O(^YTT(601.83,"C",YSNUM,YSN)) Q:YSN'>0 D
|
|
. S YSR=$P($G(^YTT(601.83,YSN,0)),U,4)
|
|
. D:YSR?1N.N SET(YSN)
|
|
Q
|
|
SECTION ;headings
|
|
S YSFILE=601.81
|
|
S YSN=0 F S YSN=$O(^YTT(601.81,"AC",YSNUM,YSN)) Q:YSN'>0 D
|
|
. D SET(YSN)
|
|
Q
|
|
SKIP ;skipped qs
|
|
S YSFILE=601.79
|
|
S YSN=0 F S YSN=$O(^YTT(601.79,"AC",YSNUM,YSN)) Q:YSN'>0 D
|
|
. D SET(YSN)
|
|
Q
|
|
DISPLAY ;display ques<intro<choice
|
|
S YSFILE=601.88
|
|
S YSN=0 F S YSN=$O(^YTT(601.76,"AC",YSNUM,YSN)) Q:YSN'>0 D
|
|
. S G=$G(^YTT(601.76,YSN,0))
|
|
. F I=7,8,9 S YSDI=$P(G,U,I) D:YSDI?1N.N SET(YSDI)
|
|
Q
|
|
CONTENT ;
|
|
S YSFILE=601.76
|
|
S YSEQ=0 F S YSEQ=$O(^YTT(601.76,"AD",YSNUM,YSEQ)) Q:YSEQ'>0 S YSN=0 F S YSN=$O(^YTT(601.76,"AD",YSNUM,YSEQ,YSN)) Q:YSN'>0 D
|
|
. D SET(YSN)
|
|
Q
|
|
QUES ;questions
|
|
S YSFILE=601.72
|
|
S YSEQ=0 F S YSEQ=$O(^YTT(601.76,"AD",YSNUM,YSEQ)) Q:YSEQ'>0 S YSN=0 F S YSN=$O(^YTT(601.76,"AD",YSNUM,YSEQ,YSN)) Q:YSN'>0 D
|
|
. S YSQN=$P(^YTT(601.76,YSN,0),U,4)
|
|
. S ^TMP($J,"YSQ",YSQN)=""
|
|
. D SET(YSQN)
|
|
Q
|
|
INTRO ;intros
|
|
S YSFILE=601.73
|
|
S YSQN=0 F S YSQN=$O(^TMP($J,"YSQ",YSQN)) Q:YSQN'>0 D
|
|
. S YSN=$P($G(^YTT(601.72,YSQN,2)),U)
|
|
. D:YSN>0 SET(YSN)
|
|
Q
|
|
PARSE ;get old name, new name and national
|
|
S YSERR=1,YSDATA(1)="[ERROR]"
|
|
S YSNAM=$G(YS("CODE"))
|
|
I YSNAM="" S YSDATA(2)="no code" Q ;-->out
|
|
I '$D(^YTT(601.71,"B",YSNAM)) S YSDATA(2)="bad code" Q ;--->out
|
|
S YSNUM=$O(^YTT(601.71,"B",YSNAM,0)),YSDATA(1)="[DATA]",YSERR=0
|
|
Q
|
|
MAIL ;Mailman
|
|
N XMSUB,XMTEXT,XMDUZ,XMY
|
|
S XMSUB="Export of "_YS("CODE")
|
|
S XMTEXT="^TMP($J,""YSE"","
|
|
S XMY(DUZ)=""
|
|
S XMDUZ="AUTOMATED MESSAGE"
|
|
D ^XMD
|
|
Q
|
|
SET(YSIEN) ;content set
|
|
S N=-1 F S N=$O(^YTT(YSFILE,YSIEN,N)) Q:N="" D G1
|
|
Q
|
|
G1 D:$D(^YTT(YSFILE,YSIEN,N))#2 S N1=-1 F S N1=$O(^YTT(YSFILE,YSIEN,N,N1)) Q:N1="" D G2
|
|
. S YSCNT=YSCNT+1
|
|
. S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_")"
|
|
. S YSCNT=YSCNT+1
|
|
. S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N)
|
|
Q
|
|
G2 D:$D(^YTT(YSFILE,YSIEN,N,N1))#2 S N2=-1 F S N2=$O(^YTT(YSFILE,YSIEN,N,N1,N2)) Q:N2="" D G3
|
|
. S YSCNT=YSCNT+1
|
|
. S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_","_N1_")"
|
|
. S YSCNT=YSCNT+1
|
|
. S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N,N1)
|
|
Q
|
|
G3 D:$D(^YTT(YSFILE,YSIEN,N,N1,N2))#2
|
|
. S YSCNT=YSCNT+1
|
|
. S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_","_N1_","_N2_")"
|
|
. S YSCNT=YSCNT+1
|
|
. S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N,N1,N2)
|
|
Q
|