YS142PST ;SLC/KCM - Patch 142 post-init ; 03/20/2017
;;5.01;MENTAL HEALTH;**142**;Dec 30, 1994;Build 14
;
EXPDATE ; export date used to update 601.71:18
;;3190815.1731
Q
;
POST ; post-init for patch 142
N REC,MMPI2RF,QOLI
;Queue check of extraneous scales
D QTASK^YS142FIX(($H+1)_",3600")
;
;Re-score QOLI to catch problems between patch 139 and this install
K REC
S REC(93)=2 ; Set scoring revision to 2
S QOLI=$O(^YTT(601.71,"B","QOLI",0))
I QOLI D
. D FMUPD^YTXCHGU(601.71,.REC,QOLI)
. D QTASK^YTSCOREV(QOLI_"~2",($H+3)_",3600")
;
;Re-score MMPI-2-RF to fix the EID, PSYC-r scales
S REC(93)=3 ; Set scoring revision to 3
S MMPI2RF=$O(^YTT(601.71,"B","MMPI-2-RF",0))
I MMPI2RF D
. D FMUPD^YTXCHGU(601.71,.REC,MMPI2RF)
. D QTASK^YTSCOREV(MMPI2RF_"~3",($H+5)_",3600")
;
;Reporting updates to C-SSRS
D INSTALLQ^YTXCHG("XCHGLST","YS142PST")
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
F I=1:1 S X=$P($T(ENTRIES+I),";;",2,99) Q:X="zzzzz" D
. S ARRAY(I,1)=$P(X,U)
. S ARRAY(I,2)=$P(X,U,2)
Q
ENTRIES ; New MHA instruments ^ Exchange Entry Date
;;YS*5.01*142 UPDATES^09/19/2019@11:58:09
;;zzzzz
;
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 instruments
;;C-SSRS^updated
;;QOLI^updated
;;zzzzz
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS142PST 1720 printed Apr 09, 2024@21:20:30 Page 2
YS142PST ;SLC/KCM - Patch 142 post-init ; 03/20/2017
+1 ;;5.01;MENTAL HEALTH;**142**;Dec 30, 1994;Build 14
+2 ;
EXPDATE ; export date used to update 601.71:18
+1 ;;3190815.1731
+2 QUIT
+3 ;
POST ; post-init for patch 142
+1 NEW REC,MMPI2RF,QOLI
+2 ;Queue check of extraneous scales
+3 DO QTASK^YS142FIX(($HOROLOG+1)_",3600")
+4 ;
+5 ;Re-score QOLI to catch problems between patch 139 and this install
+6 KILL REC
+7 ; Set scoring revision to 2
SET REC(93)=2
+8 SET QOLI=$ORDER(^YTT(601.71,"B","QOLI",0))
+9 IF QOLI
Begin DoDot:1
+10 DO FMUPD^YTXCHGU(601.71,.REC,QOLI)
+11 DO QTASK^YTSCOREV(QOLI_"~2",($HOROLOG+3)_",3600")
End DoDot:1
+12 ;
+13 ;Re-score MMPI-2-RF to fix the EID, PSYC-r scales
+14 ; Set scoring revision to 3
SET REC(93)=3
+15 SET MMPI2RF=$ORDER(^YTT(601.71,"B","MMPI-2-RF",0))
+16 IF MMPI2RF
Begin DoDot:1
+17 DO FMUPD^YTXCHGU(601.71,.REC,MMPI2RF)
+18 DO QTASK^YTSCOREV(MMPI2RF_"~3",($HOROLOG+5)_",3600")
End DoDot:1
+19 ;
+20 ;Reporting updates to C-SSRS
+21 DO INSTALLQ^YTXCHG("XCHGLST","YS142PST")
+22 QUIT
+23 ;
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 NEW I,X
+4 FOR I=1:1
SET X=$PIECE($TEXT(ENTRIES+I),";;",2,99)
if X="zzzzz"
QUIT
Begin DoDot:1
+5 SET ARRAY(I,1)=$PIECE(X,U)
+6 SET ARRAY(I,2)=$PIECE(X,U,2)
End DoDot:1
+7 QUIT
ENTRIES ; New MHA instruments ^ Exchange Entry Date
+1 ;;YS*5.01*142 UPDATES^09/19/2019@11:58:09
+2 ;;zzzzz
+3 ;
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 instruments
+1 ;;C-SSRS^updated
+2 ;;QOLI^updated
+3 ;;zzzzz
+4 ;
