18 lines
544 B
Mathematica
18 lines
544 B
Mathematica
ENEQP1 ;(WASH ISC)/DH-Actual SET in Equipment History Sub-file ;1.14.98
|
|
;;7.0;ENGINEERING;**48**;Aug 17, 1993
|
|
S ENDTCP=DT,X1="XX"
|
|
I ENACTN>0,$P(^ENG(6920.1,ENACTN,0),U,2)]"" S X1=$P(^(0),U,2)
|
|
S ENH=ENDTCP_"-"_X1_U_ENREF_U_ENSTAT_U_ENHRS_U_ENLABOR_U_ENMATRL_U_ENVNDR_U_ENEMP_U_ENWORK
|
|
I ENTMPLT,NUMBER>0 D Q
|
|
. F %=0:0 S %=$O(^DIBT(NUMBER,1,%)) Q:%'>0 D RECORD
|
|
. K ENINV,ENDTCP,ENH,X1
|
|
F %=0:0 S %=$O(^TMP($J,%)) Q:%'>0 D RECORD
|
|
K ENINV,ENDTCP,ENH,X1
|
|
Q
|
|
;
|
|
RECORD ;Get sub-node and SET it
|
|
S ENINV=% W !,ENINV
|
|
D EXT^ENEQHS
|
|
Q
|
|
;ENEQP1
|