- 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 Mar 13, 2025@21:00:45 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
