- 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 Feb 18, 2025@23:22:04 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