Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUPS209

TIUPS209.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1. EN ; control segment
  1.  N ANS,TIUOMIT
  1.  W @IOF
  1.  D ASKUSER(.ANS,"Inactivate the unused Document Titles at this time") Q:$G(ANS("EXIT"))="YES"
  1.  D
  1.  .N POP,TIUDESC,TIURTN,TIUSAVE
  1.  .S TIUDESC="TIUPS209 Active Title Report & Cleanup",TIURTN="REPORT^TIUPS209",TIUSAVE("*")=""
  1.  .W ! D EN^XUTMDEVQ(TIURTN,TIUDESC,.TIUSAVE)
  1.  Q
  1. REPORT ;
  1.  N CNT,ENDDT,ENDTIME,GBL,LINE,LINETXT,STRDT,STRTIME,TIUDA,TMP,TOTTIME,TIUX,TIUY
  1.  S STRTIME=$$NOW^XLFDT ; start time of search
  1. RESTART ;
  1.  S CNT=$NA(CNT) ; counters
  1.  S GBL=$NA(^TIU(8925.1,"B")) ; global to be searched
  1.  S TMP=$NA(^TMP("TIUPS209",$J)) ; sets temporary storage location
  1.  S @CNT@("T#8925.1")=0 ; number of document titles in 8925.1
  1.  S (TIUX,TIUY)=0 ; gets all document titles from 8925.1
  1.  F  S TIUX=$O(@GBL@(TIUX)) Q:TIUX=""  F  S TIUY=$O(@GBL@(TIUX,TIUY)) Q:'+TIUY  D
  1.  . 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
  1.  S GBL=$NA(^TIU(8925,"F")) ; global to be searched
  1.  S STRDT=$P($$FMADD^XLFDT($$NOW^XLFDT,-365),".") ; start date to search
  1.  S ENDDT=$P($$NOW^XLFDT,".")_".24" ; end date to search
  1.  S @CNT@("T#8925")=0 ; number of documents searched in 8925
  1.  S @CNT@("T#M0NODE")=0 ; number of documents with invalid .01 field
  1.  S @CNT@("T#WT8925.1")=0 ; number of documents with incorrect .01 field (non title - 8925.1)
  1.  S @CNT@("T#ADD8925.1")=0 ; number of document titles added due to wrong type
  1.  S @CNT@("T#GDOCS")=0 ; number of documents
  1.  S TIUDA=0
  1.  F  S STRDT=$O(@GBL@(STRDT)) Q:'+STRDT!(STRDT>ENDDT)  F  S TIUDA=$O(@GBL@(STRDT,TIUDA)) Q:'+TIUDA  D
  1.  . S @CNT@("T#8925")=@CNT@("T#8925")+1 ; count of documents searched
  1.  . N TIUD0,TIUD12,TIUX S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^TIU(8925,TIUDA,12))
  1.  . I '+TIUD0 S @TMP@("UNK",+TIUDA)="",@CNT@("T#M0NODE")=@CNT@("T#M0NODE")+1 Q  ; track documents with invalid .01 field
  1.  . 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)=""
  1.  . I '+$D(@TMP@("B",+TIUD0)) S @TMP@("B",+TIUD0)=0,@CNT@("T#ADD8925.1")=@CNT@("T#ADD8925.1")+1
  1.  . S @TMP@("B",+TIUD0)=(+@TMP@("B",+TIUD0)+1) S:'+$G(TIUX) @CNT@("T#GDOCS")=@CNT@("T#GDOCS")+1
  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)
  1.  S @CNT@("T#ERR8925.1")=0 ; number of errorneous document titles
  1.  S @CNT@("T#U8925.1")=0 ; number of used document titles
  1.  S @CNT@("T#UN8925.1")=0 ; number of unused document titles
  1.  S TIUDA=0
  1.  F  S TIUDA=$O(@TMP@("B",TIUDA)) Q:'+TIUDA  D
  1.  . 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
  1.  . 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
  1.  . S @CNT@("T#UN8925.1")=@CNT@("T#UN8925.1")+1,@TMP@("RPT","UNUSED",$$GET1^DIQ(8925.1,+TIUDA,.01))=$$GETLAST(+TIUDA)
  1.  S ENDTIME=$$NOW^XLFDT,TOTTIME=$FN($$FMDIFF^XLFDT(STRTIME,ENDTIME,2)/60,"-")
  1.  I $G(ANS("INACT"))="YES" D UPDATE K @TMP S ANS("INACT")="" G RESTART
  1.  F LINE=1:1 S LINETXT=$P($T(RPT+LINE),";;",2) Q:LINETXT="EOM"  W !,@LINETXT
  1.  S TIUX=""
  1.  F TIUY="UNUSED","USED" F  S TIUX=$O(@TMP@("RPT",TIUY,TIUX)) Q:TIUX=""  D
  1.  . N DATA,DISPLAY,STATUS,TITLE
  1.  . S DATA=@TMP@("RPT",TIUY,TIUX)
  1.  . I TIUY="UNUSED",$P(DATA,U,5)=13 Q  ; don't print unused/inactive titles
  1.  . S STATUS=$S($P(DATA,U,5)=11:"",$P(DATA,U,5)=13:" [Inactive]",1:" [unknown]")
  1.  . S TITLE=TIUX_STATUS,TITLE=$$WRAP^TIULS(TITLE,38)
  1.  . S DISPLAY=$$SETSTR^VALM1($P(TITLE,"|"),"",1,38)
  1.  . S DISPLAY=$$SETSTR^VALM1($$SPACER(+DATA,5,1),DISPLAY,40,5)
  1.  . S DISPLAY=$$SETSTR^VALM1($$FMTE^XLFDT($P(DATA,U,2)),DISPLAY,47,12)
  1.  . 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)
  1.  . W !,DISPLAY
  1.  . I $L(TITLE,"|")>1 F DATA=2:1:$L(TITLE,"|") W !,?2,$P(TITLE,"|",DATA)
  1.  I +$D(@TMP@("B.1")) D
  1.  . W !!,"The following IENs from File #8925.1 have an invalid #.01 Field.",!
  1.  . S TIUDA=0 F  S TIUDA=$O(@TMP@("B.1",TIUDA)) Q:'+TIUDA  W !,TIUDA
  1.  I +$D(@TMP@("WRT")) D
  1.  . W !!,"The following IENs from File #8925.1 have an incorrect #.04 Field.",!
  1.  . S TIUDA=0 F  S TIUDA=$O(@TMP@("WRT",TIUDA)) Q:'+TIUDA  D
  1.  . . N DATA,TITLE S TITLE=$$GET1^DIQ(8925.1,TIUDA,.01),TITLE=$$WRAP^TIULS(TITLE,50)
  1.  . . W !,$$SPACER(TIUDA,12)_$P(TITLE,"|")_" ["_$$GET1^DIQ(8925.1,TIUDA,.04)_"]"
  1.  . . I $L(TITLE,"|")>1 F DATA=2:1:$L(TITLE,"|") W !,?14,$P(TITLE,"|",DATA)
  1.  I +$D(@TMP@("UNK")) D
  1.  . W !!,"The following DOCUMENT IENs have an incorrect (null or zero) #.01 Field.",!
  1.  . 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)
  1.  K @TMP
  1.  Q
  1. RPT ;
  1.  ;;"Elapsed Time:    "_(TOTTIME\1)_" minute(s) "_($FN((TOTTIME#1)*60,"-",0))_" second(s)"
  1.  ;;""
  1.  ;;"                 # of Used Titles  : "_$$SPACER(@CNT@("T#U8925.1"),10,1)
  1.  ;;"               # of Unused Titles  : "_$$SPACER(@CNT@("T#UN8925.1"),10,1)
  1.  ;;"              # of Invalid Titles  : "_$$SPACER(@CNT@("T#ERR8925.1"),10,1)_$S(+@CNT@("T#ERR8925.1"):" (See End of Report)",1:"")
  1.  ;;"                                     ----------"
  1.  ;;"                # of Total Titles  : "_$$SPACER((@CNT@("T#8925.1")+@CNT@("T#ADD8925.1")),10,1)
  1.  ;;""
  1.  ;;"                        # of Docs  : "_$$SPACER(@CNT@("T#GDOCS"),10,1)
  1.  ;;"    # of Docs Incorrect .01 Field  : "_$$SPACER(@CNT@("T#WT8925.1"),10,1)_$S(+@CNT@("T#WT8925.1"):" (See End of Report)",1:"")
  1.  ;;"    # of Docs Zero/Null .01 Field  : "_$$SPACER(@CNT@("T#M0NODE"),10,1)_$S(+@CNT@("T#M0NODE"):" (See End of Report)",1:"")
  1.  ;;"                                     ----------"
  1.  ;;"         # of Total Docs Searched  : "_$$SPACER(@CNT@("T#8925"),10,1)
  1.  ;;""
  1.  ;;"       Current User:  "_($$GET1^DIQ(200,+$G(DUZ),.01))
  1.  ;;"       Current Date:  "_($$HTE^XLFDT($H))
  1.  ;;"Date range searched:  "_($$FMTE^XLFDT($P($$FMADD^XLFDT($$NOW^XLFDT,-365),"."),"D"))_" - "_($$FMTE^XLFDT(ENDDT,"D"))
  1.  ;;""
  1.  ;;"                                        # of"
  1.  ;;"Document Title                          Docs  Last DT Used  Author/Dictator"
  1.  ;;"--------------                          ----  ------------  ---------------"
  1.  ;;EOM
  1.  Q
  1. ASKUSER(ANS,DIR,TIUQUIT) ; ask the user if they want to update titles now
  1.  I $G(ANS("EXIT"))="YES"!($G(ANS("INACT"))="NO") Q
  1.  N DIRUT,DTOUT,DUOUT,POP,X,Y
  1.  S DIR(0)="Y"
  1.  S DIR("A")=DIR,DIR("B")="NO"
  1.  S DIR("?",1)="Entering 'YES' will inactivate all titles unused in the past year;"
  1.  S DIR("?",2)="their STATUS will be changed to INACTIVE.",DIR("?",3)=""
  1.  S DIR("?")="Entering 'NO' will create the report without making any changes."
  1.  D ^DIR I $D(DUOUT)!($D(DTOUT)) S ANS("EXIT")="YES" Q
  1.  S ANS("INACT")=Y(0) Q:+$G(TIUQUIT)
  1.  I ANS("INACT")="YES" D
  1.  . W !!,"All active titles that have not been used in the previous 365 days"
  1.  . W !,"will be set to INACTIVE.",!
  1.  . W !,"You may select individual DOCUMENT TITLES that will NOT be set"
  1.  . W !,"to INACTIVE by this cleanup.",!
  1.  . D ASKUSER(.ANS,"Are you sure you want to change their status to INACTIVE",1)
  1.  . I ANS("INACT")="YES" D OMIT
  1.  Q
  1. GETLAST(TIUDA) ;
  1.  N IEN,GBL,ST,TDT,TEMP,TIUY
  1.  S GBL=$NA(^TIU(8925,"ALL","ANY",TIUDA))
  1.  S TIUY="0^N/A^N/A"_U_TIUDA_U_$P($G(^TIU(8925.1,TIUDA,0)),U,7)
  1.  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
  1.  S TDT="",TDT=$O(TEMP(TDT)) I +$G(TEMP(+TDT)) S IEN=+TEMP(TDT) D
  1.  . N TIUD0,TIUD12 S TIUD0=$G(^TIU(8925,IEN,0)),TIUD12=$G(^TIU(8925,IEN,12))
  1.  . I '+TIUD0,'$D(@TMP@("UNK",+IEN)) S @TMP@("UNK",+IEN)="",@CNT@("T#M0NODE")=@CNT@("T#M0NODE")+1,@CNT@("T#8925")=@CNT@("T#8925")+1
  1.  . S $P(TIUY,U,2)=$P(+TIUD12,"."),$P(TIUY,U,3)=$P(TIUD12,U,2)
  1.  Q TIUY
  1. OMIT ;
  1.  N TIUCONT,TIUQUIT
  1.  F  D  Q:$G(TIUQUIT)=1!($G(TIUCONT)=1)
  1.  . N DIC,DIR,POP,TIUCNT,X,Y
  1.  . W !!,"Enter the DOCUMENT TITLE(S) that will NOT be INACTIVATED",!
  1.  . W "during the cleanup process.",!!
  1.  . W "Enter RETURN or '^' to finish selections.",!
  1.  . S TIUCNT=0,DIC="^TIU(8925.1,",DIC("S")="I $P(^(0),U,4)=""DOC"""
  1.  . S DIC(0)="AEMQ",DIC("A")="Enter DOCUMENT TITLE: "
  1.  . F  D ^DIC Q:Y=-1  D  Q:$G(TIUQUIT)=1
  1.  . . S TIUCNT=TIUCNT+1,TIUOMIT(+Y)="" S:TIUCNT=1 DIC("A")="                 and  "
  1.  . Q:$G(TIUQUIT)=1
  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
  1.  . W !!,$S(TIUCNT>1:"The following DOCUMENT TITLES will NOT be INACTIVATED: ",1:"The following DOCUMENT TITLE will NOT be INACTIVATED: "),!!
  1.  . S X="" F  S X=$O(TIUOMIT(X)) Q:X=""  W ?5,$$GET1^DIQ(8925.1,X_",",.01),!
  1.  . S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="YES"
  1.  . D ^DIR I +Y'=1 W !! K TIUOMIT S:Y=U TIUQUIT=1 Q
  1.  . S TIUCONT=1
  1.  Q
  1. SPACER(TEXT,LENGTH,REV) ;
  1.  N SPACER
  1.  S SPACER=""
  1.  S $P(SPACER," ",(LENGTH-$L(TEXT)))=" "
  1.  S:'$D(REV) TEXT=TEXT_SPACER
  1.  S:$D(REV) TEXT=SPACER_TEXT
  1.  Q TEXT
  1. UPDATE ; updates status field of TIU Document Title to INACTIVE
  1.  N TIUDA,TIUMSG,TIUUPDT
  1.  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")
  1.  Q