- 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 Jan 18, 2025@02:58:10 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