XU8343P.m

XU8343P ;BPOIFO/DW - Post-init for XU*8*343 ; 14 April 2004

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

 ;

 Q

 ;

POST ;Post-init functions

 ;

 N XUMSG

 ;Make sure the user has a DUZ to receive MailMan messages

 S XUMSG="Please make sure that you have a valid DUZ, so that you will receive the reports via MailMan."

 I $G(DUZ)<1 D  Q

 . D BMES^XPDUTL(.XUMSG)

 I $P($G(^VA(200,DUZ,0)),U)="" D  Q

 . D BMES^XPDUTL(.XUMSG)

 K XUMSG

 ;

 ;Update input transforms and field description for field #.01

 D ITXDES

 D NEWXR^XU8343Q

 ;

 ;Recompile input templates

 D RECOMP

 ;

 ;Update triggered fields

 D TRIG

 ;

 ;Convert existing names

 D POST^XU8343S

 ;

 Q

 ;

ITXDES ;Set input transforms and field descriptions

 D BMES^XPDUTL("Setting field descriptions and input transforms")

 ;

 S $P(^DD(200,.01,0),U,5,99)="K XLFNC K:($L(X,"","")'=2) X I $D(X) S XLFNC=X,(X,XLFNC)=$$FORMAT^XLFNAME7(.XLFNC,3,35,,,,,2) K:$L(X)>35!($L(X)<3)!($L(X,"","")'=2)!(X'?1.E1"",""1.E) X,XLFNC K:'$G(XUITNAME) XLFNC"

 ;

 K ^DD(200,.01,21)

 S ^DD(200,.01,21,0)="^^6^6^3040421^"

 S ^DD(200,.01,21,1,0)="Enter only data that is actually part of the person's name. Do not"

 S ^DD(200,.01,21,2,0)="include extra titles, identification, flags, local information, etc."

 S ^DD(200,.01,21,3,0)="Enter the person's name in 'LAST,FIRST MIDDLE SUFFIX' format."

 S ^DD(200,.01,21,4,0)="This value must be 3-35 characters in length and may contain only"

 S ^DD(200,.01,21,5,0)="uppercase alpha characters, spaces, apostrophes, hyphens and one comma."

 S ^DD(200,.01,21,6,0)="All other characters and parenthetical text will be removed."

 Q

 ;

RECOMP ;Recompile input templates

 D BMES^XPDUTL("Recompiling templates...")

 ;

 N XUFLD

 S XUFLD(200,.01)=""

 D DIEZ^DIKCUTL3(200,.XUFLD)

 ;

 Q

 ;

TRIG ;Update triggered fields

 D BMES^XPDUTL("Updating trigger field definitions...")

 ;

 N XUFLD,XUOUT

 S XUFLD(200,.01)=""

 D TRIG^DICR(.XUFLD,.XUOUT)

 ;

 N XUFL,XUFD

 S XUFL=0 F  S XUFL=$O(XUOUT(XUFL)) Q:'XUFL  D

 . S XUFD=0 F  S XUFD=$O(XUOUT(XUFL,XUFD)) Q:'XUFD  D

 .. D MES^XPDUTL("         Field #"_XUFD_" of file #"_XUFL_" updated.")

 ;

 Q

 ;

XU8343P   ;BPOIFO/DW - Post-init for XU*8*343 ; 14 April 2004

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

 +2       ;

 +3        QUIT 

 +4       ;

POST      ;Post-init functions

 +1       ;

 +2        NEW XUMSG

 +3       ;Make sure the user has a DUZ to receive MailMan messages

 +4        SET XUMSG="Please make sure that you have a valid DUZ, so that you will receive the reports via MailMan."

 +5        IF $GET(DUZ)<1

               Begin DoDot:1

 +6                DO BMES^XPDUTL(.XUMSG)

               End DoDot:1

               QUIT 

 +7        IF $PIECE($GET(^VA(200,DUZ,0)),U)=""

               Begin DoDot:1

 +8                DO BMES^XPDUTL(.XUMSG)

               End DoDot:1

               QUIT 

 +9        KILL XUMSG

 +10      ;

 +11      ;Update input transforms and field description for field #.01

 +12       DO ITXDES

 +13       DO NEWXR^XU8343Q

 +14      ;

 +15      ;Recompile input templates

 +16       DO RECOMP

 +17      ;

 +18      ;Update triggered fields

 +19       DO TRIG

 +20      ;

 +21      ;Convert existing names

 +22       DO POST^XU8343S

 +23      ;

 +24       QUIT 

 +25      ;

ITXDES    ;Set input transforms and field descriptions

 +1        DO BMES^XPDUTL("Setting field descriptions and input transforms")

 +2       ;

 +3        SET $PIECE(^DD(200,.01,0),U,5,99)="K XLFNC K:($L(X,"","")'=2) X I $D(X) S XLFNC=X,(X,XLFNC)=$$FORMAT^XLFNAME7(.XLFNC,3,35,,,,,2) K:$L(X)>35!($L(X)<3)!($L(X,"","")'=2)!(X'?1.E1"",""1.E) X,XLFNC K:'$G(XUITNAME) XLFNC"

 +4       ;

 +5        KILL ^DD(200,.01,21)

 +6        SET ^DD(200,.01,21,0)="^^6^6^3040421^"

 +7        SET ^DD(200,.01,21,1,0)="Enter only data that is actually part of the person's name. Do not"

 +8        SET ^DD(200,.01,21,2,0)="include extra titles, identification, flags, local information, etc."

 +9        SET ^DD(200,.01,21,3,0)="Enter the person's name in 'LAST,FIRST MIDDLE SUFFIX' format."

 +10       SET ^DD(200,.01,21,4,0)="This value must be 3-35 characters in length and may contain only"

 +11       SET ^DD(200,.01,21,5,0)="uppercase alpha characters, spaces, apostrophes, hyphens and one comma."

 +12       SET ^DD(200,.01,21,6,0)="All other characters and parenthetical text will be removed."

 +13       QUIT 

 +14      ;

RECOMP    ;Recompile input templates

 +1        DO BMES^XPDUTL("Recompiling templates...")

 +2       ;

 +3        NEW XUFLD

 +4        SET XUFLD(200,.01)=""

 +5        DO DIEZ^DIKCUTL3(200,.XUFLD)

 +6       ;

 +7        QUIT 

 +8       ;

TRIG      ;Update triggered fields

 +1        DO BMES^XPDUTL("Updating trigger field definitions...")

 +2       ;

 +3        NEW XUFLD,XUOUT

 +4        SET XUFLD(200,.01)=""

 +5        DO TRIG^DICR(.XUFLD,.XUOUT)

 +6       ;

 +7        NEW XUFL,XUFD

 +8        SET XUFL=0

           FOR 

               SET XUFL=$ORDER(XUOUT(XUFL))

               IF 'XUFL

                   QUIT 

               Begin DoDot:1

 +9                SET XUFD=0

                   FOR 

                       SET XUFD=$ORDER(XUOUT(XUFL,XUFD))

                       IF 'XUFD

                           QUIT 

                       Begin DoDot:2

 +10                       DO MES^XPDUTL("         Field #"_XUFD_" of file #"_XUFL_" updated.")

                       End DoDot:2

               End DoDot:1

 +11      ;

 +12       QUIT 

 +13      ;