| [613] | 1 | TIUEN137 ; SLC/MAM - Environment Check Rtn for TIU*1*137;6/3/03
|
|---|
| 2 | ;;1.0;Text Integration Utilities;**137**;Jun 20, 1997
|
|---|
| 3 | MAIN ; Check environment
|
|---|
| 4 | ; -- Set data for DDEFs to export:
|
|---|
| 5 | D SETXTMP
|
|---|
| 6 | ; -- Check for potential DDEF duplicates at site:
|
|---|
| 7 | N TIUDUPS
|
|---|
| 8 | D TIUDUPS(.TIUDUPS)
|
|---|
| 9 | ; -- If potential duplicates exist, abort install:
|
|---|
| 10 | I 'TIUDUPS W !,"Document Definitions look OK." Q
|
|---|
| 11 | S XPDABORT=1 W !,"Aborting Install..."
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | SETXTMP ; Set up ^XTMP global
|
|---|
| 15 | S ^XTMP("TIU137",0)=3031201_U_DT
|
|---|
| 16 | ; -- Set basic data for new DDEFS into ^XTMP.
|
|---|
| 17 | ; Reference DDEFS by NUMBER.
|
|---|
| 18 | ; Number parent-to-be BEFORE child.
|
|---|
| 19 | ; -- DDEF Number 1:
|
|---|
| 20 | S ^XTMP("TIU137","BASICS",1,"NAME")="LR LABORATORY REPORTS"
|
|---|
| 21 | S ^XTMP("TIU137","BASICS",1,"INTTYPE")="CL"
|
|---|
| 22 | ; -- DDEF Number 2:
|
|---|
| 23 | S ^XTMP("TIU137","BASICS",2,"NAME")="LR ANATOMIC PATHOLOGY"
|
|---|
| 24 | S ^XTMP("TIU137","BASICS",2,"INTTYPE")="DC"
|
|---|
| 25 | ; -- DDEF Number 3:
|
|---|
| 26 | S ^XTMP("TIU137","BASICS",3,"NAME")="LR AUTOPSY REPORT"
|
|---|
| 27 | S ^XTMP("TIU137","BASICS",3,"INTTYPE")="DOC"
|
|---|
| 28 | ; -- DDEF Number 4:
|
|---|
| 29 | S ^XTMP("TIU137","BASICS",4,"NAME")="LR CYTOPATHOLOGY REPORT"
|
|---|
| 30 | S ^XTMP("TIU137","BASICS",4,"INTTYPE")="DOC"
|
|---|
| 31 | ; -- DDEF Number 5:
|
|---|
| 32 | S ^XTMP("TIU137","BASICS",5,"NAME")="LR ELECTRON MICROSCOPY REPORT"
|
|---|
| 33 | S ^XTMP("TIU137","BASICS",5,"INTTYPE")="DOC"
|
|---|
| 34 | ; -- DDEF Number 6:
|
|---|
| 35 | S ^XTMP("TIU137","BASICS",6,"NAME")="LR SURGICAL PATHOLOGY REPORT"
|
|---|
| 36 | S ^XTMP("TIU137","BASICS",6,"INTTYPE")="DOC"
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | TIUDUPS(TIUDUPS,SILENT) ; Set array of potential duplicates
|
|---|
| 40 | N NUM S (NUM,TIUDUPS)=0
|
|---|
| 41 | F S NUM=$O(^XTMP("TIU137","BASICS",NUM)) Q:'NUM D
|
|---|
| 42 | . ; -- When looking for duplicates, ignore DDEF if
|
|---|
| 43 | . ; previously created by this patch:
|
|---|
| 44 | . Q:$G(^XTMP("TIU137","BASICS",NUM,"DONE"))
|
|---|
| 45 | . ; -- If site already has DDEF w/ same Name & Type as one
|
|---|
| 46 | . ; we are exporting, set its number into array TIUDUPS:
|
|---|
| 47 | . N NAME,TYPE,TIUY S TIUY=0
|
|---|
| 48 | . S NAME=^XTMP("TIU137","BASICS",NUM,"NAME"),TYPE=^XTMP("TIU137","BASICS",NUM,"INTTYPE")
|
|---|
| 49 | . F S TIUY=$O(^TIU(8925.1,"B",NAME,TIUY)) Q:+TIUY'>0 D
|
|---|
| 50 | . . I $P($G(^TIU(8925.1,+TIUY,0)),U,4)=TYPE S TIUDUPS(NUM)=+TIUY,TIUDUPS=1
|
|---|
| 51 | ; -- Write list of duplicates:
|
|---|
| 52 | I +TIUDUPS,'$G(SILENT) D
|
|---|
| 53 | . W !,"You already have the following Document Definitions exported by this patch."
|
|---|
| 54 | . W !,"I don't want to overwrite them. Please change their names so they no longer"
|
|---|
| 55 | . W !,"match the exported ones, or if you are not using them, delete them."
|
|---|
| 56 | . W !!,"If you change the name of a Document Definition, remember to update its Print"
|
|---|
| 57 | . W !,"Name, as well. For help, contact National VistA Support."
|
|---|
| 58 | . N NUM S NUM=0
|
|---|
| 59 | . F S NUM=$O(TIUDUPS(NUM)) Q:'NUM D
|
|---|
| 60 | . . W !?5,^XTMP("TIU137","BASICS",NUM,"NAME")
|
|---|
| 61 | Q
|
|---|
