ACGSECCH ;IHS/OIRM/DSD/DM - CHANGE SECURITY KEY 'ACG SMALL PURCHASE VENDOR [ 03/27/2000 3:01 PM ]
;TO ACGZ SMALL PURCHASE VENDOR'
;;2.0t1;CONTRACT INFORMATION SYSEM;;MAR 16, 2000
;
;
;CHECK TO SEE IF 'ACGZ' ALREADY EXISTS IN SECURITY KEY. QUIT IF IT DOES
N ACGOLD ;OLD ACG SECURITY KEY NAME
N DIC,X
S DIC="^DIC(19.1,"
S DIC(0)=""
S X="ACGZ SMALL PURCHASE VENDOR"
D ^DIC
Q:+Y>0
;
;
;CHANGE THE SECOND PIECE OF ZERO NODE OF FIELD .01 OF SECURITY FILE
;TO ALLOW EDITING
N ACGOLD,ACGNEW ;ACGOLD=OLD NAME ACGNEW=NEW NAME
S ACGOLD=$P(^DD(19.1,.01,0),U,2)
S ACGNEW=$TR(ACGOLD,"I","")
S $P(^DD(19.1,.01,0),U,2)=ACGNEW
;
;
;DIC LOOKUP FOR SECURITY KEY IEN
N DIC,X
S DIC="^DIC(19.1,"
S DIC(0)=""
S X="ACG SMALL PURCHASE VENDOR"
D ^DIC
Q:+Y'>0
;
;
;EDIT THE SECURITY KEY NAME
N DA,DIE,DR
S DA=+Y
S DIE=DIC
S DR=".01///"_"ACGZ SMALL PURCHASE VENDOR"
D ^DIE
;
;
;RESTORE THE SECOND PIECE OF ZERO NODE OF FIELD .01 TO UNEDITABLE
S $P(^DD(19.1,.01,0),U,2)=ACGOLD
;
Q
ACGSECCH ;IHS/OIRM/DSD/DM - CHANGE SECURITY KEY 'ACG SMALL PURCHASE VENDOR [ 03/27/2000 3:01 PM ]
+1 ;TO ACGZ SMALL PURCHASE VENDOR'
+2 ;;2.0t1;CONTRACT INFORMATION SYSEM;;MAR 16, 2000
+3 ;
+4 ;
+5 ;CHECK TO SEE IF 'ACGZ' ALREADY EXISTS IN SECURITY KEY. QUIT IF IT DOES
+6 ;OLD ACG SECURITY KEY NAME
NEW ACGOLD
+7 NEW DIC,X
+8 SET DIC="^DIC(19.1,"
+9 SET DIC(0)=""
+10 SET X="ACGZ SMALL PURCHASE VENDOR"
+11 DO ^DIC
+12 IF +Y>0
QUIT
+13 ;
+14 ;
+15 ;CHANGE THE SECOND PIECE OF ZERO NODE OF FIELD .01 OF SECURITY FILE
+16 ;TO ALLOW EDITING
+17 ;ACGOLD=OLD NAME ACGNEW=NEW NAME
NEW ACGOLD,ACGNEW
+18 SET ACGOLD=$PIECE(^DD(19.1,.01,0),U,2)
+19 SET ACGNEW=$TRANSLATE(ACGOLD,"I","")
+20 SET $PIECE(^DD(19.1,.01,0),U,2)=ACGNEW
+21 ;
+22 ;
+23 ;DIC LOOKUP FOR SECURITY KEY IEN
+24 NEW DIC,X
+25 SET DIC="^DIC(19.1,"
+26 SET DIC(0)=""
+27 SET X="ACG SMALL PURCHASE VENDOR"
+28 DO ^DIC
+29 IF +Y'>0
QUIT
+30 ;
+31 ;
+32 ;EDIT THE SECURITY KEY NAME
+33 NEW DA,DIE,DR
+34 SET DA=+Y
+35 SET DIE=DIC
+36 SET DR=".01///"_"ACGZ SMALL PURCHASE VENDOR"
+37 DO ^DIE
+38 ;
+39 ;
+40 ;RESTORE THE SECOND PIECE OF ZERO NODE OF FIELD .01 TO UNEDITABLE
+41 SET $PIECE(^DD(19.1,.01,0),U,2)=ACGOLD
+42 ;
+43 QUIT