- 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 Jan 18, 2025@02:55:37 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