| 1 | TIUPS209 ; SLC/AJB - Active Titles Report & Cleanup v2; 06/01/06 ; 7/26/06 11:46am
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**209,218**;Jun 20, 1997;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | EN ; control segment
|
|---|
| 6 | N ANS,TIUOMIT
|
|---|
| 7 | W @IOF
|
|---|
| 8 | D ASKUSER(.ANS,"Inactivate the unused Document Titles at this time") Q:$G(ANS("EXIT"))="YES"
|
|---|
| 9 | D
|
|---|
| 10 | .N POP,TIUDESC,TIURTN,TIUSAVE
|
|---|
| 11 | .S TIUDESC="TIUPS209 Active Title Report & Cleanup",TIURTN="REPORT^TIUPS209",TIUSAVE("*")=""
|
|---|
| 12 | .W ! D EN^XUTMDEVQ(TIURTN,TIUDESC,.TIUSAVE)
|
|---|
| 13 | Q
|
|---|
| 14 | REPORT ;
|
|---|
| 15 | N CNT,ENDDT,ENDTIME,GBL,LINE,LINETXT,STRDT,STRTIME,TIUDA,TMP,TOTTIME,TIUX,TIUY
|
|---|
| 16 | S STRTIME=$$NOW^XLFDT ; start time of search
|
|---|
| 17 | RESTART ;
|
|---|
| 18 | S CNT=$NA(CNT) ; counters
|
|---|
| 19 | S GBL=$NA(^TIU(8925.1,"B")) ; global to be searched
|
|---|
| 20 | S TMP=$NA(^TMP("TIUPS209",$J)) ; sets temporary storage location
|
|---|
| 21 | S @CNT@("T#8925.1")=0 ; number of document titles in 8925.1
|
|---|
| 22 | S (TIUX,TIUY)=0 ; gets all document titles from 8925.1
|
|---|
| 23 | F S TIUX=$O(@GBL@(TIUX)) Q:TIUX="" F S TIUY=$O(@GBL@(TIUX,TIUY)) Q:'+TIUY D
|
|---|
| 24 | . 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
|
|---|
| 25 | S GBL=$NA(^TIU(8925,"F")) ; global to be searched
|
|---|
| 26 | S STRDT=$P($$FMADD^XLFDT($$NOW^XLFDT,-365),".") ; start date to search
|
|---|
| 27 | S ENDDT=$P($$NOW^XLFDT,".")_".24" ; end date to search
|
|---|
| 28 | S @CNT@("T#8925")=0 ; number of documents searched in 8925
|
|---|
| 29 | S @CNT@("T#M0NODE")=0 ; number of documents with invalid .01 field
|
|---|
| 30 | S @CNT@("T#WT8925.1")=0 ; number of documents with incorrect .01 field (non title - 8925.1)
|
|---|
| 31 | S @CNT@("T#ADD8925.1")=0 ; number of document titles added due to wrong type
|
|---|
| 32 | S @CNT@("T#GDOCS")=0 ; number of documents
|
|---|
| 33 | S TIUDA=0
|
|---|
| 34 | F S STRDT=$O(@GBL@(STRDT)) Q:'+STRDT!(STRDT>ENDDT) F S TIUDA=$O(@GBL@(STRDT,TIUDA)) Q:'+TIUDA D
|
|---|
| 35 | . S @CNT@("T#8925")=@CNT@("T#8925")+1 ; count of documents searched
|
|---|
| 36 | . N TIUD0,TIUD12,TIUX S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^TIU(8925,TIUDA,12))
|
|---|
| 37 | . I '+TIUD0 S @TMP@("UNK",+TIUDA)="",@CNT@("T#M0NODE")=@CNT@("T#M0NODE")+1 Q ; track documents with invalid .01 field
|
|---|
| 38 | . 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)=""
|
|---|
| 39 | . I '+$D(@TMP@("B",+TIUD0)) S @TMP@("B",+TIUD0)=0,@CNT@("T#ADD8925.1")=@CNT@("T#ADD8925.1")+1
|
|---|
| 40 | . S @TMP@("B",+TIUD0)=(+@TMP@("B",+TIUD0)+1) S:'+$G(TIUX) @CNT@("T#GDOCS")=@CNT@("T#GDOCS")+1
|
|---|
| 41 | . 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)
|
|---|
| 42 | S @CNT@("T#ERR8925.1")=0 ; number of errorneous document titles
|
|---|
| 43 | S @CNT@("T#U8925.1")=0 ; number of used document titles
|
|---|
| 44 | S @CNT@("T#UN8925.1")=0 ; number of unused document titles
|
|---|
| 45 | S TIUDA=0
|
|---|
| 46 | F S TIUDA=$O(@TMP@("B",TIUDA)) Q:'+TIUDA D
|
|---|
| 47 | . 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
|
|---|
| 48 | . 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
|
|---|
| 49 | . S @CNT@("T#UN8925.1")=@CNT@("T#UN8925.1")+1,@TMP@("RPT","UNUSED",$$GET1^DIQ(8925.1,+TIUDA,.01))=$$GETLAST(+TIUDA)
|
|---|
| 50 | S ENDTIME=$$NOW^XLFDT,TOTTIME=$FN($$FMDIFF^XLFDT(STRTIME,ENDTIME,2)/60,"-")
|
|---|
| 51 | I $G(ANS("INACT"))="YES" D UPDATE K @TMP S ANS("INACT")="" G RESTART
|
|---|
| 52 | F LINE=1:1 S LINETXT=$P($T(RPT+LINE),";;",2) Q:LINETXT="EOM" W !,@LINETXT
|
|---|
| 53 | S TIUX=""
|
|---|
| 54 | F TIUY="UNUSED","USED" F S TIUX=$O(@TMP@("RPT",TIUY,TIUX)) Q:TIUX="" D
|
|---|
| 55 | . N DATA,DISPLAY,STATUS,TITLE
|
|---|
| 56 | . S DATA=@TMP@("RPT",TIUY,TIUX)
|
|---|
| 57 | . I TIUY="UNUSED",$P(DATA,U,5)=13 Q ; don't print unused/inactive titles
|
|---|
| 58 | . S STATUS=$S($P(DATA,U,5)=11:"",$P(DATA,U,5)=13:" [Inactive]",1:" [unknown]")
|
|---|
| 59 | . S TITLE=TIUX_STATUS,TITLE=$$WRAP^TIULS(TITLE,38)
|
|---|
| 60 | . S DISPLAY=$$SETSTR^VALM1($P(TITLE,"|"),"",1,38)
|
|---|
| 61 | . S DISPLAY=$$SETSTR^VALM1($$SPACER(+DATA,5,1),DISPLAY,40,5)
|
|---|
| 62 | . S DISPLAY=$$SETSTR^VALM1($$FMTE^XLFDT($P(DATA,U,2)),DISPLAY,47,12)
|
|---|
| 63 | . 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)
|
|---|
| 64 | . W !,DISPLAY
|
|---|
| 65 | . I $L(TITLE,"|")>1 F DATA=2:1:$L(TITLE,"|") W !,?2,$P(TITLE,"|",DATA)
|
|---|
| 66 | I +$D(@TMP@("B.1")) D
|
|---|
| 67 | . W !!,"The following IENs from File #8925.1 have an invalid #.01 Field.",!
|
|---|
| 68 | . S TIUDA=0 F S TIUDA=$O(@TMP@("B.1",TIUDA)) Q:'+TIUDA W !,TIUDA
|
|---|
| 69 | I +$D(@TMP@("WRT")) D
|
|---|
| 70 | . W !!,"The following IENs from File #8925.1 have an incorrect #.04 Field.",!
|
|---|
| 71 | . S TIUDA=0 F S TIUDA=$O(@TMP@("WRT",TIUDA)) Q:'+TIUDA D
|
|---|
| 72 | . . N DATA,TITLE S TITLE=$$GET1^DIQ(8925.1,TIUDA,.01),TITLE=$$WRAP^TIULS(TITLE,50)
|
|---|
| 73 | . . W !,$$SPACER(TIUDA,12)_$P(TITLE,"|")_" ["_$$GET1^DIQ(8925.1,TIUDA,.04)_"]"
|
|---|
| 74 | . . I $L(TITLE,"|")>1 F DATA=2:1:$L(TITLE,"|") W !,?14,$P(TITLE,"|",DATA)
|
|---|
| 75 | I +$D(@TMP@("UNK")) D
|
|---|
| 76 | . W !!,"The following DOCUMENT IENs have an incorrect (null or zero) #.01 Field.",!
|
|---|
| 77 | . 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)
|
|---|
| 78 | K @TMP
|
|---|
| 79 | Q
|
|---|
| 80 | RPT ;
|
|---|
| 81 | ;;"Elapsed Time: "_(TOTTIME\1)_" minute(s) "_($FN((TOTTIME#1)*60,"-",0))_" second(s)"
|
|---|
| 82 | ;;""
|
|---|
| 83 | ;;" # of Used Titles : "_$$SPACER(@CNT@("T#U8925.1"),10,1)
|
|---|
| 84 | ;;" # of Unused Titles : "_$$SPACER(@CNT@("T#UN8925.1"),10,1)
|
|---|
| 85 | ;;" # of Invalid Titles : "_$$SPACER(@CNT@("T#ERR8925.1"),10,1)_$S(+@CNT@("T#ERR8925.1"):" (See End of Report)",1:"")
|
|---|
| 86 | ;;" ----------"
|
|---|
| 87 | ;;" # of Total Titles : "_$$SPACER((@CNT@("T#8925.1")+@CNT@("T#ADD8925.1")),10,1)
|
|---|
| 88 | ;;""
|
|---|
| 89 | ;;" # of Docs : "_$$SPACER(@CNT@("T#GDOCS"),10,1)
|
|---|
| 90 | ;;" # of Docs Incorrect .01 Field : "_$$SPACER(@CNT@("T#WT8925.1"),10,1)_$S(+@CNT@("T#WT8925.1"):" (See End of Report)",1:"")
|
|---|
| 91 | ;;" # of Docs Zero/Null .01 Field : "_$$SPACER(@CNT@("T#M0NODE"),10,1)_$S(+@CNT@("T#M0NODE"):" (See End of Report)",1:"")
|
|---|
| 92 | ;;" ----------"
|
|---|
| 93 | ;;" # of Total Docs Searched : "_$$SPACER(@CNT@("T#8925"),10,1)
|
|---|
| 94 | ;;""
|
|---|
| 95 | ;;" Current User: "_($$GET1^DIQ(200,+$G(DUZ),.01))
|
|---|
| 96 | ;;" Current Date: "_($$HTE^XLFDT($H))
|
|---|
| 97 | ;;"Date range searched: "_($$FMTE^XLFDT($P($$FMADD^XLFDT($$NOW^XLFDT,-365),"."),"D"))_" - "_($$FMTE^XLFDT(ENDDT,"D"))
|
|---|
| 98 | ;;""
|
|---|
| 99 | ;;" # of"
|
|---|
| 100 | ;;"Document Title Docs Last DT Used Author/Dictator"
|
|---|
| 101 | ;;"-------------- ---- ------------ ---------------"
|
|---|
| 102 | ;;EOM
|
|---|
| 103 | Q
|
|---|
| 104 | ASKUSER(ANS,DIR,TIUQUIT) ; ask the user if they want to update titles now
|
|---|
| 105 | I $G(ANS("EXIT"))="YES"!($G(ANS("INACT"))="NO") Q
|
|---|
| 106 | N DIRUT,DTOUT,DUOUT,POP,X,Y
|
|---|
| 107 | S DIR(0)="Y"
|
|---|
| 108 | S DIR("A")=DIR,DIR("B")="NO"
|
|---|
| 109 | S DIR("?",1)="Entering 'YES' will inactivate all titles unused in the past year;"
|
|---|
| 110 | S DIR("?",2)="their STATUS will be changed to INACTIVE.",DIR("?",3)=""
|
|---|
| 111 | S DIR("?")="Entering 'NO' will create the report without making any changes."
|
|---|
| 112 | D ^DIR I $D(DUOUT)!($D(DTOUT)) S ANS("EXIT")="YES" Q
|
|---|
| 113 | S ANS("INACT")=Y(0) Q:+$G(TIUQUIT)
|
|---|
| 114 | I ANS("INACT")="YES" D
|
|---|
| 115 | . W !!,"All active titles that have not been used in the previous 365 days"
|
|---|
| 116 | . W !,"will be set to INACTIVE.",!
|
|---|
| 117 | . W !,"You may select individual DOCUMENT TITLES that will NOT be set"
|
|---|
| 118 | . W !,"to INACTIVE by this cleanup.",!
|
|---|
| 119 | . D ASKUSER(.ANS,"Are you sure you want to change their status to INACTIVE",1)
|
|---|
| 120 | . I ANS("INACT")="YES" D OMIT
|
|---|
| 121 | Q
|
|---|
| 122 | GETLAST(TIUDA) ;
|
|---|
| 123 | N IEN,GBL,ST,TDT,TEMP,TIUY
|
|---|
| 124 | S GBL=$NA(^TIU(8925,"ALL","ANY",TIUDA))
|
|---|
| 125 | S TIUY="0^N/A^N/A"_U_TIUDA_U_$P($G(^TIU(8925.1,TIUDA,0)),U,7)
|
|---|
| 126 | 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
|
|---|
| 127 | S TDT="",TDT=$O(TEMP(TDT)) I +$G(TEMP(+TDT)) S IEN=+TEMP(TDT) D
|
|---|
| 128 | . N TIUD0,TIUD12 S TIUD0=$G(^TIU(8925,IEN,0)),TIUD12=$G(^TIU(8925,IEN,12))
|
|---|
| 129 | . I '+TIUD0,'$D(@TMP@("UNK",+IEN)) S @TMP@("UNK",+IEN)="",@CNT@("T#M0NODE")=@CNT@("T#M0NODE")+1,@CNT@("T#8925")=@CNT@("T#8925")+1
|
|---|
| 130 | . S $P(TIUY,U,2)=$P(+TIUD12,"."),$P(TIUY,U,3)=$P(TIUD12,U,2)
|
|---|
| 131 | Q TIUY
|
|---|
| 132 | OMIT ;
|
|---|
| 133 | N TIUCONT,TIUQUIT
|
|---|
| 134 | F D Q:$G(TIUQUIT)=1!($G(TIUCONT)=1)
|
|---|
| 135 | . N DIC,DIR,POP,TIUCNT,X,Y
|
|---|
| 136 | . W !!,"Enter the DOCUMENT TITLE(S) that will NOT be INACTIVATED",!
|
|---|
| 137 | . W "during the cleanup process.",!!
|
|---|
| 138 | . W "Enter RETURN or '^' to finish selections.",!
|
|---|
| 139 | . S TIUCNT=0,DIC="^TIU(8925.1,",DIC("S")="I $P(^(0),U,4)=""DOC"""
|
|---|
| 140 | . S DIC(0)="AEMQ",DIC("A")="Enter DOCUMENT TITLE: "
|
|---|
| 141 | . F D ^DIC Q:Y=-1 D Q:$G(TIUQUIT)=1
|
|---|
| 142 | . . S TIUCNT=TIUCNT+1,TIUOMIT(+Y)="" S:TIUCNT=1 DIC("A")=" and "
|
|---|
| 143 | . Q:$G(TIUQUIT)=1
|
|---|
| 144 | . 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
|
|---|
| 145 | . W !!,$S(TIUCNT>1:"The following DOCUMENT TITLES will NOT be INACTIVATED: ",1:"The following DOCUMENT TITLE will NOT be INACTIVATED: "),!!
|
|---|
| 146 | . S X="" F S X=$O(TIUOMIT(X)) Q:X="" W ?5,$$GET1^DIQ(8925.1,X_",",.01),!
|
|---|
| 147 | . S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="YES"
|
|---|
| 148 | . D ^DIR I +Y'=1 W !! K TIUOMIT S:Y=U TIUQUIT=1 Q
|
|---|
| 149 | . S TIUCONT=1
|
|---|
| 150 | Q
|
|---|
| 151 | SPACER(TEXT,LENGTH,REV) ;
|
|---|
| 152 | N SPACER
|
|---|
| 153 | S SPACER=""
|
|---|
| 154 | S $P(SPACER," ",(LENGTH-$L(TEXT)))=" "
|
|---|
| 155 | S:'$D(REV) TEXT=TEXT_SPACER
|
|---|
| 156 | S:$D(REV) TEXT=SPACER_TEXT
|
|---|
| 157 | Q TEXT
|
|---|
| 158 | UPDATE ; updates status field of TIU Document Title to INACTIVE
|
|---|
| 159 | N TIUDA,TIUMSG,TIUUPDT
|
|---|
| 160 | 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")
|
|---|
| 161 | Q
|
|---|
