NUR35PST.m

NUR35PST ;HCIOFO/FT-NUR*4*35 Post Install Routine ;5/15/01  09:12

 ;;4.0;NURSING SERVICE;**35**;Apr 25, 1997

EN1 ; Post install for NUR*4*35.

 ; Loop through the FILE 211.3, find duplicates and rename them.

 N NURABB,NURCNT,NURIEN

 D BMES^XPDUTL("Checking FILE 211.3 for duplicate .01 values...")

 S NURABB=""

 F  S NURABB=$O(^NURSF(211.3,"B",NURABB)) Q:NURABB=""  D

 .S (NURCNT,NURIEN)=0

 .F  S NURIEN=$O(^NURSF(211.3,"B",NURABB,NURIEN)) Q:'NURIEN  D

 ..S NURCNT=NURCNT+1

 ..Q:NURCNT<2

 ..D RENAME(NURIEN,NURABB)

 ..Q

 .Q

 Q

RENAME(IEN,ABB) ; Rename FILE 211.3 entry by appending IEN to .01 value

 N DA,DIE,DR,MESSAGE,OLD

 Q:'IEN

 S OLD=ABB

 I $L(ABB_IEN)<11 S ABB=ABB_IEN

 E  S ABB=$E(ABB,1,(10-$L(IEN)))_IEN

 S DA=IEN,DIE="^NURSF(211.3,",DR=".01///"_ABB

 D ^DIE

 S MESSAGE="   Renamed entry #"_IEN_" from "_OLD_" to "_ABB

 D BMES^XPDUTL(MESSAGE)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---NUR35PST   879     printed  Apr 09, 2024@21:23:41                                                                                                                                                                                                     Page 2

NUR35PST  ;HCIOFO/FT-NUR*4*35 Post Install Routine ;5/15/01  09:12

 +1       ;;4.0;NURSING SERVICE;**35**;Apr 25, 1997

EN1       ; Post install for NUR*4*35.

 +1       ; Loop through the FILE 211.3, find duplicates and rename them.

 +2        NEW NURABB,NURCNT,NURIEN

 +3        DO BMES^XPDUTL("Checking FILE 211.3 for duplicate .01 values...")

 +4        SET NURABB=""

 +5        FOR 

               SET NURABB=$ORDER(^NURSF(211.3,"B",NURABB))

               if NURABB=""

                   QUIT 

               Begin DoDot:1

 +6                SET (NURCNT,NURIEN)=0

 +7                FOR 

                       SET NURIEN=$ORDER(^NURSF(211.3,"B",NURABB,NURIEN))

                       if 'NURIEN

                           QUIT 

                       Begin DoDot:2

 +8                        SET NURCNT=NURCNT+1

 +9                        if NURCNT<2

                               QUIT 

 +10                       DO RENAME(NURIEN,NURABB)

 +11                       QUIT 

                       End DoDot:2

 +12               QUIT 

               End DoDot:1

 +13       QUIT 

RENAME(IEN,ABB) ; Rename FILE 211.3 entry by appending IEN to .01 value

 +1        NEW DA,DIE,DR,MESSAGE,OLD

 +2        if 'IEN

               QUIT 

 +3        SET OLD=ABB

 +4        IF $LENGTH(ABB_IEN)<11

               SET ABB=ABB_IEN

 +5       IF '$TEST

               SET ABB=$EXTRACT(ABB,1,(10-$LENGTH(IEN)))_IEN

 +6        SET DA=IEN

           SET DIE="^NURSF(211.3,"

           SET DR=".01///"_ABB

 +7        DO ^DIE

 +8        SET MESSAGE="   Renamed entry #"_IEN_" from "_OLD_" to "_ABB

 +9        DO BMES^XPDUTL(MESSAGE)

 +10       QUIT