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

XLFNAME3.m

Go to the documentation of this file. 
  1. XLFNAME3 ;CIOFO-SF/MKO-CONVERSION OF NEW PERSON FILE ENTRIES ;10:39 AM  10 Mar 2000
  1.  ;;8.0;KERNEL;**134**;Jul 10, 1995
  1.  ;
  1. NEWPERS(XUFLAG,XUIEN) ;Convert New Person file names
  1.  ;In: XUFLAG [ "C"  : Update Name Components file (#20) and pointer
  1.  ;           [ "K"  : Kill ^XTMP("XLFNAME") up front
  1.  ;           [ "P"  : Update New Person Names
  1.  ;           [ "R"  : Record changes/problems in ^XTMP
  1.  ;    XUIEN  = ien of last record converted;
  1.  ;             conversion will begin with the next record
  1.  ;
  1.  N XUCNT,XUDEG,XUF,XUIENL,XUIENS,XUMSG,XUNAM,XUNMSP,XUNODEGT,XUNOTRIG
  1.  N XUNOSIGT,XUPVAL,XUSTOP,XPDIDTOT,I
  1.  S XUFLAG=$G(XUFLAG)_"M35"
  1.  S (XUNOTRIG,XUNOSIGT,XUNODEGT)=1
  1.  S XUNMSP="XLFNAME",XUCNT=0
  1.  ;
  1.  K:XUFLAG["K" ^XTMP("XLFNAME")
  1.  S:XUFLAG["R" $P(^XTMP(XUNMSP,0),U,1,2)=$$FMADD^XLFDT(DT,90)_"^"_DT
  1.  ;
  1.  ;Loop through New Person file
  1.  I '$D(ZTQUEUED),'$D(XPDNM) D
  1.  . W !!," NOTE: To cancel this process, type '^' at any time."
  1.  . W !," Please wait..."
  1.  ;
  1.  S XUIEN=+$G(XUIEN)
  1.  ;
  1.  ;Get XPDIDTOT = total number of entries to convert
  1.  I XUFLAG["P" D
  1.  . I 'XUIEN S XPDIDTOT=$P($G(^VA(200,0)),U,4) Q:XPDIDTOT>0
  1.  . S XUMSG="   Obtaining number of entries to convert. Please wait..."
  1.  . I '$D(XPDNM) W !,XUMSG
  1.  . E  D MES^XPDUTL(XUMSG)
  1.  . K XUMSG
  1.  . S I=XUIEN,XPDIDTOT=0
  1.  . F  S I=$O(^VA(200,I)) Q:'I  S:$P($G(^(I,0)),U)]"" XPDIDTOT=XPDIDTOT+1
  1.  . S:'XUIEN $P(^VA(200,0),U,4)=XPDIDTOT
  1.  ;
  1.  S XUMSG="   Converting New Person Names..."
  1.  I '$D(XPDNM) W !,XUMSG
  1.  E  D MES^XPDUTL(XUMSG)
  1.  K XUMSG
  1.  ;
  1.  S XUSTOP=0
  1.  F  S XUIEN=$O(^VA(200,XUIEN)) Q:'XUIEN  D  D STPCHK Q:XUSTOP
  1.  . S XUNAM=$P($G(^VA(200,XUIEN,0)),U)
  1.  . I XUNAM=""!$D(^VA(200,XUIEN,-9))!(XUNAM?1"MERGING INTO".E) Q
  1.  . S XUIENS=XUIEN_","
  1.  . ;
  1.  . S XUPVAL=$P($G(^VA(200,XUIEN,3.1)),U)
  1.  . S XUDEG=$P($G(^VA(200,XUIEN,3.1)),U,6)
  1.  . ;
  1.  . ;Process .01 field of file 200
  1.  . S XUF=$S(XUNAM="POSTMASTER"&(XUIEN=.5):$TR(XUFLAG,"R"),1:XUFLAG)
  1.  . D UPDATE(XUF,200,XUIENS,.01,XUNAM,10.1,XUPVAL,XUNMSP,XUDEG) K XUF
  1.  . ;
  1.  . ;Remember this ien if entries are being converted
  1.  . I XUFLAG["P",XUFLAG["R" S $P(^XTMP(XUNMSP,0),U,4)=XUIEN
  1.  ;
  1.  S XUMSG(1)=$S(XUSTOP:"   Process cancelled.",1:"   DONE!")
  1.  S XUMSG(2)="   Number of records processed: "_XUCNT
  1.  S:XUCNT XUMSG(3)="   Entry number last processed: "_$G(XUIENL)
  1.  I '$D(XPDNM) W ! F I=1:1:3 W:$D(XUMSG(I))#2 !,XUMSG(I)
  1.  E  D MES^XPDUTL(.XUMSG)
  1.  Q
  1.  ;
  1. STPCHK ;Every 200 records, check whether to stop
  1.  S XUCNT=XUCNT+1,XUIENL=XUIEN
  1.  D:'(XUCNT#200)
  1.  . I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,XUSTOP)=1 Q
  1.  . I '$D(ZTQUEUED),'$D(XPDNM) W "." I $$STOP S XUSTOP=1 Q
  1.  . I '$D(ZTQUEUED),$D(XPDNM) D UPDATE^XPDID(XUCNT)
  1.  Q
  1.  ;
  1. UPDATE(XUFLAG,XUFIL,XUIENS,XUFLD,XUNAM,XUPTR,XUPVAL,XUNMSP,XUDEG) ;Process name field
  1.  N XUAUD,XUDA,XUFDA,XUMAX,XUMSG,XUORIG,DIERR
  1.  S XUFLAG=$G(XUFLAG)
  1.  I '$G(XUNOTRIG) N XUNOTRIG S XUNOTRIG=1
  1.  ;
  1.  ;Get maximum length of standard name
  1.  S XUMAX=+$P(XUFLAG,"M",2,999)
  1.  ;
  1.  ;Standardize/parse name; Record uncertainties in ^XTMP
  1.  D STDNAME^XLFNAME(.XUNAM,"CP",.XUAUD)
  1.  I XUMAX,$L(XUNAM)>XUMAX D
  1.  . S XUNAM=$$NAMEFMT^XLFNAME(.XUNC,"F","CSL"_+$G(XUMAX))
  1.  . S XUAUD("TRUNC")=""
  1.  S:$D(XUAUD("STRIP")) XUNAM("NOTES")=XUAUD
  1.  S:XUNAM'=XUAUD XUAUD("DIFFERENT")=""
  1.  I $D(XUAUD)>9,XUFLAG["R" D RECORD(XUFIL,XUFLD,XUIENS,.XUNAM,.XUAUD,XUNMSP)
  1.  ;
  1.  ;Update file #20 and pointer to file #20
  1.  I XUFLAG["C" D
  1.  . S:$D(XUDEG)#2 XUNAM("DEGREE")=XUDEG
  1.  . D UPDCOMP^XLFNAME2(XUFIL,XUIENS,XUFLD,.XUNAM,XUPTR,.XUPVAL)
  1.  ;
  1.  ;Update source name if different
  1.  I XUFLAG["P",XUNAM'=XUAUD D
  1.  . S XUFDA(XUFIL,XUIENS,XUFLD)=XUNAM
  1.  . D FILE^DIE("","XUFDA","XUMSG") K DIERR,XUMSG
  1.  Q
  1.  ;
  1. RECORD(XUFIL,XUFLD,XUREC,XUNAM,XUAUD,XUNMSP) ;Record problems in ^XTMP
  1.  N XUIENS,XUINV
  1.  Q:$G(XUNMSP)=""
  1.  ;
  1.  ;Get IENS from XUREC
  1.  I $G(XUREC)'["," S XUIENS=$$IENS^DILF(.XUREC)
  1.  E  S XUIENS=XUREC S:XUIENS'?.E1"," XUIENS=XUIENS_","
  1.  S XUINV=$$INV(XUIENS)
  1.  ;
  1.  ;Record values
  1.  K ^XTMP(XUNMSP,XUFIL,XUFLD,XUINV)
  1.  M ^XTMP(XUNMSP,XUFIL,XUFLD,XUINV)=XUAUD
  1.  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"))
  1.  Q
  1.  ;
  1. STOP() ;Check whether to stop
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  R Y#1:0 Q:Y="" 0
  1.  F  R *X:0 E  Q
  1.  Q:Y'=U 0
  1.  S DIR(0)="Y",DIR("A")="Are you sure you want to stop",DIR("B")="NO"
  1.  S:XUFLAG["P" DIR("?")="If you stop a conversion, you can continue later where you left off."
  1.  W ! D ^DIR
  1.  Q Y=1
  1.  ;
  1. INV(IENS) ;Invert the IENS
  1.  N I,X
  1.  Q:IENS?."," ""
  1.  S:IENS'?.E1"," IENS=IENS_","
  1.  S X="" F I=$L(IENS,",")-1:-1:1 S X=X_$P(IENS,",",I)_":"
  1.  S:X?.E1":" X=$E(X,1,$L(X)-1)
  1.  Q X
  1.  ;
  1. PRE ;The Pre-Install entry point
  1.  N XUMSG,DIERR
  1.  ;
  1.  ;Delete the "AF"-xref on 200,.01
  1.  I $P($G(^DD(200,.01,1,3,0)),U,2)="AF" D
  1.  . D DELIX^DDMOD(200,.01,3,"","","XUMSG")
  1.  . I '$G(DIERR),$D(XPDNM) D BMES^XPDUTL("The 'AF' cross-reference on file #200, field #.01 was deleted.")
  1.  ;
  1.  ;Delete the traditional "B" index on 200,.01
  1.  I $P($G(^DD(200,.01,1,1,0)),U,2)="B" D
  1.  . D DELIX^DDMOD(200,.01,1,"","","XUMSG")
  1.  Q
  1.  ;
  1. POST ;The Post-Install entry point (run conversion)
  1.  N XUIEN,XUNMSP
  1.  S XUNMSP="XLFNAME"
  1.  S XUIEN=+$P($G(^XTMP(XUNMSP,0)),U,4)
  1.  D NEWPERS("CPR"_$E("K",'XUIEN),+XUIEN)
  1.  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)"
  1.  Q