Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YS103PRE

YS103PRE.m

Go to the documentation of this file. 
  1. 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
  1.  ;Reference to XPDGREF and ^XTMP supported by DBIA #2433
  1. MAIN ;Main entry
  1.  D EN1,EN1A,EN1B,EN2,EN3,EN4
  1.  Q
  1. EN1 ;MH CHOICES (601.75)
  1.  ;Delete CHOICE TEXT (field #3) for selected entries because these
  1.  ;entries have embedded control characters or spelling errors or 
  1.  ;punctuation errors. 
  1.  ;The KIDS build will add the correct value.
  1.  N YSARR,YSFDA,YSIEN
  1.  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
  1.  .K YSFDA,YSARR
  1.  .S YSFDA(601.75,YSIEN_",",3)="@"
  1.  .D UPDATE^DIE("","YSFDA","YSARR")
  1.  Q
  1. EN1A ;MH TESTS AND SURVEYS (601.71)
  1.  ;Delete PURPOSE (field #12) for selected entry because it has embedded control characters.
  1.  ;The KIDS build will add the correct value.
  1.  N YSARR,YSFDA
  1.  S YSFDA(601.71,47_",",12)="@"
  1.  D UPDATE^DIE("","YSFDA","YSARR")
  1.  Q
  1. EN1B ;MH QUESTIONS (601.72)
  1.  ;Delete QUESTION TEXT (field #1) for selected entry because it has embedded control characters.
  1.  ;The KIDS build will add the correct value.
  1.  N YSARR,YSFDA
  1.  S YSFDA(601.72,5016_",",1)="@"
  1.  D UPDATE^DIE("","YSFDA","YSARR")
  1.  Q
  1. EN2 ;MH SCALEGROUPS (601.86)
  1.  ;Modifies one entry. This is an existing entry, but the SCALEGROUP NAME
  1.  ;which is an IDENTIFIER has changed. 
  1.  N YSARR,YSFDA
  1.  S YSFDA(601.86,"134,",2)="Part I" ;SCALEGROUP NAME
  1.  S YSFDA(601.86,"134,",4)="Score"  ;ORDINATE TITLE                       
  1.  S YSFDA(601.86,"134,",7)=6        ;ORDINATEMAX
  1.  D UPDATE^DIE("","YSFDA","YSARR")
  1.  Q
  1. EN3 ;MH SCALES (601.87)
  1.  ;Modifies two entries. These are existing entries, but the SCALE NAME
  1.  ;which is an IDENTIFIER has changed.
  1.  N YSARR,YSFDA
  1.  S YSFDA(601.87,"507,",3)="Interference" ;SCALE NAME
  1.  S YSFDA(601.87,"507,",4)="Inter"        ;XLABEL
  1.  D UPDATE^DIE("","YSFDA","YSARR")
  1.  K YSARR,YSFDA
  1.  S YSFDA(601.87,"508,",3)="Support" ;SCALE NAME
  1.  S YSFDA(601.87,"508,",4)="Sup" ;XLABEL
  1.  D UPDATE^DIE("","YSFDA","YSARR")
  1.  K YSARR,YSFDA
  1.  S YSFDA(601.87,"580,",3)="Confidence in No Use" ;SCALE NAME
  1.  D UPDATE^DIE("","YSFDA","YSARR")
  1.  Q
  1. EN4 ;delete C & AU x-refs on file 601.75, field 3
  1.  ;Both x-refs will be re-built with the installation.
  1.  N YSARR,YSCHK,YSEMSG,YSERR,YSX
  1.  D FIND^DIC(.11,"",".01;.02;.11","CPX","601.75","*","B","","","YSCHK","YSEMSG") ;check if indexes already exist
  1.  I $G(YSEMSG("DIERR",1,"TEXT",1)) D  Q
  1.  .S YSARR(1)=YSEMSG("DIERR",1,"TEXT",1)
  1.  .S YSARR(2)="Please log a Remedy ticket."
  1.  .D EN^DDIOL(.YSARR)
  1.  I $P(YSCHK("DILIST",0),U,1)="3" Q  ;new indexes already created.
  1.  D DELIX^DDMOD(601.75,3,1,,,"YSERR") ;delete C x-ref definition
  1.  I +$P($G(YSERR("DIERR")),U,1)>0 D
  1.  .S YSX=$G(YSERR("DIERR",1,"TEXT",1))
  1.  .D EN^DDIOL(YSX,,"!")
  1.  D DELIX^DDMOD(601.75,3,2,,,"YSERR") ;delete AU x-ref definition
  1.  I +$P($G(YSERR("DIERR")),U,1)>0 D
  1.  .S YSX=$G(YSERR("DIERR",1,"TEXT",1))
  1.  .D EN^DDIOL(YSX,,"!")
  1.  Q
  1. PRETRAN ;Pre-Transportation entry point
  1.  ;Copy the MH CHOICETYPE (601.751) entries into the transport global
  1.  N YSLOOP
  1.  S YSLOOP=0
  1.  F  S YSLOOP=$O(^YTT(601.751,YSLOOP)) Q:'YSLOOP!(YSLOOP>99999)  D
  1.  .S @XPDGREF@(601.751,YSLOOP)=$G(^YTT(601.751,YSLOOP,0))
  1.  Q
  1. POST751 ;enter all MH CHOICETYPE (601.751) entries
  1.  N N,DIK
  1.  S N=0
  1.  F  S N=$O(^XTMP("XPDI",XPDA,"TEMP",601.751,N)) Q:N'>0  D
  1.  .S ^YTT(601.751,N,0)=^XTMP("XPDI",XPDA,"TEMP",601.751,N)
  1.  S DIK="^YTT(601.751," D IXALL^DIK
  1.  Q