YS121PST ;SLC/KCM - Patch 121 post-init - utilities; 9/15/2015
;;5.01;MENTAL HEALTH;**121**;Dec 30, 1994;Build 61
;
;Reference to PXRMEXSI APIs supported by DBIA #4371
Q
;
;Adding notes to make sure what I know doesn't slip between the cracks.
; moved the YBOCSII, YBOCSII Symptom List, and the QOLIE-10 to OPERATONAL to Under development, HAS BEEN OPERATIONAL to No
; added name changes to the Index of Adl and KTZADL
; will also be adding the CSI Partner and CSI-4 Partner as new instruments
;
;
EXPDATE ; export date used to update 601.71:18
;;3170731.1956
Q
PRE ; pre-init
D BMES^XPDUTL("Re-indexing MH CHOICETYPES file")
N DIK
K ^YTT(601.751,"AC")
S DIK="^YTT(601.751," D IXALL^DIK
;
; switch back to uppercase if earlier version of patch installed
D CHGNM("ASSIST-WHOv3","ASSIST-WHOV3")
D CHGNM("KATZ-ADL-6pt","KATZ-ADL-6PT")
D CHGNM("KATZ-ADL-18pt","KATZ-ADL-18PT")
;
; set up for Reminder Exchange install of PCL-5 fixes
D DELEXE^PXRMEXSI("EXARRAY","YS121PST")
Q
POST ; post-init
N YTXLOG
D CHGNM("ASSIST","ASSIST-WHOV3")
D CHGNM("ASSIST NIDA","ASSIST-NIDA")
D CHGNM("INDEX OF ADL","KATZ-ADL-18PT")
D CHGNM("KTZADL","KATZ-ADL-6PT")
D BAK2DEV("QOLIE-10")
D BAK2DEV("YBOCSII")
D BAK2DEV("YBOCSII SYMPTOM LIST")
D BAK2DEV("IMRA")
D BAK2DEV("SIP-2L")
D COMPANS
D FIXSMEQ
D REQLIC
;Fileman deletes, specially added to remove duplicate entries in MH REPORTS (601.93)
D FMDEL^YTXCHGU(601.93,68) ;old GAI report, current and valid one is entry #69
K ^XTMP("YTXIDX") ; force building of new index across tests
D INSTALLQ^YTXCHG("XCHGLST","YS121PST")
; drop tests
F NM="CIWA-AR","AUIR","CESD5","DOM80","DOMG","ERS","HLOC" D DROPTST(NM)
F NM="IEQ","RLOC","SAI","SDES","SMAST","VALD","WAS" D DROPTST(NM)
; for PSOCQ, remove YS_MHA_AUX.DLL VERSION value (currently 1.0.3.3)
N TST S TST=$O(^YTT(601.71,"B","PSOCQ",0))
I TST D CLRFLD(601.71,100.03,TST)
;
; call Reminder Exchange to install PCL-5 fixes
D SMEXINS^PXRMEXSI("EXARRAY","YS121PST")
Q
CHGNM(OLD,NEW) ; Change test name
N REC,IEN
S IEN=$O(^YTT(601.71,"B",OLD,0))
I 'IEN QUIT ; already updated
S REC(.01)=NEW
S REC(18)=3170914
D FMUPD^YTXCHGU(601.71,.REC,IEN)
Q
COMPANS ; add "computed answer" questions
K ^TMP($J,"WP")
N IEN,REC
F IEN=7771:1:7783 D
. I $D(^YTT(601.72,IEN,0)) Q ; already added
. S ^TMP($J,"WP",IEN,1,0)="Computed Answer #"_(IEN-7770)
. S REC(.01)=IEN
. S REC(1)=$NA(^TMP($J,"WP",IEN))
. S REC(3)=3
. D FMADD^YTXCHGU(601.72,.REC,IEN)
K ^TMP($J,"WP")
Q
FIXSMEQ ; fix choice to avoid "conflict" error with existing CSM entry
N REC
I $E($G(^YTT(601.75,3253,1)),1,8)'="A little" Q ; unexpected record
S REC(3)="A little unpleasant but no great problem"
D FMUPD^YTXCHGU(601.75,.REC,3253)
Q
REQLIC ; change instruments to require license
N NM,IEN,REC
F NM="ISI","QOLI","SF36","SSF","WAI-SR","YBOCSII","YBOCSII SYMPTOM LIST" D
. S IEN=$O(^YTT(601.71,"B",NM,0))
. S REC(11)="Y",REC(20)="Y"
. D FMUPD^YTXCHGU(601.71,.REC,IEN)
Q
DROPTST(NAME) ; Change OPERATIONAL to dropped
N IEN,REC
S IEN=$O(^YTT(601.71,"B",NAME,0)) Q:'IEN
S REC(10)="D"
S REC(18)=$P($T(EXPDATE+1),";;",2)
D FMUPD^YTXCHGU(601.71,.REC,IEN)
Q
CLRFLD(FILE,FLD,IEN) ;
N REC
S REC(FLD)=""
D FMUPD^YTXCHGU(FILE,.REC,IEN)
Q
BAK2DEV(NAME) ; Set instrument back to 'under development'
N IEN,REC
S IEN=$O(^YTT(601.71,"B",NAME,0)) Q:'IEN
S REC(10)="U"
S REC(10.5)="N"
S REC(18)=$P($T(EXPDATE+1),";;",2)
D FMUPD^YTXCHGU(601.71,.REC,IEN)
Q
XCHGLST(ARRAY) ; return array of instrument exchange entries
; ARRAY(cnt,1)=instrument exchange entry name
; ARRAY(cnt,2)=instrument exchange entry creation date
;
N I,X
S I=0 F S I=I+1,X=$P($T(ENTRIES+I),";;",2,99) Q:X="zzzzz" D
. S ARRAY(I,1)=$P(X,U,1)
. S ARRAY(I,2)=$P(X,U,2)
Q
ENTRIES ; New/Updated MHA instruments ^ Exchange Entry Date
;;YS*5.01*121 NEW INSTRUMENTS^12/12/2017@19:04:38
;;YS*5.01*121 UPDATES^12/12/2017@19:06:09
;;zzzzz
;
EXARRAY(MODE,ARRAY) ;Called by Reminder Exchange to fix PCL-5
;MODE values: I for include in build, A for include action.
N LN S LN=0
;
S LN=LN+1
S ARRAY(LN,1)="YS*5.01*121 PCL-5 FIX"
I MODE["I" S ARRAY(LN,2)="12/20/2016@16:10:39"
I MODE["A" S ARRAY(LN,3)="I"
I MODE="IA" D BMES^XPDUTL("There are "_LN_" Reminder Exchange entries to be installed.")
Q
;
;
MODDATE ; Set new dates for tests listed so the GUI will reload the definition
; This is best done in the account where the build is created so that the
; original and destination accounts match.
N I,X,NEWDT
S NEWDT=$P($T(EXPDATE+1),";;",2)
F I=1:1 S X=$P($P($T(TESTS+I),";;",2),"^") Q:X="zzzzz" D NEWDATE^YTXCHGU(X,NEWDT)
Q
TESTS ; exported tests (renamed, added,updated, and retired)
;;ASSIST-WHOV3^renamed
;;ASSIST-NIDA^added
;;BRS^added
;;CCSA-DSM5^added
;;CEMI^added
;;CIWA-AR-^added
;;CSI^added
;;CSI PARTNER VERSION^added
;;CSI-4^added
;;CSI-4 PARTNER VERSION^added
;;GAI^added
;;ISI^added
;;KATZ-ADL-18PT^updated
;;KATZ-ADL-6PT^added
;;PHQ9^updated
;;PSOCQ^added
;;PSS^added
;;RLS^added
;;SMEQ^added
;;SNQ^added
;;STOP^added
;;WAI-SR^updated
;;CIWA-AR^retired
;;AUIR^retired
;;CESD5^retired
;;DOM80^retired
;;DOMG^retired
;;ERS^retired
;;HLOC^retired
;;IEQ^retired
;;RLOC^retired
;;SAI^retired
;;SDES^retired
;;SMAST^retired
;;VALD^retired
;;WAS^retired
;;zzzzz
;
; -- decided to do these later
;;IMRA^added
;;QOLIE-10^added
;;SIP-2L^added
;;YBOCSII^added
;;YBOCSII SYMPTOM LIST^added
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS121PST 5620 printed Nov 22, 2024@17:22:11 Page 2
YS121PST ;SLC/KCM - Patch 121 post-init - utilities; 9/15/2015
+1 ;;5.01;MENTAL HEALTH;**121**;Dec 30, 1994;Build 61
+2 ;
+3 ;Reference to PXRMEXSI APIs supported by DBIA #4371
+4 QUIT
+5 ;
+6 ;Adding notes to make sure what I know doesn't slip between the cracks.
+7 ; moved the YBOCSII, YBOCSII Symptom List, and the QOLIE-10 to OPERATONAL to Under development, HAS BEEN OPERATIONAL to No
+8 ; added name changes to the Index of Adl and KTZADL
+9 ; will also be adding the CSI Partner and CSI-4 Partner as new instruments
+10 ;
+11 ;
EXPDATE ; export date used to update 601.71:18
+1 ;;3170731.1956
+2 QUIT
PRE ; pre-init
+1 DO BMES^XPDUTL("Re-indexing MH CHOICETYPES file")
+2 NEW DIK
+3 KILL ^YTT(601.751,"AC")
+4 SET DIK="^YTT(601.751,"
DO IXALL^DIK
+5 ;
+6 ; switch back to uppercase if earlier version of patch installed
+7 DO CHGNM("ASSIST-WHOv3","ASSIST-WHOV3")
+8 DO CHGNM("KATZ-ADL-6pt","KATZ-ADL-6PT")
+9 DO CHGNM("KATZ-ADL-18pt","KATZ-ADL-18PT")
+10 +11 ;
+12 ; set up for Reminder Exchange install of PCL-5 fixes
+13 DO DELEXE^PXRMEXSI("EXARRAY","YS121PST")
+14 QUIT
POST ; post-init
+1 NEW YTXLOG
+2 DO CHGNM("ASSIST","ASSIST-WHOV3")
+3 DO CHGNM("ASSIST NIDA","ASSIST-NIDA")
+4 DO CHGNM("INDEX OF ADL","KATZ-ADL-18PT")
+5 DO CHGNM("KTZADL","KATZ-ADL-6PT")
+6 DO BAK2DEV("QOLIE-10")
+7 DO BAK2DEV("YBOCSII")
+8 DO BAK2DEV("YBOCSII SYMPTOM LIST")
+9 DO BAK2DEV("IMRA")
+10 DO BAK2DEV("SIP-2L")
+11 DO COMPANS
+12 DO FIXSMEQ
+13 DO REQLIC
+14 ;Fileman deletes, specially added to remove duplicate entries in MH REPORTS (601.93)
+15 ;old GAI report, current and valid one is entry #69
DO FMDEL^YTXCHGU(601.93,68)
+16 ; force building of new index across tests
KILL ^XTMP("YTXIDX")
+17 DO INSTALLQ^YTXCHG("XCHGLST","YS121PST")
+18 ; drop tests
+19 FOR NM="CIWA-AR","AUIR","CESD5","DOM80","DOMG","ERS","HLOC"
DO DROPTST(NM)
+20 FOR NM="IEQ","RLOC","SAI","SDES","SMAST","VALD","WAS"
DO DROPTST(NM)
+21 ; for PSOCQ, remove YS_MHA_AUX.DLL VERSION value (currently 1.0.3.3)
+22 NEW TST
SET TST=$ORDER(^YTT(601.71,"B","PSOCQ",0))
+23 IF TST
DO CLRFLD(601.71,100.03,TST)
+24 ;
+25 ; call Reminder Exchange to install PCL-5 fixes
+26 DO SMEXINS^PXRMEXSI("EXARRAY","YS121PST")
+27 QUIT
CHGNM(OLD,NEW) ; Change test name
+1 NEW REC,IEN
+2 SET IEN=$ORDER(^YTT(601.71,"B",OLD,0))
+3 ; already updated
IF 'IEN
QUIT
+4 SET REC(.01)=NEW
+5 SET REC(18)=3170914
+6 DO FMUPD^YTXCHGU(601.71,.REC,IEN)
+7 QUIT
COMPANS ; add "computed answer" questions
+1 KILL ^TMP($JOB,"WP")
+2 NEW IEN,REC
+3 FOR IEN=7771:1:7783
Begin DoDot:1
+4 ; already added
IF $DATA(^YTT(601.72,IEN,0))
QUIT
+5 SET ^TMP($JOB,"WP",IEN,1,0)="Computed Answer #"_(IEN-7770)
+6 SET REC(.01)=IEN
+7 SET REC(1)=$NAME(^TMP($JOB,"WP",IEN))
+8 SET REC(3)=3
+9 DO FMADD^YTXCHGU(601.72,.REC,IEN)
End DoDot:1
+10 KILL ^TMP($JOB,"WP")
+11 QUIT
FIXSMEQ ; fix choice to avoid "conflict" error with existing CSM entry
+1 NEW REC
+2 ; unexpected record
IF $EXTRACT($GET(^YTT(601.75,3253,1)),1,8)'="A little"
QUIT
+3 SET REC(3)="A little unpleasant but no great problem"
+4 DO FMUPD^YTXCHGU(601.75,.REC,3253)
+5 QUIT
REQLIC ; change instruments to require license
+1 NEW NM,IEN,REC
+2 FOR NM="ISI","QOLI","SF36","SSF","WAI-SR","YBOCSII","YBOCSII SYMPTOM LIST"
Begin DoDot:1
+3 SET IEN=$ORDER(^YTT(601.71,"B",NM,0))
+4 SET REC(11)="Y"
SET REC(20)="Y"
+5 DO FMUPD^YTXCHGU(601.71,.REC,IEN)
End DoDot:1
+6 QUIT
DROPTST(NAME) ; Change OPERATIONAL to dropped
+1 NEW IEN,REC
+2 SET IEN=$ORDER(^YTT(601.71,"B",NAME,0))
if 'IEN
QUIT
+3 SET REC(10)="D"
+4 SET REC(18)=$PIECE($TEXT(EXPDATE+1),";;",2)
+5 DO FMUPD^YTXCHGU(601.71,.REC,IEN)
+6 QUIT
CLRFLD(FILE,FLD,IEN) ;
+1 NEW REC
+2 SET REC(FLD)=""
+3 DO FMUPD^YTXCHGU(FILE,.REC,IEN)
+4 QUIT
BAK2DEV(NAME) ; Set instrument back to 'under development'
+1 NEW IEN,REC
+2 SET IEN=$ORDER(^YTT(601.71,"B",NAME,0))
if 'IEN
QUIT
+3 SET REC(10)="U"
+4 SET REC(10.5)="N"
+5 SET REC(18)=$PIECE($TEXT(EXPDATE+1),";;",2)
+6 DO FMUPD^YTXCHGU(601.71,.REC,IEN)
+7 QUIT
XCHGLST(ARRAY) ; return array of instrument exchange entries
+1 ; ARRAY(cnt,1)=instrument exchange entry name
+2 ; ARRAY(cnt,2)=instrument exchange entry creation date
+3 ;
+4 NEW I,X
+5 SET I=0
FOR
SET I=I+1
SET X=$PIECE($TEXT(ENTRIES+I),";;",2,99)
if X="zzzzz"
QUIT
Begin DoDot:1
+6 SET ARRAY(I,1)=$PIECE(X,U,1)
+7 SET ARRAY(I,2)=$PIECE(X,U,2)
End DoDot:1
+8 QUIT
ENTRIES ; New/Updated MHA instruments ^ Exchange Entry Date
+1 ;;YS*5.01*121 NEW INSTRUMENTS^12/12/2017@19:04:38
+2 ;;YS*5.01*121 UPDATES^12/12/2017@19:06:09
+3 ;;zzzzz
+4 ;
EXARRAY(MODE,ARRAY) ;Called by Reminder Exchange to fix PCL-5
+1 ;MODE values: I for include in build, A for include action.
+2 NEW LN
SET LN=0
+3 ;
+4 SET LN=LN+1
+5 SET ARRAY(LN,1)="YS*5.01*121 PCL-5 FIX"
+6 IF MODE["I"
SET ARRAY(LN,2)="12/20/2016@16:10:39"
+7 IF MODE["A"
SET ARRAY(LN,3)="I"
+8 IF MODE="IA"
DO BMES^XPDUTL("There are "_LN_" Reminder Exchange entries to be installed.")
+9 QUIT
+10 ;
+11 ;
MODDATE ; Set new dates for tests listed so the GUI will reload the definition
+1 ; This is best done in the account where the build is created so that the
+2 ; original and destination accounts match.
+3 NEW I,X,NEWDT
+4 SET NEWDT=$PIECE($TEXT(EXPDATE+1),";;",2)
+5 FOR I=1:1
SET X=$PIECE($PIECE($TEXT(TESTS+I),";;",2),"^")
if X="zzzzz"
QUIT
DO NEWDATE^YTXCHGU(X,NEWDT)
+6 QUIT
TESTS ; exported tests (renamed, added,updated, and retired)
+1 ;;ASSIST-WHOV3^renamed
+2 ;;ASSIST-NIDA^added
+3 ;;BRS^added
+4 ;;CCSA-DSM5^added
+5 ;;CEMI^added
+6 ;;CIWA-AR-^added
+7 ;;CSI^added
+8 ;;CSI PARTNER VERSION^added
+9 ;;CSI-4^added
+10 ;;CSI-4 PARTNER VERSION^added
+11 ;;GAI^added
+12 ;;ISI^added
+13 ;;KATZ-ADL-18PT^updated
+14 ;;KATZ-ADL-6PT^added
+15 ;;PHQ9^updated
+16 ;;PSOCQ^added
+17 ;;PSS^added
+18 ;;RLS^added
+19 ;;SMEQ^added
+20 ;;SNQ^added
+21 ;;STOP^added
+22 ;;WAI-SR^updated
+23 ;;CIWA-AR^retired
+24 ;;AUIR^retired
+25 ;;CESD5^retired
+26 ;;DOM80^retired
+27 ;;DOMG^retired
+28 ;;ERS^retired
+29 ;;HLOC^retired
+30 ;;IEQ^retired
+31 ;;RLOC^retired
+32 ;;SAI^retired
+33 ;;SDES^retired
+34 ;;SMAST^retired
+35 ;;VALD^retired
+36 ;;WAS^retired
+37 ;;zzzzz
+38 ;
+39 ; -- decided to do these later
+40 ;;IMRA^added
+41 ;;QOLIE-10^added
+42 ;;SIP-2L^added
+43 ;;YBOCSII^added
+44 ;;YBOCSII SYMPTOM LIST^added
