source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI7.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1YTQAPI7 ;ALB/ASF- MHAX ANSWERS ; 5/24/07 10:12am
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 48
3 Q
4KEY(YSDATA,YS) ;get all keys for a test
5 ; input: CODE as TEST name
6 ; output:SCALE=ScaleName^scale Id
7 ; KEY=Question ID^Target^Value^Key Ien
8 N G,YSKEYI,YSCODE,I,N,YSCALEI,YSCNAME,YSCODEN,YSQN,YSTARG,YSVAL
9 K ^TMP($J,"YSKEY") S YSDATA=$NA(^TMP($J,"YSKEY"))
10 S YSCODE=$G(YS("CODE")) S:YSCODE="" YSCODE=0
11 I '$D(^YTT(601.71,"B",YSCODE)) S ^TMP($J,"YSKEY",1)="[ERROR]",^TMP($J,"YSKEY",2)="no ins" Q ;-->out
12 S YSCODEN=$O(^YTT(601.71,"B",YSCODE,0))
13 I '$D(^YTT(601.86,"AC",YSCODEN)) S ^TMP($J,"YSKEY",1)="[ERROR]",^TMP($J,"YSKEY",2)="no scale grps found" Q ;-->out
14 D SCALEG^YTQAPI3(.YSDATA,.YS)
15 S YSDATA=$NA(^TMP($J,"YSKEY"))
16 S ^TMP($J,"YSKEY",1)="[DATA]",N=1
17 F I=2:1 Q:'$D(^TMP($J,"YSG",I)) I ^TMP($J,"YSG",I)?1"Scale".E D
18 . S YSCALEI=$P(^TMP($J,"YSG",I),U),YSCALEI=$P(YSCALEI,"=",2),YSCNAME=$P(^TMP($J,"YSG",I),U,4)
19 . S N=N+1,^TMP($J,"YSKEY",N)="SCALE="_YSCNAME_U_YSCALEI_U
20 . S YSKEYI=0 F S YSKEYI=$O(^YTT(601.91,"AC",YSCALEI,YSKEYI)) Q:YSKEYI'>0 D
21 .. S G=^YTT(601.91,YSKEYI,0)
22 .. S YSQN=$P(G,U,3),YSTARG=$P(G,U,4),YSVAL=$P(G,U,5)
23 .. S N=N+1
24 .. S ^TMP($J,"YSKEY",N)="KEY="_YSQN_U_YSTARG_U_YSVAL_U_YSKEYI
25 Q
26ANSLIST(YSDATA,YS) ;simple answer list
27 N D1,N1,YSQ,YSAI,G
28 S YSAI=$G(YS("IEN")) I YSAI'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad admin ien" Q ;-->out
29 S N=1,YSQ=0
30 F S YSQ=$O(^YTT(601.85,"AC",YSAI,YSQ)) Q:YSQ'>0 S DA=0 F S DA=$O(^YTT(601.85,"AC",YSAI,YSQ,DA)) Q:DA'>0 D
31 . S D1=0,N1=0,G=$G(^YTT(601.85,DA,0))
32 . F S D1=$O(^YTT(601.85,DA,1,D1)) Q:D1'>0 D
33 .. S N=N+1,N1=N1+1
34 .. S YSDATA(N)=$P(G,U,3)_";"_N1_U_$G(^YTT(601.85,DA,1,D1,0))
35 Q
36VERSRV(YSDATA,YS) ; Return server version stored in YS BROKER1
37 ; input: YSB as option name
38 ; output: 2:MHA3 version number
39 ; 3: CR DLL VERSION
40 ; 4:mh DLL VERSION
41 N YSLST,YSB,YSVAL
42 S YSB=$G(YS("YSB"))
43 I YSB="" S YSDATA(1)="[ERROR]",YSDATA(2)="no opt" Q
44 D FIND^DIC(19,"",1,"X",YSB,1,,,,"YSLST")
45 I 'YSLST("DILIST",0) S YSDATA(1)="[ERROR]",YSDATA(2)="no version found" Q
46 S YSVAL=YSLST("DILIST","ID",1,1)
47 S YSVAL=$P(YSVAL,"version ",2)
48 S YSDATA(1)="[DATA]"
49 S YSDATA(2)=$P(YSVAL,"~",1)
50 S YSDATA(3)=$P(YSVAL,"~",2)
51 S YSDATA(4)=$P(YSVAL,"~",3)
52 Q
53RULEDEL(YSDATA,YS) ; deletes a rule and all associated skips and instrument rules
54 ;Input IEN as ien of file 601.82
55 ;Output Data vs Error
56 N YSRULE,YSIEN,DA,DIK
57 S YSRULE=$G(YS("IEN"),-1)
58 I '$D(^YTT(601.82,YSRULE)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad rule id" Q ;--> out
59 ;delete rule
60 S DA=YSRULE,DIK="^YTT(601.82," D ^DIK
61 ;delete instrument rules
62 S YSIEN=0 F S YSIEN=$O(^YTT(601.83,"AC",YSRULE,YSIEN)) Q:YSIEN'>0 S DA=YSIEN,DIK="^YTT(601.83," D ^DIK
63 ;delete skips
64 S YSIEN=0 F S YSIEN=$O(^YTT(601.79,"AE",YSRULE,YSIEN)) Q:YSIEN'>0 S DA=YSIEN,DIK="^YTT(601.79," D ^DIK
65 S YSDATA(1)="[DATA]",YSDATA(2)="ok deleted"
66 Q
67BATDEL(YSDATA,YS) ;deletes a battery and associated users and content
68 ;Input IEN as ien of file 601.77
69 ;Output Data vs Error
70 N YSBAT,YSIEN,DA,DIK
71 S YSBAT=$G(YS("IEN"),-1)
72 I '$D(^YTT(601.77,YSBAT)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad BATTERY id" Q ;--> out
73 ;delete battery
74 S DA=YSBAT,DIK="^YTT(601.77," D ^DIK
75 ;delete battery Content
76 S YSIEN=0 F S YSIEN=$O(^YTT(601.78,"AD",YSBAT,YSIEN)) Q:YSIEN'>0 S DA=YSIEN,DIK="^YTT(601.78," D ^DIK
77 ;delete batt Users
78 S YSIEN=0 F S YSIEN=$O(^YTT(601.781,"AD",YSBAT,YSIEN)) Q:YSIEN'>0 S DA=YSIEN,DIK="^YTT(601.781," D ^DIK
79 S YSDATA(1)="[DATA]",YSDATA(2)="ok batt deleted"
80 Q
81SNDBUL(YSDATA,YS) ;send message to psych test ordering clinician
82 ;Input: DFN as patient ien
83 ; : ORD as ordered for (in duz form)
84 ; : TEST1 as name of test ordered (required;string)
85 ; : TEST2-TEST10 as name of other tests ordered (optional but in order;string)
86 ;Output: [DATA] VS [ERROR]
87 N I,XMB,XMDUZ,XMY,X,DIC,YSORD,YSDFN,Y,YSDT
88 S YSDFN=$G(YS("DFN")) I YSDFN="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO DFN" Q ;--> out
89 S YSORD=$G(YS("ORD")) I YSORD="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO ORD" Q ;--> out
90 F I=6:1:15 S XMB(I)=$G(YS("TEST"_(I-5)))
91 I XMB(6)="" S YSDATA(1)="[ERROR]",YSDATA(2)="no tests" Q ;--> out
92 S Y=DT X ^DD("DD") S YSDT(1)=Y
93 ;as in ENBUL^YSUTL
94 S DIC=3.8,DIC(0)="MZ",X="YS PSYCHTEST" D ^DIC
95 I Y'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="no YS bulletin" Q ;-->out
96 S XMB="YS PSYCHTEST",XMB(1)=$P(^DPT(YSDFN,0),U),XMB(2)=$P(^VA(200,DUZ,0),U),XMB(3)=YSDT(1) S XMB(4)="" S:YSORD]"" XMB(4)=$P(^VA(200,YSORD,0),U),XMY(YSORD)="" S XMDUZ=DUZ D EN^XMB
97 S YSDATA(1)="[DATA]",YSDATA(2)="OK"
Note: See TracBrowser for help on using the repository browser.