ENUTL ;(WIRMFO)/DH-Engineering Utilities ;1.12.98
;;7.0;ENGINEERING;**35,42,48**;Aug 17, 1993
;
GETEQ ; Lookup equipment file entries allowing searches by user
; specified x-refs
; Called from ENEQ2, ENEQ4, ENEQLT,ENEQNX5, ENEQPMR4, ENEQRP1, ENEQRP6,
; ENEQTD, ENLBL3, ENWO1
; DIC("S") may be passed, but is not required or returned
; Output => Y as per ^DIC
;
N D,X,ENX,ENI
S DIC="^ENG(6914,"
EQA ; Ask for input
R !,"Select EQUIPMENT ENTRY #: ",ENX:DTIME I '$T!(ENX="")!($E(ENX)="^") S Y=-1 G EQX
I $E(ENX,3)="." D I $G(D)]"" S X=$E(ENX,4,99),DIC(0)="QE" D IX^DIC G EQR
. S ENI=$E(ENX,1,2) I "^EC^LI^LO^MA^MF^MO^SN^"'[(U_ENI_U) Q
. S D=$S(ENI="EC":"G",ENI="LI":"L",ENI="LO":"D",ENI="MA":"K",ENI="MF":"H",ENI="MO":"EC",ENI="SN":"FC",1:"") I D="" Q
. I "EC^FC"[D D EQCOMP
S X=ENX I $E(X)="?" D
. W !," 'EC.value' => equipment whose EQUIP. CATEGORY starts with 'value'"
. W !," 'LI.value' => equipment whose LOCAL ID starts with 'value'"
. W !," 'LO.value' => equipment whose LOCATION starts with 'value'"
. W !," 'MA.value' => equipment whose MANUFACTURER starts with 'value'"
. W !," 'MF.value' => equipment whose MFGR. EQUIP. NAME starts with 'value'"
. W !," 'MO.value' => equipment whose MODEL starts with 'value'"
. W !," 'SN.value' => equipment whose SERIAL NUMBER starts with 'value'"
S DIC(0)="QEM" D ^DIC
EQR ; Result of ^DIC call
G:Y'>0 EQA
EQX ; Design EXIT
K DIC
Q
;
EQCOMP ; Compress local var X
Q:$G(X)']""
S X=$$UP^XLFSTR(X)
S X=$TR(X," ""~!@#$%^&*()_+|-=\[];',./{}:<>?`","")
Q
;
ZIS ; Get BOLD and UNBOLD sequences
; Set to NULL if printer (bolding in hard copy would be nice,
; but the Device Files are too messy for it to work well)
I $E(IOST,1,2)'="C-" S (IOINLOW,IOINHI)="" Q
N X S X="IOINLOW;IOINHI;IOINORM" D ENDR^%ZISS
I IOINLOW="",IOINORM]"" S IOINLOW=IOINORM
Q
;
EOM(ENDT) ;End of Month Extrinsic Function
; ENDT - Date (internal format)
; Returns - Date for end of month (internal format)
I "^01^03^05^07^08^10^12^"[(U_$E(ENDT,4,5)_U) S ENDT=$E(ENDT,1,5)_"31"
I "^04^06^09^11^"[(U_$E(ENDT,4,5)_U) S ENDT=$E(ENDT,1,5)_"30"
I "02"=$E(ENDT,4,5) N YEAR,LEAP D
. S YEAR=$E(ENDT,1,3)+1700,LEAP=$S('(YEAR#400):1,'(YEAR#4)&(YEAR#100):1,1:0)
. S ENDT=$E(ENDT,1,5)_$S(LEAP:"29",1:"28")
Q ENDT
;
;ENUTL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENUTL 2356 printed Dec 13, 2024@01:56:05 Page 2
ENUTL ;(WIRMFO)/DH-Engineering Utilities ;1.12.98
+1 ;;7.0;ENGINEERING;**35,42,48**;Aug 17, 1993
+2 ;
GETEQ ; Lookup equipment file entries allowing searches by user
+1 ; specified x-refs
+2 ; Called from ENEQ2, ENEQ4, ENEQLT,ENEQNX5, ENEQPMR4, ENEQRP1, ENEQRP6,
+3 ; ENEQTD, ENLBL3, ENWO1
+4 ; DIC("S") may be passed, but is not required or returned
+5 ; Output => Y as per ^DIC
+6 ;
+7 NEW D,X,ENX,ENI
+8 SET DIC="^ENG(6914,"
EQA ; Ask for input
+1 READ !,"Select EQUIPMENT ENTRY #: ",ENX:DTIME
IF '$TEST!(ENX="")!($EXTRACT(ENX)="^")
SET Y=-1
GOTO EQX
+2 IF $EXTRACT(ENX,3)="."
Begin DoDot:1
+3 SET ENI=$EXTRACT(ENX,1,2)
IF "^EC^LI^LO^MA^MF^MO^SN^"'[(U_ENI_U)
QUIT
+4 SET D=$SELECT(ENI="EC":"G",ENI="LI":"L",ENI="LO":"D",ENI="MA":"K",ENI="MF":"H",ENI="MO":"EC",ENI="SN":"FC",1:"")
IF D=""
QUIT
+5 IF "EC^FC"[D
DO EQCOMP
End DoDot:1
IF $GET(D)]""
SET X=$EXTRACT(ENX,4,99)
SET DIC(0)="QE"
DO IX^DIC
GOTO EQR
+6 SET X=ENX
IF $EXTRACT(X)="?"
Begin DoDot:1
+7 WRITE !," 'EC.value' => equipment whose EQUIP. CATEGORY starts with 'value'"
+8 WRITE !," 'LI.value' => equipment whose LOCAL ID starts with 'value'"
+9 WRITE !," 'LO.value' => equipment whose LOCATION starts with 'value'"
+10 WRITE !," 'MA.value' => equipment whose MANUFACTURER starts with 'value'"
+11 WRITE !," 'MF.value' => equipment whose MFGR. EQUIP. NAME starts with 'value'"
+12 WRITE !," 'MO.value' => equipment whose MODEL starts with 'value'"
+13 WRITE !," 'SN.value' => equipment whose SERIAL NUMBER starts with 'value'"
End DoDot:1
+14 SET DIC(0)="QEM"
DO ^DIC
EQR ; Result of ^DIC call
+1 if Y'>0
GOTO EQA
EQX ; Design EXIT
+1 KILL DIC
+2 QUIT
+3 ;
EQCOMP ; Compress local var X
+1 if $GET(X)']""
QUIT
+2 SET X=$$UP^XLFSTR(X)
+3 SET X=$TRANSLATE(X," ""~!@#$%^&*()_+|-=\[];',./{}:<>?`","")
+4 QUIT
+5 ;
ZIS ; Get BOLD and UNBOLD sequences
+1 ; Set to NULL if printer (bolding in hard copy would be nice,
+2 ; but the Device Files are too messy for it to work well)
+3 IF $EXTRACT(IOST,1,2)'="C-"
SET (IOINLOW,IOINHI)=""
QUIT
+4 NEW X
SET X="IOINLOW;IOINHI;IOINORM"
DO ENDR^%ZISS
+5 IF IOINLOW=""
IF IOINORM]""
SET IOINLOW=IOINORM
+6 QUIT
+7 ;
EOM(ENDT) ;End of Month Extrinsic Function
+1 ; ENDT - Date (internal format)
+2 ; Returns - Date for end of month (internal format)
+3 IF "^01^03^05^07^08^10^12^"[(U_$EXTRACT(ENDT,4,5)_U)
SET ENDT=$EXTRACT(ENDT,1,5)_"31"
+4 IF "^04^06^09^11^"[(U_$EXTRACT(ENDT,4,5)_U)
SET ENDT=$EXTRACT(ENDT,1,5)_"30"
+5 IF "02"=$EXTRACT(ENDT,4,5)
NEW YEAR,LEAP
Begin DoDot:1
+6 SET YEAR=$EXTRACT(ENDT,1,3)+1700
SET LEAP=$SELECT('(YEAR#400):1,'(YEAR#4)&(YEAR#100):1,1:0)
+7 SET ENDT=$EXTRACT(ENDT,1,5)_$SELECT(LEAP:"29",1:"28")
End DoDot:1
+8 QUIT ENDT
+9 ;
+10 ;ENUTL
