ENSP2 ;(WCIOFO)/WDS@CHARLESTON,SAB-DISPLAY ROOM DATA ;7/8/1999
;;7.0;ENGINEERING;**62**;Aug 17, 1993
;
HDR W @IOF,!,?15,"ENGINEERING SPACE INVENTORY REPORT MENU",!!
Q
ENT ;DISPLAY ROOM/SPACE DATA
S DIC="^ENG(""SP"",",DIE=DIC,DIC(0)="AEQM",J=0
D ^DIC S DA=+Y G:DA<1 EXIT W @IOF
START F X=1:1:28 S EN(X)=""
S (EN(18,1),EN(18,2),EN(18,3))=""
S EN("SYN")=""
K EN("OKEY")
;
FDAT I $D(^ENG("SP",DA,0))>0 S EN(1)=$P(^(0),"^",1),EN(2)=$P(^(0),"^",2),EN(3)=$P(^(0),"^",3),EN(4)=$P(^(0),"^",4),EN(5)=$P(^(0),"^",5),EN(6)=$P(^(0),"^",6),EN(7)=$P(^(0),"^",7),EN(8)=$P(^(0),"^",8),EN(9)=$P(^(0),"^",9) D SSER D:EN(5)'="" SKEY
FDAT1 I $D(^ENG("SP",DA,0))>0 S EN(15)=$P(^(0),"^",11),EN(16)=$P(^(0),"^",12),EN(17)=$P(^(0),"^",13),EN(22)=$P(^(0),"^",16),EN(25)=$P(^(0),"^",18)
FDAT2 I $D(^ENG("SP",DA,2))>0 S EN(10)=$P(^(2),"^",2),EN(11)=$P(^(2),"^",3),EN(12)=$P(^(2),"^",4),EN(13)=$P(^(2),"^",5),EN(14)=$P(^(2),"^",6),EN(21)=$P(^(2),"^",8),EN(23)=$P(^(2),"^",9),EN(24)=$P(^(2),"^",10)
FDAT21 I $D(^ENG("SP",DA,2))>0 S EN(26)=$P(^(2),"^",13)
MLITE I $D(^ENG("SP",DA,6,0)) S ENXT=0 D MLITE1
;
MUTL I $D(^ENG("SP",DA,1,0)) S J=27,ENTNX=0 D MUTIL
;
SYN I $D(^ENG("SP",DA,8,0)) D
. F I=0:0 S I=$O(^ENG("SP",DA,8,I)) Q:I'>0 D
.. S:EN("SYN")]"" EN("SYN")=EN("SYN")_"; "
.. S EN("SYN")=EN("SYN")_$P(^ENG("SP",DA,8,I,0),U)
OKEY ;get other keys (I = ien of other key, ENJ = last output line # used)
; loop thru other keys multiple
S (I,ENJ)=0 F S I=$O(^ENG("SP",DA,5,I)) Q:'I D
. N ENX
. S ENX=$P($G(^ENG("SP",DA,5,I,0)),U) Q:ENX=""
. ; if no values stored yet then initialize first line
. I ENJ=0 S ENJ=1,EN("OKEY",ENJ)=""
. ; if value won't fit on this line then add another line
. I $L(EN("OKEY",ENJ))+$L(ENX)>60 D
. . S EN("OKEY",ENJ)=EN("OKEY",ENJ)_";"
. . S ENJ=ENJ+1,EN("OKEY",ENJ)=""
. ; add value to line
. S EN("OKEY",ENJ)=EN("OKEY",ENJ)_$S(EN("OKEY",ENJ)]"":"; ",1:"")_ENX
;
G ^ENSP3
SSER I EN(4)'="" S:$D(^DIC(49,EN(4),0))>0 EN(4)=$P(^DIC(49,EN(4),0),"^",1)
Q
SKEY I $D(^ENG("LK",EN(5),0))>0 S EN(5)=$P(^ENG("LK",EN(5),0),"^",1)
Q
;
MUTIL S ENTNX=$O(^ENG("SP",DA,1,ENTNX)) Q:ENTNX="" S ENTEMP=$P(^ENG("SP",DA,1,ENTNX,0),"^",1),EN(J)=^ENG(6928.2,ENTEMP,0),J=J+1 G MUTIL
MLITE1 F J=18:1:20 S ENXT=$O(^ENG("SP",DA,6,ENXT)) Q:ENXT="" F ENML=1:1:3 S EN(J,ENML)=$P(^ENG("SP",DA,6,ENXT,0),"^",ENML)
Q
EXIT K DIC,DIE,ENML,ENTEMP,ENXT,ENTNX,I,J,K,O,S,X,Y Q
;ENSP2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENSP2 2429 printed Dec 13, 2024@01:55:40 Page 2
ENSP2 ;(WCIOFO)/WDS@CHARLESTON,SAB-DISPLAY ROOM DATA ;7/8/1999
+1 ;;7.0;ENGINEERING;**62**;Aug 17, 1993
+2 ;
HDR WRITE @IOF,!,?15,"ENGINEERING SPACE INVENTORY REPORT MENU",!!
+1 QUIT
ENT ;DISPLAY ROOM/SPACE DATA
+1 SET DIC="^ENG(""SP"","
SET DIE=DIC
SET DIC(0)="AEQM"
SET J=0
+2 DO ^DIC
SET DA=+Y
if DA<1
GOTO EXIT
WRITE @IOF
START FOR X=1:1:28
SET EN(X)=""
+1 SET (EN(18,1),EN(18,2),EN(18,3))=""
+2 SET EN("SYN")=""
+3 KILL EN("OKEY")
+4 ;
FDAT IF $DATA(^ENG("SP",DA,0))>0
SET EN(1)=$PIECE(^(0),"^",1)
SET EN(2)=$PIECE(^(0),"^",2)
SET EN(3)=$PIECE(^(0),"^",3)
SET EN(4)=$PIECE(^(0),"^",4)
SET EN(5)=$PIECE(^(0),"^",5)
SET EN(6)=$PIECE(^(0),"^",6)
SET EN(7)=$PIECE(^(0),"^",7)
SET EN(8)=$PIECE(^(0),"^",8)
SET EN(9)=$PIECE(^(0),"^",9)
DO SSER
if EN(5)'=""
DO SKEY
FDAT1 IF $DATA(^ENG("SP",DA,0))>0
SET EN(15)=$PIECE(^(0),"^",11)
SET EN(16)=$PIECE(^(0),"^",12)
SET EN(17)=$PIECE(^(0),"^",13)
SET EN(22)=$PIECE(^(0),"^",16)
SET EN(25)=$PIECE(^(0),"^",18)
FDAT2 IF $DATA(^ENG("SP",DA,2))>0
SET EN(10)=$PIECE(^(2),"^",2)
SET EN(11)=$PIECE(^(2),"^",3)
SET EN(12)=$PIECE(^(2),"^",4)
SET EN(13)=$PIECE(^(2),"^",5)
SET EN(14)=$PIECE(^(2),"^",6)
SET EN(21)=$PIECE(^(2),"^",8)
SET EN(23)=$PIECE(^(2),"^",9)
SET EN(24)=$PIECE(^(2),"^",10)
FDAT21 IF $DATA(^ENG("SP",DA,2))>0
SET EN(26)=$PIECE(^(2),"^",13)
MLITE IF $DATA(^ENG("SP",DA,6,0))
SET ENXT=0
DO MLITE1
+1 ;
MUTL IF $DATA(^ENG("SP",DA,1,0))
SET J=27
SET ENTNX=0
DO MUTIL
+1 ;
SYN IF $DATA(^ENG("SP",DA,8,0))
Begin DoDot:1
+1 FOR I=0:0
SET I=$ORDER(^ENG("SP",DA,8,I))
if I'>0
QUIT
Begin DoDot:2
+2 if EN("SYN")]""
SET EN("SYN")=EN("SYN")_"; "
+3 SET EN("SYN")=EN("SYN")_$PIECE(^ENG("SP",DA,8,I,0),U)
End DoDot:2
End DoDot:1
OKEY ;get other keys (I = ien of other key, ENJ = last output line # used)
+1 ; loop thru other keys multiple
+2 SET (I,ENJ)=0
FOR
SET I=$ORDER(^ENG("SP",DA,5,I))
if 'I
QUIT
Begin DoDot:1
+3 NEW ENX
+4 SET ENX=$PIECE($GET(^ENG("SP",DA,5,I,0)),U)
if ENX=""
QUIT
+5 ; if no values stored yet then initialize first line
+6 IF ENJ=0
SET ENJ=1
SET EN("OKEY",ENJ)=""
+7 ; if value won't fit on this line then add another line
+8 IF $LENGTH(EN("OKEY",ENJ))+$LENGTH(ENX)>60
Begin DoDot:2
+9 SET EN("OKEY",ENJ)=EN("OKEY",ENJ)_";"
+10 SET ENJ=ENJ+1
SET EN("OKEY",ENJ)=""
End DoDot:2
+11 ; add value to line
+12 SET EN("OKEY",ENJ)=EN("OKEY",ENJ)_$SELECT(EN("OKEY",ENJ)]"":"; ",1:"")_ENX
End DoDot:1
+13 ;
+14 GOTO ^ENSP3
SSER IF EN(4)'=""
if $DATA(^DIC(49,EN(4),0))>0
SET EN(4)=$PIECE(^DIC(49,EN(4),0),"^",1)
+1 QUIT
SKEY IF $DATA(^ENG("LK",EN(5),0))>0
SET EN(5)=$PIECE(^ENG("LK",EN(5),0),"^",1)
+1 QUIT
+2 ;
MUTIL SET ENTNX=$ORDER(^ENG("SP",DA,1,ENTNX))
if ENTNX=""
QUIT
SET ENTEMP=$PIECE(^ENG("SP",DA,1,ENTNX,0),"^",1)
SET EN(J)=^ENG(6928.2,ENTEMP,0)
SET J=J+1
GOTO MUTIL
MLITE1 FOR J=18:1:20
SET ENXT=$ORDER(^ENG("SP",DA,6,ENXT))
if ENXT=""
QUIT
FOR ENML=1:1:3
SET EN(J,ENML)=$PIECE(^ENG("SP",DA,6,ENXT,0),"^",ENML)
+1 QUIT
EXIT KILL DIC,DIE,ENML,ENTEMP,ENXT,ENTNX,I,J,K,O,S,X,Y
QUIT
+1 ;ENSP2
