ENXLFIX0 ;WISC/SAB-FIX POINTERS TO ENG SPACE FILE (continued) ;1-6-94
;;7.0;ENGINEERING;**1**;Aug 17, 1993
SPACES ; handle locations with leading spaces here (convert mode only)
;
; if location only has spaces then delete it from all records
; otherwise remove the leading spaces from the location.
; The modified location will be processed later during the
; main $Order thru the location x-ref.
;
; lets get the location without leading spaces
S ENLOCN=ENLOC,ENDA=""
F Q:$E(ENLOCN,1)'=" " S ENLOCN=$E(ENLOCN,2,$L(ENLOCN))
; if nothing left then delete the location
I ENLOCN']"" F S ENDA=$O(@(ENXRF_"ENLOC,ENDA)")) Q:'ENDA D
.S DIE=$S(ENFL="EQ":"^ENG(6914,",1:"^ENG(6920,"),DA=ENDA
.S DR=$S(ENFL="EQ":"24",1:"3")_"///@" D ^DIE
; if something left then change current location
I ENLOCN]"" F S ENDA=$O(@(ENXRF_"ENLOC,ENDA)")) Q:'ENDA D
.S $P(@ENODE,U,ENPIECE)=ENLOCN ; update location
.K @(ENXRF_"ENLOC,ENDA)") ; kill old x-ref
.S @(ENXRF_"ENLOCN,ENDA)")="" ; set new x-ref
K ENLOCN
Q
RFTR ; report footer
W !,"# of different free-text locations = ",ENT("LOC")," (# convertible = ",ENT("LOC_CVT"),")",!
W "# of records with free-text locations = ",ENT("REC")," (# convertible = ",ENT("REC_CVT"),")",!!
I ENT("REC") D
.W "Free-Text values were found in the LOCATION field of",!
.W ENFLNM," records. These free-text values",!
.I ENCVTM D
..W "were either converted to pointers or identified",!
..W "by a leading '*'. The leading astrisk ensures",!
..W "that these values will not be inappropriately",!
..W "evaluated as a pointer.",!
.E D
..W "should be converted to pointer values. If an exact match",!
..W "exists in the ENG SPACE file ROOM NUMBER or SYNONYM fields",!
..W "then option 'Convert Free-Text Locations' can be used to",!
..W "perform the conversion. A leading '*' will be removed from",!
..W "the free-text location before checking for a match.",!
I ENT("REC_CVT") D
.W !,"Convertable free-text entries were found in the ",!
.I ENCVTM D
..W ENFLNM,". They have been converted to pointers.",!
.E D
..W ENFLNM,". You must use the 'Convert Free-Text Locations'",!
..W "option for the ",ENFLNM," to actually convert",!
..W "these values to pointers.",!
I 'ENT("REC") D
.W "The ",ENFLNM," LOCATION field does not contain any",!
.W "Free-Text values. No further action is required on this file.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENXLFIX0 2420 printed Dec 13, 2024@01:56:57 Page 2
ENXLFIX0 ;WISC/SAB-FIX POINTERS TO ENG SPACE FILE (continued) ;1-6-94
+1 ;;7.0;ENGINEERING;**1**;Aug 17, 1993
SPACES ; handle locations with leading spaces here (convert mode only)
+1 ;
+2 ; if location only has spaces then delete it from all records
+3 ; otherwise remove the leading spaces from the location.
+4 ; The modified location will be processed later during the
+5 ; main $Order thru the location x-ref.
+6 ;
+7 ; lets get the location without leading spaces
+8 SET ENLOCN=ENLOC
SET ENDA=""
+9 FOR
if $EXTRACT(ENLOCN,1)'=" "
QUIT
SET ENLOCN=$EXTRACT(ENLOCN,2,$LENGTH(ENLOCN))
+10 ; if nothing left then delete the location
+11 IF ENLOCN']""
FOR
SET ENDA=$ORDER(@(ENXRF_"ENLOC,ENDA)"))
if 'ENDA
QUIT
Begin DoDot:1
+12 SET DIE=$SELECT(ENFL="EQ":"^ENG(6914,",1:"^ENG(6920,")
SET DA=ENDA
+13 SET DR=$SELECT(ENFL="EQ":"24",1:"3")_"///@"
DO ^DIE
End DoDot:1
+14 ; if something left then change current location
+15 IF ENLOCN]""
FOR
SET ENDA=$ORDER(@(ENXRF_"ENLOC,ENDA)"))
if 'ENDA
QUIT
Begin DoDot:1
+16 ; update location
SET $PIECE(@ENODE,U,ENPIECE)=ENLOCN
+17 ; kill old x-ref
KILL @(ENXRF_"ENLOC,ENDA)")
+18 ; set new x-ref
SET @(ENXRF_"ENLOCN,ENDA)")=""
End DoDot:1
+19 KILL ENLOCN
+20 QUIT
RFTR ; report footer
+1 WRITE !,"# of different free-text locations = ",ENT("LOC")," (# convertible = ",ENT("LOC_CVT"),")",!
+2 WRITE "# of records with free-text locations = ",ENT("REC")," (# convertible = ",ENT("REC_CVT"),")",!!
+3 IF ENT("REC")
Begin DoDot:1
+4 WRITE "Free-Text values were found in the LOCATION field of",!
+5 WRITE ENFLNM," records. These free-text values",!
+6 IF ENCVTM
Begin DoDot:2
+7 WRITE "were either converted to pointers or identified",!
+8 WRITE "by a leading '*'. The leading astrisk ensures",!
+9 WRITE "that these values will not be inappropriately",!
+10 WRITE "evaluated as a pointer.",!
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 WRITE "should be converted to pointer values. If an exact match",!
+13 WRITE "exists in the ENG SPACE file ROOM NUMBER or SYNONYM fields",!
+14 WRITE "then option 'Convert Free-Text Locations' can be used to",!
+15 WRITE "perform the conversion. A leading '*' will be removed from",!
+16 WRITE "the free-text location before checking for a match.",!
End DoDot:2
End DoDot:1
+17 IF ENT("REC_CVT")
Begin DoDot:1
+18 WRITE !,"Convertable free-text entries were found in the ",!
+19 IF ENCVTM
Begin DoDot:2
+20 WRITE ENFLNM,". They have been converted to pointers.",!
End DoDot:2
+21 IF '$TEST
Begin DoDot:2
+22 WRITE ENFLNM,". You must use the 'Convert Free-Text Locations'",!
+23 WRITE "option for the ",ENFLNM," to actually convert",!
+24 WRITE "these values to pointers.",!
End DoDot:2
End DoDot:1
+25 IF 'ENT("REC")
Begin DoDot:1
+26 WRITE "The ",ENFLNM," LOCATION field does not contain any",!
+27 WRITE "Free-Text values. No further action is required on this file.",!
End DoDot:1
+28 QUIT