FHP43.m

FHP43 ;EPIP/WLE - Remove three data dictionary fields for file 115 ;6/5/2018 3:45 PM

 ;;5.5;DIETETICS;**43**;Jan 28, 2005;Build 66

 ; Post install routine for patch FH*5.5*43 to remove fields created in a previous version at test sites

 ; Copy the old data at ^FHPT(IEN,662910) to ^FHPT(IEN,22)

 ; then remove the old data and node

EN ;

 I '$$VFIELD^DILFD(115,662910.01) Q  ; The fields do not exist so no reason to continue

 D BMES^XPDUTL("If NUTRITION PERSON FILE #115 has existing tray tickets flags. The data will be moved to a new node.")

 S IEN="" F  S IEN=$O(^FHPT(IEN)) Q:IEN=""  D

  .I $D(^FHPT(IEN,662910)) S ^FHPT(IEN,22)=^FHPT(IEN,662910) K ^FHPT(IEN,662910)

 D BMES^XPDUTL("If NUTRITION PERSON FILE #115 had data it has been moved to the new node.")

 ;

 ; delete the old fields in file 115 

 S DIK="^DD(115,",DA=662910.01,DA(1)=115

 D ^DIK

 S DIK="^DD(115,",DA=662910.02,DA(1)=115

 D ^DIK

 S DIK="^DD(115,",DA=662910.03,DA(1)=115

 D ^DIK

 K DIK,DA,DA(1)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHP43   991     printed  Feb 18, 2025@23:20:31                                                                                                                                                                                                        Page 2

FHP43     ;EPIP/WLE - Remove three data dictionary fields for file 115 ;6/5/2018 3:45 PM

 +1       ;;5.5;DIETETICS;**43**;Jan 28, 2005;Build 66

 +2       ; Post install routine for patch FH*5.5*43 to remove fields created in a previous version at test sites

 +3       ; Copy the old data at ^FHPT(IEN,662910) to ^FHPT(IEN,22)

 +4       ; then remove the old data and node

EN        ;

 +1       ; The fields do not exist so no reason to continue

           IF '$$VFIELD^DILFD(115,662910.01)

               QUIT 

 +2        DO BMES^XPDUTL("If NUTRITION PERSON FILE #115 has existing tray tickets flags. The data will be moved to a new node.")

 +3        SET IEN=""

           FOR 

               SET IEN=$ORDER(^FHPT(IEN))

               if IEN=""

                   QUIT 

               Begin DoDot:1

 +4                IF $DATA(^FHPT(IEN,662910))

                       SET ^FHPT(IEN,22)=^FHPT(IEN,662910)

                       KILL ^FHPT(IEN,662910)

               End DoDot:1

 +5        DO BMES^XPDUTL("If NUTRITION PERSON FILE #115 had data it has been moved to the new node.")

 +6       ;

 +7       ; delete the old fields in file 115 

 +8        SET DIK="^DD(115,"

           SET DA=662910.01

           SET DA(1)=115

 +9        DO ^DIK

 +10       SET DIK="^DD(115,"

           SET DA=662910.02

           SET DA(1)=115

 +11       DO ^DIK

 +12       SET DIK="^DD(115,"

           SET DA=662910.03

           SET DA(1)=115

 +13       DO ^DIK

 +14       KILL DIK,DA,DA(1)

 +15       QUIT