YS103PRE ;HIOFO/FT - YS*5.01*103 PRE-INIT ; 2/7/11 11:54am
;;5.01;MENTAL HEALTH;**103**;Dec 30, 1994;Build 27
;Reference to XPDGREF and ^XTMP supported by DBIA #2433
MAIN ;Main entry
D EN1,EN1A,EN1B,EN2,EN3,EN4
Q
EN1 ;MH CHOICES (601.75)
;Delete CHOICE TEXT (field #3) for selected entries because these
;entries have embedded control characters or spelling errors or
;punctuation errors.
;The KIDS build will add the correct value.
N YSARR,YSFDA,YSIEN
F YSIEN=569,602,645,1012,1021,1378,1379,1633,1800,1865,1921,1952,1969,1982,1986,1989,2007,2020,2027,2033,2036,2068,2133,2140,2241,2242,2248,2249,2375,2439,2517,2583,2626,2702,2703,2884 D
.K YSFDA,YSARR
.S YSFDA(601.75,YSIEN_",",3)="@"
.D UPDATE^DIE("","YSFDA","YSARR")
Q
EN1A ;MH TESTS AND SURVEYS (601.71)
;Delete PURPOSE (field #12) for selected entry because it has embedded control characters.
;The KIDS build will add the correct value.
N YSARR,YSFDA
S YSFDA(601.71,47_",",12)="@"
D UPDATE^DIE("","YSFDA","YSARR")
Q
EN1B ;MH QUESTIONS (601.72)
;Delete QUESTION TEXT (field #1) for selected entry because it has embedded control characters.
;The KIDS build will add the correct value.
N YSARR,YSFDA
S YSFDA(601.72,5016_",",1)="@"
D UPDATE^DIE("","YSFDA","YSARR")
Q
EN2 ;MH SCALEGROUPS (601.86)
;Modifies one entry. This is an existing entry, but the SCALEGROUP NAME
;which is an IDENTIFIER has changed.
N YSARR,YSFDA
S YSFDA(601.86,"134,",2)="Part I" ;SCALEGROUP NAME
S YSFDA(601.86,"134,",4)="Score" ;ORDINATE TITLE
S YSFDA(601.86,"134,",7)=6 ;ORDINATEMAX
D UPDATE^DIE("","YSFDA","YSARR")
Q
EN3 ;MH SCALES (601.87)
;Modifies two entries. These are existing entries, but the SCALE NAME
;which is an IDENTIFIER has changed.
N YSARR,YSFDA
S YSFDA(601.87,"507,",3)="Interference" ;SCALE NAME
S YSFDA(601.87,"507,",4)="Inter" ;XLABEL
D UPDATE^DIE("","YSFDA","YSARR")
K YSARR,YSFDA
S YSFDA(601.87,"508,",3)="Support" ;SCALE NAME
S YSFDA(601.87,"508,",4)="Sup" ;XLABEL
D UPDATE^DIE("","YSFDA","YSARR")
K YSARR,YSFDA
S YSFDA(601.87,"580,",3)="Confidence in No Use" ;SCALE NAME
D UPDATE^DIE("","YSFDA","YSARR")
Q
EN4 ;delete C & AU x-refs on file 601.75, field 3
;Both x-refs will be re-built with the installation.
N YSARR,YSCHK,YSEMSG,YSERR,YSX
D FIND^DIC(.11,"",".01;.02;.11","CPX","601.75","*","B","","","YSCHK","YSEMSG") ;check if indexes already exist
I $G(YSEMSG("DIERR",1,"TEXT",1)) D Q
.S YSARR(1)=YSEMSG("DIERR",1,"TEXT",1)
.S YSARR(2)="Please log a Remedy ticket."
.D EN^DDIOL(.YSARR)
I $P(YSCHK("DILIST",0),U,1)="3" Q ;new indexes already created.
D DELIX^DDMOD(601.75,3,1,,,"YSERR") ;delete C x-ref definition
I +$P($G(YSERR("DIERR")),U,1)>0 D
.S YSX=$G(YSERR("DIERR",1,"TEXT",1))
.D EN^DDIOL(YSX,,"!")
D DELIX^DDMOD(601.75,3,2,,,"YSERR") ;delete AU x-ref definition
I +$P($G(YSERR("DIERR")),U,1)>0 D
.S YSX=$G(YSERR("DIERR",1,"TEXT",1))
.D EN^DDIOL(YSX,,"!")
Q
PRETRAN ;Pre-Transportation entry point
;Copy the MH CHOICETYPE (601.751) entries into the transport global
N YSLOOP
S YSLOOP=0
F S YSLOOP=$O(^YTT(601.751,YSLOOP)) Q:'YSLOOP!(YSLOOP>99999) D
.S @XPDGREF@(601.751,YSLOOP)=$G(^YTT(601.751,YSLOOP,0))
Q
POST751 ;enter all MH CHOICETYPE (601.751) entries
N N,DIK
S N=0
F S N=$O(^XTMP("XPDI",XPDA,"TEMP",601.751,N)) Q:N'>0 D
.S ^YTT(601.751,N,0)=^XTMP("XPDI",XPDA,"TEMP",601.751,N)
S DIK="^YTT(601.751," D IXALL^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS103PRE 3497 printed Sep 23, 2025@19:48:01 Page 2
YS103PRE ;HIOFO/FT - YS*5.01*103 PRE-INIT ; 2/7/11 11:54am
+1 ;;5.01;MENTAL HEALTH;**103**;Dec 30, 1994;Build 27
+2 ;Reference to XPDGREF and ^XTMP supported by DBIA #2433
MAIN ;Main entry
+1 DO EN1
DO EN1A
DO EN1B
DO EN2
DO EN3
DO EN4
+2 QUIT
EN1 ;MH CHOICES (601.75)
+1 ;Delete CHOICE TEXT (field #3) for selected entries because these
+2 ;entries have embedded control characters or spelling errors or
+3 ;punctuation errors.
+4 ;The KIDS build will add the correct value.
+5 NEW YSARR,YSFDA,YSIEN
+6 FOR YSIEN=569,602,645,1012,1021,1378,1379,1633,1800,1865,1921,1952,1969,1982,1986,1989,2007,2020,2027,2033,2036,2068,2133,2140,2241,2242,2248,2249,2375,2439,2517,2583,2626,2702,2703,2884
Begin DoDot:1
+7 KILL YSFDA,YSARR
+8 SET YSFDA(601.75,YSIEN_",",3)="@"
+9 DO UPDATE^DIE("","YSFDA","YSARR")
End DoDot:1
+10 QUIT
EN1A ;MH TESTS AND SURVEYS (601.71)
+1 ;Delete PURPOSE (field #12) for selected entry because it has embedded control characters.
+2 ;The KIDS build will add the correct value.
+3 NEW YSARR,YSFDA
+4 SET YSFDA(601.71,47_",",12)="@"
+5 DO UPDATE^DIE("","YSFDA","YSARR")
+6 QUIT
EN1B ;MH QUESTIONS (601.72)
+1 ;Delete QUESTION TEXT (field #1) for selected entry because it has embedded control characters.
+2 ;The KIDS build will add the correct value.
+3 NEW YSARR,YSFDA
+4 SET YSFDA(601.72,5016_",",1)="@"
+5 DO UPDATE^DIE("","YSFDA","YSARR")
+6 QUIT
EN2 ;MH SCALEGROUPS (601.86)
+1 ;Modifies one entry. This is an existing entry, but the SCALEGROUP NAME
+2 ;which is an IDENTIFIER has changed.
+3 NEW YSARR,YSFDA
+4 ;SCALEGROUP NAME
SET YSFDA(601.86,"134,",2)="Part I"
+5 ;ORDINATE TITLE
SET YSFDA(601.86,"134,",4)="Score"
+6 ;ORDINATEMAX
SET YSFDA(601.86,"134,",7)=6
+7 DO UPDATE^DIE("","YSFDA","YSARR")
+8 QUIT
EN3 ;MH SCALES (601.87)
+1 ;Modifies two entries. These are existing entries, but the SCALE NAME
+2 ;which is an IDENTIFIER has changed.
+3 NEW YSARR,YSFDA
+4 ;SCALE NAME
SET YSFDA(601.87,"507,",3)="Interference"
+5 ;XLABEL
SET YSFDA(601.87,"507,",4)="Inter"
+6 DO UPDATE^DIE("","YSFDA","YSARR")
+7 KILL YSARR,YSFDA
+8 ;SCALE NAME
SET YSFDA(601.87,"508,",3)="Support"
+9 ;XLABEL
SET YSFDA(601.87,"508,",4)="Sup"
+10 DO UPDATE^DIE("","YSFDA","YSARR")
+11 KILL YSARR,YSFDA
+12 ;SCALE NAME
SET YSFDA(601.87,"580,",3)="Confidence in No Use"
+13 DO UPDATE^DIE("","YSFDA","YSARR")
+14 QUIT
EN4 ;delete C & AU x-refs on file 601.75, field 3
+1 ;Both x-refs will be re-built with the installation.
+2 NEW YSARR,YSCHK,YSEMSG,YSERR,YSX
+3 ;check if indexes already exist
DO FIND^DIC(.11,"",".01;.02;.11","CPX","601.75","*","B","","","YSCHK","YSEMSG")
+4 IF $GET(YSEMSG("DIERR",1,"TEXT",1))
Begin DoDot:1
+5 SET YSARR(1)=YSEMSG("DIERR",1,"TEXT",1)
+6 SET YSARR(2)="Please log a Remedy ticket."
+7 DO EN^DDIOL(.YSARR)
End DoDot:1
QUIT
+8 ;new indexes already created.
IF $PIECE(YSCHK("DILIST",0),U,1)="3"
QUIT
+9 ;delete C x-ref definition
DO DELIX^DDMOD(601.75,3,1,,,"YSERR")
+10 IF +$PIECE($GET(YSERR("DIERR")),U,1)>0
Begin DoDot:1
+11 SET YSX=$GET(YSERR("DIERR",1,"TEXT",1))
+12 DO EN^DDIOL(YSX,,"!")
End DoDot:1
+13 ;delete AU x-ref definition
DO DELIX^DDMOD(601.75,3,2,,,"YSERR")
+14 IF +$PIECE($GET(YSERR("DIERR")),U,1)>0
Begin DoDot:1
+15 SET YSX=$GET(YSERR("DIERR",1,"TEXT",1))
+16 DO EN^DDIOL(YSX,,"!")
End DoDot:1
+17 QUIT
PRETRAN ;Pre-Transportation entry point
+1 ;Copy the MH CHOICETYPE (601.751) entries into the transport global
+2 NEW YSLOOP
+3 SET YSLOOP=0
+4 FOR
SET YSLOOP=$ORDER(^YTT(601.751,YSLOOP))
if 'YSLOOP!(YSLOOP>99999)
QUIT
Begin DoDot:1
+5 SET @XPDGREF@(601.751,YSLOOP)=$GET(^YTT(601.751,YSLOOP,0))
End DoDot:1
+6 QUIT
POST751 ;enter all MH CHOICETYPE (601.751) entries
+1 NEW N,DIK
+2 SET N=0
+3 FOR
SET N=$ORDER(^XTMP("XPDI",XPDA,"TEMP",601.751,N))
if N'>0
QUIT
Begin DoDot:1
+4 SET ^YTT(601.751,N,0)=^XTMP("XPDI",XPDA,"TEMP",601.751,N)
End DoDot:1
+5 SET DIK="^YTT(601.751,"
DO IXALL^DIK
+6 QUIT
