XU8375P.m

XU8375P ;;BPOIFO/DW - Post-init for XU*8*375 ; 14 April 2004

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

 ;

 ;Update the DD

 D UPDATE

 ;

 ;Recompile input templates

 D RECOMP

 ;

 ;Update triggered fields

 D TRIG

 Q

 ;

UPDATE ;Update DD of the SIGNATURE BLOCK PRINTED NAME field

 S $P(^DD(200,20.2,0),U,5,999)="K:X[""""""""!($A(X)=45)!($L(X)>40)!($L(X)<2) X I $D(X) K:$$FORMAT^XLFNAME7(X,2,40,,0,,1)'[$P(^VA(200,DA,0),"","") X"

 Q

 ;

RECOMP ;Recompile input templates

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

 ;

 N XUFLD

 S XUFLD(200,20.2)=""

 D DIEZ^DIKCUTL3(200,.XUFLD)

 ;

 Q

 ;

TRIG ;Update triggered fields

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

 ;

 N XUFLD,XUOUT

 S XUFLD(200,20.2)=""

 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

 ;

XU8375P   ;;BPOIFO/DW - Post-init for XU*8*375 ; 14 April 2004

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

 +2       ;

 +3       ;Update the DD

 +4        DO UPDATE

 +5       ;

 +6       ;Recompile input templates

 +7        DO RECOMP

 +8       ;

 +9       ;Update triggered fields

 +10       DO TRIG

 +11       QUIT 

 +12      ;

UPDATE    ;Update DD of the SIGNATURE BLOCK PRINTED NAME field

 +1        SET $PIECE(^DD(200,20.2,0),U,5,999)="K:X[""""""""!($A(X)=45)!($L(X)>40)!($L(X)<2) X I $D(X) K:$$FORMAT^XLFNAME7(X,2,40,,0,,1)'[$P(^VA(200,DA,0),"","") X"

 +2        QUIT 

 +3       ;

RECOMP    ;Recompile input templates

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

 +2       ;

 +3        NEW XUFLD

 +4        SET XUFLD(200,20.2)=""

 +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,20.2)=""

 +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      ;