98 lines
4.4 KiB
Mathematica
98 lines
4.4 KiB
Mathematica
YTQAPI7 ;ALB/ASF- MHAX ANSWERS ; 5/24/07 10:12am
|
|
;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 48
|
|
Q
|
|
KEY(YSDATA,YS) ;get all keys for a test
|
|
; input: CODE as TEST name
|
|
; output:SCALE=ScaleName^scale Id
|
|
; KEY=Question ID^Target^Value^Key Ien
|
|
N G,YSKEYI,YSCODE,I,N,YSCALEI,YSCNAME,YSCODEN,YSQN,YSTARG,YSVAL
|
|
K ^TMP($J,"YSKEY") S YSDATA=$NA(^TMP($J,"YSKEY"))
|
|
S YSCODE=$G(YS("CODE")) S:YSCODE="" YSCODE=0
|
|
I '$D(^YTT(601.71,"B",YSCODE)) S ^TMP($J,"YSKEY",1)="[ERROR]",^TMP($J,"YSKEY",2)="no ins" Q ;-->out
|
|
S YSCODEN=$O(^YTT(601.71,"B",YSCODE,0))
|
|
I '$D(^YTT(601.86,"AC",YSCODEN)) S ^TMP($J,"YSKEY",1)="[ERROR]",^TMP($J,"YSKEY",2)="no scale grps found" Q ;-->out
|
|
D SCALEG^YTQAPI3(.YSDATA,.YS)
|
|
S YSDATA=$NA(^TMP($J,"YSKEY"))
|
|
S ^TMP($J,"YSKEY",1)="[DATA]",N=1
|
|
F I=2:1 Q:'$D(^TMP($J,"YSG",I)) I ^TMP($J,"YSG",I)?1"Scale".E D
|
|
. S YSCALEI=$P(^TMP($J,"YSG",I),U),YSCALEI=$P(YSCALEI,"=",2),YSCNAME=$P(^TMP($J,"YSG",I),U,4)
|
|
. S N=N+1,^TMP($J,"YSKEY",N)="SCALE="_YSCNAME_U_YSCALEI_U
|
|
. S YSKEYI=0 F S YSKEYI=$O(^YTT(601.91,"AC",YSCALEI,YSKEYI)) Q:YSKEYI'>0 D
|
|
.. S G=^YTT(601.91,YSKEYI,0)
|
|
.. S YSQN=$P(G,U,3),YSTARG=$P(G,U,4),YSVAL=$P(G,U,5)
|
|
.. S N=N+1
|
|
.. S ^TMP($J,"YSKEY",N)="KEY="_YSQN_U_YSTARG_U_YSVAL_U_YSKEYI
|
|
Q
|
|
ANSLIST(YSDATA,YS) ;simple answer list
|
|
N D1,N1,YSQ,YSAI,G
|
|
S YSAI=$G(YS("IEN")) I YSAI'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad admin ien" Q ;-->out
|
|
S N=1,YSQ=0
|
|
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
|
|
. S D1=0,N1=0,G=$G(^YTT(601.85,DA,0))
|
|
. F S D1=$O(^YTT(601.85,DA,1,D1)) Q:D1'>0 D
|
|
.. S N=N+1,N1=N1+1
|
|
.. S YSDATA(N)=$P(G,U,3)_";"_N1_U_$G(^YTT(601.85,DA,1,D1,0))
|
|
Q
|
|
VERSRV(YSDATA,YS) ; Return server version stored in YS BROKER1
|
|
; input: YSB as option name
|
|
; output: 2:MHA3 version number
|
|
; 3: CR DLL VERSION
|
|
; 4:mh DLL VERSION
|
|
N YSLST,YSB,YSVAL
|
|
S YSB=$G(YS("YSB"))
|
|
I YSB="" S YSDATA(1)="[ERROR]",YSDATA(2)="no opt" Q
|
|
D FIND^DIC(19,"",1,"X",YSB,1,,,,"YSLST")
|
|
I 'YSLST("DILIST",0) S YSDATA(1)="[ERROR]",YSDATA(2)="no version found" Q
|
|
S YSVAL=YSLST("DILIST","ID",1,1)
|
|
S YSVAL=$P(YSVAL,"version ",2)
|
|
S YSDATA(1)="[DATA]"
|
|
S YSDATA(2)=$P(YSVAL,"~",1)
|
|
S YSDATA(3)=$P(YSVAL,"~",2)
|
|
S YSDATA(4)=$P(YSVAL,"~",3)
|
|
Q
|
|
RULEDEL(YSDATA,YS) ; deletes a rule and all associated skips and instrument rules
|
|
;Input IEN as ien of file 601.82
|
|
;Output Data vs Error
|
|
N YSRULE,YSIEN,DA,DIK
|
|
S YSRULE=$G(YS("IEN"),-1)
|
|
I '$D(^YTT(601.82,YSRULE)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad rule id" Q ;--> out
|
|
;delete rule
|
|
S DA=YSRULE,DIK="^YTT(601.82," D ^DIK
|
|
;delete instrument rules
|
|
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
|
|
;delete skips
|
|
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
|
|
S YSDATA(1)="[DATA]",YSDATA(2)="ok deleted"
|
|
Q
|
|
BATDEL(YSDATA,YS) ;deletes a battery and associated users and content
|
|
;Input IEN as ien of file 601.77
|
|
;Output Data vs Error
|
|
N YSBAT,YSIEN,DA,DIK
|
|
S YSBAT=$G(YS("IEN"),-1)
|
|
I '$D(^YTT(601.77,YSBAT)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad BATTERY id" Q ;--> out
|
|
;delete battery
|
|
S DA=YSBAT,DIK="^YTT(601.77," D ^DIK
|
|
;delete battery Content
|
|
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
|
|
;delete batt Users
|
|
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
|
|
S YSDATA(1)="[DATA]",YSDATA(2)="ok batt deleted"
|
|
Q
|
|
SNDBUL(YSDATA,YS) ;send message to psych test ordering clinician
|
|
;Input: DFN as patient ien
|
|
; : ORD as ordered for (in duz form)
|
|
; : TEST1 as name of test ordered (required;string)
|
|
; : TEST2-TEST10 as name of other tests ordered (optional but in order;string)
|
|
;Output: [DATA] VS [ERROR]
|
|
N I,XMB,XMDUZ,XMY,X,DIC,YSORD,YSDFN,Y,YSDT
|
|
S YSDFN=$G(YS("DFN")) I YSDFN="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO DFN" Q ;--> out
|
|
S YSORD=$G(YS("ORD")) I YSORD="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO ORD" Q ;--> out
|
|
F I=6:1:15 S XMB(I)=$G(YS("TEST"_(I-5)))
|
|
I XMB(6)="" S YSDATA(1)="[ERROR]",YSDATA(2)="no tests" Q ;--> out
|
|
S Y=DT X ^DD("DD") S YSDT(1)=Y
|
|
;as in ENBUL^YSUTL
|
|
S DIC=3.8,DIC(0)="MZ",X="YS PSYCHTEST" D ^DIC
|
|
I Y'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="no YS bulletin" Q ;-->out
|
|
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
|
|
S YSDATA(1)="[DATA]",YSDATA(2)="OK"
|