TIUE1008.m

TIUE1008 ;IHS/MSC/MGH - Environment Check Rtn for TIU*1*1008;28-Jan-2011 15:42;DU

 ;;1.0;Text Integration Utilities;**1008**;Jun 20, 1997;Build 15

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("TIU1008",0)=310111_U_DT

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

 ;    Reference DDEFS by NUMBER.

 ;    Number parent-to-be BEFORE child.

 ; -- DDEF Document classes:

 S ^XTMP("TIU1008","BASICS",1,"NAME")="DISCHARGE INSTRUCTIONS"

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

 S ^XTMP("TIU1008","BASICS",2,"NAME")="E-COPY"

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

 ; -- DDEF:

 S ^XTMP("TIU1008","BASICS",3,"NAME")="DISCHARGE INSTRUCTIONS"

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

 S ^XTMP("TIU1008","BASICS",4,"NAME")="E-COPY DISCHARGE INSTR RECEIVED"

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

 S ^XTMP("TIU1008","BASICS",5,"NAME")="E-COPY DISCHARGE INSTR NOT RECEIVED"

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

 Q

 ;

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

 N NUM S (NUM,TIUDUPS)=0

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

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

 . ;      previously created by this patch:

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

 Q

TIUE1008  ;IHS/MSC/MGH - Environment Check Rtn for TIU*1*1008;28-Jan-2011 15:42;DU

 +1       ;;1.0;Text Integration Utilities;**1008**;Jun 20, 1997;Build 15

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("TIU1008",0)=310111_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 Document classes:

 +6        SET ^XTMP("TIU1008","BASICS",1,"NAME")="DISCHARGE INSTRUCTIONS"

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

 +8        SET ^XTMP("TIU1008","BASICS",2,"NAME")="E-COPY"

 +9        SET ^XTMP("TIU1008","BASICS",2,"INTTYPE")="DC"

 +10      ; -- DDEF:

 +11       SET ^XTMP("TIU1008","BASICS",3,"NAME")="DISCHARGE INSTRUCTIONS"

 +12       SET ^XTMP("TIU1008","BASICS",3,"INTTYPE")="DOC"

 +13       SET ^XTMP("TIU1008","BASICS",4,"NAME")="E-COPY DISCHARGE INSTR RECEIVED"

 +14       SET ^XTMP("TIU1008","BASICS",4,"INTTYPE")="DOC"

 +15       SET ^XTMP("TIU1008","BASICS",5,"NAME")="E-COPY DISCHARGE INSTR NOT RECEIVED"

 +16       SET ^XTMP("TIU1008","BASICS",5,"INTTYPE")="DOC"

 +17       QUIT 

 +18      ;

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

 +1        NEW NUM

           SET (NUM,TIUDUPS)=0

 +2        FOR 

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

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

                           End DoDot:2

                   End DoDot:1

 +22       QUIT