source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUEN165.m@ 1753

Last change on this file since 1753 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1TIUEN165 ; SLC/MAM - Environment Check Rtn for TIU*1*165;6/16/03
2 ;;1.0;Text Integration Utilities;**165**;Jun 20, 1997
3MAIN ; 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 ;
14SETXTMP ; Set up ^XTMP global
15 S ^XTMP("TIU165",0)=304301_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("TIU165","BASICS",1,"NAME")="PATIENT RECORD FLAG CAT I"
21 S ^XTMP("TIU165","BASICS",1,"INTTYPE")="DC"
22 ; -- DDEF Number 2:
23 S ^XTMP("TIU165","BASICS",2,"NAME")="PATIENT RECORD FLAG CAT II"
24 S ^XTMP("TIU165","BASICS",2,"INTTYPE")="DC"
25 ; -- DDEF Number 3:
26 S ^XTMP("TIU165","BASICS",3,"NAME")="PATIENT RECORD FLAG CATEGORY I"
27 S ^XTMP("TIU165","BASICS",3,"INTTYPE")="DOC"
28 ; -- DDEF Number 4:
29 S ^XTMP("TIU165","BASICS",4,"NAME")="PATIENT RECORD FLAG CATEGORY II - RISK, FALL"
30 S ^XTMP("TIU165","BASICS",4,"INTTYPE")="DOC"
31 ; -- DDEF Number 5:
32 S ^XTMP("TIU165","BASICS",5,"NAME")="PATIENT RECORD FLAG CATEGORY II - RISK, WANDERING"
33 S ^XTMP("TIU165","BASICS",5,"INTTYPE")="DOC"
34 ; -- DDEF Number 6:
35 S ^XTMP("TIU165","BASICS",6,"NAME")="PATIENT RECORD FLAG CATEGORY II - RESEARCH STUDY"
36 S ^XTMP("TIU165","BASICS",6,"INTTYPE")="DOC"
37 ; -- DDEF Number 7:
38 S ^XTMP("TIU165","BASICS",7,"NAME")="PATIENT RECORD FLAG CATEGORY II - INFECTIOUS DISEASE"
39 S ^XTMP("TIU165","BASICS",7,"INTTYPE")="DOC"
40 Q
41 ;
42TIUDUPS(TIUDUPS,SILENT) ; Set array of potential duplicates
43 N NUM S (NUM,TIUDUPS)=0
44 F S NUM=$O(^XTMP("TIU165","BASICS",NUM)) Q:'NUM D
45 . ; -- When looking for duplicates, ignore DDEF if
46 . ; previously created by this patch:
47 . Q:$G(^XTMP("TIU165","BASICS",NUM,"DONE"))
48 . ; -- If site already has DDEF w/ same Name & Type as one
49 . ; we are exporting, set its number into array TIUDUPS:
50 . N NAME,TYPE,TIUY S TIUY=0
51 . S NAME=^XTMP("TIU165","BASICS",NUM,"NAME"),TYPE=^XTMP("TIU165","BASICS",NUM,"INTTYPE")
52 . F S TIUY=$O(^TIU(8925.1,"B",NAME,TIUY)) Q:+TIUY'>0 D
53 . . I $P($G(^TIU(8925.1,+TIUY,0)),U,4)=TYPE S TIUDUPS(NUM)=+TIUY,TIUDUPS=1
54 ; -- Write list of duplicates:
55 I +TIUDUPS,'$G(SILENT) D
56 . W !,"You already have the following Document Definitions exported by this patch."
57 . W !,"I don't want to overwrite them. Please change their names so they no longer"
58 . W !,"match the exported ones, or if you are not using them, delete them."
59 . W !!,"If you change the name of a Document Definition, remember to update its Print"
60 . W !,"Name, as well. For help, contact National VistA Support."
61 . N NUM S NUM=0
62 . F S NUM=$O(TIUDUPS(NUM)) Q:'NUM D
63 . . W !?5,^XTMP("TIU165","BASICS",NUM,"NAME")
64 Q
Note: See TracBrowser for help on using the repository browser.