Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NUR35PST

NUR35PST.m

Go to the documentation of this file.
  1. NUR35PST ;HCIOFO/FT-NUR*4*35 Post Install Routine ;5/15/01 09:12
  1. ;;4.0;NURSING SERVICE;**35**;Apr 25, 1997
  1. EN1 ; Post install for NUR*4*35.
  1. ; Loop through the FILE 211.3, find duplicates and rename them.
  1. N NURABB,NURCNT,NURIEN
  1. D BMES^XPDUTL("Checking FILE 211.3 for duplicate .01 values...")
  1. S NURABB=""
  1. F S NURABB=$O(^NURSF(211.3,"B",NURABB)) Q:NURABB="" D
  1. .S (NURCNT,NURIEN)=0
  1. .F S NURIEN=$O(^NURSF(211.3,"B",NURABB,NURIEN)) Q:'NURIEN D
  1. ..S NURCNT=NURCNT+1
  1. ..Q:NURCNT<2
  1. ..D RENAME(NURIEN,NURABB)
  1. ..Q
  1. .Q
  1. Q
  1. RENAME(IEN,ABB) ; Rename FILE 211.3 entry by appending IEN to .01 value
  1. N DA,DIE,DR,MESSAGE,OLD
  1. Q:'IEN
  1. S OLD=ABB
  1. I $L(ABB_IEN)<11 S ABB=ABB_IEN
  1. E S ABB=$E(ABB,1,(10-$L(IEN)))_IEN
  1. S DA=IEN,DIE="^NURSF(211.3,",DR=".01///"_ABB
  1. D ^DIE
  1. S MESSAGE=" Renamed entry #"_IEN_" from "_OLD_" to "_ABB
  1. D BMES^XPDUTL(MESSAGE)
  1. Q