XLFNAME3 ;CIOFO-SF/MKO-CONVERSION OF NEW PERSON FILE ENTRIES ;10:39 AM 10 Mar 2000
;;8.0;KERNEL;**134**;Jul 10, 1995
;
NEWPERS(XUFLAG,XUIEN) ;Convert New Person file names
;In: XUFLAG [ "C" : Update Name Components file (#20) and pointer
; [ "K" : Kill ^XTMP("XLFNAME") up front
; [ "P" : Update New Person Names
; [ "R" : Record changes/problems in ^XTMP
; XUIEN = ien of last record converted;
; conversion will begin with the next record
;
N XUCNT,XUDEG,XUF,XUIENL,XUIENS,XUMSG,XUNAM,XUNMSP,XUNODEGT,XUNOTRIG
N XUNOSIGT,XUPVAL,XUSTOP,XPDIDTOT,I
S XUFLAG=$G(XUFLAG)_"M35"
S (XUNOTRIG,XUNOSIGT,XUNODEGT)=1
S XUNMSP="XLFNAME",XUCNT=0
;
K:XUFLAG["K" ^XTMP("XLFNAME")
S:XUFLAG["R" $P(^XTMP(XUNMSP,0),U,1,2)=$$FMADD^XLFDT(DT,90)_"^"_DT
;
;Loop through New Person file
I '$D(ZTQUEUED),'$D(XPDNM) D
. W !!," NOTE: To cancel this process, type '^' at any time."
. W !," Please wait..."
;
S XUIEN=+$G(XUIEN)
;
;Get XPDIDTOT = total number of entries to convert
I XUFLAG["P" D
. I 'XUIEN S XPDIDTOT=$P($G(^VA(200,0)),U,4) Q:XPDIDTOT>0
. S XUMSG=" Obtaining number of entries to convert. Please wait..."
. I '$D(XPDNM) W !,XUMSG
. E D MES^XPDUTL(XUMSG)
. K XUMSG
. S I=XUIEN,XPDIDTOT=0
. F S I=$O(^VA(200,I)) Q:'I S:$P($G(^(I,0)),U)]"" XPDIDTOT=XPDIDTOT+1
. S:'XUIEN $P(^VA(200,0),U,4)=XPDIDTOT
;
S XUMSG=" Converting New Person Names..."
I '$D(XPDNM) W !,XUMSG
E D MES^XPDUTL(XUMSG)
K XUMSG
;
S XUSTOP=0
F S XUIEN=$O(^VA(200,XUIEN)) Q:'XUIEN D D STPCHK Q:XUSTOP
. S XUNAM=$P($G(^VA(200,XUIEN,0)),U)
. I XUNAM=""!$D(^VA(200,XUIEN,-9))!(XUNAM?1"MERGING INTO".E) Q
. S XUIENS=XUIEN_","
. ;
. S XUPVAL=$P($G(^VA(200,XUIEN,3.1)),U)
. S XUDEG=$P($G(^VA(200,XUIEN,3.1)),U,6)
. ;
. ;Process .01 field of file 200
. S XUF=$S(XUNAM="POSTMASTER"&(XUIEN=.5):$TR(XUFLAG,"R"),1:XUFLAG)
. D UPDATE(XUF,200,XUIENS,.01,XUNAM,10.1,XUPVAL,XUNMSP,XUDEG) K XUF
. ;
. ;Remember this ien if entries are being converted
. I XUFLAG["P",XUFLAG["R" S $P(^XTMP(XUNMSP,0),U,4)=XUIEN
;
S XUMSG(1)=$S(XUSTOP:" Process cancelled.",1:" DONE!")
S XUMSG(2)=" Number of records processed: "_XUCNT
S:XUCNT XUMSG(3)=" Entry number last processed: "_$G(XUIENL)
I '$D(XPDNM) W ! F I=1:1:3 W:$D(XUMSG(I))#2 !,XUMSG(I)
E D MES^XPDUTL(.XUMSG)
Q
;
STPCHK ;Every 200 records, check whether to stop
S XUCNT=XUCNT+1,XUIENL=XUIEN
D:'(XUCNT#200)
. I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,XUSTOP)=1 Q
. I '$D(ZTQUEUED),'$D(XPDNM) W "." I $$STOP S XUSTOP=1 Q
. I '$D(ZTQUEUED),$D(XPDNM) D UPDATE^XPDID(XUCNT)
Q
;
UPDATE(XUFLAG,XUFIL,XUIENS,XUFLD,XUNAM,XUPTR,XUPVAL,XUNMSP,XUDEG) ;Process name field
N XUAUD,XUDA,XUFDA,XUMAX,XUMSG,XUORIG,DIERR
S XUFLAG=$G(XUFLAG)
I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
;
;Get maximum length of standard name
S XUMAX=+$P(XUFLAG,"M",2,999)
;
;Standardize/parse name; Record uncertainties in ^XTMP
D STDNAME^XLFNAME(.XUNAM,"CP",.XUAUD)
I XUMAX,$L(XUNAM)>XUMAX D
. S XUNAM=$$NAMEFMT^XLFNAME(.XUNC,"F","CSL"_+$G(XUMAX))
. S XUAUD("TRUNC")=""
S:$D(XUAUD("STRIP")) XUNAM("NOTES")=XUAUD
S:XUNAM'=XUAUD XUAUD("DIFFERENT")=""
I $D(XUAUD)>9,XUFLAG["R" D RECORD(XUFIL,XUFLD,XUIENS,.XUNAM,.XUAUD,XUNMSP)
;
;Update file #20 and pointer to file #20
I XUFLAG["C" D
. S:$D(XUDEG)#2 XUNAM("DEGREE")=XUDEG
. D UPDCOMP^XLFNAME2(XUFIL,XUIENS,XUFLD,.XUNAM,XUPTR,.XUPVAL)
;
;Update source name if different
I XUFLAG["P",XUNAM'=XUAUD D
. S XUFDA(XUFIL,XUIENS,XUFLD)=XUNAM
. D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
Q
;
RECORD(XUFIL,XUFLD,XUREC,XUNAM,XUAUD,XUNMSP) ;Record problems in ^XTMP
N XUIENS,XUINV
Q:$G(XUNMSP)=""
;
;Get IENS from XUREC
I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
E S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
S XUINV=$$INV(XUIENS)
;
;Record values
K ^XTMP(XUNMSP,XUFIL,XUFLD,XUINV)
M ^XTMP(XUNMSP,XUFIL,XUFLD,XUINV)=XUAUD
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"))
Q
;
STOP() ;Check whether to stop
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
R Y#1:0 Q:Y="" 0
F R *X:0 E Q
Q:Y'=U 0
S DIR(0)="Y",DIR("A")="Are you sure you want to stop",DIR("B")="NO"
S:XUFLAG["P" DIR("?")="If you stop a conversion, you can continue later where you left off."
W ! D ^DIR
Q Y=1
;
INV(IENS) ;Invert the IENS
N I,X
Q:IENS?."," ""
S:IENS'?.E1"," IENS=IENS_","
S X="" F I=$L(IENS,",")-1:-1:1 S X=X_$P(IENS,",",I)_":"
S:X?.E1":" X=$E(X,1,$L(X)-1)
Q X
;
PRE ;The Pre-Install entry point
N XUMSG,DIERR
;
;Delete the "AF"-xref on 200,.01
I $P($G(^DD(200,.01,1,3,0)),U,2)="AF" D
. D DELIX^DDMOD(200,.01,3,"","","XUMSG")
. I '$G(DIERR),$D(XPDNM) D BMES^XPDUTL("The 'AF' cross-reference on file #200, field #.01 was deleted.")
;
;Delete the traditional "B" index on 200,.01
I $P($G(^DD(200,.01,1,1,0)),U,2)="B" D
. D DELIX^DDMOD(200,.01,1,"","","XUMSG")
Q
;
POST ;The Post-Install entry point (run conversion)
N XUIEN,XUNMSP
S XUNMSP="XLFNAME"
S XUIEN=+$P($G(^XTMP(XUNMSP,0)),U,4)
D NEWPERS("CPR"_$E("K",'XUIEN),+XUIEN)
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)"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFNAME3 5364 printed Sep 23, 2025@19:39 Page 2
XLFNAME3 ;CIOFO-SF/MKO-CONVERSION OF NEW PERSON FILE ENTRIES ;10:39 AM 10 Mar 2000
+1 ;;8.0;KERNEL;**134**;Jul 10, 1995
+2 ;
NEWPERS(XUFLAG,XUIEN) ;Convert New Person file names
+1 ;In: XUFLAG [ "C" : Update Name Components file (#20) and pointer
+2 ; [ "K" : Kill ^XTMP("XLFNAME") up front
+3 ; [ "P" : Update New Person Names
+4 ; [ "R" : Record changes/problems in ^XTMP
+5 ; XUIEN = ien of last record converted;
+6 ; conversion will begin with the next record
+7 ;
+8 NEW XUCNT,XUDEG,XUF,XUIENL,XUIENS,XUMSG,XUNAM,XUNMSP,XUNODEGT,XUNOTRIG
+9 NEW XUNOSIGT,XUPVAL,XUSTOP,XPDIDTOT,I
+10 SET XUFLAG=$GET(XUFLAG)_"M35"
+11 SET (XUNOTRIG,XUNOSIGT,XUNODEGT)=1
+12 SET XUNMSP="XLFNAME"
SET XUCNT=0
+13 ;
+14 if XUFLAG["K"
KILL ^XTMP("XLFNAME")
+15 if XUFLAG["R"
SET $PIECE(^XTMP(XUNMSP,0),U,1,2)=$$FMADD^XLFDT(DT,90)_"^"_DT
+16 ;
+17 ;Loop through New Person file
+18 IF '$DATA(ZTQUEUED)
IF '$DATA(XPDNM)
Begin DoDot:1
+19 WRITE !!," NOTE: To cancel this process, type '^' at any time."
+20 WRITE !," Please wait..."
End DoDot:1
+21 ;
+22 SET XUIEN=+$GET(XUIEN)
+23 ;
+24 ;Get XPDIDTOT = total number of entries to convert
+25 IF XUFLAG["P"
Begin DoDot:1
+26 IF 'XUIEN
SET XPDIDTOT=$PIECE($GET(^VA(200,0)),U,4)
if XPDIDTOT>0
QUIT
+27 SET XUMSG=" Obtaining number of entries to convert. Please wait..."
+28 IF '$DATA(XPDNM)
WRITE !,XUMSG
+29 IF '$TEST
DO MES^XPDUTL(XUMSG)
+30 KILL XUMSG
+31 SET I=XUIEN
SET XPDIDTOT=0
+32 FOR
SET I=$ORDER(^VA(200,I))
if 'I
QUIT
if $PIECE($GET(^(I,0)),U)]""
SET XPDIDTOT=XPDIDTOT+1
+33 if 'XUIEN
SET $PIECE(^VA(200,0),U,4)=XPDIDTOT
End DoDot:1
+34 ;
+35 SET XUMSG=" Converting New Person Names..."
+36 IF '$DATA(XPDNM)
WRITE !,XUMSG
+37 IF '$TEST
DO MES^XPDUTL(XUMSG)
+38 KILL XUMSG
+39 ;
+40 SET XUSTOP=0
+41 FOR
SET XUIEN=$ORDER(^VA(200,XUIEN))
if 'XUIEN
QUIT
Begin DoDot:1
+42 SET XUNAM=$PIECE($GET(^VA(200,XUIEN,0)),U)
+43 IF XUNAM=""!$DATA(^VA(200,XUIEN,-9))!(XUNAM?1"MERGING INTO".E)
QUIT
+44 SET XUIENS=XUIEN_","
+45 ;
+46 SET XUPVAL=$PIECE($GET(^VA(200,XUIEN,3.1)),U)
+47 SET XUDEG=$PIECE($GET(^VA(200,XUIEN,3.1)),U,6)
+48 ;
+49 ;Process .01 field of file 200
+50 SET XUF=$SELECT(XUNAM="POSTMASTER"&(XUIEN=.5):$TRANSLATE(XUFLAG,"R"),1:XUFLAG)
+51 DO UPDATE(XUF,200,XUIENS,.01,XUNAM,10.1,XUPVAL,XUNMSP,XUDEG)
KILL XUF
+52 ;
+53 ;Remember this ien if entries are being converted
+54 IF XUFLAG["P"
IF XUFLAG["R"
SET $PIECE(^XTMP(XUNMSP,0),U,4)=XUIEN
End DoDot:1
DO STPCHK
if XUSTOP
QUIT
+55 ;
+56 SET XUMSG(1)=$SELECT(XUSTOP:" Process cancelled.",1:" DONE!")
+57 SET XUMSG(2)=" Number of records processed: "_XUCNT
+58 if XUCNT
SET XUMSG(3)=" Entry number last processed: "_$GET(XUIENL)
+59 IF '$DATA(XPDNM)
WRITE !
FOR I=1:1:3
if $DATA(XUMSG(I))#2
WRITE !,XUMSG(I)
+60 IF '$TEST
DO MES^XPDUTL(.XUMSG)
+61 QUIT
+62 ;
STPCHK ;Every 200 records, check whether to stop
+1 SET XUCNT=XUCNT+1
SET XUIENL=XUIEN
+2 if '(XUCNT#200)
Begin DoDot:1
+3 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,XUSTOP)=1
QUIT
+4 IF '$DATA(ZTQUEUED)
IF '$DATA(XPDNM)
WRITE "."
IF $$STOP
SET XUSTOP=1
QUIT
+5 IF '$DATA(ZTQUEUED)
IF $DATA(XPDNM)
DO UPDATE^XPDID(XUCNT)
End DoDot:1
+6 QUIT
+7 ;
UPDATE(XUFLAG,XUFIL,XUIENS,XUFLD,XUNAM,XUPTR,XUPVAL,XUNMSP,XUDEG) ;Process name field
+1 NEW XUAUD,XUDA,XUFDA,XUMAX,XUMSG,XUORIG,DIERR
+2 SET XUFLAG=$GET(XUFLAG)
+3 IF '$GET(XUNOTRIG)
NEW XUNOTRIG
SET XUNOTRIG=1
+4 ;
+5 ;Get maximum length of standard name
+6 SET XUMAX=+$PIECE(XUFLAG,"M",2,999)
+7 ;
+8 ;Standardize/parse name; Record uncertainties in ^XTMP
+9 DO STDNAME^XLFNAME(.XUNAM,"CP",.XUAUD)
+10 IF XUMAX
IF $LENGTH(XUNAM)>XUMAX
Begin DoDot:1
+11 SET XUNAM=$$NAMEFMT^XLFNAME(.XUNC,"F","CSL"_+$GET(XUMAX))
+12 SET XUAUD("TRUNC")=""
End DoDot:1
+13 if $DATA(XUAUD("STRIP"))
SET XUNAM("NOTES")=XUAUD
+14 if XUNAM'=XUAUD
SET XUAUD("DIFFERENT")=""
+15 IF $DATA(XUAUD)>9
IF XUFLAG["R"
DO RECORD(XUFIL,XUFLD,XUIENS,.XUNAM,.XUAUD,XUNMSP)
+16 ;
+17 ;Update file #20 and pointer to file #20
+18 IF XUFLAG["C"
Begin DoDot:1
+19 if $DATA(XUDEG)#2
SET XUNAM("DEGREE")=XUDEG
+20 DO UPDCOMP^XLFNAME2(XUFIL,XUIENS,XUFLD,.XUNAM,XUPTR,.XUPVAL)
End DoDot:1
+21 ;
+22 ;Update source name if different
+23 IF XUFLAG["P"
IF XUNAM'=XUAUD
Begin DoDot:1
+24 SET XUFDA(XUFIL,XUIENS,XUFLD)=XUNAM
+25 DO FILE^DIE("","XUFDA","XUMSG")
KILL DIERR,XUMSG
End DoDot:1
+26 QUIT
+27 ;
RECORD(XUFIL,XUFLD,XUREC,XUNAM,XUAUD,XUNMSP) ;Record problems in ^XTMP
+1 NEW XUIENS,XUINV
+2 if $GET(XUNMSP)=""
QUIT
+3 ;
+4 ;Get IENS from XUREC
+5 IF $GET(XUREC)'[","
SET XUIENS=$$IENS^DILF(.XUREC)
+6 IF '$TEST
SET XUIENS=XUREC
if XUIENS'?.E1","
SET XUIENS=XUIENS_","
+7 SET XUINV=$$INV(XUIENS)
+8 ;
+9 ;Record values
+10 KILL ^XTMP(XUNMSP,XUFIL,XUFLD,XUINV)
+11 MERGE ^XTMP(XUNMSP,XUFIL,XUFLD,XUINV)=XUAUD
+12 SET $PIECE(^XTMP(XUNMSP,XUFIL,XUFLD,XUINV),U,2,6)=XUNAM_U_$GET(XUNAM("GIVEN"))_U_$GET(XUNAM("MIDDLE"))_U_$GET(XUNAM("FAMILY"))_U_$GET(XUNAM("SUFFIX"))
+13 QUIT
+14 ;
STOP() ;Check whether to stop
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 READ Y#1:0
if Y=""
QUIT 0
+3 FOR
READ *X:0
IF '$TEST
QUIT
+4 if Y'=U
QUIT 0
+5 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to stop"
SET DIR("B")="NO"
+6 if XUFLAG["P"
SET DIR("?")="If you stop a conversion, you can continue later where you left off."
+7 WRITE !
DO ^DIR
+8 QUIT Y=1
+9 ;
INV(IENS) ;Invert the IENS
+1 NEW I,X
+2 if IENS?.","
QUIT ""
+3 if IENS'?.E1","
SET IENS=IENS_","
+4 SET X=""
FOR I=$LENGTH(IENS,",")-1:-1:1
SET X=X_$PIECE(IENS,",",I)_":"
+5 if X?.E1"
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+6 QUIT X
+7 ;
PRE ;The Pre-Install entry point
+1 NEW XUMSG,DIERR
+2 ;
+3 ;Delete the "AF"-xref on 200,.01
+4 IF $PIECE($GET(^DD(200,.01,1,3,0)),U,2)="AF"
Begin DoDot:1
+5 DO DELIX^DDMOD(200,.01,3,"","","XUMSG")
+6 IF '$GET(DIERR)
IF $DATA(XPDNM)
DO BMES^XPDUTL("The 'AF' cross-reference on file #200, field #.01 was deleted.")
End DoDot:1
+7 ;
+8 ;Delete the traditional "B" index on 200,.01
+9 IF $PIECE($GET(^DD(200,.01,1,1,0)),U,2)="B"
Begin DoDot:1
+10 DO DELIX^DDMOD(200,.01,1,"","","XUMSG")
End DoDot:1
+11 QUIT
+12 ;
POST ;The Post-Install entry point (run conversion)
+1 NEW XUIEN,XUNMSP
+2 SET XUNMSP="XLFNAME"
+3 SET XUIEN=+$PIECE($GET(^XTMP(XUNMSP,0)),U,4)
+4 DO NEWPERS("CPR"_$EXTRACT("K",'XUIEN),+XUIEN)
+5 IF $DATA(^XTMP(XUNMSP,0))#2
IF XUIEN'=+$PIECE(^(0),U,4)
SET $PIECE(^(0),U,3)="Created by POST~XLFNAME (Post Install Conversion of XU*8.0*134)"
+6 QUIT
