- 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 Jan 18, 2025@03:12:41 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