- 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