Routine: XU8343R

XU8343R ;BPOIFO/DW - Post-install for XU*8*343 continued ; 14 April 2004

 ;;8.0;KERNEL;**343**; Jul 10, 1995;

NOTICE(XUT) ;Send a notification when the conversion process is stopped\done

 ;IN:

 ; XUT(1)=Number of records processed

 ; XUT(2)=Last processed IEN

 ; XUT(3)=Total NPF entries

 ; XUT(4)=1 if the conversion process was cancelled, 0 if it was done.

 ;If called within a task, protect variables

 N %,DIFROM

 ;I $D(ZTQUEUED) N %,DIFROM

 N RDT,Y

 D NOW^%DTC S Y=% X ^DD("DD")

 S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)

 N XMY,XMTEXT,XMDUZ,XUSUB,XUWHAT,XUSITE,XUPLACE,XUNUM,XUSTOP,XMSUB

 S XUSITE=$$SITE^VASITE

 S XUPLACE=$P(XUSITE,"^",2)

 S XUNUM=$P(XUSITE,"^",3)

 S XMDUZ=.5

 S XMY(DUZ)=""

 S XMY("G.XUPS IDENTITY MANAGEMENT@DOMAIN.NAME")=""

 S XMSUB="XUPS NPF NAME STANDARDIZATION - "_XUPLACE_"("_XUNUM_")"

 S XUSTOP=$S(XUT(4):"cancelled.",1:"DONE!")

 S XUWHAT(1)=" New Person file name conversion (XU*8*343) is "_XUSTOP

 S XUWHAT(2)=""

 S XUWHAT(3)="                 Facility Name: "_XUPLACE

 S XUWHAT(4)="                Station Number: "_XUNUM

 S XUWHAT(5)=""

 S XUWHAT(6)=" Total records to be processed: "_XUT(3)

 S XUWHAT(7)="   Number of records processed: "_XUT(1)

 S XUWHAT(8)="            Last IEN processed: "_XUT(2)

 S XUWHAT(9)=""

 S XUWHAT(10)="                    Date/Time: "_RDT

 S XMTEXT="XUWHAT("

 D ^XMD

HEADER(XULINE,XUSUB) ;Report Header

 N C1,C0

 S XULINE=XULINE+1

 S ^TMP(XUNMSP,$J,XULINE)=""

 I '$D(^XTMP(XUNMSP,XUSUB)) D  Q

 . S XULINE=XULINE+1

 . S ^TMP(XUNMSP,$J,XULINE)="None."

 I XUSUB="CHANGED" D

 . S C0=$$LJ^XLFSTR("IEN",15," ")

 . S C1=$$LJ^XLFSTR("NAME",35," ")

 . S XULINE=XULINE+1

 . S ^TMP(XUNMSP,$J,XULINE)=C0_" "_C1

 . S C1=$$LJ^XLFSTR("=============== ==============================",51," ")

 . S XULINE=XULINE+1

 . S ^TMP(XUNMSP,$J,XULINE)=C1

 I XUSUB="UNCHANGED" D

 . S C0=$$LJ^XLFSTR("IEN",15," ")

 . S C1=$$LJ^XLFSTR("NAME",35," ")

 . S XULINE=XULINE+1

 . S ^TMP(XUNMSP,$J,XULINE)=C0_" "_C1

 . S C1=$$LJ^XLFSTR("=============== ==============================",51," ")

 . S XULINE=XULINE+1

 . S ^TMP(XUNMSP,$J,XULINE)=C1

