TIUEN137 ; SLC/MAM - Environment Check Rtn for TIU*1*137;6/3/03
;;1.0;Text Integration Utilities;**137**;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..."
Q
;
SETXTMP ; Set up ^XTMP global
S ^XTMP("TIU137",0)=3031201_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("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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEN137 2670 printed Dec 13, 2024@02:40:12 Page 2
TIUEN137 ; SLC/MAM - Environment Check Rtn for TIU*1*137;6/3/03
+1 ;;1.0;Text Integration Utilities;**137**;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("TIU137",0)=3031201_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("TIU137","BASICS",1,"NAME")="LR LABORATORY REPORTS"
+7 SET ^XTMP("TIU137","BASICS",1,"INTTYPE")="CL"
+8 ; -- DDEF Number 2:
+9 SET ^XTMP("TIU137","BASICS",2,"NAME")="LR ANATOMIC PATHOLOGY"
+10 SET ^XTMP("TIU137","BASICS",2,"INTTYPE")="DC"
+11 ; -- DDEF Number 3:
+12 SET ^XTMP("TIU137","BASICS",3,"NAME")="LR AUTOPSY REPORT"
+13 SET ^XTMP("TIU137","BASICS",3,"INTTYPE")="DOC"
+14 ; -- DDEF Number 4:
+15 SET ^XTMP("TIU137","BASICS",4,"NAME")="LR CYTOPATHOLOGY REPORT"
+16 SET ^XTMP("TIU137","BASICS",4,"INTTYPE")="DOC"
+17 ; -- DDEF Number 5:
+18 SET ^XTMP("TIU137","BASICS",5,"NAME")="LR ELECTRON MICROSCOPY REPORT"
+19 SET ^XTMP("TIU137","BASICS",5,"INTTYPE")="DOC"
+20 ; -- DDEF Number 6:
+21 SET ^XTMP("TIU137","BASICS",6,"NAME")="LR SURGICAL PATHOLOGY REPORT"
+22 SET ^XTMP("TIU137","BASICS",6,"INTTYPE")="DOC"
+23 QUIT
+24 ;
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
