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

ACGSECCH.m

Go to the documentation of this file.
  1. ACGSECCH ;IHS/OIRM/DSD/DM - CHANGE SECURITY KEY 'ACG SMALL PURCHASE VENDOR [ 03/27/2000 3:01 PM ]
  1. ;TO ACGZ SMALL PURCHASE VENDOR'
  1. ;;2.0t1;CONTRACT INFORMATION SYSEM;;MAR 16, 2000
  1. ;
  1. ;
  1. ;CHECK TO SEE IF 'ACGZ' ALREADY EXISTS IN SECURITY KEY. QUIT IF IT DOES
  1. N ACGOLD ;OLD ACG SECURITY KEY NAME
  1. N DIC,X
  1. S DIC="^DIC(19.1,"
  1. S DIC(0)=""
  1. S X="ACGZ SMALL PURCHASE VENDOR"
  1. D ^DIC
  1. Q:+Y>0
  1. ;
  1. ;
  1. ;CHANGE THE SECOND PIECE OF ZERO NODE OF FIELD .01 OF SECURITY FILE
  1. ;TO ALLOW EDITING
  1. N ACGOLD,ACGNEW ;ACGOLD=OLD NAME ACGNEW=NEW NAME
  1. S ACGOLD=$P(^DD(19.1,.01,0),U,2)
  1. S ACGNEW=$TR(ACGOLD,"I","")
  1. S $P(^DD(19.1,.01,0),U,2)=ACGNEW
  1. ;
  1. ;
  1. ;DIC LOOKUP FOR SECURITY KEY IEN
  1. N DIC,X
  1. S DIC="^DIC(19.1,"
  1. S DIC(0)=""
  1. S X="ACG SMALL PURCHASE VENDOR"
  1. D ^DIC
  1. Q:+Y'>0
  1. ;
  1. ;
  1. ;EDIT THE SECURITY KEY NAME
  1. N DA,DIE,DR
  1. S DA=+Y
  1. S DIE=DIC
  1. S DR=".01///"_"ACGZ SMALL PURCHASE VENDOR"
  1. D ^DIE
  1. ;
  1. ;
  1. ;RESTORE THE SECOND PIECE OF ZERO NODE OF FIELD .01 TO UNEDITABLE
  1. S $P(^DD(19.1,.01,0),U,2)=ACGOLD
  1. ;
  1. Q