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

PRCIN116.m

Go to the documentation of this file.
  1. PRCIN116 ;RB-PREINSTALL PRC*116 TO ADD 441.2 entry ;4-26-94/3:45 PM
  1. V ;;5.1;IFCAP;**116**;Oct 20, 2000;Build 8
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. START ;Adding FSC code 5331 O-RINGS
  1. N DIC,Y,MREC,IEN S IEN=0
  1. S IEN=$O(^PRC(441.2,"B",4235,IEN))
  1. I IEN S DA=IEN,DIK="^PRC(441.2," D ^DIK K DA,DIK
  1. S IEN=0,IEN=$O(^PRC(441.2,"B",5331,IEN))
  1. I IEN S DA=IEN,DIK="^PRC(441.2," D ^DIK K DA,DIK
  1. A S DIC="^PRC(441.2,",X=5331
  1. D ^DIC
  1. I Y=-1 D
  1. .S (DIC,Y)=""
  1. .S DIC="^PRC(441.2,",X=5331,DIC(0)="",(DA,DINUM)=5331,DLAYGO=441.2,DIC(0)="FLZ"
  1. .D FILE^DICN
  1. .I Y'=-1 S MREC=+Y
  1. .S THISDESC="Excludes Packing and Gasket Material (FSC5330)"
  1. .S (DIC,Y)=""
  1. .S DIE="^PRC(441.2,",DA=MREC,DR="1///O-RINGS;2///^S X=THISDESC;3///53;4///General;5///DLA/DASS"
  1. .D ^DIE
  1. N DIC,Y,MREC
  1. B S DIC="^PRC(441.2,",X=4235
  1. D ^DIC
  1. I Y=-1 D
  1. .S (DIC,Y)=""
  1. .S DIC="^PRC(441.2,",X=4235,DIC(0)="",(DA,DINUM)=4235,DLAYGO=441.2,DIC(0)="FLZ"
  1. .D FILE^DICN
  1. .I Y'=-1 S MREC=+Y
  1. .S THISDESC="Hazardous Material Spill Containment and Clean-up Equipment and Material."
  1. .S THISDESC=THISDESC_" Includes Secondary Spill Containment Sumps; Liquid Spill Containment Pallets; Spill Containment Basins; Spill Containment Systems; Absorbent, Sorbent and Blotting Materials."
  1. .S (DIC,Y)=""
  1. .S DIE="^PRC(441.2,",DA=MREC,DR="1///Hazardous Material Spill;2///^S X=THISDESC;3///42;4///General;5///DLA/DASS"
  1. .D ^DIE
  1. K DIC,DIE,Y,DLAYGO,MREC,DA,X,DINUM
  1. Q