TIUPS209 ; SLC/AJB - Active Titles Report & Cleanup v2; 06/01/06 ; 7/26/06 11:46am
;;1.0;TEXT INTEGRATION UTILITIES;**209,218**;Jun 20, 1997;Build 1
;
Q
EN ; control segment
N ANS,TIUOMIT
W @IOF
D ASKUSER(.ANS,"Inactivate the unused Document Titles at this time") Q:$G(ANS("EXIT"))="YES"
D
.N POP,TIUDESC,TIURTN,TIUSAVE
.S TIUDESC="TIUPS209 Active Title Report & Cleanup",TIURTN="REPORT^TIUPS209",TIUSAVE("*")=""
.W ! D EN^XUTMDEVQ(TIURTN,TIUDESC,.TIUSAVE)
Q
REPORT ;
N CNT,ENDDT,ENDTIME,GBL,LINE,LINETXT,STRDT,STRTIME,TIUDA,TMP,TOTTIME,TIUX,TIUY
S STRTIME=$$NOW^XLFDT ; start time of search
RESTART ;
S CNT=$NA(CNT) ; counters
S GBL=$NA(^TIU(8925.1,"B")) ; global to be searched
S TMP=$NA(^TMP("TIUPS209",$J)) ; sets temporary storage location
S @CNT@("T#8925.1")=0 ; number of document titles in 8925.1
S (TIUX,TIUY)=0 ; gets all document titles from 8925.1
F S TIUX=$O(@GBL@(TIUX)) Q:TIUX="" F S TIUY=$O(@GBL@(TIUX,TIUY)) Q:'+TIUY D
. I $P($G(^TIU(8925.1,TIUY,0)),U,4)="DOC" S @TMP@("B",TIUY)=0,@CNT@("T#8925.1")=@CNT@("T#8925.1")+1
S GBL=$NA(^TIU(8925,"F")) ; global to be searched
S STRDT=$P($$FMADD^XLFDT($$NOW^XLFDT,-365),".") ; start date to search
S ENDDT=$P($$NOW^XLFDT,".")_".24" ; end date to search
S @CNT@("T#8925")=0 ; number of documents searched in 8925
S @CNT@("T#M0NODE")=0 ; number of documents with invalid .01 field
S @CNT@("T#WT8925.1")=0 ; number of documents with incorrect .01 field (non title - 8925.1)
S @CNT@("T#ADD8925.1")=0 ; number of document titles added due to wrong type
S @CNT@("T#GDOCS")=0 ; number of documents
S TIUDA=0
F S STRDT=$O(@GBL@(STRDT)) Q:'+STRDT!(STRDT>ENDDT) F S TIUDA=$O(@GBL@(STRDT,TIUDA)) Q:'+TIUDA D
. S @CNT@("T#8925")=@CNT@("T#8925")+1 ; count of documents searched
. N TIUD0,TIUD12,TIUX S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^TIU(8925,TIUDA,12))
. I '+TIUD0 S @TMP@("UNK",+TIUDA)="",@CNT@("T#M0NODE")=@CNT@("T#M0NODE")+1 Q ; track documents with invalid .01 field
. I $P($G(^TIU(8925.1,+TIUD0,0)),U,4)'="DOC" S TIUX=1,@CNT@("T#WT8925.1")=@CNT@("T#WT8925.1")+1,@TMP@("WRT",+TIUD0)=""
. I '+$D(@TMP@("B",+TIUD0)) S @TMP@("B",+TIUD0)=0,@CNT@("T#ADD8925.1")=@CNT@("T#ADD8925.1")+1
. S @TMP@("B",+TIUD0)=(+@TMP@("B",+TIUD0)+1) S:'+$G(TIUX) @CNT@("T#GDOCS")=@CNT@("T#GDOCS")+1
. S @TMP@("B",+TIUD0)=@TMP@("B",+TIUD0)_U_+$P(TIUD12,".")_U_$P(TIUD12,U,2)_U_+TIUD0_U_$P(^TIU(8925.1,+TIUD0,0),U,7)
S @CNT@("T#ERR8925.1")=0 ; number of errorneous document titles
S @CNT@("T#U8925.1")=0 ; number of used document titles
S @CNT@("T#UN8925.1")=0 ; number of unused document titles
S TIUDA=0
F S TIUDA=$O(@TMP@("B",TIUDA)) Q:'+TIUDA D
. I +$L($P($G(^TIU(8925.1,TIUDA,0)),U))<3 S @CNT@("T#ERR8925.1")=@CNT@("T#ERR8925.1")+1,@TMP@("B.1",+TIUDA)="" Q
. I +@TMP@("B",TIUDA) S @CNT@("T#U8925.1")=@CNT@("T#U8925.1")+1,@TMP@("RPT","USED",$$GET1^DIQ(8925.1,+TIUDA,.01))=@TMP@("B",+TIUDA) Q
. S @CNT@("T#UN8925.1")=@CNT@("T#UN8925.1")+1,@TMP@("RPT","UNUSED",$$GET1^DIQ(8925.1,+TIUDA,.01))=$$GETLAST(+TIUDA)
S ENDTIME=$$NOW^XLFDT,TOTTIME=$FN($$FMDIFF^XLFDT(STRTIME,ENDTIME,2)/60,"-")
I $G(ANS("INACT"))="YES" D UPDATE K @TMP S ANS("INACT")="" G RESTART
F LINE=1:1 S LINETXT=$P($T(RPT+LINE),";;",2) Q:LINETXT="EOM" W !,@LINETXT
S TIUX=""
F TIUY="UNUSED","USED" F S TIUX=$O(@TMP@("RPT",TIUY,TIUX)) Q:TIUX="" D
. N DATA,DISPLAY,STATUS,TITLE
. S DATA=@TMP@("RPT",TIUY,TIUX)
. I TIUY="UNUSED",$P(DATA,U,5)=13 Q ; don't print unused/inactive titles
. S STATUS=$S($P(DATA,U,5)=11:"",$P(DATA,U,5)=13:" [Inactive]",1:" [unknown]")
. S TITLE=TIUX_STATUS,TITLE=$$WRAP^TIULS(TITLE,38)
. S DISPLAY=$$SETSTR^VALM1($P(TITLE,"|"),"",1,38)
. S DISPLAY=$$SETSTR^VALM1($$SPACER(+DATA,5,1),DISPLAY,40,5)
. S DISPLAY=$$SETSTR^VALM1($$FMTE^XLFDT($P(DATA,U,2)),DISPLAY,47,12)
. S DISPLAY=$$SETSTR^VALM1($S($P(DATA,U,3)="N/A":"N/A",1:$$GET1^DIQ(200,+$P(DATA,U,3),.01)),DISPLAY,61,18)
. W !,DISPLAY
. I $L(TITLE,"|")>1 F DATA=2:1:$L(TITLE,"|") W !,?2,$P(TITLE,"|",DATA)
I +$D(@TMP@("B.1")) D
. W !!,"The following IENs from File #8925.1 have an invalid #.01 Field.",!
. S TIUDA=0 F S TIUDA=$O(@TMP@("B.1",TIUDA)) Q:'+TIUDA W !,TIUDA
I +$D(@TMP@("WRT")) D
. W !!,"The following IENs from File #8925.1 have an incorrect #.04 Field.",!
. S TIUDA=0 F S TIUDA=$O(@TMP@("WRT",TIUDA)) Q:'+TIUDA D
. . N DATA,TITLE S TITLE=$$GET1^DIQ(8925.1,TIUDA,.01),TITLE=$$WRAP^TIULS(TITLE,50)
. . W !,$$SPACER(TIUDA,12)_$P(TITLE,"|")_" ["_$$GET1^DIQ(8925.1,TIUDA,.04)_"]"
. . I $L(TITLE,"|")>1 F DATA=2:1:$L(TITLE,"|") W !,?14,$P(TITLE,"|",DATA)
I +$D(@TMP@("UNK")) D
. W !!,"The following DOCUMENT IENs have an incorrect (null or zero) #.01 Field.",!
. S TIUDA=0 F S TIUDA=$O(@TMP@("UNK",TIUDA)) Q:'+TIUDA W !,$$SPACER(TIUDA,12) ; I +@TMP@("UNK",TIUDA) W $$GET1^DIQ(8925.1,@TMP@("UNK",TIUDA),.01)
K @TMP
Q
RPT ;
;;"Elapsed Time: "_(TOTTIME\1)_" minute(s) "_($FN((TOTTIME#1)*60,"-",0))_" second(s)"
;;""
;;" # of Used Titles : "_$$SPACER(@CNT@("T#U8925.1"),10,1)
;;" # of Unused Titles : "_$$SPACER(@CNT@("T#UN8925.1"),10,1)
;;" # of Invalid Titles : "_$$SPACER(@CNT@("T#ERR8925.1"),10,1)_$S(+@CNT@("T#ERR8925.1"):" (See End of Report)",1:"")
;;" ----------"
;;" # of Total Titles : "_$$SPACER((@CNT@("T#8925.1")+@CNT@("T#ADD8925.1")),10,1)
;;""
;;" # of Docs : "_$$SPACER(@CNT@("T#GDOCS"),10,1)
;;" # of Docs Incorrect .01 Field : "_$$SPACER(@CNT@("T#WT8925.1"),10,1)_$S(+@CNT@("T#WT8925.1"):" (See End of Report)",1:"")
;;" # of Docs Zero/Null .01 Field : "_$$SPACER(@CNT@("T#M0NODE"),10,1)_$S(+@CNT@("T#M0NODE"):" (See End of Report)",1:"")
;;" ----------"
;;" # of Total Docs Searched : "_$$SPACER(@CNT@("T#8925"),10,1)
;;""
;;" Current User: "_($$GET1^DIQ(200,+$G(DUZ),.01))
;;" Current Date: "_($$HTE^XLFDT($H))
;;"Date range searched: "_($$FMTE^XLFDT($P($$FMADD^XLFDT($$NOW^XLFDT,-365),"."),"D"))_" - "_($$FMTE^XLFDT(ENDDT,"D"))
;;""
;;" # of"
;;"Document Title Docs Last DT Used Author/Dictator"
;;"-------------- ---- ------------ ---------------"
;;EOM
Q
ASKUSER(ANS,DIR,TIUQUIT) ; ask the user if they want to update titles now
I $G(ANS("EXIT"))="YES"!($G(ANS("INACT"))="NO") Q
N DIRUT,DTOUT,DUOUT,POP,X,Y
S DIR(0)="Y"
S DIR("A")=DIR,DIR("B")="NO"
S DIR("?",1)="Entering 'YES' will inactivate all titles unused in the past year;"
S DIR("?",2)="their STATUS will be changed to INACTIVE.",DIR("?",3)=""
S DIR("?")="Entering 'NO' will create the report without making any changes."
D ^DIR I $D(DUOUT)!($D(DTOUT)) S ANS("EXIT")="YES" Q
S ANS("INACT")=Y(0) Q:+$G(TIUQUIT)
I ANS("INACT")="YES" D
. W !!,"All active titles that have not been used in the previous 365 days"
. W !,"will be set to INACTIVE.",!
. W !,"You may select individual DOCUMENT TITLES that will NOT be set"
. W !,"to INACTIVE by this cleanup.",!
. D ASKUSER(.ANS,"Are you sure you want to change their status to INACTIVE",1)
. I ANS("INACT")="YES" D OMIT
Q
GETLAST(TIUDA) ;
N IEN,GBL,ST,TDT,TEMP,TIUY
S GBL=$NA(^TIU(8925,"ALL","ANY",TIUDA))
S TIUY="0^N/A^N/A"_U_TIUDA_U_$P($G(^TIU(8925.1,TIUDA,0)),U,7)
S ST="" F S ST=$O(@GBL@(ST)) Q:'ST S TDT="",TDT=$O(@GBL@(+ST,TDT)),IEN="",IEN=$O(@GBL@(+ST,+TDT,IEN)) S TEMP(TDT)=IEN
S TDT="",TDT=$O(TEMP(TDT)) I +$G(TEMP(+TDT)) S IEN=+TEMP(TDT) D
. N TIUD0,TIUD12 S TIUD0=$G(^TIU(8925,IEN,0)),TIUD12=$G(^TIU(8925,IEN,12))
. I '+TIUD0,'$D(@TMP@("UNK",+IEN)) S @TMP@("UNK",+IEN)="",@CNT@("T#M0NODE")=@CNT@("T#M0NODE")+1,@CNT@("T#8925")=@CNT@("T#8925")+1
. S $P(TIUY,U,2)=$P(+TIUD12,"."),$P(TIUY,U,3)=$P(TIUD12,U,2)
Q TIUY
OMIT ;
N TIUCONT,TIUQUIT
F D Q:$G(TIUQUIT)=1!($G(TIUCONT)=1)
. N DIC,DIR,POP,TIUCNT,X,Y
. W !!,"Enter the DOCUMENT TITLE(S) that will NOT be INACTIVATED",!
. W "during the cleanup process.",!!
. W "Enter RETURN or '^' to finish selections.",!
. S TIUCNT=0,DIC="^TIU(8925.1,",DIC("S")="I $P(^(0),U,4)=""DOC"""
. S DIC(0)="AEMQ",DIC("A")="Enter DOCUMENT TITLE: "
. F D ^DIC Q:Y=-1 D Q:$G(TIUQUIT)=1
. . S TIUCNT=TIUCNT+1,TIUOMIT(+Y)="" S:TIUCNT=1 DIC("A")=" and "
. Q:$G(TIUQUIT)=1
. I TIUCNT=0 W !!,"No selections made.",! S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E" D ^DIR S TIUQUIT=1 Q
. W !!,$S(TIUCNT>1:"The following DOCUMENT TITLES will NOT be INACTIVATED: ",1:"The following DOCUMENT TITLE will NOT be INACTIVATED: "),!!
. S X="" F S X=$O(TIUOMIT(X)) Q:X="" W ?5,$$GET1^DIQ(8925.1,X_",",.01),!
. S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="YES"
. D ^DIR I +Y'=1 W !! K TIUOMIT S:Y=U TIUQUIT=1 Q
. S TIUCONT=1
Q
SPACER(TEXT,LENGTH,REV) ;
N SPACER
S SPACER=""
S $P(SPACER," ",(LENGTH-$L(TEXT)))=" "
S:'$D(REV) TEXT=TEXT_SPACER
S:$D(REV) TEXT=SPACER_TEXT
Q TEXT
UPDATE ; updates status field of TIU Document Title to INACTIVE
N TIUDA,TIUMSG,TIUUPDT
S TIUDA=0 F S TIUDA=$O(@TMP@("B",TIUDA)) Q:'+TIUDA I '+@TMP@("B",TIUDA),'$D(TIUOMIT(TIUDA)) S TIUUPDT(8925.1,TIUDA_",",.07)=13 D FILE^DIE("","TIUUPDT","TIUMSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS209 9313 printed Oct 16, 2024@18:44:50 Page 2
TIUPS209 ; SLC/AJB - Active Titles Report & Cleanup v2; 06/01/06 ; 7/26/06 11:46am
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**209,218**;Jun 20, 1997;Build 1
+2 ;
+3 QUIT
EN ; control segment
+1 NEW ANS,TIUOMIT
+2 WRITE @IOF
+3 DO ASKUSER(.ANS,"Inactivate the unused Document Titles at this time")
if $GET(ANS("EXIT"))="YES"
QUIT
+4 Begin DoDot:1
+5 NEW POP,TIUDESC,TIURTN,TIUSAVE
+6 SET TIUDESC="TIUPS209 Active Title Report & Cleanup"
SET TIURTN="REPORT^TIUPS209"
SET TIUSAVE("*")=""
+7 WRITE !
DO EN^XUTMDEVQ(TIURTN,TIUDESC,.TIUSAVE)
End DoDot:1
+8 QUIT
REPORT ;
+1 NEW CNT,ENDDT,ENDTIME,GBL,LINE,LINETXT,STRDT,STRTIME,TIUDA,TMP,TOTTIME,TIUX,TIUY
+2 ; start time of search
SET STRTIME=$$NOW^XLFDT
RESTART ;
+1 ; counters
SET CNT=$NAME(CNT)
+2 ; global to be searched
SET GBL=$NAME(^TIU(8925.1,"B"))
+3 ; sets temporary storage location
SET TMP=$NAME(^TMP("TIUPS209",$JOB))
+4 ; number of document titles in 8925.1
SET @CNT@("T#8925.1")=0
+5 ; gets all document titles from 8925.1
SET (TIUX,TIUY)=0
+6 FOR
SET TIUX=$ORDER(@GBL@(TIUX))
if TIUX=""
QUIT
FOR
SET TIUY=$ORDER(@GBL@(TIUX,TIUY))
if '+TIUY
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^TIU(8925.1,TIUY,0)),U,4)="DOC"
SET @TMP@("B",TIUY)=0
SET @CNT@("T#8925.1")=@CNT@("T#8925.1")+1
End DoDot:1
+8 ; global to be searched
SET GBL=$NAME(^TIU(8925,"F"))
+9 ; start date to search
SET STRDT=$PIECE($$FMADD^XLFDT($$NOW^XLFDT,-365),".")
+10 ; end date to search
SET ENDDT=$PIECE($$NOW^XLFDT,".")_".24"
+11 ; number of documents searched in 8925
SET @CNT@("T#8925")=0
+12 ; number of documents with invalid .01 field
SET @CNT@("T#M0NODE")=0
+13 ; number of documents with incorrect .01 field (non title - 8925.1)
SET @CNT@("T#WT8925.1")=0
+14 ; number of document titles added due to wrong type
SET @CNT@("T#ADD8925.1")=0
+15 ; number of documents
SET @CNT@("T#GDOCS")=0
+16 SET TIUDA=0
+17 FOR
SET STRDT=$ORDER(@GBL@(STRDT))
if '+STRDT!(STRDT>ENDDT)
QUIT
FOR
SET TIUDA=$ORDER(@GBL@(STRDT,TIUDA))
if '+TIUDA
QUIT
Begin DoDot:1
+18 ; count of documents searched
SET @CNT@("T#8925")=@CNT@("T#8925")+1
+19 NEW TIUD0,TIUD12,TIUX
SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD12=$GET(^TIU(8925,TIUDA,12))
+20 ; track documents with invalid .01 field
IF '+TIUD0
SET @TMP@("UNK",+TIUDA)=""
SET @CNT@("T#M0NODE")=@CNT@("T#M0NODE")+1
QUIT
+21 IF $PIECE($GET(^TIU(8925.1,+TIUD0,0)),U,4)'="DOC"
SET TIUX=1
SET @CNT@("T#WT8925.1")=@CNT@("T#WT8925.1")+1
SET @TMP@("WRT",+TIUD0)=""
+22 IF '+$DATA(@TMP@("B",+TIUD0))
SET @TMP@("B",+TIUD0)=0
SET @CNT@("T#ADD8925.1")=@CNT@("T#ADD8925.1")+1
+23 SET @TMP@("B",+TIUD0)=(+@TMP@("B",+TIUD0)+1)
if '+$GET(TIUX)
SET @CNT@("T#GDOCS")=@CNT@("T#GDOCS")+1
+24 SET @TMP@("B",+TIUD0)=@TMP@("B",+TIUD0)_U_+$PIECE(TIUD12,".")_U_$PIECE(TIUD12,U,2)_U_+TIUD0_U_$PIECE(^TIU(8925.1,+TIUD0,0),U,7)
End DoDot:1
+25 ; number of errorneous document titles
SET @CNT@("T#ERR8925.1")=0
+26 ; number of used document titles
SET @CNT@("T#U8925.1")=0
+27 ; number of unused document titles
SET @CNT@("T#UN8925.1")=0
+28 SET TIUDA=0
+29 FOR
SET TIUDA=$ORDER(@TMP@("B",TIUDA))
if '+TIUDA
QUIT
Begin DoDot:1
+30 IF +$LENGTH($PIECE($GET(^TIU(8925.1,TIUDA,0)),U))<3
SET @CNT@("T#ERR8925.1")=@CNT@("T#ERR8925.1")+1
SET @TMP@("B.1",+TIUDA)=""
QUIT
+31 IF +@TMP@("B",TIUDA)
SET @CNT@("T#U8925.1")=@CNT@("T#U8925.1")+1
SET @TMP@("RPT","USED",$$GET1^DIQ(8925.1,+TIUDA,.01))=@TMP@("B",+TIUDA)
QUIT
+32 SET @CNT@("T#UN8925.1")=@CNT@("T#UN8925.1")+1
SET @TMP@("RPT","UNUSED",$$GET1^DIQ(8925.1,+TIUDA,.01))=$$GETLAST(+TIUDA)
End DoDot:1
+33 SET ENDTIME=$$NOW^XLFDT
SET TOTTIME=$FNUMBER($$FMDIFF^XLFDT(STRTIME,ENDTIME,2)/60,"-")
+34 IF $GET(ANS("INACT"))="YES"
DO UPDATE
KILL @TMP
SET ANS("INACT")=""
GOTO RESTART
+35 FOR LINE=1:1
SET LINETXT=$PIECE($TEXT(RPT+LINE),";;",2)
if LINETXT="EOM"
QUIT
WRITE !,@LINETXT
+36 SET TIUX=""
+37 FOR TIUY="UNUSED","USED"
FOR
SET TIUX=$ORDER(@TMP@("RPT",TIUY,TIUX))
if TIUX=""
QUIT
Begin DoDot:1
+38 NEW DATA,DISPLAY,STATUS,TITLE
+39 SET DATA=@TMP@("RPT",TIUY,TIUX)
+40 ; don't print unused/inactive titles
IF TIUY="UNUSED"
IF $PIECE(DATA,U,5)=13
QUIT
+41 SET STATUS=$SELECT($PIECE(DATA,U,5)=11:"",$PIECE(DATA,U,5)=13:" [Inactive]",1:" [unknown]")
+42 SET TITLE=TIUX_STATUS
SET TITLE=$$WRAP^TIULS(TITLE,38)
+43 SET DISPLAY=$$SETSTR^VALM1($PIECE(TITLE,"|"),"",1,38)
+44 SET DISPLAY=$$SETSTR^VALM1($$SPACER(+DATA,5,1),DISPLAY,40,5)
+45 SET DISPLAY=$$SETSTR^VALM1($$FMTE^XLFDT($PIECE(DATA,U,2)),DISPLAY,47,12)
+46 SET DISPLAY=$$SETSTR^VALM1($SELECT($PIECE(DATA,U,3)="N/A":"N/A",1:$$GET1^DIQ(200,+$PIECE(DATA,U,3),.01)),DISPLAY,61,18)
+47 WRITE !,DISPLAY
+48 IF $LENGTH(TITLE,"|")>1
FOR DATA=2:1:$LENGTH(TITLE,"|")
WRITE !,?2,$PIECE(TITLE,"|",DATA)
End DoDot:1
+49 IF +$DATA(@TMP@("B.1"))
Begin DoDot:1
+50 WRITE !!,"The following IENs from File #8925.1 have an invalid #.01 Field.",!
+51 SET TIUDA=0
FOR
SET TIUDA=$ORDER(@TMP@("B.1",TIUDA))
if '+TIUDA
QUIT
WRITE !,TIUDA
End DoDot:1
+52 IF +$DATA(@TMP@("WRT"))
Begin DoDot:1
+53 WRITE !!,"The following IENs from File #8925.1 have an incorrect #.04 Field.",!
+54 SET TIUDA=0
FOR
SET TIUDA=$ORDER(@TMP@("WRT",TIUDA))
if '+TIUDA
QUIT
Begin DoDot:2
+55 NEW DATA,TITLE
SET TITLE=$$GET1^DIQ(8925.1,TIUDA,.01)
SET TITLE=$$WRAP^TIULS(TITLE,50)
+56 WRITE !,$$SPACER(TIUDA,12)_$PIECE(TITLE,"|")_" ["_$$GET1^DIQ(8925.1,TIUDA,.04)_"]"
+57 IF $LENGTH(TITLE,"|")>1
FOR DATA=2:1:$LENGTH(TITLE,"|")
WRITE !,?14,$PIECE(TITLE,"|",DATA)
End DoDot:2
End DoDot:1
+58 IF +$DATA(@TMP@("UNK"))
Begin DoDot:1
+59 WRITE !!,"The following DOCUMENT IENs have an incorrect (null or zero) #.01 Field.",!
+60 ; I +@TMP@("UNK",TIUDA) W $$GET1^DIQ(8925.1,@TMP@("UNK",TIUDA),.01)
SET TIUDA=0
FOR
SET TIUDA=$ORDER(@TMP@("UNK",TIUDA))
if '+TIUDA
QUIT
WRITE !,$$SPACER(TIUDA,12)
End DoDot:1
+61 KILL @TMP
+62 QUIT
RPT ;
+1 ;;"Elapsed Time: "_(TOTTIME\1)_" minute(s) "_($FN((TOTTIME#1)*60,"-",0))_" second(s)"
+2 ;;""
+3 ;;" # of Used Titles : "_$$SPACER(@CNT@("T#U8925.1"),10,1)
+4 ;;" # of Unused Titles : "_$$SPACER(@CNT@("T#UN8925.1"),10,1)
+5 ;;" # of Invalid Titles : "_$$SPACER(@CNT@("T#ERR8925.1"),10,1)_$S(+@CNT@("T#ERR8925.1"):" (See End of Report)",1:"")
+6 ;;" ----------"
+7 ;;" # of Total Titles : "_$$SPACER((@CNT@("T#8925.1")+@CNT@("T#ADD8925.1")),10,1)
+8 ;;""
+9 ;;" # of Docs : "_$$SPACER(@CNT@("T#GDOCS"),10,1)
+10 ;;" # of Docs Incorrect .01 Field : "_$$SPACER(@CNT@("T#WT8925.1"),10,1)_$S(+@CNT@("T#WT8925.1"):" (See End of Report)",1:"")
+11 ;;" # of Docs Zero/Null .01 Field : "_$$SPACER(@CNT@("T#M0NODE"),10,1)_$S(+@CNT@("T#M0NODE"):" (See End of Report)",1:"")
+12 ;;" ----------"
+13 ;;" # of Total Docs Searched : "_$$SPACER(@CNT@("T#8925"),10,1)
+14 ;;""
+15 ;;" Current User: "_($$GET1^DIQ(200,+$G(DUZ),.01))
+16 ;;" Current Date: "_($$HTE^XLFDT($H))
+17 ;;"Date range searched: "_($$FMTE^XLFDT($P($$FMADD^XLFDT($$NOW^XLFDT,-365),"."),"D"))_" - "_($$FMTE^XLFDT(ENDDT,"D"))
+18 ;;""
+19 ;;" # of"
+20 ;;"Document Title Docs Last DT Used Author/Dictator"
+21 ;;"-------------- ---- ------------ ---------------"
+22 ;;EOM
+23 QUIT
ASKUSER(ANS,DIR,TIUQUIT) ; ask the user if they want to update titles now
+1 IF $GET(ANS("EXIT"))="YES"!($GET(ANS("INACT"))="NO")
QUIT
+2 NEW DIRUT,DTOUT,DUOUT,POP,X,Y
+3 SET DIR(0)="Y"
+4 SET DIR("A")=DIR
SET DIR("B")="NO"
+5 SET DIR("?",1)="Entering 'YES' will inactivate all titles unused in the past year;"
+6 SET DIR("?",2)="their STATUS will be changed to INACTIVE."
SET DIR("?",3)=""
+7 SET DIR("?")="Entering 'NO' will create the report without making any changes."
+8 DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET ANS("EXIT")="YES"
QUIT
+9 SET ANS("INACT")=Y(0)
if +$GET(TIUQUIT)
QUIT
+10 IF ANS("INACT")="YES"
Begin DoDot:1
+11 WRITE !!,"All active titles that have not been used in the previous 365 days"
+12 WRITE !,"will be set to INACTIVE.",!
+13 WRITE !,"You may select individual DOCUMENT TITLES that will NOT be set"
+14 WRITE !,"to INACTIVE by this cleanup.",!
+15 DO ASKUSER(.ANS,"Are you sure you want to change their status to INACTIVE",1)
+16 IF ANS("INACT")="YES"
DO OMIT
End DoDot:1
+17 QUIT
GETLAST(TIUDA) ;
+1 NEW IEN,GBL,ST,TDT,TEMP,TIUY
+2 SET GBL=$NAME(^TIU(8925,"ALL","ANY",TIUDA))
+3 SET TIUY="0^N/A^N/A"_U_TIUDA_U_$PIECE($GET(^TIU(8925.1,TIUDA,0)),U,7)
+4 SET ST=""
FOR
SET ST=$ORDER(@GBL@(ST))
if 'ST
QUIT
SET TDT=""
SET TDT=$ORDER(@GBL@(+ST,TDT))
SET IEN=""
SET IEN=$ORDER(@GBL@(+ST,+TDT,IEN))
SET TEMP(TDT)=IEN
+5 SET TDT=""
SET TDT=$ORDER(TEMP(TDT))
IF +$GET(TEMP(+TDT))
SET IEN=+TEMP(TDT)
Begin DoDot:1
+6 NEW TIUD0,TIUD12
SET TIUD0=$GET(^TIU(8925,IEN,0))
SET TIUD12=$GET(^TIU(8925,IEN,12))
+7 IF '+TIUD0
IF '$DATA(@TMP@("UNK",+IEN))
SET @TMP@("UNK",+IEN)=""
SET @CNT@("T#M0NODE")=@CNT@("T#M0NODE")+1
SET @CNT@("T#8925")=@CNT@("T#8925")+1
+8 SET $PIECE(TIUY,U,2)=$PIECE(+TIUD12,".")
SET $PIECE(TIUY,U,3)=$PIECE(TIUD12,U,2)
End DoDot:1
+9 QUIT TIUY
OMIT ;
+1 NEW TIUCONT,TIUQUIT
+2 FOR
Begin DoDot:1
+3 NEW DIC,DIR,POP,TIUCNT,X,Y
+4 WRITE !!,"Enter the DOCUMENT TITLE(S) that will NOT be INACTIVATED",!
+5 WRITE "during the cleanup process.",!!
+6 WRITE "Enter RETURN or '^' to finish selections.",!
+7 SET TIUCNT=0
SET DIC="^TIU(8925.1,"
SET DIC("S")="I $P(^(0),U,4)=""DOC"""
+8 SET DIC(0)="AEMQ"
SET DIC("A")="Enter DOCUMENT TITLE: "
+9 FOR
DO ^DIC
if Y=-1
QUIT
Begin DoDot:2
+10 SET TIUCNT=TIUCNT+1
SET TIUOMIT(+Y)=""
if TIUCNT=1
SET DIC("A")=" and "
End DoDot:2
if $GET(TIUQUIT)=1
QUIT
+11 if $GET(TIUQUIT)=1
QUIT
+12 IF TIUCNT=0
WRITE !!,"No selections made.",!
SET DIR("A")="Enter RETURN to continue or '^' to exit"
SET DIR(0)="E"
DO ^DIR
SET TIUQUIT=1
QUIT
+13 WRITE !!,$SELECT(TIUCNT>1:"The following DOCUMENT TITLES will NOT be INACTIVATED: ",1:"The following DOCUMENT TITLE will NOT be INACTIVATED: "),!!
+14 SET X=""
FOR
SET X=$ORDER(TIUOMIT(X))
if X=""
QUIT
WRITE ?5,$$GET1^DIQ(8925.1,X_",",.01),!
+15 SET DIR(0)="Y"
SET DIR("A")="Is this correct"
SET DIR("B")="YES"
+16 DO ^DIR
IF +Y'=1
WRITE !!
KILL TIUOMIT
if Y=U
SET TIUQUIT=1
QUIT
+17 SET TIUCONT=1
End DoDot:1
if $GET(TIUQUIT)=1!($GET(TIUCONT)=1)
QUIT
+18 QUIT
SPACER(TEXT,LENGTH,REV) ;
+1 NEW SPACER
+2 SET SPACER=""
+3 SET $PIECE(SPACER," ",(LENGTH-$LENGTH(TEXT)))=" "
+4 if '$DATA(REV)
SET TEXT=TEXT_SPACER
+5 if $DATA(REV)
SET TEXT=SPACER_TEXT
+6 QUIT TEXT
UPDATE ; updates status field of TIU Document Title to INACTIVE
+1 NEW TIUDA,TIUMSG,TIUUPDT
+2 SET TIUDA=0
FOR
SET TIUDA=$ORDER(@TMP@("B",TIUDA))
if '+TIUDA
QUIT
IF '+@TMP@("B",TIUDA)
IF '$DATA(TIUOMIT(TIUDA))
SET TIUUPDT(8925.1,TIUDA_",",.07)=13
DO FILE^DIE("","TIUUPDT","TIUMSG")
+3 QUIT
