Routine: TIUEN165

TIUEN165 ; SLC/MAM - Environment Check Rtn for TIU*1*165;6/16/03

 ;;1.0;Text Integration Utilities;**165**;Jun 20, 1997

MAIN ; Check environment

 ; -- Set data for DDEFs to export:

 D SETXTMP

 ; -- Check for potential DDEF duplicates at site:

 N TIUDUPS

 D TIUDUPS(.TIUDUPS)

 ; -- If potential duplicates exist, abort install:

 I 'TIUDUPS W !,"Document Definitions look OK." Q

 S XPDABORT=1 W !,"Aborting Install..."

SETXTMP ; Set up ^XTMP global

 S ^XTMP("TIU165",0)=304301_U_DT

 ; -- Set basic data for new DDEFS into ^XTMP.

 ;    Reference DDEFS by NUMBER.

 ;    Number parent-to-be BEFORE child.

 ; -- DDEF Number 1:

 S ^XTMP("TIU165","BASICS",1,"NAME")="PATIENT RECORD FLAG CAT I"

 S ^XTMP("TIU165","BASICS",1,"INTTYPE")="DC"

 ; -- DDEF Number 2:

 S ^XTMP("TIU165","BASICS",2,"NAME")="PATIENT RECORD FLAG CAT II"

 S ^XTMP("TIU165","BASICS",2,"INTTYPE")="DC"

 ; -- DDEF Number 3:

 S ^XTMP("TIU165","BASICS",3,"NAME")="PATIENT RECORD FLAG CATEGORY I"

 S ^XTMP("TIU165","BASICS",3,"INTTYPE")="DOC"

 ; -- DDEF Number 4:

 S ^XTMP("TIU165","BASICS",4,"NAME")="PATIENT RECORD FLAG CATEGORY II - RISK, FALL"

 S ^XTMP("TIU165","BASICS",4,"INTTYPE")="DOC"

 ; -- DDEF Number 5:

 S ^XTMP("TIU165","BASICS",5,"NAME")="PATIENT RECORD FLAG CATEGORY II - RISK, WANDERING"

 S ^XTMP("TIU165","BASICS",5,"INTTYPE")="DOC"

 ; -- DDEF Number 6:

 S ^XTMP("TIU165","BASICS",6,"NAME")="PATIENT RECORD FLAG CATEGORY II - RESEARCH STUDY"

 S ^XTMP("TIU165","BASICS",6,"INTTYPE")="DOC"

 ; -- DDEF Number 7:

 S ^XTMP("TIU165","BASICS",7,"NAME")="PATIENT RECORD FLAG CATEGORY II - INFECTIOUS DISEASE"

 S ^XTMP("TIU165","BASICS",7,"INTTYPE")="DOC"

TIUDUPS(TIUDUPS,SILENT) ; Set array of potential duplicates

 N NUM S (NUM,TIUDUPS)=0

 F  S NUM=$O(^XTMP("TIU165","BASICS",NUM)) Q:'NUM  D

 . ; -- When looking for duplicates, ignore DDEF if

 . ;      previously created by this patch:

 . Q:$G(^XTMP("TIU165","BASICS",NUM,"DONE"))

 . ; -- If site already has DDEF w/ same Name & Type as one

 . ;    we are exporting, set its number into array TIUDUPS:

 . N NAME,TYPE,TIUY S TIUY=0

 . S NAME=^XTMP("TIU165","BASICS",NUM,"NAME"),TYPE=^XTMP("TIU165","BASICS",NUM,"INTTYPE")

 . F  S TIUY=$O(^TIU(8925.1,"B",NAME,TIUY)) Q:+TIUY'>0  D

 . . I $P($G(^TIU(8925.1,+TIUY,0)),U,4)=TYPE S TIUDUPS(NUM)=+TIUY,TIUDUPS=1

 ; -- Write list of duplicates:

 I +TIUDUPS,'$G(SILENT) D

 . W !,"You already have the following Document Definitions exported by this patch."

 . W !,"I don't want to overwrite them. Please change their names so they no longer"

 . W !,"match the exported ones, or if you are not using them, delete them."

 . W !!,"If you change the name of a Document Definition, remember to update its Print"

 . W !,"Name, as well. For help, contact National VistA Support."

 . N NUM S NUM=0

 . F  S NUM=$O(TIUDUPS(NUM)) Q:'NUM  D

 . . W !?5,^XTMP("TIU165","BASICS",NUM,"NAME")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEN165   2915     printed  Apr 23, 2025@18:54:43                                                                                                                                                                                                    Page 2

TIUEN165  ; SLC/MAM - Environment Check Rtn for TIU*1*165;6/16/03

 +1       ;;1.0;Text Integration Utilities;**165**;Jun 20, 1997

