source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XLFNAME3.m@ 1800

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1XLFNAME3 ;CIOFO-SF/MKO-CONVERSION OF NEW PERSON FILE ENTRIES ;10:39 AM 10 Mar 2000
2 ;;8.0;KERNEL;**134**;Jul 10, 1995
3 ;
4NEWPERS(XUFLAG,XUIEN) ;Convert New Person file names
5 ;In: XUFLAG [ "C" : Update Name Components file (#20) and pointer
6 ; [ "K" : Kill ^XTMP("XLFNAME") up front
7 ; [ "P" : Update New Person Names
8 ; [ "R" : Record changes/problems in ^XTMP
9 ; XUIEN = ien of last record converted;
10 ; conversion will begin with the next record
11 ;
12 N XUCNT,XUDEG,XUF,XUIENL,XUIENS,XUMSG,XUNAM,XUNMSP,XUNODEGT,XUNOTRIG
13 N XUNOSIGT,XUPVAL,XUSTOP,XPDIDTOT,I
14 S XUFLAG=$G(XUFLAG)_"M35"
15 S (XUNOTRIG,XUNOSIGT,XUNODEGT)=1
16 S XUNMSP="XLFNAME",XUCNT=0
17 ;
18 K:XUFLAG["K" ^XTMP("XLFNAME")
19 S:XUFLAG["R" $P(^XTMP(XUNMSP,0),U,1,2)=$$FMADD^XLFDT(DT,90)_"^"_DT
20 ;
21 ;Loop through New Person file
22 I '$D(ZTQUEUED),'$D(XPDNM) D
23 . W !!," NOTE: To cancel this process, type '^' at any time."
24 . W !," Please wait..."
25 ;
26 S XUIEN=+$G(XUIEN)
27 ;
28 ;Get XPDIDTOT = total number of entries to convert
29 I XUFLAG["P" D
30 . I 'XUIEN S XPDIDTOT=$P($G(^VA(200,0)),U,4) Q:XPDIDTOT>0
31 . S XUMSG=" Obtaining number of entries to convert. Please wait..."
32 . I '$D(XPDNM) W !,XUMSG
33 . E D MES^XPDUTL(XUMSG)
34 . K XUMSG
35 . S I=XUIEN,XPDIDTOT=0
36 . F S I=$O(^VA(200,I)) Q:'I S:$P($G(^(I,0)),U)]"" XPDIDTOT=XPDIDTOT+1
37 . S:'XUIEN $P(^VA(200,0),U,4)=XPDIDTOT
38 ;
39 S XUMSG=" Converting New Person Names..."
40 I '$D(XPDNM) W !,XUMSG
41 E D MES^XPDUTL(XUMSG)
42 K XUMSG
43 ;
44 S XUSTOP=0
45 F S XUIEN=$O(^VA(200,XUIEN)) Q:'XUIEN D D STPCHK Q:XUSTOP
46 . S XUNAM=$P($G(^VA(200,XUIEN,0)),U)
47 . I XUNAM=""!$D(^VA(200,XUIEN,-9))!(XUNAM?1"MERGING INTO".E) Q
48 . S XUIENS=XUIEN_","
49 . ;
50 . S XUPVAL=$P($G(^VA(200,XUIEN,3.1)),U)
51 . S XUDEG=$P($G(^VA(200,XUIEN,3.1)),U,6)
52 . ;
53 . ;Process .01 field of file 200
54 . S XUF=$S(XUNAM="POSTMASTER"&(XUIEN=.5):$TR(XUFLAG,"R"),1:XUFLAG)
55 . D UPDATE(XUF,200,XUIENS,.01,XUNAM,10.1,XUPVAL,XUNMSP,XUDEG) K XUF
56 . ;
57 . ;Remember this ien if entries are being converted
58 . I XUFLAG["P",XUFLAG["R" S $P(^XTMP(XUNMSP,0),U,4)=XUIEN
59 ;
60 S XUMSG(1)=$S(XUSTOP:" Process cancelled.",1:" DONE!")
61 S XUMSG(2)=" Number of records processed: "_XUCNT
62 S:XUCNT XUMSG(3)=" Entry number last processed: "_$G(XUIENL)
63 I '$D(XPDNM) W ! F I=1:1:3 W:$D(XUMSG(I))#2 !,XUMSG(I)
64 E D MES^XPDUTL(.XUMSG)
65 Q
66 ;
67STPCHK ;Every 200 records, check whether to stop
68 S XUCNT=XUCNT+1,XUIENL=XUIEN
69 D:'(XUCNT#200)
70 . I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,XUSTOP)=1 Q
71 . I '$D(ZTQUEUED),'$D(XPDNM) W "." I $$STOP S XUSTOP=1 Q
72 . I '$D(ZTQUEUED),$D(XPDNM) D UPDATE^XPDID(XUCNT)
73 Q
74 ;
75UPDATE(XUFLAG,XUFIL,XUIENS,XUFLD,XUNAM,XUPTR,XUPVAL,XUNMSP,XUDEG) ;Process name field
76 N XUAUD,XUDA,XUFDA,XUMAX,XUMSG,XUORIG,DIERR
77 S XUFLAG=$G(XUFLAG)
78 I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
79 ;
80 ;Get maximum length of standard name
81 S XUMAX=+$P(XUFLAG,"M",2,999)
82 ;
83 ;Standardize/parse name; Record uncertainties in ^XTMP
84 D STDNAME^XLFNAME(.XUNAM,"CP",.XUAUD)
85 I XUMAX,$L(XUNAM)>XUMAX D
86 . S XUNAM=$$NAMEFMT^XLFNAME(.XUNC,"F","CSL"_+$G(XUMAX))
87 . S XUAUD("TRUNC")=""
88 S:$D(XUAUD("STRIP")) XUNAM("NOTES")=XUAUD
89 S:XUNAM'=XUAUD XUAUD("DIFFERENT")=""
90 I $D(XUAUD)>9,XUFLAG["R" D RECORD(XUFIL,XUFLD,XUIENS,.XUNAM,.XUAUD,XUNMSP)
91 ;
92 ;Update file #20 and pointer to file #20
93 I XUFLAG["C" D
94 . S:$D(XUDEG)#2 XUNAM("DEGREE")=XUDEG
95 . D UPDCOMP^XLFNAME2(XUFIL,XUIENS,XUFLD,.XUNAM,XUPTR,.XUPVAL)
96 ;
97 ;Update source name if different
98 I XUFLAG["P",XUNAM'=XUAUD D
99 . S XUFDA(XUFIL,XUIENS,XUFLD)=XUNAM
100 . D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
101 Q
102 ;
103RECORD(XUFIL,XUFLD,XUREC,XUNAM,XUAUD,XUNMSP) ;Record problems in ^XTMP
104 N XUIENS,XUINV
105 Q:$G(XUNMSP)=""
106 ;
107 ;Get IENS from XUREC
108 I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
109 E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
110 S XUINV=$$INV(XUIENS)
111 ;
112 ;Record values
113 K ^XTMP(XUNMSP,XUFIL,XUFLD,XUINV)
114 M ^XTMP(XUNMSP,XUFIL,XUFLD,XUINV)=XUAUD
115 S $P(^XTMP(XUNMSP,XUFIL,XUFLD,XUINV),U,2,6)=XUNAM_U_$G(XUNAM("GIVEN"))_U_$G(XUNAM("MIDDLE"))_U_$G(XUNAM("FAMILY"))_U_$G(XUNAM("SUFFIX"))
116 Q
117 ;
118STOP() ;Check whether to stop
119 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
120 R Y#1:0 Q:Y="" 0
121 F R *X:0 E Q
122 Q:Y'=U 0
123 S DIR(0)="Y",DIR("A")="Are you sure you want to stop",DIR("B")="NO"
124 S:XUFLAG["P" DIR("?")="If you stop a conversion, you can continue later where you left off."
125 W ! D ^DIR
126 Q Y=1
127 ;
128INV(IENS) ;Invert the IENS
129 N I,X
130 Q:IENS?."," ""
131 S:IENS'?.E1"," IENS=IENS_","
132 S X="" F I=$L(IENS,",")-1:-1:1 S X=X_$P(IENS,",",I)_":"
133 S:X?.E1":" X=$E(X,1,$L(X)-1)
134 Q X
135 ;
136PRE ;The Pre-Install entry point
137 N XUMSG,DIERR
138 ;
139 ;Delete the "AF"-xref on 200,.01
140 I $P($G(^DD(200,.01,1,3,0)),U,2)="AF" D
141 . D DELIX^DDMOD(200,.01,3,"","","XUMSG")
142 . I '$G(DIERR),$D(XPDNM) D BMES^XPDUTL("The 'AF' cross-reference on file #200, field #.01 was deleted.")
143 ;
144 ;Delete the traditional "B" index on 200,.01
145 I $P($G(^DD(200,.01,1,1,0)),U,2)="B" D
146 . D DELIX^DDMOD(200,.01,1,"","","XUMSG")
147 Q
148 ;
149POST ;The Post-Install entry point (run conversion)
150 N XUIEN,XUNMSP
151 S XUNMSP="XLFNAME"
152 S XUIEN=+$P($G(^XTMP(XUNMSP,0)),U,4)
153 D NEWPERS("CPR"_$E("K",'XUIEN),+XUIEN)
154 I $D(^XTMP(XUNMSP,0))#2,XUIEN'=+$P(^(0),U,4) S $P(^(0),U,3)="Created by POST~XLFNAME (Post Install Conversion of XU*8.0*134)"
155 Q
Note: See TracBrowser for help on using the repository browser.