DINIT29P.m

DINIT29P ;SFISC/MKO-SCREENMAN POSTINIT ;11:21 AM  2 Oct 1998

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 N B,F

 ;

 ;Delete the "AZ" global for each form. Starting in Version 22.0

 ;compiled data will be stored in ^DIST(.403,form#,"AY") instead of

 ;^DIST(.403,form#,"AZ")

 S F=0 F  S F=$O(^DIST(.403,F)) Q:F'=+$P(F,"E")  K ^DIST(.403,F,"AZ")

 ;

 ;Update Field Type field of fields on old blocks.

 ;Convert 0 or null to 3 (data dictionary field)

 S B=0 F  S B=$O(^DIST(.404,B)) Q:B'=+B  D

 . Q:$P($G(^DIST(.404,B,0)),U)?1"DDGF".E

 . S F=0 F  S F=$O(^DIST(.404,B,40,F)) Q:F'=+F  D

 .. Q:$D(^DIST(.404,B,40,F,0))[0

 .. S:'$P(^DIST(.404,B,40,F,0),U,3) $P(^(0),U,3)=3

 ;

 ;Rename two version 19 options

 I $P($G(^DIC(19,0)),U)="OPTION" D

 . D:$D(^DIC(19,"B","DDS CREATE FORM")) RENAME("DDS CREATE FORM","DDS EDIT/CREATE A FORM")

 . D:$D(^DIC(19,"B","DDS CREATE BLOCK")) RENAME("DDS CREATE BLOCK","DDS RUN A FORM")

 ;

 G ^DINIT2A0

 ;

RENAME(DDSOLD,DDSNEW) ;Rename options

 N DIC,X,Y

 S DIC="^DIC(19,",DIC(0)="Z",X=DDSOLD

 D ^DIC Q:Y<0

 ;

 N DIE,DA,DR

 S DIE=DIC,DA=+Y,DR=".01///"_DDSNEW

 D ^DIE

 Q

 ;

PRE ;ScreenMan pre-init

 ;Delete old forms and blocks used by FileMan

 N I

 S I=0 F  S I=$O(^DIST(.403,I)) Q:'I!(I'<1)  K ^DIST(.403,I)

 S I=0 F  S I=$O(^DIST(.404,I)) Q:'I!(I'<1)  K ^DIST(.404,I)

 Q

DINIT29P  ;SFISC/MKO-SCREENMAN POSTINIT ;11:21 AM  2 Oct 1998

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        NEW B,F

 +4       ;

 +5       ;Delete the "AZ" global for each form. Starting in Version 22.0

 +6       ;compiled data will be stored in ^DIST(.403,form#,"AY") instead of

 +7       ;^DIST(.403,form#,"AZ")

 +8        SET F=0

           FOR 

               SET F=$ORDER(^DIST(.403,F))

               IF F'=+$PIECE(F,"E")

                   QUIT 

               KILL ^DIST(.403,F,"AZ")

 +9       ;

 +10      ;Update Field Type field of fields on old blocks.

 +11      ;Convert 0 or null to 3 (data dictionary field)

 +12       SET B=0

           FOR 

               SET B=$ORDER(^DIST(.404,B))

               IF B'=+B

                   QUIT 

               Begin DoDot:1

 +13               IF $PIECE($GET(^DIST(.404,B,0)),U)?1"DDGF".E

                       QUIT 

 +14               SET F=0

                   FOR 

                       SET F=$ORDER(^DIST(.404,B,40,F))

                       IF F'=+F

                           QUIT 

                       Begin DoDot:2

 +15                       IF $DATA(^DIST(.404,B,40,F,0))[0

                               QUIT 

 +16                       IF '$PIECE(^DIST(.404,B,40,F,0),U,3)

                               SET $PIECE(^(0),U,3)=3

                       End DoDot:2

               End DoDot:1

 +17      ;

 +18      ;Rename two version 19 options

 +19       IF $PIECE($GET(^DIC(19,0)),U)="OPTION"

               Begin DoDot:1

 +20               IF $DATA(^DIC(19,"B","DDS CREATE FORM"))

                       DO RENAME("DDS CREATE FORM","DDS EDIT/CREATE A FORM")

 +21               IF $DATA(^DIC(19,"B","DDS CREATE BLOCK"))

                       DO RENAME("DDS CREATE BLOCK","DDS RUN A FORM")

               End DoDot:1

 +22      ;

 +23       GOTO ^DINIT2A0

 +24      ;

RENAME(DDSOLD,DDSNEW) ;Rename options

 +1        NEW DIC,X,Y

 +2        SET DIC="^DIC(19,"

           SET DIC(0)="Z"

           SET X=DDSOLD

 +3        DO ^DIC

           IF Y<0

               QUIT 

 +4       ;

 +5        NEW DIE,DA,DR

 +6        SET DIE=DIC

           SET DA=+Y

           SET DR=".01///"_DDSNEW

 +7        DO ^DIE

 +8        QUIT 

 +9       ;

PRE       ;ScreenMan pre-init

 +1       ;Delete old forms and blocks used by FileMan

 +2        NEW I

 +3        SET I=0

           FOR 

               SET I=$ORDER(^DIST(.403,I))

               IF 'I!(I'<1)

                   QUIT 

               KILL ^DIST(.403,I)

 +4        SET I=0

           FOR 

               SET I=$ORDER(^DIST(.404,I))

               IF 'I!(I'<1)

                   QUIT 

               KILL ^DIST(.404,I)

 +5        QUIT