PRCIN116 ;RB-PREINSTALL PRC*116 TO ADD 441.2 entry ;4-26-94/3:45 PM
V ;;5.1;IFCAP;**116**;Oct 20, 2000;Build 8
;Per VHA Directive 2004-038, this routine should not be modified.
Q
START ;Adding FSC code 5331 O-RINGS
N DIC,Y,MREC,IEN S IEN=0
S IEN=$O(^PRC(441.2,"B",4235,IEN))
I IEN S DA=IEN,DIK="^PRC(441.2," D ^DIK K DA,DIK
S IEN=0,IEN=$O(^PRC(441.2,"B",5331,IEN))
I IEN S DA=IEN,DIK="^PRC(441.2," D ^DIK K DA,DIK
A S DIC="^PRC(441.2,",X=5331
D ^DIC
I Y=-1 D
.S (DIC,Y)=""
.S DIC="^PRC(441.2,",X=5331,DIC(0)="",(DA,DINUM)=5331,DLAYGO=441.2,DIC(0)="FLZ"
.D FILE^DICN
.I Y'=-1 S MREC=+Y
.S THISDESC="Excludes Packing and Gasket Material (FSC5330)"
.S (DIC,Y)=""
.S DIE="^PRC(441.2,",DA=MREC,DR="1///O-RINGS;2///^S X=THISDESC;3///53;4///General;5///DLA/DASS"
.D ^DIE
N DIC,Y,MREC
B S DIC="^PRC(441.2,",X=4235
D ^DIC
I Y=-1 D
.S (DIC,Y)=""
.S DIC="^PRC(441.2,",X=4235,DIC(0)="",(DA,DINUM)=4235,DLAYGO=441.2,DIC(0)="FLZ"
.D FILE^DICN
.I Y'=-1 S MREC=+Y
.S THISDESC="Hazardous Material Spill Containment and Clean-up Equipment and Material."
.S THISDESC=THISDESC_" Includes Secondary Spill Containment Sumps; Liquid Spill Containment Pallets; Spill Containment Basins; Spill Containment Systems; Absorbent, Sorbent and Blotting Materials."
.S (DIC,Y)=""
.S DIE="^PRC(441.2,",DA=MREC,DR="1///Hazardous Material Spill;2///^S X=THISDESC;3///42;4///General;5///DLA/DASS"
.D ^DIE
K DIC,DIE,Y,DLAYGO,MREC,DA,X,DINUM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCIN116 1478 printed Dec 13, 2024@02:11:29 Page 2
PRCIN116 ;RB-PREINSTALL PRC*116 TO ADD 441.2 entry ;4-26-94/3:45 PM
V ;;5.1;IFCAP;**116**;Oct 20, 2000;Build 8
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 QUIT
START ;Adding FSC code 5331 O-RINGS
+1 NEW DIC,Y,MREC,IEN
SET IEN=0
+2 SET IEN=$ORDER(^PRC(441.2,"B",4235,IEN))
+3 IF IEN
SET DA=IEN
SET DIK="^PRC(441.2,"
DO ^DIK
KILL DA,DIK
+4 SET IEN=0
SET IEN=$ORDER(^PRC(441.2,"B",5331,IEN))
+5 IF IEN
SET DA=IEN
SET DIK="^PRC(441.2,"
DO ^DIK
KILL DA,DIK
A SET DIC="^PRC(441.2,"
SET X=5331
+1 DO ^DIC
+2 IF Y=-1
Begin DoDot:1
+3 SET (DIC,Y)=""
+4 SET DIC="^PRC(441.2,"
SET X=5331
SET DIC(0)=""
SET (DA,DINUM)=5331
SET DLAYGO=441.2
SET DIC(0)="FLZ"
+5 DO FILE^DICN
+6 IF Y'=-1
SET MREC=+Y
+7 SET THISDESC="Excludes Packing and Gasket Material (FSC5330)"
+8 SET (DIC,Y)=""
+9 SET DIE="^PRC(441.2,"
SET DA=MREC
SET DR="1///O-RINGS;2///^S X=THISDESC;3///53;4///General;5///DLA/DASS"
+10 DO ^DIE
End DoDot:1
+11 NEW DIC,Y,MREC
B SET DIC="^PRC(441.2,"
SET X=4235
+1 DO ^DIC
+2 IF Y=-1
Begin DoDot:1
+3 SET (DIC,Y)=""
+4 SET DIC="^PRC(441.2,"
SET X=4235
SET DIC(0)=""
SET (DA,DINUM)=4235
SET DLAYGO=441.2
SET DIC(0)="FLZ"
+5 DO FILE^DICN
+6 IF Y'=-1
SET MREC=+Y
+7 SET THISDESC="Hazardous Material Spill Containment and Clean-up Equipment and Material."
+8 SET THISDESC=THISDESC_" Includes Secondary Spill Containment Sumps; Liquid Spill Containment Pallets; Spill Containment Basins; Spill Containment Systems; Absorbent, Sorbent and Blotting Materials."
+9 SET (DIC,Y)=""
+10 SET DIE="^PRC(441.2,"
SET DA=MREC
SET DR="1///Hazardous Material Spill;2///^S X=THISDESC;3///42;4///General;5///DLA/DASS"
+11 DO ^DIE
End DoDot:1
+12 KILL DIC,DIE,Y,DLAYGO,MREC,DA,X,DINUM
+13 QUIT
