source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI13.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1YTQAPI13 ;ASF/ALB MHQ EXPORT PROCEEDURES ; 4/3/07 11:21am
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
3 Q
4EXPORT(YSDATA,YS) ;export instrument
5 N %X,%Y,G,I,N,N1,N2,YSCALE,YSCI,YSCNT,YSDI,YSEQ,YSERR,YSFILE,YSKEY,YSN,YSNAM,YSNUM,YSQ,YSQN,YSR,YSCT
6 K ^TMP($J,"YSE"),^TMP($J,"YSQ")
7 S YSCNT=0
8 S YSERR=0
9 D PARSE Q:YSERR ; set/check inputs
10 S YSFILE=601.71 D SET(YSNUM) ; test entry
11 D CONTENT ;inst content
12 D QUES ;questions
13 D INTRO
14 D DISPLAY ; q<i>c displays
15 D CHOICE ;types & choices
16 D SKIP ;skipped questions
17 D RULES ;instrument rules and rules
18 D SECTION
19 D SCALES ;scale grps,scales,keys
20 D MAIL ;export mailman
21 Q
22CHOICE ;
23 ;choice type
24 S YSQ=0 F S YSQ=$O(^TMP($J,"YSQ",YSQ)) Q:YSQ="" D
25 . S YSCT=$P($G(^YTT(601.72,YSQ,2)),U,3)
26 . Q:YSCT'?1N.N
27 . S ^TMP($J,"YSCT",YSCT)=""
28 . S YSFILE=601.751 D SET(YSCT)
29 S YSCT=0 F S YSCT=$O(^TMP($J,"YSCT",YSCT)) Q:YSCT'>0 D
30 . S YSCI=$P($G(^YTT(601.751,0)),U,3)
31 . S YSFILE=601.75 D:YSCI?1N.N SET(YSCI)
32 Q
33SCALES ;
34 ;scale grp
35 S YSFILE=601.86
36 S YSN=0 F S N=$O(^YTT(601.86,"AD",YSNUM,YSN)) Q:YSN'>0 D
37 . S YSFILE=601.86 D SET(YSN)
38 . ;scales
39 . S YSCALE=0 F S YSCALE=$O(^YTT(601.87,"AD",YSN,YSCALE)) Q:YSCALE'>0 D
40 .. S YSFILE=601.87 D SET(YSCALE)
41 .. S YSKEY=0 F S YSKEY=$O(^YTT(601.91,"AC",YSCALE,YSKEY)) Q:YSKEY'>0 S YSFILE=601.91 D SET(YSKEY)
42 Q
43RULES ;ins rules-rules
44 S YSFILE=601.83
45 S YSN=0 F S YSN=$O(^YTT(601.83,"C",YSNUM,YSN)) Q:YSN'>0 D
46 . D SET(YSN)
47 S YSFILE=601.82
48 S YSN=0 F S YSN=$O(^YTT(601.83,"C",YSNUM,YSN)) Q:YSN'>0 D
49 . S YSR=$P($G(^YTT(601.83,YSN,0)),U,4)
50 . D:YSR?1N.N SET(YSN)
51 Q
52SECTION ;headings
53 S YSFILE=601.81
54 S YSN=0 F S YSN=$O(^YTT(601.81,"AC",YSNUM,YSN)) Q:YSN'>0 D
55 . D SET(YSN)
56 Q
57SKIP ;skipped qs
58 S YSFILE=601.79
59 S YSN=0 F S YSN=$O(^YTT(601.79,"AC",YSNUM,YSN)) Q:YSN'>0 D
60 . D SET(YSN)
61 Q
62DISPLAY ;display ques<intro<choice
63 S YSFILE=601.88
64 S YSN=0 F S YSN=$O(^YTT(601.76,"AC",YSNUM,YSN)) Q:YSN'>0 D
65 . S G=$G(^YTT(601.76,YSN,0))
66 . F I=7,8,9 S YSDI=$P(G,U,I) D:YSDI?1N.N SET(YSDI)
67 Q
68CONTENT ;
69 S YSFILE=601.76
70 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
71 . D SET(YSN)
72 Q
73QUES ;questions
74 S YSFILE=601.72
75 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
76 . S YSQN=$P(^YTT(601.76,YSN,0),U,4)
77 . S ^TMP($J,"YSQ",YSQN)=""
78 . D SET(YSQN)
79 Q
80INTRO ;intros
81 S YSFILE=601.73
82 S YSQN=0 F S YSQN=$O(^TMP($J,"YSQ",YSQN)) Q:YSQN'>0 D
83 . S YSN=$P($G(^YTT(601.72,YSQN,2)),U)
84 . D:YSN>0 SET(YSN)
85 Q
86PARSE ;get old name, new name and national
87 S YSERR=1,YSDATA(1)="[ERROR]"
88 S YSNAM=$G(YS("CODE"))
89 I YSNAM="" S YSDATA(2)="no code" Q ;-->out
90 I '$D(^YTT(601.71,"B",YSNAM)) S YSDATA(2)="bad code" Q ;--->out
91 S YSNUM=$O(^YTT(601.71,"B",YSNAM,0)),YSDATA(1)="[DATA]",YSERR=0
92 Q
93MAIL ;Mailman
94 N XMSUB,XMTEXT,XMDUZ,XMY
95 S XMSUB="Export of "_YS("CODE")
96 S XMTEXT="^TMP($J,""YSE"","
97 S XMY(DUZ)=""
98 S XMDUZ="AUTOMATED MESSAGE"
99 D ^XMD
100 Q
101SET(YSIEN) ;content set
102 S N=-1 F S N=$O(^YTT(YSFILE,YSIEN,N)) Q:N="" D G1
103 Q
104G1 D:$D(^YTT(YSFILE,YSIEN,N))#2 S N1=-1 F S N1=$O(^YTT(YSFILE,YSIEN,N,N1)) Q:N1="" D G2
105 . S YSCNT=YSCNT+1
106 . S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_")"
107 . S YSCNT=YSCNT+1
108 . S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N)
109 Q
110G2 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
111 . S YSCNT=YSCNT+1
112 . S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_","_N1_")"
113 . S YSCNT=YSCNT+1
114 . S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N,N1)
115 Q
116G3 D:$D(^YTT(YSFILE,YSIEN,N,N1,N2))#2
117 . S YSCNT=YSCNT+1
118 . S ^TMP($J,"YSE",YSCNT)="^TMP($J,""YSI"","_YSFILE_","_YSIEN_","_N_","_N1_","_N2_")"
119 . S YSCNT=YSCNT+1
120 . S ^TMP($J,"YSE",YSCNT)=^YTT(YSFILE,YSIEN,N,N1,N2)
121 Q
Note: See TracBrowser for help on using the repository browser.