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 ---[H[J[2J[HNUR35PST 879 printed Dec 13, 2024@02:18:05 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
