- 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 Feb 19, 2025@00:07:54 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 ;