TIUFWRAP1 ;SPFO/AJB - Clean File #8927 ;04/06/22 12:50
;;1.0;TEXT INTEGRATION UTILITIES;**338,254**;Jun 20, 1997;Build 9
;
Q
;
BACKUP(BU,DISPLAY) ; saves a copy of #8927 to ^XTMP
N PD S BU=1,DT=$G(DT,$$DT^XLFDT),PD=$$FMADD^XLFDT(DT,30) ; purge date=t+30
I '$D(^XTMP("TIUFWRAP")) D Q
. W !!,"Saving a copy of the TIU TEMPLATE file..."
. S ^XTMP("TIUFWRAP",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"File #8927 Backup"
. M ^XTMP("TIUFWRAP",8927)=^TIU(8927)
. W "done.",! D FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
S ^XTMP("TIUFWRAP",0)=PD_U_DT_U_"File #8927 Backup" ; update 0 node only
Q:'DISPLAY
W !!,"File #8927 backup already exists. Updating purge date for saved data."
W ! D FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
Q
;
RESTORE ; restores data from ^XTMP to #8927
I '$D(^XTMP("TIUFWRAP")) D Q
. W !!,"Backup global NOT found!",!!,"Use the BACKUP option to save a copy of File #8927",!
. D FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
W ! I '+$$FMR^TIUFWRAP2("YA","Are you sure you wish to restore TIU TEMPLATE from the backup? ","NO") Q
W !!,"Restoring the TIU TEMPLATE file..." K ^TIU(8927),@OUTPUT M ^TIU(8927)=^XTMP("TIUFWRAP",8927) W "done.",!
D FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
Q
;
GATHER(UPDATE,LOD) ; analyze File #8927 - main loop starts at root level
N IEN,INDEX S UPDATE=+$G(UPDATE,0)
S INDEX="" F S INDEX=$O(^TIU(8927,"AROOT",INDEX),-1) Q:INDEX="" S IEN=0 F S IEN=$O(^TIU(8927,"AROOT",INDEX,IEN)) Q:'+IEN D
. D EE^TIUFWRAP(IEN,0,"",LOD) ; evaluate the entry ITEMS & BOILERPLATE TEXT
Q
;
UPDATE(BU) ;
I '$D(^XTMP("TIUFWRAP")) D Q
. W !!,"Backup global NOT found!",!!,"Use the BACKUP option to save a copy of File #8927",!
. D FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
I +BU D Q ; backup present, update the file
. N LOD S LOD=$$LOD^TIUFWRAP2(.LOD) Q:LOD=U!(LOD="Q") ; set level of detail
. K @OUTPUT W @IOF,"Updating File #8927..."
. D GATHER^TIUFWRAP1(1,LOD) D:LOD>1 GATHER^TIUFWRAP1(1,1) ; if level of detail includes wrapping, do basic clean after (for wrapped fields/objects)
. W "done." W ! I $$FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
Q
;
EMAIL ; mail the results
N IEN,INDEX,XMDUN,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
S INDEX="" F S INDEX=$O(@OUTPUT@(INDEX)) Q:INDEX="" D
. S XMDUZ=.5,XMTEXT="XMTEXT(",XMY(+DUZ)=""
. N SUB S (SUB,XMSUB)="File #8927 ["_INDEX_"]" ; subject
. S IEN=0 F S IEN=$O(@OUTPUT@(INDEX,IEN)) Q:'+IEN D
. . S XMTEXT(IEN)=@OUTPUT@(INDEX,IEN)
. D ^XMD
. W:$D(XMMG) !!,XMMG ; error message
. W:'$D(XMMG) !!,"Message Subject: ",SUB
. W:'$D(XMMG) !,"Message ID : ",XMZ
W ! D FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
Q
;
PREPOUT(DATA,OUTPUT,TYPE) ; prepare output
N LOC S LOC=$NA(^TMP($J,"OUTPUT",TYPE))
N TOTAL S TOTAL=0
N IEN S IEN=0 F S IEN=$O(@DATA@(IEN)) Q:'+IEN D
. N NODE0,POWNER S NODE0=$G(^TIU(8927,IEN,0))
. S TOTAL=TOTAL+1,@LOC@(TOTAL)="IEN: "_IEN
. S POWNER=$P(NODE0,U,6) I +POWNER S POWNER=$$GET1^DIQ(200,POWNER,.01),POWNER=$S(POWNER="":"<unknown>",1:POWNER) ; imported entries may not have an entry in File #200
. I POWNER'="" S TOTAL=TOTAL+1,@LOC@(TOTAL)="Personal Owner: "_POWNER ; display personal owner
. ; display the path
. N LEN,PIE S LEN=$L(@DATA@(IEN,"PATH"),U) F PIE=1:1:LEN D
. . N LN S LN=$$SETSTR^VALM1(" ","",(PIE-1)*4,1) ; pad spaces before data
. . S LN=$S(PIE'=LEN:LN_"<",1:LN_" - ")
. . S TOTAL=TOTAL+1,@LOC@(TOTAL)=LN_$P(@DATA@(IEN,"PATH"),U,PIE)_$S(PIE'=LEN:">",1:"") ; set the entry for display
. . I PIE=LEN,$D(@DATA@(IEN,"NODE")) D ; display the lines (if any) for each entry
. . . N LEN,PIE S LEN=$L(@DATA@(IEN,"NODE"),U)
. . . F PIE=1:1:LEN S @LOC@(TOTAL)=@LOC@(TOTAL)_$S(LEN=1:" ["_$P(@DATA@(IEN,"NODE"),U)_"]",PIE=1:" ["_$P(@DATA@(IEN,"NODE"),U,PIE)_",",PIE<LEN:$P(@DATA@(IEN,"NODE"),U,PIE)_",",1:$P(@DATA@(IEN,"NODE"),U,PIE)_"]")
. K @DATA@(IEN) ; remove entries as we go
. I +$O(@DATA@(IEN)) S TOTAL=TOTAL+1,@LOC@(TOTAL)="" ; blank line
;K DATA ; remove remaining data
Q
;
PRINT ; print the results to a device
N END,X S (END,X)="" F S X=$O(@OUTPUT@(X)) Q:X="" S @OUTPUT@(X,.1)=X,$P(@OUTPUT@(X,.2),"-",$L(X))="-"
S X="" F S X=$O(@OUTPUT@(X)) Q:X="" S @OUTPUT@(X,($O(@OUTPUT@(X,""),-1)+1))="" ; add a blank line between each group
N ZTSAVE S ZTSAVE("OUTPUT")="" W !,IOCUON
D EN^XUTMDEVQ("PRINT^TIUFWRAP2(OUTPUT)","File #8927 Analysis",.ZTSAVE)
W ! I END'=U,$$FMR^TIUFWRAP2("EA","Press <Enter> to continue ")
Q
;
VIEW ; view the results
N DISPLAY,DY W $G(IOCUON)
S X="" F S X=$O(@OUTPUT@(X)) Q:X="" S DISPLAY(X)=$NA(@OUTPUT@(X))
K DIERR D DOCLIST^DDBR("DISPLAY","NR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFWRAP1 4700 printed Sep 23, 2025@20:17:42 Page 2
TIUFWRAP1 ;SPFO/AJB - Clean File #8927 ;04/06/22 12:50
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**338,254**;Jun 20, 1997;Build 9
+2 ;
+3 QUIT
+4 ;
BACKUP(BU,DISPLAY) ; saves a copy of #8927 to ^XTMP
+1 ; purge date=t+30
NEW PD
SET BU=1
SET DT=$GET(DT,$$DT^XLFDT)
SET PD=$$FMADD^XLFDT(DT,30)
+2 IF '$DATA(^XTMP("TIUFWRAP"))
Begin DoDot:1
+3 WRITE !!,"Saving a copy of the TIU TEMPLATE file..."
+4 SET ^XTMP("TIUFWRAP",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"File #8927 Backup"
+5 MERGE ^XTMP("TIUFWRAP",8927)=^TIU(8927)
+6 WRITE "done.",!
DO FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
End DoDot:1
QUIT
+7 ; update 0 node only
SET ^XTMP("TIUFWRAP",0)=PD_U_DT_U_"File #8927 Backup"
+8 if 'DISPLAY
QUIT
+9 WRITE !!,"File #8927 backup already exists. Updating purge date for saved data."
+10 WRITE !
DO FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
+11 QUIT
+12 ;
RESTORE ; restores data from ^XTMP to #8927
+1 IF '$DATA(^XTMP("TIUFWRAP"))
Begin DoDot:1
+2 WRITE !!,"Backup global NOT found!",!!,"Use the BACKUP option to save a copy of File #8927",!
+3 DO FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
End DoDot:1
QUIT
+4 WRITE !
IF '+$$FMR^TIUFWRAP2("YA","Are you sure you wish to restore TIU TEMPLATE from the backup? ","NO")
QUIT
+5 WRITE !!,"Restoring the TIU TEMPLATE file..."
KILL ^TIU(8927),@OUTPUT
MERGE ^TIU(8927)=^XTMP("TIUFWRAP",8927)
WRITE "done.",!
+6 DO FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
+7 QUIT
+8 ;
GATHER(UPDATE,LOD) ; analyze File #8927 - main loop starts at root level
+1 NEW IEN,INDEX
SET UPDATE=+$GET(UPDATE,0)
+2 SET INDEX=""
FOR
SET INDEX=$ORDER(^TIU(8927,"AROOT",INDEX),-1)
if INDEX=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TIU(8927,"AROOT",INDEX,IEN))
if '+IEN
QUIT
Begin DoDot:1
+3 ; evaluate the entry ITEMS & BOILERPLATE TEXT
DO EE^TIUFWRAP(IEN,0,"",LOD)
End DoDot:1
+4 QUIT
+5 ;
UPDATE(BU) ;
+1 IF '$DATA(^XTMP("TIUFWRAP"))
Begin DoDot:1
+2 WRITE !!,"Backup global NOT found!",!!,"Use the BACKUP option to save a copy of File #8927",!
+3 DO FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
End DoDot:1
QUIT
+4 ; backup present, update the file
IF +BU
Begin DoDot:1
+5 ; set level of detail
NEW LOD
SET LOD=$$LOD^TIUFWRAP2(.LOD)
if LOD=U!(LOD="Q")
QUIT
+6 KILL @OUTPUT
WRITE @IOF,"Updating File #8927..."
+7 ; if level of detail includes wrapping, do basic clean after (for wrapped fields/objects)
DO GATHER^TIUFWRAP1(1,LOD)
if LOD>1
DO GATHER^TIUFWRAP1(1,1)
+8 WRITE "done."
WRITE !
IF $$FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
End DoDot:1
QUIT
+9 QUIT
+10 ;
EMAIL ; mail the results
+1 NEW IEN,INDEX,XMDUN,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+2 SET INDEX=""
FOR
SET INDEX=$ORDER(@OUTPUT@(INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+3 SET XMDUZ=.5
SET XMTEXT="XMTEXT("
SET XMY(+DUZ)=""
+4 ; subject
NEW SUB
SET (SUB,XMSUB)="File #8927 ["_INDEX_"]"
+5 SET IEN=0
FOR
SET IEN=$ORDER(@OUTPUT@(INDEX,IEN))
if '+IEN
QUIT
Begin DoDot:2
+6 SET XMTEXT(IEN)=@OUTPUT@(INDEX,IEN)
End DoDot:2
+7 DO ^XMD
+8 ; error message
if $DATA(XMMG)
WRITE !!,XMMG
+9 if '$DATA(XMMG)
WRITE !!,"Message Subject: ",SUB
+10 if '$DATA(XMMG)
WRITE !,"Message ID : ",XMZ
End DoDot:1
+11 WRITE !
DO FMR^TIUFWRAP2("EA","Press <Enter> to continue.")
+12 QUIT
+13 ;
PREPOUT(DATA,OUTPUT,TYPE) ; prepare output
+1 NEW LOC
SET LOC=$NAME(^TMP($JOB,"OUTPUT",TYPE))
+2 NEW TOTAL
SET TOTAL=0
+3 NEW IEN
SET IEN=0
FOR
SET IEN=$ORDER(@DATA@(IEN))
if '+IEN
QUIT
Begin DoDot:1
+4 NEW NODE0,POWNER
SET NODE0=$GET(^TIU(8927,IEN,0))
+5 SET TOTAL=TOTAL+1
SET @LOC@(TOTAL)="IEN: "_IEN
+6 ; imported entries may not have an entry in File #200
SET POWNER=$PIECE(NODE0,U,6)
IF +POWNER
SET POWNER=$$GET1^DIQ(200,POWNER,.01)
SET POWNER=$SELECT(POWNER="":"<unknown>",1:POWNER)
+7 ; display personal owner
IF POWNER'=""
SET TOTAL=TOTAL+1
SET @LOC@(TOTAL)="Personal Owner: "_POWNER
+8 ; display the path
+9 NEW LEN,PIE
SET LEN=$LENGTH(@DATA@(IEN,"PATH"),U)
FOR PIE=1:1:LEN
Begin DoDot:2
+10 ; pad spaces before data
NEW LN
SET LN=$$SETSTR^VALM1(" ","",(PIE-1)*4,1)
+11 SET LN=$SELECT(PIE'=LEN:LN_"<",1:LN_" - ")
+12 ; set the entry for display
SET TOTAL=TOTAL+1
SET @LOC@(TOTAL)=LN_$PIECE(@DATA@(IEN,"PATH"),U,PIE)_$SELECT(PIE'=LEN:">",1:"")
+13 ; display the lines (if any) for each entry
IF PIE=LEN
IF $DATA(@DATA@(IEN,"NODE"))
Begin DoDot:3
+14 NEW LEN,PIE
SET LEN=$LENGTH(@DATA@(IEN,"NODE"),U)
+15 FOR PIE=1:1:LEN
SET @LOC@(TOTAL)=@LOC@(TOTAL)_$SELECT(LEN=1:" ["_$PIECE(@DATA@(IEN,"NODE"),U)_"]",PIE=1:" ["_$PIECE(@DATA@(IEN,"NODE"),U,PIE)_",",PIE<LEN:$PIECE(@DATA@(IEN,"NODE"),U,PIE)_",",1:$PIECE(@DATA@(IEN,"NODE"),U,PIE)_"]
")
End DoDot:3
End DoDot:2
+16 ; remove entries as we go
KILL @DATA@(IEN)
+17 ; blank line
IF +$ORDER(@DATA@(IEN))
SET TOTAL=TOTAL+1
SET @LOC@(TOTAL)=""
End DoDot:1
+18 ;K DATA ; remove remaining data
+19 QUIT
+20 ;
PRINT ; print the results to a device
+1 NEW END,X
SET (END,X)=""
FOR
SET X=$ORDER(@OUTPUT@(X))
if X=""
QUIT
SET @OUTPUT@(X,.1)=X
SET $PIECE(@OUTPUT@(X,.2),"-",$LENGTH(X))="-"
+2 ; add a blank line between each group
SET X=""
FOR
SET X=$ORDER(@OUTPUT@(X))
if X=""
QUIT
SET @OUTPUT@(X,($ORDER(@OUTPUT@(X,""),-1)+1))=""
+3 NEW ZTSAVE
SET ZTSAVE("OUTPUT")=""
WRITE !,IOCUON
+4 DO EN^XUTMDEVQ("PRINT^TIUFWRAP2(OUTPUT)","File #8927 Analysis",.ZTSAVE)
+5 WRITE !
IF END'=U
IF $$FMR^TIUFWRAP2("EA","Press <Enter> to continue ")
+6 QUIT
+7 ;
VIEW ; view the results
+1 NEW DISPLAY,DY
WRITE $GET(IOCUON)
+2 SET X=""
FOR
SET X=$ORDER(@OUTPUT@(X))
if X=""
QUIT
SET DISPLAY(X)=$NAME(@OUTPUT@(X))
+3 KILL DIERR
DO DOCLIST^DDBR("DISPLAY","NR")
+4 QUIT
+5 ;
