ENSPSRT ;(WIRMFO)/DH-Sort by LOCATION ;6.18.97
;;7.0;ENGINEERING;**35,42**;Aug 17, 1993
GEN ; Full SORT
; Builds ENSRT(x) array
N EN,ENI,I
S ENSRT("DIV")=0 I $D(^ENG(6928.3,"D")) S ENSRT("DIV")=1
I ENSRT("DIV") S DIR(0)="S^1:DIV, BLDG, WING, ROOM;2:DIV, WING, BLDG, ROOM;3:DIV, BLDG, ROOM;4:BLDG, WING, ROOM;5:WING, BLDG, ROOM;6:BLDG, ROOM;7:WING, ROOM;8:ROOM"
E S DIR(0)="S^1:BLDG, WING, ROOM;2:WING, BLDG, ROOM;3:BLDG, ROOM;4:WING, ROOM;5:ROOM"
S DIR("A")="Choose 'SELECT BY' Parameters",DIR("B")=$S(ENSRT("DIV"):3,1:1)
D ^DIR K DIR I $D(DIRUT) K ENSRT G EXIT
I ENSRT("DIV") S ENSRT("BY")=$S(Y=1:"DBWR",Y=2:"DWBR",Y=3:"DBR",Y=4:"BWR",Y=5:"WBR",Y=6:"BR",Y=7:"WR",Y=8:"R",1:"")
E S ENSRT("BY")=$S(Y=1:"BWR",Y=2:"WBR",Y=3:"BR",Y=4:"WR",Y=5:"R",1:"")
I ENSRT("BY")="" K ENSRT G EXIT ;Shouldn't happen
S DIR(0)="Y",DIR("A")="Would you like to specify a range of LOCATIONS",DIR("B")="NO"
S DIR("?",1)=" Enter 'YES' if you want only some "_$S(ENSRT("DIV"):"DIVISIONS, ",1:"")_"BUILDINGS, WINGS, or ROOMS."
S DIR("?")=" Enter 'NO' if you want to include all LOCATIONS."
D ^DIR K DIR I $D(DIRUT) K ENSRT G EXIT
S ENSRT("LOC","ALL")=$S(Y:0,1:1) G:ENSRT("LOC","ALL") EXIT
;
F ENI=1:1:$L(ENSRT("BY")) S PARAM=$E(ENSRT("BY"),ENI) D @PARAM Q:$D(DIRUT)
G EXIT
;
D ; DIVISION range
S DIR("A",1)=""
S DIR("A",2)="Enter individual DIVISIONS (ex: "_$O(^ENG(6928.3,"D",0))_") separated by comas, or a range of"
S DIR("A",3)="DIVISIONS separated by a colon, or 'ALL' for all DIVISIONS. The '@'"
S DIR("A",4)="character represents the empty set (no DIVISION), and 'ALL' includes"
S DIR("A",5)="entries with no DIVISION."
S DIR("A",6)=""
S DIR("A",7)=" For example, 'OPC,JB:JBZ' would yield the OPC division and all divisions"
S DIR("A",8)=" beginning with JB. The ""@"" character (which must be enclosed in double"
S DIR("A",9)=" quotes) would yield entries having no division, and '@:C' would yield"
S DIR("A",10)=" entries having no division and entries with a division beginning with '0'"
S DIR("A",11)=" through '9' or 'A' through 'C' (numbers collate before letters)."
S DIR("A",12)=""
S DIR(0)="F^1:100",DIR("A")="Select DIVISION(S)"
D ^DIR K DIR Q:$D(DIRUT)
K EN F I=1:1 S EN(I)=$P(Y,",",I) Q:EN(I)=""
S I=0 F S I=$O(EN(I)) Q:EN(I)="" D
. I EN(I)="ALL" S ENSRT("DIV","ALL")="" Q
. I EN(I)'[":" S:EN(I)="""@""" EN(I)="NULL" S ENSRT("DIV","AIND",EN(I))="" Q
. I $P(EN(I),":",2)="@",$P(EN(I),":")'="@" Q
. I $P(EN(I),":")="@" D Q
.. S ENSRT("DIV","FR",I)=""
.. S ENSRT("DIV","TO",I)=$S($P(EN(I),":",2)="@":"",1:$P(EN(I),":",2)_"z")
. I $P(EN(I),":")']$P(EN(I),":",2) D
.. S ENSRT("DIV","FR",I)=$P(EN(I),":")
.. S ENSRT("DIV","TO",I)=$P(EN(I),":",2)
Q
B ; BUILDING range
S DIR("A",1)=""
S DIR("A",2)="Enter individual BUILDINGS separated by comas, or a range of BUILDINGS"
S DIR("A",3)="separated by a colon, or 'ALL' for all BUILDINGS."
S DIR("A",4)=""
S DIR("A",5)=" For example, '13,100:114A,65' would yield buildings 13 and 65 and all"
S DIR("A",6)=" buildings from 100 thru 114A (inclusive)."
S DIR("A",7)=""
S DIR(0)="F^1:200",DIR("A")="Select BUILDING(S)",DIR("B")="ALL"
D ^DIR K DIR Q:$D(DIRUT)
K EN F I=1:1 S EN(I)=$P(Y,",",I) Q:EN(I)=""
S I=0 F S I=$O(EN(I)) Q:EN(I)="" D
. I EN(I)="ALL" S ENSRT("BLDG","ALL")="" Q
. I EN(I)'[":" S:EN(I)="""@""" EN(I)="NULL" S ENSRT("BLDG","AIND",EN(I))="" Q
. I $P(EN(I),":",2)="@",$P(EN(I),":")'="@" Q
. I $P(EN(I),":")="@" D Q
.. S ENSRT("BLDG","FR",I)=""
.. S ENSRT("BLDG","TO",I)=$S($P(EN(I),":",2)="@":"",1:$P(EN(I),":",2))
. I $P(EN(I),":")']$P(EN(I),":",2) D
.. S ENSRT("BLDG","FR",I)=$P(EN(I),":")
.. S ENSRT("BLDG","TO",I)=$P(EN(I),":",2)
Q
W ; WING range
S DIR("A",1)=""
S DIR("A",2)="Enter individual WINGS separated by comas, or a range of WINGS separated"
S DIR("A",3)="by a colon, or 'ALL' for all WINGS. The ""@"" (double quotes are necessary)"
S DIR("A",4)="character represents null WINGS, and 'ALL' will include entries with no WING."
S DIR("A",5)=""
S DIR("A",6)=" For example, '4,3A:3C' would yield WINGS 4 and 3A through 3C (inclusive)."
S DIR("A",7)=" The ""@"" character would yield only those entries having no WING."
S DIR("A",8)=" Note that numbers collate before letters."
S DIR("A",9)=""
S DIR(0)="F^1:150",DIR("A")="Select WING(S)",DIR("B")="ALL"
D ^DIR K DIR Q:$D(DIRUT)
K EN F I=1:1 S EN(I)=$P(Y,",",I) Q:EN(I)=""
S I=0 F S I=$O(EN(I)) Q:EN(I)="" D
. I EN(I)="ALL" S ENSRT("WING","ALL")="" Q
. I EN(I)'[":" S:EN(I)="""@""" EN(I)="NULL" S ENSRT("WING","AIND",EN(I))="" Q
. I $P(EN(I),":",2)="@",$P(EN(I),":")'="@" Q
. I $P(EN(I),":")="@" D Q
.. S ENSRT("WING","FR",I)=""
.. S ENSRT("WING","TO",I)=$S($P(EN(I),":",2)="@":"",1:$P(EN(I),":",2)_"z")
. I $P(EN(I),":")']$P(EN(I),":",2) D
.. S ENSRT("WING","FR",I)=$P(EN(I),":")
.. S ENSRT("WING","TO",I)=$P(EN(I),":",2)
Q
R ; ROOM range
S DIR("A",1)=""
S DIR("A",2)="Enter individual ROOMS separated by comas, or a range of ROOMS separated"
S DIR("A",3)="by a colon, or 'ALL' for all ROOMS. The ""@"" character will not be accepted"
S DIR("A",4)="because NULL ROOMS cannot exist."
S DIR("A",4)=""
S DIR("A",5)=" For example, '501,100:299' would yield all rooms numbered 501 and all"
S DIR("A",6)=" rooms whose first three characters are between 100 and 299 (inclusive)."
S DIR("A",7)=" Remember that numbers collate before letters."
S DIR("A",8)=""
S DIR(0)="F^1:200",DIR("A")="Select ROOM(S)",DIR("B")="ALL"
D ^DIR K DIR Q:$D(DIRUT)
K EN F I=1:1 S EN(I)=$P(Y,",",I) Q:EN(I)=""
S I=0 F S I=$O(EN(I)) Q:EN(I)="" D I Y["@" W !!,"The ROOM cannot possibly be NULL. Perhaps you mean 'ALL'." G R
. I Y="ALL" S ENSRT("ROOM","ALL")="" Q
. I Y["@" Q ;Can't have null ROOMS
. I Y'[":" S ENSRT("ROOM","AIND",EN(I))="" Q
. I $P(EN(I),":")']$P(EN(I),":",2) D
.. S ENSRT("ROOM","FR",I)=$P(EN(I),":")
.. S ENSRT("ROOM","TO",I)=$P(EN(I),":",2)_"z"
Q
;
EXIT K:$D(DIRUT) ENSRT
Q
;ENSPSRT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENSPSRT 6053 printed Nov 22, 2024@17:05:52 Page 2
ENSPSRT ;(WIRMFO)/DH-Sort by LOCATION ;6.18.97
+1 ;;7.0;ENGINEERING;**35,42**;Aug 17, 1993
GEN ; Full SORT
+1 ; Builds ENSRT(x) array
+2 NEW EN,ENI,I
+3 SET ENSRT("DIV")=0
IF $DATA(^ENG(6928.3,"D"))
SET ENSRT("DIV")=1
+4 IF ENSRT("DIV")
SET DIR(0)="S^1:DIV, BLDG, WING, ROOM;2:DIV, WING, BLDG, ROOM;3:DIV, BLDG, ROOM;4:BLDG, WING, ROOM;5:WING, BLDG, ROOM;6:BLDG, ROOM;7:WING, ROOM;8:ROOM"
+5 IF '$TEST
SET DIR(0)="S^1:BLDG, WING, ROOM;2:WING, BLDG, ROOM;3:BLDG, ROOM;4:WING, ROOM;5:ROOM"
+6 SET DIR("A")="Choose 'SELECT BY' Parameters"
SET DIR("B")=$SELECT(ENSRT("DIV"):3,1:1)
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
KILL ENSRT
GOTO EXIT
+8 IF ENSRT("DIV")
SET ENSRT("BY")=$SELECT(Y=1:"DBWR",Y=2:"DWBR",Y=3:"DBR",Y=4:"BWR",Y=5:"WBR",Y=6:"BR",Y=7:"WR",Y=8:"R",1:"")
+9 IF '$TEST
SET ENSRT("BY")=$SELECT(Y=1:"BWR",Y=2:"WBR",Y=3:"BR",Y=4:"WR",Y=5:"R",1:"")
+10 ;Shouldn't happen
IF ENSRT("BY")=""
KILL ENSRT
GOTO EXIT
+11 SET DIR(0)="Y"
SET DIR("A")="Would you like to specify a range of LOCATIONS"
SET DIR("B")="NO"
+12 SET DIR("?",1)=" Enter 'YES' if you want only some "_$SELECT(ENSRT("DIV"):"DIVISIONS, ",1:"")_"BUILDINGS, WINGS, or ROOMS."
+13 SET DIR("?")=" Enter 'NO' if you want to include all LOCATIONS."
+14 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
KILL ENSRT
GOTO EXIT
+15 SET ENSRT("LOC","ALL")=$SELECT(Y:0,1:1)
if ENSRT("LOC","ALL")
GOTO EXIT
+16 ;
+17 FOR ENI=1:1:$LENGTH(ENSRT("BY"))
SET PARAM=$EXTRACT(ENSRT("BY"),ENI)
DO @PARAM
if $DATA(DIRUT)
QUIT
+18 GOTO EXIT
+19 ;
D ; DIVISION range
+1 SET DIR("A",1)=""
+2 SET DIR("A",2)="Enter individual DIVISIONS (ex: "_$ORDER(^ENG(6928.3,"D",0))_") separated by comas, or a range of"
+3 SET DIR("A",3)="DIVISIONS separated by a colon, or 'ALL' for all DIVISIONS. The '@'"
+4 SET DIR("A",4)="character represents the empty set (no DIVISION), and 'ALL' includes"
+5 SET DIR("A",5)="entries with no DIVISION."
+6 SET DIR("A",6)=""
+7 SET DIR("A",7)=" For example, 'OPC,JB:JBZ' would yield the OPC division and all divisions"
+8 SET DIR("A",8)=" beginning with JB. The ""@"" character (which must be enclosed in double"
+9 SET DIR("A",9)=" quotes) would yield entries having no division, and '@:C' would yield"
+10 SET DIR("A",10)=" entries having no division and entries with a division beginning with '0'"
+11 SET DIR("A",11)=" through '9' or 'A' through 'C' (numbers collate before letters)."
+12 SET DIR("A",12)=""
+13 SET DIR(0)="F^1:100"
SET DIR("A")="Select DIVISION(S)"
+14 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+15 KILL EN
FOR I=1:1
SET EN(I)=$PIECE(Y,",",I)
if EN(I)=""
QUIT
+16 SET I=0
FOR
SET I=$ORDER(EN(I))
if EN(I)=""
QUIT
Begin DoDot:1
+17 IF EN(I)="ALL"
SET ENSRT("DIV","ALL")=""
QUIT
+18 IF EN(I)'[":"
if EN(I)="""@"""
SET EN(I)="NULL"
SET ENSRT("DIV","AIND",EN(I))=""
QUIT
+19 IF $PIECE(EN(I),":",2)="@"
IF $PIECE(EN(I),":")'="@"
QUIT
+20 IF $PIECE(EN(I),":")="@"
Begin DoDot:2
+21 SET ENSRT("DIV","FR",I)=""
+22 SET ENSRT("DIV","TO",I)=$SELECT($PIECE(EN(I),":",2)="@":"",1:$PIECE(EN(I),":",2)_"z")
End DoDot:2
QUIT
+23 IF $PIECE(EN(I),":")']$PIECE(EN(I),":",2)
Begin DoDot:2
+24 SET ENSRT("DIV","FR",I)=$PIECE(EN(I),":")
+25 SET ENSRT("DIV","TO",I)=$PIECE(EN(I),":",2)
End DoDot:2
End DoDot:1
+26 QUIT
B ; BUILDING range
+1 SET DIR("A",1)=""
+2 SET DIR("A",2)="Enter individual BUILDINGS separated by comas, or a range of BUILDINGS"
+3 SET DIR("A",3)="separated by a colon, or 'ALL' for all BUILDINGS."
+4 SET DIR("A",4)=""
+5 SET DIR("A",5)=" For example, '13,100:114A,65' would yield buildings 13 and 65 and all"
+6 SET DIR("A",6)=" buildings from 100 thru 114A (inclusive)."
+7 SET DIR("A",7)=""
+8 SET DIR(0)="F^1:200"
SET DIR("A")="Select BUILDING(S)"
SET DIR("B")="ALL"
+9 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+10 KILL EN
FOR I=1:1
SET EN(I)=$PIECE(Y,",",I)
if EN(I)=""
QUIT
+11 SET I=0
FOR
SET I=$ORDER(EN(I))
if EN(I)=""
QUIT
Begin DoDot:1
+12 IF EN(I)="ALL"
SET ENSRT("BLDG","ALL")=""
QUIT
+13 IF EN(I)'[":"
if EN(I)="""@"""
SET EN(I)="NULL"
SET ENSRT("BLDG","AIND",EN(I))=""
QUIT
+14 IF $PIECE(EN(I),":",2)="@"
IF $PIECE(EN(I),":")'="@"
QUIT
+15 IF $PIECE(EN(I),":")="@"
Begin DoDot:2
+16 SET ENSRT("BLDG","FR",I)=""
+17 SET ENSRT("BLDG","TO",I)=$SELECT($PIECE(EN(I),":",2)="@":"",1:$PIECE(EN(I),":",2))
End DoDot:2
QUIT
+18 IF $PIECE(EN(I),":")']$PIECE(EN(I),":",2)
Begin DoDot:2
+19 SET ENSRT("BLDG","FR",I)=$PIECE(EN(I),":")
+20 SET ENSRT("BLDG","TO",I)=$PIECE(EN(I),":",2)
End DoDot:2
End DoDot:1
+21 QUIT
W ; WING range
+1 SET DIR("A",1)=""
+2 SET DIR("A",2)="Enter individual WINGS separated by comas, or a range of WINGS separated"
+3 SET DIR("A",3)="by a colon, or 'ALL' for all WINGS. The ""@"" (double quotes are necessary)"
+4 SET DIR("A",4)="character represents null WINGS, and 'ALL' will include entries with no WING."
+5 SET DIR("A",5)=""
+6 SET DIR("A",6)=" For example, '4,3A:3C' would yield WINGS 4 and 3A through 3C (inclusive)."
+7 SET DIR("A",7)=" The ""@"" character would yield only those entries having no WING."
+8 SET DIR("A",8)=" Note that numbers collate before letters."
+9 SET DIR("A",9)=""
+10 SET DIR(0)="F^1:150"
SET DIR("A")="Select WING(S)"
SET DIR("B")="ALL"
+11 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+12 KILL EN
FOR I=1:1
SET EN(I)=$PIECE(Y,",",I)
if EN(I)=""
QUIT
+13 SET I=0
FOR
SET I=$ORDER(EN(I))
if EN(I)=""
QUIT
Begin DoDot:1
+14 IF EN(I)="ALL"
SET ENSRT("WING","ALL")=""
QUIT
+15 IF EN(I)'[":"
if EN(I)="""@"""
SET EN(I)="NULL"
SET ENSRT("WING","AIND",EN(I))=""
QUIT
+16 IF $PIECE(EN(I),":",2)="@"
IF $PIECE(EN(I),":")'="@"
QUIT
+17 IF $PIECE(EN(I),":")="@"
Begin DoDot:2
+18 SET ENSRT("WING","FR",I)=""
+19 SET ENSRT("WING","TO",I)=$SELECT($PIECE(EN(I),":",2)="@":"",1:$PIECE(EN(I),":",2)_"z")
End DoDot:2
QUIT
+20 IF $PIECE(EN(I),":")']$PIECE(EN(I),":",2)
Begin DoDot:2
+21 SET ENSRT("WING","FR",I)=$PIECE(EN(I),":")
+22 SET ENSRT("WING","TO",I)=$PIECE(EN(I),":",2)
End DoDot:2
End DoDot:1
+23 QUIT
R ; ROOM range
+1 SET DIR("A",1)=""
+2 SET DIR("A",2)="Enter individual ROOMS separated by comas, or a range of ROOMS separated"
+3 SET DIR("A",3)="by a colon, or 'ALL' for all ROOMS. The ""@"" character will not be accepted"
+4 SET DIR("A",4)="because NULL ROOMS cannot exist."
+5 SET DIR("A",4)=""
+6 SET DIR("A",5)=" For example, '501,100:299' would yield all rooms numbered 501 and all"
+7 SET DIR("A",6)=" rooms whose first three characters are between 100 and 299 (inclusive)."
+8 SET DIR("A",7)=" Remember that numbers collate before letters."
+9 SET DIR("A",8)=""
+10 SET DIR(0)="F^1:200"
SET DIR("A")="Select ROOM(S)"
SET DIR("B")="ALL"
+11 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+12 KILL EN
FOR I=1:1
SET EN(I)=$PIECE(Y,",",I)
if EN(I)=""
QUIT
+13 SET I=0
FOR
SET I=$ORDER(EN(I))
if EN(I)=""
QUIT
Begin DoDot:1
+14 IF Y="ALL"
SET ENSRT("ROOM","ALL")=""
QUIT
+15 ;Can't have null ROOMS
IF Y["@"
QUIT
+16 IF Y'[":"
SET ENSRT("ROOM","AIND",EN(I))=""
QUIT
+17 IF $PIECE(EN(I),":")']$PIECE(EN(I),":",2)
Begin DoDot:2
+18 SET ENSRT("ROOM","FR",I)=$PIECE(EN(I),":")
+19 SET ENSRT("ROOM","TO",I)=$PIECE(EN(I),":",2)_"z"
End DoDot:2
End DoDot:1
IF Y["@"
WRITE !!,"The ROOM cannot possibly be NULL. Perhaps you mean 'ALL'."
GOTO R
+20 QUIT
+21 ;
EXIT if $DATA(DIRUT)
KILL ENSRT
+1 QUIT
+2 ;ENSPSRT
