source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQPXRM5.m@ 724

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1YTQPXRM5 ;ASF/ALB CLINICAL REMINDERS CONT ; 7/13/07 2:27pm
2 ;;5.01;MENTAL HEALTH;**85**;DEC 30,1994;Build 49
3 ;
4 Q
5CRTEST(YSDATA,YS) ;clinical reminders approrpiate instruments
6 ;input: LIMIT highest # of questions allowed (25 is default)
7 ;output: [DATA] vs [ERROR] 0K vs error msg
8 ; test_name^601.71 ien^# of questions
9 N YSLIMIT,YSCODE,YSCODEN,YSNUMB,YSG,YSIEN,YSOPER,YSQG2,YSERR,YSCTYPE,YSCHT,YSCHOICE,YSLEG,YSQN,YSNN
10 K YSDATA
11 S YSLIMIT=$G(YS("LIMIT"),25)
12 S YSDATA(1)="[DATA]",YSNN=1
13 S YSCODE=""
14 F S YSCODE=$O(^YTT(601.71,"B",YSCODE)) Q:YSCODE="" S YSERR=0,YSNUMB=0,YSCODEN=$O(^YTT(601.71,"B",YSCODE,0)) D TCK,SETCR
15 Q
16TCK ;check a test for CR
17 S YSOPER=$$GET1^DIQ(601.71,YSCODEN_",",10,"I")
18 IF YSOPER="C" S YSNUMB="C" Q ;-->out ASF 11/1/06
19 Q:(YSOPER'="Y")
20 S YSIEN=0 F S YSIEN=$O(^YTT(601.76,"AC",YSCODEN,YSIEN)) Q:YSIEN'>0 S YSNUMB=YSNUMB+1
21 Q
22SETCR ;set out queue
23 I (YSNUMB=0)!(YSNUMB>YSLIMIT)!(YSERR=1) Q ;->out
24 S YSNN=YSNN+1,YSDATA(YSNN)=YSCODE_U_YSCODEN_U_YSNUMB
25 Q
26ONECR(YSCODEN,YSLIMIT) ;FUNCTION check one test for CR
27 ;input YSCODEN ien OF 601.71
28 ; YSLIMIT # OF QUESTIONS (25 DEFAULT)
29 ;output 1: OK for CR
30 ;
31 N YSOPER,YSERR,YSIEN,YSNUMB
32 S YSOK=0
33 I '$D(^YTT(601.71,YSCODEN,0)) Q YSOK ;->out
34 I $P(^YTT(601.71,YSCODEN,0),U)="ASI" Q YSOK ;-->out
35 S YSLIMIT=$G(YSLIMIT,25)
36 S YSNUMB=0,YSERR=0 D TCK
37 I (YSNUMB=0)!(YSNUMB>YSLIMIT)!(YSERR=1) Q YSOK ;->out
38 S YSOK=1
39 Q YSOK
40SHOWALL(YSDATA,YS) ;
41 ;returns all item information for a specified test
42 ; same format as SHOWALL^YTAPI3
43 N G,YSCODE,YSCODEN,YSNUMB,YSEQ,YSIEN,YSR,YSCTYPE,YSG,YSQN,YSQG2,YSCHTSEQ,YSLEG,YSCTEXT,YSCHOICE,YSINTRO,YSLINES,N1
44 K YSDATA
45 S YSCODE=$G(YS("CODE"),0)
46 I '$D(^YTT(601.71,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="INCORRECT TEST CODE" Q
47 S YSCODEN=$O(^YTT(601.71,"B",YSCODE,0))
48 S YSNUMB=0
49 S YSDATA(1)="[DATA]"
50 S YSDATA(2)=YSCODE_U_$P(^YTT(601.71,YSCODEN,0),U,3)
51 ;Loop thru test for all items
52 S YSEQ=0 F S YSEQ=$O(^YTT(601.76,"AD",YSCODEN,YSEQ)) Q:YSEQ'>0 S YSIEN=$O(^YTT(601.76,"AD",YSCODEN,YSEQ,0)) Q:YSIEN'>0 S YSNUMB=YSNUMB+1,YSR=0 D
53 . S YSG=^YTT(601.76,YSIEN,0),YSQN=$P(YSG,U,4),YSQG2=$G(^YTT(601.72,YSQN,2))
54 . D GETTEXT
55 . S YSCTYPE=$P(YSQG2,U,3) Q:YSCTYPE="" ;->out
56 . S YSCHTSEQ=0 F S YSCHTSEQ=$O(^YTT(601.751,"AC",YSCTYPE,YSCHTSEQ)) Q:YSCHTSEQ'>0 D
57 .. S YSCHOICE=$O(^YTT(601.751,"AC",YSCTYPE,YSCHTSEQ,0)) Q:YSCHOICE'>0 D
58 ... S YSCTEXT=$G(^YTT(601.75,YSCHOICE,1))
59 ... S YSLEG=$P($G(^YTT(601.75,YSCHOICE,0)),U,2)
60 ... D RESP
61 Q
62GETTEXT ;pull text and intros
63 S N1=0,YSLINES=0 F S N1=$O(^YTT(601.72,YSQN,1,N1)) Q:N1'>0 S YSLINES=N1 D
64 . S YSDATA(YSNUMB,"T",N1)=^YTT(601.72,YSQN,1,N1,0)
65 S YSLINES=YSLINES+1,YSDATA(YSNUMB,"T",YSLINES)=" "
66 S YSINTRO=$P($G(^YTT(601.72,YSQN,2)),U)
67 Q:YSINTRO'?1N.N
68 S N1=0 F S N1=$O(^YTT(601.73,YSINTRO,1,N1)) Q:N1'>0 D
69 . S YSDATA(YSNUMB,"I",N1)=^YTT(601.73,YSINTRO,1,N1,0)
70 Q
71RESP ;get approp responses
72 S YSDATA(YSNUMB,"R",1)="Answer= "
73 S YSDATA(YSNUMB,"R",0)=$G(YSDATA(YSNUMB,"R",0))_YSLEG
74 S YSLINES=YSLINES+1,YSDATA(YSNUMB,"T",YSLINES)=YSLEG_". "_YSCTEXT
75 Q
76SCALES(YSDATA,YSCODEN) ;scales for a test
77 ;input :YSCODEN AS 601.71 IEN
78 ;output scalename^601.82 ENTRY
79 N G,YSCODE,N,N1,YS1,YSZ,YS87,YSONLY,YSNAME
80 ;S YSCODEN=$G(YS("CODE"),0)
81 I '$D(^YTT(601.71,YSCODEN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q ;->out
82 S YSCODE=$P(^YTT(601.71,YSCODEN,0),U)
83 I YSCODE="ASI" D Q ;-->out
84 . S YSDATA(1)="[DATA]"
85 . S YSDATA("S",1)="Medical"
86 . S YSDATA("S",2)="Employment"
87 . S YSDATA("S",3)="Alcohol"
88 . S YSDATA("S",4)="Drug"
89 . S YSDATA("S",5)="Legal"
90 . S YSDATA("S",6)="Family"
91 . S YSDATA("S",7)="Psychiatric"
92 S YS1("CODE")=YSCODE D SCALEG^YTQAPI3(.YSZ,.YS1)
93 S YSDATA(1)="[DATA]"
94 S N=0 F S N=$O(^TMP($J,"YSG",N)) Q:N'>0 D
95 . S G=^TMP($J,"YSG",N)
96 . S YSNAME=$P(G,U,4),YS87=$P($P(G,U,1),"=",2)
97 . Q:G'?1"Scale".E
98 . S:'$D(YSONLY(YSNAME)) YSONLY(YSNAME)="",YSDATA("S",YS87)=YSNAME
99 K ^TMP($J,"YSG")
100 Q
101SCNAME(YSIEN) ;get scale name from 601.87 ien
102 ;input 601.87 ien
103 N YS87
104 S YS87=0
105 Q:YSIEN'?1N.N YS87 ;out-->
106 Q:'$D(^YTT(601.87,YSIEN)) YS87 ;out-->
107 S YS87=$$GET1^DIQ(601.87,YSIEN_",",3)
108 Q YS87
109ALLKEYS(YSDATA,YS) ;Return ALL or most KEYS that a user has.
110 ;input IEN as internal of file 200 [optional/DUZ]
111 N YSIEN,I,J,K,L K ^TMP("YSXU",$J)
112 S YSIEN=$G(YS("IEN"))
113 S:YSIEN="" YSIEN=DUZ
114 I YSIEN'>0 S YSDATA(1)="[ERROR]" Q
115 S I=0,L=1,YSDATA(1)="[DATA]"
116 F S I=$O(^VA(200,YSIEN,51,I)) Q:I'>0 S K=$G(^DIC(19.1,I,0)) D
117 . S L=L+1,YSDATA(L)=$P(K,U,1)
118 . Q
Note: See TracBrowser for help on using the repository browser.