YTQAPI7 ;ALB/ASF- MHAX ANSWERS ; 5/24/07 10:12am
;;5.01;MENTAL HEALTH;**85,129,141**;Dec 30, 1994;Build 85
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)
S YSDATA(5)=$$GET^XPAR("ALL","YS MHA_AUX DLL LOCATION")
S YSDATA(6)=$$GET^XPAR("ALL","YS MHA SECURE DESKTOP DISABLE")
; I $$GET^XPAR("ALL","YSMOCA ATTESTATION ENABLED") D
I $$NOW^XLFDT>$$GET^XPAR("SYS","YSMOCA ATTESTATION DATE") D
. N I,X,YSMSG
. D GETWP^XPAR(.YSMSG,"ALL","YSMOCA MESSAGE")
. S I=0,X="" F S I=$O(YSMSG(I)) Q:'I S X=X_YSMSG(I,0)
. S YSDATA(7)=X
Q
UPDVER(WHICH,VER) ; update MHA version number in broker option
; WHICH: 1=server, 2="A" DLL, 3=MHA exe
; VER: version string for WHICH component
N OPT,TXT,VERPART,FDA,DIERR
S OPT=$$FIND1^DIC(19,"","X","YS BROKER1","B")
I 'OPT D BMES^XPDUTL("ERROR: YS BROKER1 not found on this system.") QUIT
I $D(DIERR) D BMES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1))) QUIT
S TXT=$$GET1^DIQ(19,OPT_",",1),VERPART=$P(TXT,"version ",2)
S $P(VERPART,"~",WHICH)=VER,$P(TXT,"version ",2)=VERPART
S FDA(19,OPT_",",1)=TXT
D FILE^DIE("","FDA")
I $D(DIERR) D BMES^XPDUTL("ERROR: "_$G(^TMP("DIERR",$J,1,"TEXT",1)))
D CLEAN^DILF
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"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQAPI7 5647 printed Apr 09, 2024@21:18:04 Page 2
YTQAPI7 ;ALB/ASF- MHAX ANSWERS ; 5/24/07 10:12am
+1 ;;5.01;MENTAL HEALTH;**85,129,141**;Dec 30, 1994;Build 85
+2 QUIT
KEY(YSDATA,YS) ;get all keys for a test
+1 ; input: CODE as TEST name
+2 ; output:SCALE=ScaleName^scale Id
+3 ; KEY=Question ID^Target^Value^Key Ien
+4 NEW G,YSKEYI,YSCODE,I,N,YSCALEI,YSCNAME,YSCODEN,YSQN,YSTARG,YSVAL
+5 KILL ^TMP($JOB,"YSKEY")
SET YSDATA=$NAME(^TMP($JOB,"YSKEY"))
+6 SET YSCODE=$GET(YS("CODE"))
if YSCODE=""
SET YSCODE=0
+7 ;-->out
IF '$DATA(^YTT(601.71,"B",YSCODE))
SET ^TMP($JOB,"YSKEY",1)="[ERROR]"
SET ^TMP($JOB,"YSKEY",2)="no ins"
QUIT
+8 SET YSCODEN=$ORDER(^YTT(601.71,"B",YSCODE,0))
+9 ;-->out
IF '$DATA(^YTT(601.86,"AC",YSCODEN))
SET ^TMP($JOB,"YSKEY",1)="[ERROR]"
SET ^TMP($JOB,"YSKEY",2)="no scale grps found"
QUIT
+10 DO SCALEG^YTQAPI3(.YSDATA,.YS)
+11 SET YSDATA=$NAME(^TMP($JOB,"YSKEY"))
+12 SET ^TMP($JOB,"YSKEY",1)="[DATA]"
SET N=1
+13 FOR I=2:1
if '$DATA(^TMP($JOB,"YSG",I))
QUIT
IF ^TMP($JOB,"YSG",I)?1"Scale".E
Begin DoDot:1
+14 SET YSCALEI=$PIECE(^TMP($JOB,"YSG",I),U)
SET YSCALEI=$PIECE(YSCALEI,"=",2)
SET YSCNAME=$PIECE(^TMP($JOB,"YSG",I),U,4)
+15 SET N=N+1
SET ^TMP($JOB,"YSKEY",N)="SCALE="_YSCNAME_U_YSCALEI_U
+16 SET YSKEYI=0
FOR
SET YSKEYI=$ORDER(^YTT(601.91,"AC",YSCALEI,YSKEYI))
if YSKEYI'>0
QUIT
Begin DoDot:2
+17 SET G=^YTT(601.91,YSKEYI,0)
+18 SET YSQN=$PIECE(G,U,3)
SET YSTARG=$PIECE(G,U,4)
SET YSVAL=$PIECE(G,U,5)
+19 SET N=N+1
+20 SET ^TMP($JOB,"YSKEY",N)="KEY="_YSQN_U_YSTARG_U_YSVAL_U_YSKEYI
End DoDot:2
End DoDot:1
+21 QUIT
ANSLIST(YSDATA,YS) ;simple answer list
+1 NEW D1,N1,YSQ,YSAI,G
+2 ;-->out
SET YSAI=$GET(YS("IEN"))
IF YSAI'?1N.N
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad admin ien"
QUIT
+3 SET N=1
SET YSQ=0
+4 FOR
SET YSQ=$ORDER(^YTT(601.85,"AC",YSAI,YSQ))
if YSQ'>0
QUIT
SET DA=0
FOR
SET DA=$ORDER(^YTT(601.85,"AC",YSAI,YSQ,DA))
if DA'>0
QUIT
Begin DoDot:1
+5 SET D1=0
SET N1=0
SET G=$GET(^YTT(601.85,DA,0))
+6 FOR
SET D1=$ORDER(^YTT(601.85,DA,1,D1))
if D1'>0
QUIT
Begin DoDot:2
+7 SET N=N+1
SET N1=N1+1
+8 SET YSDATA(N)=$PIECE(G,U,3)_";"_N1_U_$GET(^YTT(601.85,DA,1,D1,0))
End DoDot:2
End DoDot:1
+9 QUIT
VERSRV(YSDATA,YS) ; Return server version stored in YS BROKER1
+1 ; input: YSB as option name
+2 ; output: 2:MHA3 version number
+3 ; 3: CR DLL VERSION
+4 ; 4:mh DLL VERSION
+5 NEW YSLST,YSB,YSVAL
+6 SET YSB=$GET(YS("YSB"))
+7 IF YSB=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no opt"
QUIT
+8 DO FIND^DIC(19,"",1,"X",YSB,1,,,,"YSLST")
+9 IF 'YSLST("DILIST",0)
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no version found"
QUIT
+10 SET YSVAL=YSLST("DILIST","ID",1,1)
+11 SET YSVAL=$PIECE(YSVAL,"version ",2)
+12 SET YSDATA(1)="[DATA]"
+13 SET YSDATA(2)=$PIECE(YSVAL,"~",1)
+14 SET YSDATA(3)=$PIECE(YSVAL,"~",2)
+15 SET YSDATA(4)=$PIECE(YSVAL,"~",3)
+16 SET YSDATA(5)=$$GET^XPAR("ALL","YS MHA_AUX DLL LOCATION")
+17 SET YSDATA(6)=$$GET^XPAR("ALL","YS MHA SECURE DESKTOP DISABLE")
+18 ; I $$GET^XPAR("ALL","YSMOCA ATTESTATION ENABLED") D
+19 IF $$NOW^XLFDT>$$GET^XPAR("SYS","YSMOCA ATTESTATION DATE")
Begin DoDot:1
+20 NEW I,X,YSMSG
+21 DO GETWP^XPAR(.YSMSG,"ALL","YSMOCA MESSAGE")
+22 SET I=0
SET X=""
FOR
SET I=$ORDER(YSMSG(I))
if 'I
QUIT
SET X=X_YSMSG(I,0)
+23 SET YSDATA(7)=X
End DoDot:1
+24 QUIT
UPDVER(WHICH,VER) ; update MHA version number in broker option
+1 ; WHICH: 1=server, 2="A" DLL, 3=MHA exe
+2 ; VER: version string for WHICH component
+3 NEW OPT,TXT,VERPART,FDA,DIERR
+4 SET OPT=$$FIND1^DIC(19,"","X","YS BROKER1","B")
+5 IF 'OPT
DO BMES^XPDUTL("ERROR: YS BROKER1 not found on this system.")
QUIT
+6 IF $DATA(DIERR)
DO BMES^XPDUTL("ERROR: "_$GET(^TMP("DIERR",$JOB,1,"TEXT",1)))
QUIT
+7 SET TXT=$$GET1^DIQ(19,OPT_",",1)
SET VERPART=$PIECE(TXT,"version ",2)
+8 SET $PIECE(VERPART,"~",WHICH)=VER
SET $PIECE(TXT,"version ",2)=VERPART
+9 SET FDA(19,OPT_",",1)=TXT
+10 DO FILE^DIE("","FDA")
+11 IF $DATA(DIERR)
DO BMES^XPDUTL("ERROR: "_$GET(^TMP("DIERR",$JOB,1,"TEXT",1)))
+12 DO CLEAN^DILF
+13 QUIT
RULEDEL(YSDATA,YS) ; deletes a rule and all associated skips and instrument rules
+1 ;Input IEN as ien of file 601.82
+2 ;Output Data vs Error
+3 NEW YSRULE,YSIEN,DA,DIK
+4 SET YSRULE=$GET(YS("IEN"),-1)
+5 ;--> out
IF '$DATA(^YTT(601.82,YSRULE))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad rule id"
QUIT
+6 ;delete rule
+7 SET DA=YSRULE
SET DIK="^YTT(601.82,"
DO ^DIK
+8 ;delete instrument rules
+9 SET YSIEN=0
FOR
SET YSIEN=$ORDER(^YTT(601.83,"AC",YSRULE,YSIEN))
if YSIEN'>0
QUIT
SET DA=YSIEN
SET DIK="^YTT(601.83,"
DO ^DIK
+10 ;delete skips
+11 SET YSIEN=0
FOR
SET YSIEN=$ORDER(^YTT(601.79,"AE",YSRULE,YSIEN))
if YSIEN'>0
QUIT
SET DA=YSIEN
SET DIK="^YTT(601.79,"
DO ^DIK
+12 SET YSDATA(1)="[DATA]"
SET YSDATA(2)="ok deleted"
+13 QUIT
BATDEL(YSDATA,YS) ;deletes a battery and associated users and content
+1 ;Input IEN as ien of file 601.77
+2 ;Output Data vs Error
+3 NEW YSBAT,YSIEN,DA,DIK
+4 SET YSBAT=$GET(YS("IEN"),-1)
+5 ;--> out
IF '$DATA(^YTT(601.77,YSBAT))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad BATTERY id"
QUIT
+6 ;delete battery
+7 SET DA=YSBAT
SET DIK="^YTT(601.77,"
DO ^DIK
+8 ;delete battery Content
+9 SET YSIEN=0
FOR
SET YSIEN=$ORDER(^YTT(601.78,"AD",YSBAT,YSIEN))
if YSIEN'>0
QUIT
SET DA=YSIEN
SET DIK="^YTT(601.78,"
DO ^DIK
+10 ;delete batt Users
+11 SET YSIEN=0
FOR
SET YSIEN=$ORDER(^YTT(601.781,"AD",YSBAT,YSIEN))
if YSIEN'>0
QUIT
SET DA=YSIEN
SET DIK="^YTT(601.781,"
DO ^DIK
+12 SET YSDATA(1)="[DATA]"
SET YSDATA(2)="ok batt deleted"
+13 QUIT
SNDBUL(YSDATA,YS) ;send message to psych test ordering clinician
+1 ;Input: DFN as patient ien
+2 ; : ORD as ordered for (in duz form)
+3 ; : TEST1 as name of test ordered (required;string)
+4 ; : TEST2-TEST10 as name of other tests ordered (optional but in order;string)
+5 ;Output: [DATA] VS [ERROR]
+6 NEW I,XMB,XMDUZ,XMY,X,DIC,YSORD,YSDFN,Y,YSDT
+7 ;--> out
SET YSDFN=$GET(YS("DFN"))
IF YSDFN=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="NO DFN"
QUIT
+8 ;--> out
SET YSORD=$GET(YS("ORD"))
IF YSORD=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="NO ORD"
QUIT
+9 FOR I=6:1:15
SET XMB(I)=$GET(YS("TEST"_(I-5)))
+10 ;--> out
IF XMB(6)=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no tests"
QUIT
+11 SET Y=DT
XECUTE ^DD("DD")
SET YSDT(1)=Y
+12 ;as in ENBUL^YSUTL
+13 SET DIC=3.8
SET DIC(0)="MZ"
SET X="YS PSYCHTEST"
DO ^DIC
+14 ;-->out
IF Y'>0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no YS bulletin"
QUIT
+15 SET XMB="YS PSYCHTEST"
SET XMB(1)=$PIECE(^DPT(YSDFN,0),U)
SET XMB(2)=$PIECE(^VA(200,DUZ,0),U)
SET XMB(3)=YSDT(1)
SET XMB(4)=""
if YSORD]""
SET XMB(4)=$PIECE(^VA(200,YSORD,0),U)
SET XMY(YSORD)=""
SET XMDUZ=DUZ
DO EN^XMB
+16 SET YSDATA(1)="[DATA]"
SET YSDATA(2)="OK"
