1 | YTQPXRM6 ;ASF/ALB CLINICAL REMINDERS CONT ; 11/15/07 10:57am
|
---|
2 | ;;5.01;MENTAL HEALTH;**85**;DEC 30,1994;Build 48
|
---|
3 | ;
|
---|
4 | Q
|
---|
5 | CONVERT(YSDATA,YS) ;convet 601 ien into 601.71 iens
|
---|
6 | ;input YS601 AS 601 IEN
|
---|
7 | ;output 601.71 ien
|
---|
8 | N YS601,YS60171,YSCODE,YSOP
|
---|
9 | S YS601=$G(YS("YS601"),0)
|
---|
10 | I YS601=0 S YSDATA(1)="[ERROR]",YSDATA(2)="NO code" Q ;-->out
|
---|
11 | S YSCODE=$P($G(^YTT(601,YS601,0)),U)
|
---|
12 | I YSCODE'?2AN.E S YSDATA(1)="[ERROR]",YSDATA(2)="bad 601" Q ;-->out
|
---|
13 | S YS60171=$O(^YTT(601.71,"B",YSCODE,0))
|
---|
14 | I YS60171'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="no 71 entry" Q ;-->out
|
---|
15 | S YSOP=$P($G(^YTT(601.71,YS60171,2)),U,2)
|
---|
16 | I YSOP="D" S YSDATA(1)="[DATA]",YSDATA(2)=YS60171_U_"dropped" Q ;-->out
|
---|
17 | S YSDATA(1)="[DATA]",YSDATA(2)=YS60171_U_YSCODE
|
---|
18 | Q
|
---|
19 | PRIVL(YSDATA,YS) ;check privileges
|
---|
20 | N YSCODE,YSET,YSKEY
|
---|
21 | S YSCODE=$G(YS("CODE"),-1)
|
---|
22 | I (YSCODE="GAF")!(YSCODE="ASI") S YSDATA(1)="[DATA]",YSDATA(2)="1^exempt test" Q ;-->out test exempt
|
---|
23 | I '$D(^YTT(601.71,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD TEST CODE" Q ;--> out
|
---|
24 | S YSET=$O(^YTT(601.71,"B",YSCODE,0))
|
---|
25 | S YSDATA(1)="[DATA]"
|
---|
26 | S YSKEY=$$GET1^DIQ(601.71,YSET_",",9)
|
---|
27 | I YSKEY="" S YSDATA(2)="1^exempt test" Q ;-->out
|
---|
28 | I $D(^XUSEC(YSKEY,DUZ)) S YSDATA(2)="1^user privileged" Q ;-->out has key
|
---|
29 | S YSDATA(2)="0^no access"
|
---|
30 | Q
|
---|
31 | MHA3CODE(X) ;function to return mha3 test NAME from ien of 601.71
|
---|
32 | ;ie S YS("CODE")=$$MHA3CODE^YTQPXRM6(1) sets YS("CODE")="MMPI2"
|
---|
33 | S X=$$GET1^DIQ(601.71,X_",",.01)
|
---|
34 | Q X
|
---|
35 | ENDAS71(YSDATA,DAS) ;single administration output
|
---|
36 | ;Input
|
---|
37 | ;DAS from ^PXRMINDX(
|
---|
38 | ;Output:
|
---|
39 | ;Array(1)=[DATA]
|
---|
40 | ;Array(2)= Patient Name^Test Code^Test Title^Internal Admin date^External Admin Date ^Ordered by
|
---|
41 | ;Array("R",running number)=MH Administration IEN^MH Answer IEN^MH Question IEN^MH Choice IEN [if avail]^MH Legacy answer [single character answer is available^text of answer [first 200 chars]
|
---|
42 | ;Array("SI",601.87 IEN)=S_running number1^Scale Name^Raw Score^Transformed Score
|
---|
43 | N J,G,N1,N2,YSNAME,YSDATEE,YSDATEI,YSCODE,YSCODEN,YSORD,YSPRT,YSAID,YSADATE,YSA,YSLEG,YSCIS,YSZZ,YSTEXT,YSQID,YSDFN,YSIZE,YSC1,YSCALE1,YSG1,YSRT,YSRTI,YSXXZ
|
---|
44 | I DAS?.E1";".E D LEGDAS^YTQPXRM7(.YSDATA,DAS) D SS,SILEG Q ;--> use old rts
|
---|
45 | I '$D(^YTT(601.84,DAS,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad das" Q ;-->out
|
---|
46 | S YSDATA(1)="[DATA]"
|
---|
47 | S YSNAME=$$GET1^DIQ(601.84,DAS_",",1)
|
---|
48 | S YSCODE=$$GET1^DIQ(601.84,DAS_",",2)
|
---|
49 | S YSCODEN=$$GET1^DIQ(601.84,DAS_",",2,"I")
|
---|
50 | S YSORD=$$GET1^DIQ(601.84,DAS_",",5)
|
---|
51 | S YSDATEE=$$GET1^DIQ(601.84,DAS_",",3)
|
---|
52 | S YSDATEI=$$GET1^DIQ(601.84,DAS_",",3,"I")
|
---|
53 | S YSPRT=$P(^YTT(601.71,YSCODEN,0),U,3)
|
---|
54 | S YSDATA(2)=YSNAME_U_YSCODE_U_YSPRT_U_YSDATEI_U_YSDATEE_U_YSORD
|
---|
55 | ;ASF 11/15/07
|
---|
56 | S YSAID=0,N1=0 F S YSAID=$O(^YTT(601.85,"AD",DAS,YSAID)) Q:YSAID'>0 Q:'$D(^YTT(601.85,YSAID,0)) S N1=N1+1 D
|
---|
57 | . S (YSTEXT,YSLEG)=""
|
---|
58 | . S YSA=^YTT(601.85,YSAID,0),YSCIS=$P(YSA,U,4),YSQID=$P(YSA,U,3)
|
---|
59 | . I $D(^YTT(601.85,YSAID,1,1,0)) S YSIZE=0,YSTEXT="",J=0 D S YSTEXT=$E(YSTEXT,2,201)
|
---|
60 | .. F S J=$O(^YTT(601.85,1,J)) Q:J'>0!(YSIZE>200) S YSTEXT=" "_^YTT(601.85,YSAID,1,J,0),YSIZE=$L(YSTEXT)
|
---|
61 | . S:YSCIS?1N.N YSLEG=$P($G(^YTT(601.75,YSCIS,0)),U,2),YSTEXT=$G(^YTT(601.75,YSCIS,1))
|
---|
62 | . S:$D(^YTT(601.85,YSAID,1,1,0)) YSTEXT=^YTT(601.85,YSAID,1,1,0)
|
---|
63 | . S YSDATA("R",N1)=DAS_U_YSAID_U_YSQID_U_YSCIS_U_YSLEG_U_YSTEXT
|
---|
64 | D SS
|
---|
65 | S YS("AD")=DAS D GETSCORE^YTQAPI8(.YSZZ,.YS)
|
---|
66 | D SI
|
---|
67 | Q
|
---|
68 | UCASE(X) ;upper case
|
---|
69 | N %
|
---|
70 | F %=1:1:$L(X) S:$E(X,%)?1L X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999)
|
---|
71 | Q X
|
---|
72 | SS ;scale listing
|
---|
73 | S:DAS?.E1";".E YSCODEN=$O(^YTT(601.71,"B",YSCODEN,0))
|
---|
74 | D SCALES^YTQPXRM5(.YSQQ,YSCODEN)
|
---|
75 | S N2=0 F S N2=$O(YSQQ("S",N2)) Q:N2'>0 D
|
---|
76 | . S YSCALE1=YSQQ("S",N2)
|
---|
77 | . S YSC1($$UCASE(YSCALE1),N2)=""
|
---|
78 | K YSQQ
|
---|
79 | Q
|
---|
80 | SI ;set internal scale walk
|
---|
81 | S N2=1 F S N2=$O(^TMP($J,"YSCOR",N2)) Q:N2'>0 D
|
---|
82 | . S YSG1=^TMP($J,"YSCOR",N2)
|
---|
83 | . S YSCALE1=$P(YSG1,"="),YSRT=$P(YSG1,"=",2)
|
---|
84 | . ;S YSDATA("S",N2-1)="S"_(N2-1)_U_YSCALE1_U_YSRT
|
---|
85 | . S YSRTI=$O(YSC1($$UCASE(YSCALE1),0))
|
---|
86 | . S:YSRTI'="" YSDATA("SI",YSRTI)="S"_(N2-1)_U_YSCALE1_U_YSRT
|
---|
87 | K ^TMP($J,"YSCOR"),^TMP($J,"YSG"),YS
|
---|
88 | Q
|
---|
89 | SILEG ;legacy internal walk
|
---|
90 | S N2=0 F S N2=$O(YSDATA("S",N2)) Q:N2'>0 D
|
---|
91 | . S YSG1=YSDATA("S",N2),YSCALE1=$P(YSG1,U,2),YSRT=$P(YSG1,U,3,4)
|
---|
92 | . S YSRTI=$O(YSC1($$UCASE(YSCALE1),0))
|
---|
93 | . S:YSRTI'="" YSDATA("SI",YSRTI)="S"_(N2)_U_YSCALE1_U_YSRT
|
---|
94 | K YSDATA("S")
|
---|
95 | Q
|
---|