ENLIB ;(WASH ISC)/JED/SAW/DH-Package Utilities ;2.17.98
;;7.0;ENGINEERING;**35,45,47,48**;Aug 17, 1993
;
ENOUT ;ENGINEERING OUTPUT PORT SELECTOR DLM/WASH; 27 JUL 84 8:01 AM
DEV ;DEVICE SELECTION ;devices may be suppressed from listing
W !!,"Select output device: ",!,?3,"RETURN",?13,"DISPLAY"
I '$D(ENXP("NOLIST")) S ENOT="" F S ENOT=$O(^DIC(6910.1,"B",ENOT)) Q:ENOT="" S ENOT(0)=$O(^(ENOT,0)) D:ENOT(0)
. I '$P(^DIC(6910.1,ENOT(0),0),U,4) W !,?3,$P(^(0),U,2),?13,$P(^(0),U,3)
K ENOT,IO("Q") W ! S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q
DEVSHOW ;DEVICE SELECTION
W !!,"Select output device: ",!,?3,"RETURN",?13,"DISPLAY"
S ENOT="" F I=1:1 S ENOT=$O(^DIC(6910.1,"B",ENOT)) Q:ENOT="" W !,?3,$P(^DIC(6910.1,$O(^DIC(6910.1,"B",ENOT,"")),0),"^",2),?13,$P(^(0),"^",3)
K ENOT,I W ! S %ZIS("B")="HOME" Q
;
;SAW/WASH ; 28 AUG 84 6:14 pm
FYS ;SELECT FISCAL YEAR AND QUARTER THEN SELECT DEVICE
S ENFYT("I")=$E(DT,1,3) I $E(DT,4,7)>1000 S ENFYT("I")=ENFYT("I")+1
S I=+$E(DT,4,5),ENFYT=$E(ENFYT("I"),2,3),ENQTT=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",I)
FYS1 W !,"SELECT FISCAL YEAR: ",ENFYT,"//" R ENFY:DTIME G EXIT:'$T S:ENFY="" ENFY=ENFYT G:ENFY="^" EXIT I ENFY'?2N G FYS1
QTRS W !,"SELECT QUARTER: ",ENQTT,"//" R ENQT:DTIME G EXIT:'$T S:ENQT="" ENQT=ENQTT G:ENQT="^" EXIT I ENQT<1!(ENQT>4) G QTRS
K ENFYT,ENQTT G DEV
;
FYSONLY ;SELECT FISCAL YEAR AND QUARTER
S ENFYT("I")=$E(DT,1,3) I $E(DT,4,7)>1000 S ENFYT("I")=ENFYT("I")+1
S ENFYT=$E(ENFYT("I"),2,3)
FYS1ON W !,"SELECT FISCAL YEAR: ",ENFYT," //" R ENFY:DTIME G EXIT:'$T S:ENFY="" ENFY=ENFYT G:ENFY="^" EXIT I ENFY'?2N G FYS1ON
K ENFYT Q
;
FYQTS ;SELECT FISCAL YEAR AND QUARTER ONLY
S ENFYT("I")=$E(DT,1,3) I $E(DT,4,7)>1000 S ENFYT("I")=ENFYT("I")+1
S I=+$E(DT,4,5),ENFYT=$E(ENFYT("I"),2,3),ENQTT=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",I)
FYQTS1 W !,"SELECT FISCAL YEAR: ",ENFYT,"//" R ENFY:DTIME G EXIT:'$T S:ENFY="" ENFY=ENFYT G:ENFY="^" EXIT I ENFY'?2N G FYQTS1
QTS W !,"SELECT QUARTER: ",ENQTT,"//" R ENQT:DTIME G EXIT:'$T S:ENQT="" ENQT=ENQTT G:ENQT="^" EXIT I ENQT<1!(ENQT>4) G QTS
K ENFYT,ENQTT Q
EXIT K ENFYT,ENFY,ENQTT,ENQT Q
;
ROUND ;Round off number
;Number in X
;Dec places in X(0)
S ENA=$P(X,".",1),ENB=$P(X,".",2) I X(0)=0 S Y=ENA G DNRND
I $L(ENB)'>X(0) S Y=ENA_"."_ENB G DNRND
S X(1)=$E(ENB,X(0)) I $E(ENB,X(0)+1)>4 S X(1)=X(1)+1
S Y=ENA_"."_$E(ENB,1,(X(0)-1))_X(1)
DNRND K ENA,ENB,X
Q
;
ROOM ; Check for allowable format
N X1
S X1=$TR($P(X,"-"),"e","E") Q:X1?.NUP
D EN^DDIOL(" ROOM is not in proper format.") K X
Q
;
BLDG ; Called when BUILDING is not in the file
N X1
S X1(1)=" The BUILDING (including DIVISION, if applicable) portion of the ROOM"
S X1(2)=" NUMBER must be defined in your Building File (6928.3) before this ROOM"
S X1(3)=" NUMBER may be added to your Space File."
S X1(4)=" In this case, "_$P(X,"-",2,3)_" does not appear to be in your Building File."
D EN^DDIOL(.X1)
Q
;
VENPRE ; Vendor pre-action from ENG DJ screen handler
; DA => IEN for file 6914
; Needed because post-action on acquisition won't execute on deletes
;
I $P($G(^ENG(6914,DA,3)),U,4)="L",$P($G(^(2)),U,3)]"" S DJNX=12,V(14)="",$P(^(2),U,3)="",DJSV=V D N^ENJDPL S V=DJSV ;clear asset value if LEASE
I "^L^M^"'[(U_$P($G(^ENG(6914,DA,3)),U,4)_U),$P($G(^(2)),U,12)]"" S DJNX=12,V(13)="",$P(^(2),U,12)="",DJSV=V D N^ENJDPL S V=DJSV ;clear lease cost if not LEASE or CAPITAL LEASE
Q
;
X ;EXIT FOR THE INCONSISTENT RESPONSE
W *7,!,"TRY LATER"
Q ;EXIT POINT
K %,%DT,%X,%Y,DQTIME,J,X,Y,ZTSK Q
;ENLIB
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLIB 3575 printed Dec 13, 2024@01:54:24 Page 2
ENLIB ;(WASH ISC)/JED/SAW/DH-Package Utilities ;2.17.98
+1 ;;7.0;ENGINEERING;**35,45,47,48**;Aug 17, 1993
+2 ;
ENOUT ;ENGINEERING OUTPUT PORT SELECTOR DLM/WASH; 27 JUL 84 8:01 AM
DEV ;DEVICE SELECTION ;devices may be suppressed from listing
+1 WRITE !!,"Select output device: ",!,?3,"RETURN",?13,"DISPLAY"
+2 IF '$DATA(ENXP("NOLIST"))
SET ENOT=""
FOR
SET ENOT=$ORDER(^DIC(6910.1,"B",ENOT))
if ENOT=""
QUIT
SET ENOT(0)=$ORDER(^(ENOT,0))
if ENOT(0)
Begin DoDot:1
+3 IF '$PIECE(^DIC(6910.1,ENOT(0),0),U,4)
WRITE !,?3,$PIECE(^(0),U,2),?13,$PIECE(^(0),U,3)
End DoDot:1
+4 KILL ENOT,IO("Q")
WRITE !
SET %ZIS("B")="HOME"
SET %ZIS="MQ"
DO ^%ZIS
QUIT
DEVSHOW ;DEVICE SELECTION
+1 WRITE !!,"Select output device: ",!,?3,"RETURN",?13,"DISPLAY"
+2 SET ENOT=""
FOR I=1:1
SET ENOT=$ORDER(^DIC(6910.1,"B",ENOT))
if ENOT=""
QUIT
WRITE !,?3,$PIECE(^DIC(6910.1,$ORDER(^DIC(6910.1,"B",ENOT,"")),0),"^",2),?13,$PIECE(^(0),"^",3)
+3 KILL ENOT,I
WRITE !
SET %ZIS("B")="HOME"
QUIT
+4 ;
+5 ;SAW/WASH ; 28 AUG 84 6:14 pm
FYS ;SELECT FISCAL YEAR AND QUARTER THEN SELECT DEVICE
+1 SET ENFYT("I")=$EXTRACT(DT,1,3)
IF $EXTRACT(DT,4,7)>1000
SET ENFYT("I")=ENFYT("I")+1
+2 SET I=+$EXTRACT(DT,4,5)
SET ENFYT=$EXTRACT(ENFYT("I"),2,3)
SET ENQTT=$PIECE("2^2^2^3^3^3^4^4^4^1^1^1","^",I)
FYS1 WRITE !,"SELECT FISCAL YEAR: ",ENFYT,"//"
READ ENFY:DTIME
if '$TEST
GOTO EXIT
if ENFY=""
SET ENFY=ENFYT
if ENFY="^"
GOTO EXIT
IF ENFY'?2N
GOTO FYS1
QTRS WRITE !,"SELECT QUARTER: ",ENQTT,"//"
READ ENQT:DTIME
if '$TEST
GOTO EXIT
if ENQT=""
SET ENQT=ENQTT
if ENQT="^"
GOTO EXIT
IF ENQT<1!(ENQT>4)
GOTO QTRS
+1 KILL ENFYT,ENQTT
GOTO DEV
+2 ;
FYSONLY ;SELECT FISCAL YEAR AND QUARTER
+1 SET ENFYT("I")=$EXTRACT(DT,1,3)
IF $EXTRACT(DT,4,7)>1000
SET ENFYT("I")=ENFYT("I")+1
+2 SET ENFYT=$EXTRACT(ENFYT("I"),2,3)
FYS1ON WRITE !,"SELECT FISCAL YEAR: ",ENFYT," //"
READ ENFY:DTIME
if '$TEST
GOTO EXIT
if ENFY=""
SET ENFY=ENFYT
if ENFY="^"
GOTO EXIT
IF ENFY'?2N
GOTO FYS1ON
+1 KILL ENFYT
QUIT
+2 ;
FYQTS ;SELECT FISCAL YEAR AND QUARTER ONLY
+1 SET ENFYT("I")=$EXTRACT(DT,1,3)
IF $EXTRACT(DT,4,7)>1000
SET ENFYT("I")=ENFYT("I")+1
+2 SET I=+$EXTRACT(DT,4,5)
SET ENFYT=$EXTRACT(ENFYT("I"),2,3)
SET ENQTT=$PIECE("2^2^2^3^3^3^4^4^4^1^1^1","^",I)
FYQTS1 WRITE !,"SELECT FISCAL YEAR: ",ENFYT,"//"
READ ENFY:DTIME
if '$TEST
GOTO EXIT
if ENFY=""
SET ENFY=ENFYT
if ENFY="^"
GOTO EXIT
IF ENFY'?2N
GOTO FYQTS1
QTS WRITE !,"SELECT QUARTER: ",ENQTT,"//"
READ ENQT:DTIME
if '$TEST
GOTO EXIT
if ENQT=""
SET ENQT=ENQTT
if ENQT="^"
GOTO EXIT
IF ENQT<1!(ENQT>4)
GOTO QTS
+1 KILL ENFYT,ENQTT
QUIT
EXIT KILL ENFYT,ENFY,ENQTT,ENQT
QUIT
+1 ;
ROUND ;Round off number
+1 ;Number in X
+2 ;Dec places in X(0)
+3 SET ENA=$PIECE(X,".",1)
SET ENB=$PIECE(X,".",2)
IF X(0)=0
SET Y=ENA
GOTO DNRND
+4 IF $LENGTH(ENB)'>X(0)
SET Y=ENA_"."_ENB
GOTO DNRND
+5 SET X(1)=$EXTRACT(ENB,X(0))
IF $EXTRACT(ENB,X(0)+1)>4
SET X(1)=X(1)+1
+6 SET Y=ENA_"."_$EXTRACT(ENB,1,(X(0)-1))_X(1)
DNRND KILL ENA,ENB,X
+1 QUIT
+2 ;
ROOM ; Check for allowable format
+1 NEW X1
+2 SET X1=$TRANSLATE($PIECE(X,"-"),"e","E")
if X1?.NUP
QUIT
+3 DO EN^DDIOL(" ROOM is not in proper format.")
KILL X
+4 QUIT
+5 ;
BLDG ; Called when BUILDING is not in the file
+1 NEW X1
+2 SET X1(1)=" The BUILDING (including DIVISION, if applicable) portion of the ROOM"
+3 SET X1(2)=" NUMBER must be defined in your Building File (6928.3) before this ROOM"
+4 SET X1(3)=" NUMBER may be added to your Space File."
+5 SET X1(4)=" In this case, "_$PIECE(X,"-",2,3)_" does not appear to be in your Building File."
+6 DO EN^DDIOL(.X1)
+7 QUIT
+8 ;
VENPRE ; Vendor pre-action from ENG DJ screen handler
+1 ; DA => IEN for file 6914
+2 ; Needed because post-action on acquisition won't execute on deletes
+3 ;
+4 ;clear asset value if LEASE
IF $PIECE($GET(^ENG(6914,DA,3)),U,4)="L"
IF $PIECE($GET(^(2)),U,3)]""
SET DJNX=12
SET V(14)=""
SET $PIECE(^(2),U,3)=""
SET DJSV=V
DO N^ENJDPL
SET V=DJSV
+5 ;clear lease cost if not LEASE or CAPITAL LEASE
IF "^L^M^"'[(U_$PIECE($GET(^ENG(6914,DA,3)),U,4)_U)
IF $PIECE($GET(^(2)),U,12)]""
SET DJNX=12
SET V(13)=""
SET $PIECE(^(2),U,12)=""
SET DJSV=V
DO N^ENJDPL
SET V=DJSV
+6 QUIT
+7 ;
X ;EXIT FOR THE INCONSISTENT RESPONSE
+1 WRITE *7,!,"TRY LATER"
Q ;EXIT POINT
+1 KILL %,%DT,%X,%Y,DQTIME,J,X,Y,ZTSK
QUIT
+2 ;ENLIB