REPORT ;Report

 S:'$G(XUNMSP) XUNMSP="XUNAME"

 N XULINE,XUSUB,XUIEN,XUOLD,XUNEW,C1,C2,C0,C,XUC,XU20P

 S XULINE=0

 S C=$$LJ^XLFSTR(" ",15," ")

 F XUSUB="CHANGED","UNCHANGED" D

 . K ^TMP(XUNMSP,$J)

 . I XUSUB="CHANGED" S XUT="are converted"

 . I XUSUB="UNCHANGED" S XUT="could not be converted"

 . S XULINE=XULINE+1

 . S ^TMP(XUNMSP,$J,XULINE)="The following names "_XUT_":"

 . D HEADER(.XULINE,XUSUB)

 . S XUIEN=0 F  S XUIEN=$O(^XTMP(XUNMSP,XUSUB,XUIEN)) Q:XUIEN=""  D

 .. S XUOLD=$G(^XTMP(XUNMSP,XUSUB,XUIEN,"OLD"))

 .. S XUNEW=$G(^XTMP(XUNMSP,XUSUB,XUIEN,"NEW"))

 .. S XULINE=XULINE+1

 .. S C0=$$LJ^XLFSTR(XUIEN,15," ")

 .. S C1=$$LJ^XLFSTR(XUOLD,35," ")

 .. S C2=$$LJ^XLFSTR(XUNEW,35," ")

 .. I XUSUB="CHANGED" D

 ... S ^TMP(XUNMSP,$J,XULINE)=C0_" Old: "_C1

 ... S XULINE=XULINE+1

 ... S ^TMP(XUNMSP,$J,XULINE)=C_" New: "_C2

 ... K XUC D NMCOM(XUIEN,.XUC)

 ... S XULINE=XULINE+1

 ... S ^TMP(XUNMSP,$J,XULINE)=C_"      Given: "_$G(XUC("GIVEN"))

 ... S XULINE=XULINE+1

 ... S ^TMP(XUNMSP,$J,XULINE)=C_"     Middle: "_$G(XUC("MIDDLE"))

 ... S XULINE=XULINE+1

 ... S ^TMP(XUNMSP,$J,XULINE)=C_"     Family: "_$G(XUC("FAMILY"))

 ... S XULINE=XULINE+1

 ... S ^TMP(XUNMSP,$J,XULINE)=C_"     Suffix: "_$G(XUC("SUFFIX"))

 ... S XULINE=XULINE+1

 ... S ^TMP(XUNMSP,$J,XULINE)=""

 .. I XUSUB="UNCHANGED" S ^TMP(XUNMSP,$J,XULINE)=C0_" "_C1

 . D EMAIL(XUNMSP)

 . K ^TMP(XUNMSP,$J)

NMCOM(XUIEN,XUC) ;Get name components from file #20.

 N DIC,DR,DA,DIQ,XUR,XUCOM,XUI,XUCOMP,XUNC,C,XU20P,X,Y

 S XU20P=$P($G(^VA(200,XUIEN,3.1)),U)

 S DIC=20

 S DR="1;2;3;4;5;6"

 S DA=XU20P

 S DIQ="XUR"

 D EN^DIQ1

 S XUCOM="FAMILY^GIVEN^MIDDLE^PREFIX^SUFFIX^DEGREE"

 F XUI=1:1:6 D

 . S XUCOMP=$P(XUCOM,U,XUI)

 . S XUC(XUCOMP)=$G(XUR(20,XU20P,XUI))

