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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8343P 2158 printed Dec 13, 2024@02:06:58 Page 2
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 ;
