- ENXLFIX ;WISC/SAB-FIX POINTERS TO ENG SPACE FILE ;1-24-94
- ;;7.0;ENGINEERING;**1**;Aug 17, 1993
- EN S DIR(0)="S^EQ:EQUIPMENT FILE;WO:WORK ORDER FILE;"
- S DIR("A")=$S(ENCVTM:"Convert",1:"Report of")_" location fields in which file"
- S DIR("?")="Enter EQ or WO to select the desired file."
- S DIR("?",1)="You must choose which file to process. The LOCATION"
- S DIR("?",2)="field of the selected file will be checked and"
- I ENCVTM D
- .S DIR("?",3)="any free-text values which match an entry in the space"
- .S DIR("?",4)="file will be converted to pointers. Any unconverted"
- .S DIR("?",5)="free-text values will be identified by a leading '*'"
- E D
- .S DIR("?",3)="the number and type of free-text entries in this"
- .S DIR("?",4)="pointer field will be reported."
- S DIR("?",9)=" "
- D ^DIR K DIR I $D(DIRUT) G EXIT
- S ENFL=Y
- S ENDETAIL=1
- I ENCVTM D D ^DIR K DIR S ENDETAIL=Y I $D(DIRUT) G EXIT
- .S DIR(0)="Y",DIR("A")="Should locations be listed on output? Y/N"
- .S DIR("?")="Enter Y or N"
- .S DIR("?",1)="If you answer yes a line will be printed for each"
- .S DIR("?",2)="unique free-text location. The line will contain"
- .S DIR("?",3)="the location, the number of entries with that location,"
- .S DIR("?",4)="and if the location was converted to a pointer."
- S %ZIS="QM" D ^%ZIS G EXIT:POP
- I $D(IO("Q")) D G EXIT
- .S ZTRTN="DQ^ENXLFIX"
- .S ZTSAVE("ENCVTM")="",ZTSAVE("ENFL")="",ZTSAVE("ENDETAIL")=""
- .S ZTDESC=$S(ENCVTM:"Convert",1:"Report of")_" Locations in "_$S(ENFL="EQ":"EQUIP",1:"W.O.")_" file"
- .D ^%ZTLOAD D HOME^%ZIS K IO("Q")
- DQ ; queued entry
- S Y=DT D DD^%DT S ENDATE=Y
- S (END,ENPG,ENT("LOC"),ENT("REC"),ENT("LOC_CVT"),ENT("REC_CVT"))=0
- S ENFLNM=$S(ENFL="EQ":"Equipment File",1:"Work Order File")
- S ENXRF=$S(ENFL="EQ":"^ENG(6914,""D"",",1:"^ENG(6920,""C"",")
- S ENODE=$S(ENFL="EQ":"^ENG(6914,ENDA,3)",1:"^ENG(6920,ENDA,0)")
- S ENPIECE=$S(ENFL="EQ":5,1:4)
- U IO D HDR
- I 'ENDETAIL W !," Locations not listed by user request",!
- ; loop thru free-text locations
- S ENLOC=" " F S ENLOC=$O(@(ENXRF_"ENLOC)")) Q:ENLOC=""!END D LOCAT
- I 'END D
- .I ENCVTM,$Y+6+$S(ENT("REC"):6,1:2)+$S(ENT("REC_CVT"):3,1:0)>IOSL D HDR
- .I 'ENCVTM,$Y+6+$S(ENT("REC"):7,1:2)+$S(ENT("REC_CVT"):6,1:0)>IOSL D HDR
- I END W !,"HALTED BY USER REQUEST",!
- E D RFTR^ENXLFIX0
- D ^%ZISC
- EXIT I $D(ZTQUEUED),'$D(ZTSTOP) S ZTREQ="Q"
- K %ZIS,DA,DIE,DIRUT,DR
- K ENCVTM,ENCVTS,END,ENDA,ENDATE,ENDETAIL,ENFL,ENFLNM,ENLOC,ENODE
- K ENPG,ENPIECE,ENSPDA,ENSPLOC,ENT,ENXRF,POP,X,Y
- Q
- LOCAT ; process location
- I ENCVTM,$E(ENLOC,1)=" " D SPACES^ENXLFIX0 Q ; handle leading spaces
- S ENCVTS=0,ENT("LOC")=ENT("LOC")+1
- ; strip * for match
- S ENSPLOC=$E(ENLOC,$S($E(ENLOC,1)="*":2,1:1),$L(ENLOC))
- I ENSPLOC']"" S ENSPLOC=ENLOC
- ; match space .01?
- S ENSPDA=$O(^ENG("SP","B",ENSPLOC,""))
- ; if not match and has lowercase, uppercase match .01?
- I 'ENSPDA,ENSPLOC?.E1L.E D
- .S X=ENSPLOC X ^%ZOSF("UPPERCASE")
- .S ENSPDA=$O(^ENG("SP","B",Y,""))
- ; if we found a match to .01 (either method)
- I ENSPDA S ENCVTS=1,ENT("LOC_CVT")=ENT("LOC_CVT")+1
- ; if not match, match space synonym?
- I 'ENSPDA S ENSPDA=$O(^ENG("SP","F",ENSPLOC,"")) D:ENSPDA
- .I $O(^ENG("SP","F",ENSPLOC,ENSPDA)) S ENCVTS="M"
- .E S ENCVTS=2,ENT("LOC_CVT")=ENT("LOC_CVT")+1
- ; if still no match and free-text location has *, match synonym?
- I 'ENSPDA,ENSPLOC'=ENLOC S ENSPDA=$O(^ENG("SP","F",ENLOC,"")) D:ENSPDA
- .I $O(^ENG("SP","F",ENLOC,ENSPDA)) S ENCVTS="M"
- .E S ENCVTS=2,ENT("LOC_CVT")=ENT("LOC_CVT")+1
- ; loop thru records within location
- S ENT("REC_IN_LOC")=0,ENDA=""
- F S ENDA=$O(@(ENXRF_"ENLOC,ENDA)")) Q:'ENDA D
- .I '$D(@ENODE) K @(ENXRF_"ENLOC,ENDA)") Q ; invalid x-ref node
- .S ENT("REC_IN_LOC")=ENT("REC_IN_LOC")+1
- .I ENCVTM,ENCVTS D ; convert to pointer
- ..I ENFL="EQ",ENLOC["E" K ^ENG(6914,"D",ENLOC,ENDA) S $P(^ENG(6914,ENDA,3),U,5)=""
- ..S DIE=$S(ENFL="EQ":"^ENG(6914,",1:"^ENG(6920,"),DA=ENDA
- ..S DR=$S(ENFL="EQ":"24",1:"3")_"////"_ENSPDA D ^DIE
- .I ENCVTM,'ENCVTS,$E(ENLOC,1)'="*" D ; add leading *
- ..S $P(@ENODE,U,ENPIECE)="*"_$P(@ENODE,U,ENPIECE)
- ..K @(ENXRF_"ENLOC,ENDA)") ; old x-ref
- ..S @(ENXRF_"""*"_ENLOC_""","_ENDA_")")="" ; new x-ref
- S ENT("REC")=ENT("REC")+ENT("REC_IN_LOC")
- I ENCVTS S ENT("REC_CVT")=ENT("REC_CVT")+ENT("REC_IN_LOC")
- W:ENDETAIL ?5,ENLOC,?30,ENT("REC_IN_LOC"),?40,$S($E(ENLOC,1)=" ":"?? (leading spaces)",ENCVTS=1:"YES, by room number",ENCVTS=2:"YES, by synonym",ENCVTS="M":"NO, multiple synonyms",1:"NO"),!
- I $Y+4>IOSL D HDR
- Q
- HDR ; page header
- I $$S^%ZTLOAD S (END,ZTSTOP)=1 Q
- I ENPG,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S END='Y Q:END
- W:'($E(IOST,1,2)'="C-"&'ENPG) @IOF
- S ENPG=ENPG+1
- W ?5,"Free-Text Values in ",ENFLNM," LOCATION Fields"
- W ?60,ENDATE,?73,"page ",ENPG,!!
- W ?5,"Free-Text Location",?30,"Count"
- W ?40,"Convert"_$S(ENCVTM:"ed?",1:"ible?"),!
- W ?5,"------------------",?30,"-----",?40,"------------",!!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENXLFIX 4942 printed Jan 18, 2025@02:58:09 Page 2
- ENXLFIX ;WISC/SAB-FIX POINTERS TO ENG SPACE FILE ;1-24-94
- +1 ;;7.0;ENGINEERING;**1**;Aug 17, 1993
- EN SET DIR(0)="S^EQ:EQUIPMENT FILE;WO:WORK ORDER FILE;"
- +1 SET DIR("A")=$SELECT(ENCVTM:"Convert",1:"Report of")_" location fields in which file"
- +2 SET DIR("?")="Enter EQ or WO to select the desired file."
- +3 SET DIR("?",1)="You must choose which file to process. The LOCATION"
- +4 SET DIR("?",2)="field of the selected file will be checked and"
- +5 IF ENCVTM
- Begin DoDot:1
- +6 SET DIR("?",3)="any free-text values which match an entry in the space"
- +7 SET DIR("?",4)="file will be converted to pointers. Any unconverted"
- +8 SET DIR("?",5)="free-text values will be identified by a leading '*'"
- End DoDot:1
- +9 IF '$TEST
- Begin DoDot:1
- +10 SET DIR("?",3)="the number and type of free-text entries in this"
- +11 SET DIR("?",4)="pointer field will be reported."
- End DoDot:1
- +12 SET DIR("?",9)=" "
- +13 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO EXIT
- +14 SET ENFL=Y
- +15 SET ENDETAIL=1
- +16 IF ENCVTM
- Begin DoDot:1
- +17 SET DIR(0)="Y"
- SET DIR("A")="Should locations be listed on output? Y/N"
- +18 SET DIR("?")="Enter Y or N"
- +19 SET DIR("?",1)="If you answer yes a line will be printed for each"
- +20 SET DIR("?",2)="unique free-text location. The line will contain"
- +21 SET DIR("?",3)="the location, the number of entries with that location,"
- +22 SET DIR("?",4)="and if the location was converted to a pointer."
- End DoDot:1
- DO ^DIR
- KILL DIR
- SET ENDETAIL=Y
- IF $DATA(DIRUT)
- GOTO EXIT
- +23 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO EXIT
- +24 IF $DATA(IO("Q"))
- Begin DoDot:1
- +25 SET ZTRTN="DQ^ENXLFIX"
- +26 SET ZTSAVE("ENCVTM")=""
- SET ZTSAVE("ENFL")=""
- SET ZTSAVE("ENDETAIL")=""
- +27 SET ZTDESC=$SELECT(ENCVTM:"Convert",1:"Report of")_" Locations in "_$SELECT(ENFL="EQ":"EQUIP",1:"W.O.")_" file"
- +28 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL IO("Q")
- End DoDot:1
- GOTO EXIT
- DQ ; queued entry
- +1 SET Y=DT
- DO DD^%DT
- SET ENDATE=Y
- +2 SET (END,ENPG,ENT("LOC"),ENT("REC"),ENT("LOC_CVT"),ENT("REC_CVT"))=0
- +3 SET ENFLNM=$SELECT(ENFL="EQ":"Equipment File",1:"Work Order File")
- +4 SET ENXRF=$SELECT(ENFL="EQ":"^ENG(6914,""D"",",1:"^ENG(6920,""C"",")
- +5 SET ENODE=$SELECT(ENFL="EQ":"^ENG(6914,ENDA,3)",1:"^ENG(6920,ENDA,0)")
- +6 SET ENPIECE=$SELECT(ENFL="EQ":5,1:4)
- +7 USE IO
- DO HDR
- +8 IF 'ENDETAIL
- WRITE !," Locations not listed by user request",!
- +9 ; loop thru free-text locations
- +10 SET ENLOC=" "
- FOR
- SET ENLOC=$ORDER(@(ENXRF_"ENLOC)"))
- if ENLOC=""!END
- QUIT
- DO LOCAT
- +11 IF 'END
- Begin DoDot:1
- +12 IF ENCVTM
- IF $Y+6+$SELECT(ENT("REC"):6,1:2)+$SELECT(ENT("REC_CVT"):3,1:0)>IOSL
- DO HDR
- +13 IF 'ENCVTM
- IF $Y+6+$SELECT(ENT("REC"):7,1:2)+$SELECT(ENT("REC_CVT"):6,1:0)>IOSL
- DO HDR
- End DoDot:1
- +14 IF END
- WRITE !,"HALTED BY USER REQUEST",!
- +15 IF '$TEST
- DO RFTR^ENXLFIX0
- +16 DO ^%ZISC
- EXIT IF $DATA(ZTQUEUED)
- IF '$DATA(ZTSTOP)
- SET ZTREQ="Q"
- +1 KILL %ZIS,DA,DIE,DIRUT,DR
- +2 KILL ENCVTM,ENCVTS,END,ENDA,ENDATE,ENDETAIL,ENFL,ENFLNM,ENLOC,ENODE
- +3 KILL ENPG,ENPIECE,ENSPDA,ENSPLOC,ENT,ENXRF,POP,X,Y
- +4 QUIT
- LOCAT ; process location
- +1 ; handle leading spaces
- IF ENCVTM
- IF $EXTRACT(ENLOC,1)=" "
- DO SPACES^ENXLFIX0
- QUIT
- +2 SET ENCVTS=0
- SET ENT("LOC")=ENT("LOC")+1
- +3 ; strip * for match
- +4 SET ENSPLOC=$EXTRACT(ENLOC,$SELECT($EXTRACT(ENLOC,1)="*":2,1:1),$LENGTH(ENLOC))
- +5 IF ENSPLOC']""
- SET ENSPLOC=ENLOC
- +6 ; match space .01?
- +7 SET ENSPDA=$ORDER(^ENG("SP","B",ENSPLOC,""))
- +8 ; if not match and has lowercase, uppercase match .01?
- +9 IF 'ENSPDA
- IF ENSPLOC?.E1L.E
- Begin DoDot:1
- +10 SET X=ENSPLOC
- XECUTE ^%ZOSF("UPPERCASE")
- +11 SET ENSPDA=$ORDER(^ENG("SP","B",Y,""))
- End DoDot:1
- +12 ; if we found a match to .01 (either method)
- +13 IF ENSPDA
- SET ENCVTS=1
- SET ENT("LOC_CVT")=ENT("LOC_CVT")+1
- +14 ; if not match, match space synonym?
- +15 IF 'ENSPDA
- SET ENSPDA=$ORDER(^ENG("SP","F",ENSPLOC,""))
- if ENSPDA
- Begin DoDot:1
- +16 IF $ORDER(^ENG("SP","F",ENSPLOC,ENSPDA))
- SET ENCVTS="M"
- +17 IF '$TEST
- SET ENCVTS=2
- SET ENT("LOC_CVT")=ENT("LOC_CVT")+1
- End DoDot:1
- +18 ; if still no match and free-text location has *, match synonym?
- +19 IF 'ENSPDA
- IF ENSPLOC'=ENLOC
- SET ENSPDA=$ORDER(^ENG("SP","F",ENLOC,""))
- if ENSPDA
- Begin DoDot:1
- +20 IF $ORDER(^ENG("SP","F",ENLOC,ENSPDA))
- SET ENCVTS="M"
- +21 IF '$TEST
- SET ENCVTS=2
- SET ENT("LOC_CVT")=ENT("LOC_CVT")+1
- End DoDot:1
- +22 ; loop thru records within location
- +23 SET ENT("REC_IN_LOC")=0
- SET ENDA=""
- +24 FOR
- SET ENDA=$ORDER(@(ENXRF_"ENLOC,ENDA)"))
- if 'ENDA
- QUIT
- Begin DoDot:1
- +25 ; invalid x-ref node
- IF '$DATA(@ENODE)
- KILL @(ENXRF_"ENLOC,ENDA)")
- QUIT
- +26 SET ENT("REC_IN_LOC")=ENT("REC_IN_LOC")+1
- +27 ; convert to pointer
- IF ENCVTM
- IF ENCVTS
- Begin DoDot:2
- +28 IF ENFL="EQ"
- IF ENLOC["E"
- KILL ^ENG(6914,"D",ENLOC,ENDA)
- SET $PIECE(^ENG(6914,ENDA,3),U,5)=""
- +29 SET DIE=$SELECT(ENFL="EQ":"^ENG(6914,",1:"^ENG(6920,")
- SET DA=ENDA
- +30 SET DR=$SELECT(ENFL="EQ":"24",1:"3")_"////"_ENSPDA
- DO ^DIE
- End DoDot:2
- +31 ; add leading *
- IF ENCVTM
- IF 'ENCVTS
- IF $EXTRACT(ENLOC,1)'="*"
- Begin DoDot:2
- +32 SET $PIECE(@ENODE,U,ENPIECE)="*"_$PIECE(@ENODE,U,ENPIECE)
- +33 ; old x-ref
- KILL @(ENXRF_"ENLOC,ENDA)")
- +34 ; new x-ref
- SET @(ENXRF_"""*"_ENLOC_""","_ENDA_")")=""
- End DoDot:2
- End DoDot:1
- +35 SET ENT("REC")=ENT("REC")+ENT("REC_IN_LOC")
- +36 IF ENCVTS
- SET ENT("REC_CVT")=ENT("REC_CVT")+ENT("REC_IN_LOC")
- +37 if ENDETAIL
- WRITE ?5,ENLOC,?30,ENT("REC_IN_LOC"),?40,$SELECT($EXTRACT(ENLOC,1)=" ":"?? (leading spaces)",ENCVTS=1:"YES, by room number",ENCVTS=2:"YES, by synonym",ENCVTS="M":"NO, multiple synonyms",1:"NO"),!
- +38 IF $Y+4>IOSL
- DO HDR
- +39 QUIT
- HDR ; page header
- +1 IF $$S^%ZTLOAD
- SET (END,ZTSTOP)=1
- QUIT
- +2 IF ENPG
- IF $EXTRACT(IOST,1,2)="C-"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- SET END='Y
- if END
- QUIT
- +3 if '($EXTRACT(IOST,1,2)'="C-"&'ENPG)
- WRITE @IOF
- +4 SET ENPG=ENPG+1
- +5 WRITE ?5,"Free-Text Values in ",ENFLNM," LOCATION Fields"
- +6 WRITE ?60,ENDATE,?73,"page ",ENPG,!!
- +7 WRITE ?5,"Free-Text Location",?30,"Count"
- +8 WRITE ?40,"Convert"_$SELECT(ENCVTM:"ed?",1:"ible?"),!
- +9 WRITE ?5,"------------------",?30,"-----",?40,"------------",!!
- +10 QUIT