XU8343R ;BPOIFO/DW - Post-install for XU*8*343 continued ; 14 April 2004
;;8.0;KERNEL;**343**; Jul 10, 1995;
Q
;
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
;
Q
;
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
Q
;
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)
Q
;
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))
Q
;
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
Q
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 ;
+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
