TIUEN137.m

TIUEN137 ; SLC/MAM - Environment Check Rtn for TIU*1*137;6/3/03

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

 ;IHS/ITSC/LJF 11/28/2003 moved required install by, up a year for IHS

 ;

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..."

 Q

 ;

SETXTMP ; Set up ^XTMP global

 ;S ^XTMP("TIU137",0)=3031201_U_DT  ;IHS/ITSC/LJF 11/28/2003

 S ^XTMP("TIU137",0)=3041201_U_DT   ;IHS/ITSC/LJF 11/28/2003

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

 ;    Reference DDEFS by NUMBER.

 ;    Number parent-to-be BEFORE child.

 ; -- DDEF Number 1:

 S ^XTMP("TIU137","BASICS",1,"NAME")="LR LABORATORY REPORTS"

 S ^XTMP("TIU137","BASICS",1,"INTTYPE")="CL"

 ; -- DDEF Number 2:

 S ^XTMP("TIU137","BASICS",2,"NAME")="LR ANATOMIC PATHOLOGY"

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

 ; -- DDEF Number 3:

 S ^XTMP("TIU137","BASICS",3,"NAME")="LR AUTOPSY REPORT"

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

 ; -- DDEF Number 4:

 S ^XTMP("TIU137","BASICS",4,"NAME")="LR CYTOPATHOLOGY REPORT"

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

 ; -- DDEF Number 5:

 S ^XTMP("TIU137","BASICS",5,"NAME")="LR ELECTRON MICROSCOPY REPORT"

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

 ; -- DDEF Number 6:

 S ^XTMP("TIU137","BASICS",6,"NAME")="LR SURGICAL PATHOLOGY REPORT"

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

 Q

 ;

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

 N NUM S (NUM,TIUDUPS)=0

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

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

 . ;      previously created by this patch:

 . Q:$G(^XTMP("TIU137","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("TIU137","BASICS",NUM,"NAME"),TYPE=^XTMP("TIU137","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("TIU137","BASICS",NUM,"NAME")

 Q

TIUEN137  ; SLC/MAM - Environment Check Rtn for TIU*1*137;6/3/03

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

 +2       ;IHS/ITSC/LJF 11/28/2003 moved required install by, up a year for IHS

 +3       ;

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       ;S ^XTMP("TIU137",0)=3031201_U_DT  ;IHS/ITSC/LJF 11/28/2003

 +2       ;IHS/ITSC/LJF 11/28/2003

           SET ^XTMP("TIU137",0)=3041201_U_DT

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

 +4       ;    Reference DDEFS by NUMBER.

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

 +6       ; -- DDEF Number 1:

 +7        SET ^XTMP("TIU137","BASICS",1,"NAME")="LR LABORATORY REPORTS"

 +8        SET ^XTMP("TIU137","BASICS",1,"INTTYPE")="CL"

 +9       ; -- DDEF Number 2:

 +10       SET ^XTMP("TIU137","BASICS",2,"NAME")="LR ANATOMIC PATHOLOGY"

 +11       SET ^XTMP("TIU137","BASICS",2,"INTTYPE")="DC"

 +12      ; -- DDEF Number 3:

 +13       SET ^XTMP("TIU137","BASICS",3,"NAME")="LR AUTOPSY REPORT"

 +14       SET ^XTMP("TIU137","BASICS",3,"INTTYPE")="DOC"

 +15      ; -- DDEF Number 4:

 +16       SET ^XTMP("TIU137","BASICS",4,"NAME")="LR CYTOPATHOLOGY REPORT"

 +17       SET ^XTMP("TIU137","BASICS",4,"INTTYPE")="DOC"

 +18      ; -- DDEF Number 5:

 +19       SET ^XTMP("TIU137","BASICS",5,"NAME")="LR ELECTRON MICROSCOPY REPORT"

 +20       SET ^XTMP("TIU137","BASICS",5,"INTTYPE")="DOC"

 +21      ; -- DDEF Number 6:

 +22       SET ^XTMP("TIU137","BASICS",6,"NAME")="LR SURGICAL PATHOLOGY REPORT"

 +23       SET ^XTMP("TIU137","BASICS",6,"INTTYPE")="DOC"

 +24       QUIT 

 +25      ;

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

 +1        NEW NUM

           SET (NUM,TIUDUPS)=0

 +2        FOR 

               SET NUM=$ORDER(^XTMP("TIU137","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("TIU137","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("TIU137","BASICS",NUM,"NAME")

                   SET TYPE=^XTMP("TIU137","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("TIU137","BASICS",NUM,"NAME")

                           End DoDot:2

                   End DoDot:1

 +22       QUIT