source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS209.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.9 KB
Line 
1TIUPS209 ; 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
5EN ; 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
14REPORT ;
15 N CNT,ENDDT,ENDTIME,GBL,LINE,LINETXT,STRDT,STRTIME,TIUDA,TMP,TOTTIME,TIUX,TIUY
16 S STRTIME=$$NOW^XLFDT ; start time of search
17RESTART ;
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
80RPT ;
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
104ASKUSER(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
122GETLAST(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
132OMIT ;
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
151SPACER(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
158UPDATE ; 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
Note: See TracBrowser for help on using the repository browser.