source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFZZ8.m@ 1407

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1TIUFZZ8 ; SLC/MAM - Post Patch TIU*1*27 Cleanup. Scratch. Updates fld .04 for documents in TIU DOCUMENT FILE ;8/27/97 14:02
2 ;;1.0;TEXT INTEGRATION UTILITIES;**27**;Jun 20, 1997
3 ;
4ZZUPDATE ; Update Parent Document Type for all documents, one title at a time. Scratch tool, needed by sites that have moved documents before having patch 27.
5 S %ZIS="Q" D ^%ZIS I POP G UPDAX
6 I '$D(IO("Q")) G ZZUP1
7 S ZTRTN="ZZUP1^TIUFZZ8",ZTDESC="TIU Document File - Update Parent Document Type"
8 D ^%ZTLOAD G UPDAX
9 ;
10ZZUP1 N TITLEDA,FILEDA,NUPDATE,TIUFMOVE
11 S TIUFMOVE="",(TITLEDA,NUPDATE)=0 W !!
12 K ^XTMP("TIUFZZ8"),^XTMP("TIUFZZ8P")
13 S ^XTMP("TIUFZZ8",0)=+$$FMADD^XLFDT(DT,30)_U_DT
14 S ^XTMP("TIUFZZ8P",0)=+$$FMADD^XLFDT(DT,30)_U_DT
15 F S TITLEDA=$O(^TIU(8925.1,"AT","DOC",TITLEDA)) Q:'TITLEDA K ^XTMP("TIUFMOVE"_TITLEDA) D:$D(^TIU(8925,"B",TITLEDA)) MTRPOINT(TITLEDA,.NUPDATE)
16 U IO
17 W !!!," *** RESULTS: TIU Document File - Update Parent Document Type ***",!
18 I NUPDATE D G UPDAX
19 . I $O(^XTMP("TIUFZZ8P",0)) D
20 . . W !!,"The following titles have documents but are orphan Titles. Please make sure you",!,"own each title. Then add them to the hierarchy using option Edit Document"
21 . . W !,"Definitions, action Items for the desired parent, action Add/Create. Then",!,"update each title, using action Update Documents (under action Copy/Move)."
22 . . W !,"If needed, this list can be found in ^XTMP(""TIUFZZ8P"",TITLEDA).",!
23 . . W !,"IEN Title:"
24 . . S TITLEDA=0 F S TITLEDA=$O(^XTMP("TIUFZZ8P",TITLEDA)) Q:'TITLEDA W !,TITLEDA," ",$P(^TIU(8925.1,TITLEDA,0),U)
25 . I $O(^XTMP("TIUFZZ8",0)) D
26 . . W !!,"The following titles have documents that were not able to be updated. Please",!,"update them, using regular Document Definition action Update Documents"
27 . . W !,"(under action Copy/Move) for each listed title. If needed, this list can be",!,"found in ^XTMP(""TIUFZZ8"",TITLEDA).",!
28 . . W !,"IEN Title:"
29 . . S TITLEDA=0 F S TITLEDA=$O(^XTMP("TIUFZZ8",TITLEDA)) Q:'TITLEDA W !,TITLEDA," ",$P(^TIU(8925.1,TITLEDA,0),U)
30 W !!,"All documents updated for all Titles.",!
31 K ^XTMP("TIUFZZ8"),^XTMP("TIUFZZ8P")
32UPDAX D ^%ZISC,HOME^%ZIS
33 I $D(ZTQUEUED) S ZTREQ="@"
34 Q
35 ;
36MTRPOINT(TITLEDA,NUPDATE) ; Repoints PARENT DOCUMENT TYPE to parent of TITLEDA for documents using title TITLEDA.
37 N DIE,DR,DA,FILEDA,XDCDA,NOLOCK,TIUFI
38 Q:TITLEDA=81 ;ADDENDUM
39 I $E(IOST,1,2)="C-" W !!,"Processing documents that use Title ",TITLEDA," ..."
40 S (FILEDA,NOLOCK,TIUFI)=0,XDCDA=+$O(^TIU(8925.1,"AD",TITLEDA,0))
41 I 'XDCDA D Q
42 . I $O(^TIU(8925,"B",TITLEDA,FILEDA)) S ^XTMP("TIUFZZ8P",TITLEDA)="",NUPDATE=1
43 F S FILEDA=$O(^TIU(8925,"B",TITLEDA,FILEDA)) Q:'FILEDA D
44 . S TIUFI=TIUFI+1
45 . I $E(IOST,1,2)="C-",(TIUFI#1000)=1 W "."
46 . D MTRPT1(TITLEDA,FILEDA,XDCDA,.NOLOCK)
47 I NOLOCK D Q
48 . S NUPDATE=1,^XTMP("TIUFZZ8",TITLEDA)=""
49 . S ^XTMP("TIUFMOVE"_TITLEDA,0)=+$$FMADD^XLFDT(DT,30)_U_DT
50 . S ^XTMP("TIUFMOVE"_TITLEDA,"ONCETHRU")=""
51 Q
52 ;
53MTRPT1(TITLEDA,DA,XDCDA,NOLOCK) ; Repoint 1 docmt for Move TL.
54 ; Requires TITLEDA,DA,XDCDA.
55 I '$G(^TIU(8925,DA,0)) W !!,"Document ",DA,", from B Cross Reference, doesn't exist in file 8925.",! Q
56 I XDCDA=$P(^TIU(8925,DA,0),U,4) Q ; Parent Docmt Type already ok.
57 L +^TIU(8925,DA,0):1 I '$T S NOLOCK=1 S ^XTMP("TIUFMOVE"_TITLEDA,DA)="" Q
58 S DR=".04////"_XDCDA,DIE=8925 D ^DIE
59 L -^TIU(8925,DA,0)
60 Q
61 ;
Note: See TracBrowser for help on using the repository browser.