MAIN      ; Check environment

 +1       ; -- Set data for DDEFs to export:

 +2        DO SETXTMP

 +3       ; -- Check for potential DDEF duplicates at site:

 +4        NEW TIUDUPS

 +5        DO TIUDUPS(.TIUDUPS)

 +6       ; -- If potential duplicates exist, abort install:

 +7        IF 'TIUDUPS

               WRITE !,"Document Definitions look OK."

               QUIT

 +8        SET XPDABORT=1

           WRITE !,"Aborting Install..."

 +9        QUIT

 +10      ;

SETXTMP   ; Set up ^XTMP global

 +1        SET ^XTMP("TIU165",0)=304301_U_DT

 +2       ; -- Set basic data for new DDEFS into ^XTMP.

 +3       ;    Reference DDEFS by NUMBER.

 +4       ;    Number parent-to-be BEFORE child.

 +5       ; -- DDEF Number 1:

 +6        SET ^XTMP("TIU165","BASICS",1,"NAME")="PATIENT RECORD FLAG CAT I"

 +7        SET ^XTMP("TIU165","BASICS",1,"INTTYPE")="DC"

 +8       ; -- DDEF Number 2:

 +9        SET ^XTMP("TIU165","BASICS",2,"NAME")="PATIENT RECORD FLAG CAT II"

 +10       SET ^XTMP("TIU165","BASICS",2,"INTTYPE")="DC"

 +11      ; -- DDEF Number 3:

 +12       SET ^XTMP("TIU165","BASICS",3,"NAME")="PATIENT RECORD FLAG CATEGORY I"

 +13       SET ^XTMP("TIU165","BASICS",3,"INTTYPE")="DOC"

 +14      ; -- DDEF Number 4:

 +15       SET ^XTMP("TIU165","BASICS",4,"NAME")="PATIENT RECORD FLAG CATEGORY II - RISK, FALL"

 +16       SET ^XTMP("TIU165","BASICS",4,"INTTYPE")="DOC"

 +17      ; -- DDEF Number 5:

 +18       SET ^XTMP("TIU165","BASICS",5,"NAME")="PATIENT RECORD FLAG CATEGORY II - RISK, WANDERING"

 +19       SET ^XTMP("TIU165","BASICS",5,"INTTYPE")="DOC"

 +20      ; -- DDEF Number 6:

 +21       SET ^XTMP("TIU165","BASICS",6,"NAME")="PATIENT RECORD FLAG CATEGORY II - RESEARCH STUDY"

 +22       SET ^XTMP("TIU165","BASICS",6,"INTTYPE")="DOC"

 +23      ; -- DDEF Number 7:

 +24       SET ^XTMP("TIU165","BASICS",7,"NAME")="PATIENT RECORD FLAG CATEGORY II - INFECTIOUS DISEASE"

 +25       SET ^XTMP("TIU165","BASICS",7,"INTTYPE")="DOC"

 +26       QUIT

 +27      ;

TIUDUPS(TIUDUPS,SILENT) ; Set array of potential duplicates

 +1        NEW NUM

           SET (NUM,TIUDUPS)=0

 +2        FOR

               SET NUM=$ORDER(^XTMP("TIU165","BASICS",NUM))

               if 'NUM

                   QUIT

               Begin DoDot:1

 +3       ; -- When looking for duplicates, ignore DDEF if

 +4       ;      previously created by this patch:

 +5                if $GET(^XTMP("TIU165","BASICS",NUM,"DONE"))

                       QUIT

 +6       ; -- If site already has DDEF w/ same Name & Type as one

 +7       ;    we are exporting, set its number into array TIUDUPS:

 +8                NEW NAME,TYPE,TIUY

                   SET TIUY=0

 +9                SET NAME=^XTMP("TIU165","BASICS",NUM,"NAME")

                   SET TYPE=^XTMP("TIU165","BASICS",NUM,"INTTYPE")

 +10               FOR

                       SET TIUY=$ORDER(^TIU(8925.1,"B",NAME,TIUY))

                       if +TIUY'>0

                           QUIT

                       Begin DoDot:2

 +11                       IF $PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)=TYPE

                               SET TIUDUPS(NUM)=+TIUY

                               SET TIUDUPS=1

                       End DoDot:2

               End DoDot:1

 +12      ; -- Write list of duplicates:

 +13       IF +TIUDUPS

               IF '$GET(SILENT)

                   Begin DoDot:1

 +14                   WRITE !,"You already have the following Document Definitions exported by this patch."

 +15                   WRITE !,"I don't want to overwrite them. Please change their names so they no longer"

 +16                   WRITE !,"match the exported ones, or if you are not using them, delete them."

 +17                   WRITE !!,"If you change the name of a Document Definition, remember to update its Print"

 +18                   WRITE !,"Name, as well. For help, contact National VistA Support."

 +19                   NEW NUM

                       SET NUM=0

 +20                   FOR

                           SET NUM=$ORDER(TIUDUPS(NUM))

                           if 'NUM

                               QUIT

                           Begin DoDot:2

 +21                           WRITE !?5,^XTMP("TIU165","BASICS",NUM,"NAME")

                           End DoDot:2

                   End DoDot:1

 +22       QUIT

TIUEN165.m