EMAIL(XUNMSP) ;SEND THE REPORT

 N %,DIFROM

 ;I $D(ZTQUEUED) N %,DIFROM

 N RDT,Y

 D NOW^%DTC S Y=% X ^DD("DD")

 S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)

 N XMY,XMTEXT,XMDUZ,XMSUB

 S XMY(DUZ)="",XMDUZ=.5

 S XMSUB="NEW PERSON File Name Conversion Report"

 S XMTEXT="^TMP("""_XUNMSP_""",$J,"

 D ^XMD

XU8343R   ;BPOIFO/DW - Post-install for XU*8*343 continued ; 14 April 2004

 +1       ;;8.0;KERNEL;**343**; Jul 10, 1995;

 +2        QUIT

 +3       ;

NOTICE(XUT) ;Send a notification when the conversion process is stopped\done

 +1       ;IN:

 +2       ; XUT(1)=Number of records processed

 +3       ; XUT(2)=Last processed IEN

 +4       ; XUT(3)=Total NPF entries

 +5       ; XUT(4)=1 if the conversion process was cancelled, 0 if it was done.

 +6       ;

 +7       ;If called within a task, protect variables

 +8        NEW %,DIFROM

 +9       ;I $D(ZTQUEUED) N %,DIFROM

 +10      ;

 +11       NEW RDT,Y

 +12       DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

 +13       SET RDT=$PIECE(Y,"@",1)_"@"_$PIECE($PIECE(Y,"@",2),":",1,2)

 +14      ;

 +15       NEW XMY,XMTEXT,XMDUZ,XUSUB,XUWHAT,XUSITE,XUPLACE,XUNUM,XUSTOP,XMSUB

 +16      ;

 +17       SET XUSITE=$$SITE^VASITE

 +18       SET XUPLACE=$PIECE(XUSITE,"^",2)

 +19       SET XUNUM=$PIECE(XUSITE,"^",3)

 +20      ;

 +21       SET XMDUZ=.5

 +22       SET XMY(DUZ)=""

 +23       SET XMY("G.XUPS IDENTITY MANAGEMENT@DOMAIN.NAME")=""

 +24       SET XMSUB="XUPS NPF NAME STANDARDIZATION - "_XUPLACE_"("_XUNUM_")"

 +25      ;

 +26       SET XUSTOP=$SELECT(XUT(4):"cancelled.",1:"DONE!")

 +27       SET XUWHAT(1)=" New Person file name conversion (XU*8*343) is "_XUSTOP

 +28       SET XUWHAT(2)=""

 +29       SET XUWHAT(3)="                 Facility Name: "_XUPLACE

 +30       SET XUWHAT(4)="                Station Number: "_XUNUM

 +31       SET XUWHAT(5)=""

 +32       SET XUWHAT(6)=" Total records to be processed: "_XUT(3)

 +33       SET XUWHAT(7)="   Number of records processed: "_XUT(1)

 +34       SET XUWHAT(8)="            Last IEN processed: "_XUT(2)

 +35       SET XUWHAT(9)=""

 +36       SET XUWHAT(10)="                    Date/Time: "_RDT

 +37      ;

 +38       SET XMTEXT="XUWHAT("

 +39      ;

 +40       DO ^XMD

 +41      ;

 +42       QUIT

 +43      ;

HEADER(XULINE,XUSUB) ;Report Header

 +1        NEW C1,C0

 +2        SET XULINE=XULINE+1

 +3        SET ^TMP(XUNMSP,$JOB,XULINE)=""

 +4       ;

 +5        IF '$DATA(^XTMP(XUNMSP,XUSUB))

               Begin DoDot:1

 +6                SET XULINE=XULINE+1

 +7                SET ^TMP(XUNMSP,$JOB,XULINE)="None."

               End DoDot:1

               QUIT

 +8       ;

 +9        IF XUSUB="CHANGED"

               Begin DoDot:1

 +10               SET C0=$$LJ^XLFSTR("IEN",15," ")

 +11               SET C1=$$LJ^XLFSTR("NAME",35," ")

 +12               SET XULINE=XULINE+1

 +13               SET ^TMP(XUNMSP,$JOB,XULINE)=C0_" "_C1

 +14               SET C1=$$LJ^XLFSTR("=============== ==============================",51," ")

 +15               SET XULINE=XULINE+1

 +16               SET ^TMP(XUNMSP,$JOB,XULINE)=C1

               End DoDot:1

 +17      ;

 +18       IF XUSUB="UNCHANGED"

               Begin DoDot:1

 +19               SET C0=$$LJ^XLFSTR("IEN",15," ")

 +20               SET C1=$$LJ^XLFSTR("NAME",35," ")

 +21               SET XULINE=XULINE+1

 +22               SET ^TMP(XUNMSP,$JOB,XULINE)=C0_" "_C1

 +23               SET C1=$$LJ^XLFSTR("=============== ==============================",51," ")

 +24               SET XULINE=XULINE+1

 +25               SET ^TMP(XUNMSP,$JOB,XULINE)=C1

               End DoDot:1

 +26       QUIT

 +27      ;

REPORT    ;Report

 +1        IF '$GET(XUNMSP)

               SET XUNMSP="XUNAME"

 +2        NEW XULINE,XUSUB,XUIEN,XUOLD,XUNEW,C1,C2,C0,C,XUC,XU20P

 +3        SET XULINE=0

 +4        SET C=$$LJ^XLFSTR(" ",15," ")

 +5        FOR XUSUB="CHANGED","UNCHANGED"

               Begin DoDot:1

 +6                KILL ^TMP(XUNMSP,$JOB)

 +7                IF XUSUB="CHANGED"

                       SET XUT="are converted"

 +8                IF XUSUB="UNCHANGED"

                       SET XUT="could not be converted"

 +9                SET XULINE=XULINE+1

 +10               SET ^TMP(XUNMSP,$JOB,XULINE)="The following names "_XUT_":"

 +11               DO HEADER(.XULINE,XUSUB)

 +12               SET XUIEN=0

FOR

                       SET XUIEN=$ORDER(^XTMP(XUNMSP,XUSUB,XUIEN))

                       IF XUIEN=""

                           QUIT

                       Begin DoDot:2

 +13                       SET XUOLD=$GET(^XTMP(XUNMSP,XUSUB,XUIEN,"OLD"))

 +14                       SET XUNEW=$GET(^XTMP(XUNMSP,XUSUB,XUIEN,"NEW"))

 +15                       SET XULINE=XULINE+1

 +16                       SET C0=$$LJ^XLFSTR(XUIEN,15," ")

 +17                       SET C1=$$LJ^XLFSTR(XUOLD,35," ")

 +18                       SET C2=$$LJ^XLFSTR(XUNEW,35," ")

 +19                       IF XUSUB="CHANGED"

                               Begin DoDot:3

 +20                               SET ^TMP(XUNMSP,$JOB,XULINE)=C0_" Old: "_C1

 +21                               SET XULINE=XULINE+1

 +22                               SET ^TMP(XUNMSP,$JOB,XULINE)=C_" New: "_C2

 +23                               KILL XUC

                                   DO NMCOM(XUIEN,.XUC)

 +24                               SET XULINE=XULINE+1

 +25                               SET ^TMP(XUNMSP,$JOB,XULINE)=C_"      Given: "_$GET(XUC("GIVEN"))

 +26                               SET XULINE=XULINE+1

 +27                               SET ^TMP(XUNMSP,$JOB,XULINE)=C_"     Middle: "_$GET(XUC("MIDDLE"))

 +28                               SET XULINE=XULINE+1

 +29                               SET ^TMP(XUNMSP,$JOB,XULINE)=C_"     Family: "_$GET(XUC("FAMILY"))

 +30                               SET XULINE=XULINE+1

 +31                               SET ^TMP(XUNMSP,$JOB,XULINE)=C_"     Suffix: "_$GET(XUC("SUFFIX"))

 +32                               SET XULINE=XULINE+1

 +33                               SET ^TMP(XUNMSP,$JOB,XULINE)=""

                               End DoDot:3

 +34                       IF XUSUB="UNCHANGED"

                               SET ^TMP(XUNMSP,$JOB,XULINE)=C0_" "_C1

                       End DoDot:2

 +35               DO EMAIL(XUNMSP)

 +36               KILL ^TMP(XUNMSP,$JOB)

               End DoDot:1

 +37       QUIT

 +38      ;

NMCOM(XUIEN,XUC) ;Get name components from file #20.

 +1        NEW DIC,DR,DA,DIQ,XUR,XUCOM,XUI,XUCOMP,XUNC,C,XU20P,X,Y

 +2       ;

 +3        SET XU20P=$PIECE($GET(^VA(200,XUIEN,3.1)),U)

 +4       ;

 +5        SET DIC=20

 +6        SET DR="1;2;3;4;5;6"

 +7        SET DA=XU20P

 +8        SET DIQ="XUR"

 +9        DO EN^DIQ1

 +10      ;

 +11       SET XUCOM="FAMILY^GIVEN^MIDDLE^PREFIX^SUFFIX^DEGREE"

 +12       FOR XUI=1:1:6

               Begin DoDot:1

 +13               SET XUCOMP=$PIECE(XUCOM,U,XUI)

 +14               SET XUC(XUCOMP)=$GET(XUR(20,XU20P,XUI))

               End DoDot:1

 +15       QUIT

 +16      ;

EMAIL(XUNMSP) ;SEND THE REPORT

 +1        NEW %,DIFROM

 +2       ;I $D(ZTQUEUED) N %,DIFROM

 +3       ;

 +4        NEW RDT,Y

 +5        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

 +6        SET RDT=$PIECE(Y,"@",1)_"@"_$PIECE($PIECE(Y,"@",2),":",1,2)

 +7       ;

 +8        NEW XMY,XMTEXT,XMDUZ,XMSUB

 +9       ;

 +10       SET XMY(DUZ)=""

           SET XMDUZ=.5

 +11       SET XMSUB="NEW PERSON File Name Conversion Report"

 +12       SET XMTEXT="^TMP("""_XUNMSP_""",$J,"

 +13       DO ^XMD

 +14       QUIT

XU8343R.m