ENLIB2 ;(WASH ISC)/DH-Package Utilities ;1/10/2001
;;7.0;ENGINEERING;**21,35,68**;Aug 17, 1993
PO ;Called when PO# entered into Equip File
;X=PO# and DA is Equip IEN
S ENPO=X,ENPO(0)=0 I $D(^PRC(442,"B",ENPO)) S ENPO(0)=$O(^(ENPO,0))
E I $D(^PRC(442,"C",ENPO)) S ENPO(0)=$O(^(ENPO,0))
I ENPO(0)'>0!('$D(^PRC(442,ENPO(0),0))) K ENPO Q
S ENPO("FCP")=$P(^PRC(442,ENPO(0),0),U,3),ENPO("CC")=$P(^(0),U,5),ENPO("SUB")=$P(^(0),U,6)
S (ENPO("VEN"),ENPO("SRV"),ENPO("SRC"))=""
I $D(^PRC(442,ENPO(0),1)) S ENPO("VEN")=$P(^(1),U),ENPO("SRV")=$P(^(1),U,2),ENPO("SRC")=$P(^(1),U,7)
I '$D(^ENG(6914,DA,8)) S ^ENG(6914,DA,8)="^^"_ENPO("FCP")_"^"_ENPO("CC")_"^"_ENPO("SUB") G PO1
I $P(^ENG(6914,DA,8),U,3)="" S $P(^(8),U,3)=ENPO("FCP")
I $P(^ENG(6914,DA,8),U,4)="" S $P(^(8),U,4)=ENPO("CC")
I $P(^ENG(6914,DA,8),U,5)="" S $P(^(8),U,5)=ENPO("SUB")
PO1 I ENPO("VEN")]"" S:'$D(^ENG(6914,DA,2)) ^ENG(6914,DA,2)=ENPO("VEN") I $P(^ENG(6914,DA,2),U)="" S $P(^(2),U)=ENPO("VEN")
I ENPO("SRV")]"" D SRV
I ENPO("SRC")]"" S:'$D(^ENG(6914,DA,2)) $P(^ENG(6914,DA,2),U,14)=ENPO("SRC") I $P(^ENG(6914,DA,2),U,14)="" S $P(^(2),U,14)=ENPO("SRC")
EXIT K ENPO
Q
;
ACC ;Toggle WO STATUS on basis of 2237
;Expects DA based on Work Order File
I $D(^ENG(6920,DA,5)),$P(^(5),U,2)]"" Q
S ENX="" I $D(^ENG(6920,DA,4)) S ENX=$P(^(4),U,2)
I ENX'>0 K ENX Q
I $D(^PRCS(410,ENX,9)),$P(^(9),U,3)]"" K ENX Q
S (ENX(0),ENX(1))="" I $D(^PRCS(410,ENX,"IT")) S ENX(0)=$O(^PRCS(410,ENX,"IT",0)) S:ENX(0)>0 ENX(1)=$E($P(^PRCS(410,ENX,"IT",ENX(0),0),U,4),1,2)
S $P(^ENG(6920,DA,4),U,3)=$S(ENX(1)=25:4,1:3)
K ENX
Q
;
ACCX ; IFCAP entry point from File 410
; DA => IEN to File 6914
; +X => IEN to Work Order File
Q:'$D(^ENG(6920,+X,0)) ; in case W.O. deleted and file 410 re-indexed
N ENDA S ENDA=DA
N DA S DA=+X,$P(^ENG(6920,DA,4),U,2)=ENDA
D ACC
Q
;
POWO ; IFCAP entry point from File 442
Q ;May be activated in conjunction with a future IFCAP patch
;
SRV ;Service pointer
I $D(^ENG(6914,DA,3)),$P(^(3),U,2)]"" Q ;Don't overwrite
S $P(^ENG(6914,DA,3),U,2)=ENPO("SRV"),^ENG(6914,"AC",ENPO("SRV"),DA)=""
Q
;
CMRNOM ;Subheader on CMR
Q:'$D(D0) I '$D(ENCMR) S ENCMR=$S($D(^ENG(6914,D0,2)):$P(^(2),U,9),1:0) S:ENCMR="" ENCMR=0 I $D(^ENG(6914.1,ENCMR,0)) S ENCMR(0)=$P(^(0),U,5) I ENCMR(0)]"",$D(^DIC(49,ENCMR(0),0)) W !,?13,$P(^(0),U)," SERVICE" D CMRRO W !!
I $D(^ENG(6914,D0,2)),$P(^(2),U,9)'=ENCMR S ENCMR=$P(^(2),U,9) S:ENCMR="" ENCMR=0 I $D(^ENG(6914.1,ENCMR,0)) S ENCMR(0)=$P(^(0),U,5) I ENCMR(0)]"",$D(^DIC(49,ENCMR(0),0)) W !,?13,$P(^(0),U)," SERVICE" D CMRRO W !!
I '$D(ENNOMEN) S ENNOMEN=$S($D(^ENG(6914,D0,2)):$P(^(2),U,8),1:0) S:ENNOMEN="" ENNOMEN=0 D:$D(^ENCSN(6917,ENNOMEN,0)) CMRPRNT Q
I $D(^ENG(6914,D0,2)),$P(^(2),U,8)=ENNOMEN Q
I '$D(^ENG(6914,D0,2)) K ENNOMEN Q
S ENNOMEN=$S($P(^ENG(6914,D0,2),U,8)]"":$P(^(2),U,8),1:0) D:$D(^ENCSN(6917,ENNOMEN,0)) CMRPRNT
Q
CMRPRNT N X,DIWL,DIWR,DIWF K ^UTILITY($J,"W") S DIWL=1,DIWR=IOM,DIWF="W"
W !!,"CATEGORY STOCK NUMBER: ",$P(^ENCSN(6917,ENNOMEN,0),U) F ENNX=0:0 S ENNX=$O(^ENCSN(6917,ENNOMEN,1,ENNX)) Q:ENNX'>0 I $D(^(ENNX,0)) S X=^(0) D ^DIWP
D ^DIWW K ENNX
Q
CMRRO ; CMR Responsible Official
N ENRO,DIERR
S ENRO=$$GET1^DIQ(6914.1,ENCMR,1)
I ENRO]"" W !,?13,"Responsible Official: ",ENRO
Q
;
WA ;Count the number of WORK ACTIONS
;called by the input transform of File 6920 Subfile 6920.035 Field .01
N I,J,COUNT S COUNT=0
F I=0:0 S I=$O(^ENG(6920,DA,8,I)) Q:I'>0 S COUNT=COUNT+1,J=$P(^(I,0),U) Q:J=X
Q:COUNT<4 Q:J=X
D EN^DDIOL(" Can't have more than four WORK ACTIONS.")
K X
Q
;
ASN ;Count the number of ALTERNATE STATION NUMBERS
;called by the input transform of File 6910 Subfile 6910.012 Field .01
N I,J,COUNT S (COUNT,I)=0
F S I=$O(^DIC(6910,DA,3,I)) Q:'I S COUNT=COUNT+1,J=$P(^(I,0),U) Q:J=X
Q:COUNT<30 Q:J=X
D EN^DDIOL(" Can't have more than thirty (30) ALTERNATE STATION NUMBERS.")
K X
Q
;ENLIB2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLIB2 3979 printed Oct 16, 2024@17:55:14 Page 2
ENLIB2 ;(WASH ISC)/DH-Package Utilities ;1/10/2001
+1 ;;7.0;ENGINEERING;**21,35,68**;Aug 17, 1993
PO ;Called when PO# entered into Equip File
+1 ;X=PO# and DA is Equip IEN
+2 SET ENPO=X
SET ENPO(0)=0
IF $DATA(^PRC(442,"B",ENPO))
SET ENPO(0)=$ORDER(^(ENPO,0))
+3 IF '$TEST
IF $DATA(^PRC(442,"C",ENPO))
SET ENPO(0)=$ORDER(^(ENPO,0))
+4 IF ENPO(0)'>0!('$DATA(^PRC(442,ENPO(0),0)))
KILL ENPO
QUIT
+5 SET ENPO("FCP")=$PIECE(^PRC(442,ENPO(0),0),U,3)
SET ENPO("CC")=$PIECE(^(0),U,5)
SET ENPO("SUB")=$PIECE(^(0),U,6)
+6 SET (ENPO("VEN"),ENPO("SRV"),ENPO("SRC"))=""
+7 IF $DATA(^PRC(442,ENPO(0),1))
SET ENPO("VEN")=$PIECE(^(1),U)
SET ENPO("SRV")=$PIECE(^(1),U,2)
SET ENPO("SRC")=$PIECE(^(1),U,7)
+8 IF '$DATA(^ENG(6914,DA,8))
SET ^ENG(6914,DA,8)="^^"_ENPO("FCP")_"^"_ENPO("CC")_"^"_ENPO("SUB")
GOTO PO1
+9 IF $PIECE(^ENG(6914,DA,8),U,3)=""
SET $PIECE(^(8),U,3)=ENPO("FCP")
+10 IF $PIECE(^ENG(6914,DA,8),U,4)=""
SET $PIECE(^(8),U,4)=ENPO("CC")
+11 IF $PIECE(^ENG(6914,DA,8),U,5)=""
SET $PIECE(^(8),U,5)=ENPO("SUB")
PO1 IF ENPO("VEN")]""
if '$DATA(^ENG(6914,DA,2))
SET ^ENG(6914,DA,2)=ENPO("VEN")
IF $PIECE(^ENG(6914,DA,2),U)=""
SET $PIECE(^(2),U)=ENPO("VEN")
+1 IF ENPO("SRV")]""
DO SRV
+2 IF ENPO("SRC")]""
if '$DATA(^ENG(6914,DA,2))
SET $PIECE(^ENG(6914,DA,2),U,14)=ENPO("SRC")
IF $PIECE(^ENG(6914,DA,2),U,14)=""
SET $PIECE(^(2),U,14)=ENPO("SRC")
EXIT KILL ENPO
+1 QUIT
+2 ;
ACC ;Toggle WO STATUS on basis of 2237
+1 ;Expects DA based on Work Order File
+2 IF $DATA(^ENG(6920,DA,5))
IF $PIECE(^(5),U,2)]""
QUIT
+3 SET ENX=""
IF $DATA(^ENG(6920,DA,4))
SET ENX=$PIECE(^(4),U,2)
+4 IF ENX'>0
KILL ENX
QUIT
+5 IF $DATA(^PRCS(410,ENX,9))
IF $PIECE(^(9),U,3)]""
KILL ENX
QUIT
+6 SET (ENX(0),ENX(1))=""
IF $DATA(^PRCS(410,ENX,"IT"))
SET ENX(0)=$ORDER(^PRCS(410,ENX,"IT",0))
if ENX(0)>0
SET ENX(1)=$EXTRACT($PIECE(^PRCS(410,ENX,"IT",ENX(0),0),U,4),1,2)
+7 SET $PIECE(^ENG(6920,DA,4),U,3)=$SELECT(ENX(1)=25:4,1:3)
+8 KILL ENX
+9 QUIT
+10 ;
ACCX ; IFCAP entry point from File 410
+1 ; DA => IEN to File 6914
+2 ; +X => IEN to Work Order File
+3 ; in case W.O. deleted and file 410 re-indexed
if '$DATA(^ENG(6920,+X,0))
QUIT
+4 NEW ENDA
SET ENDA=DA
+5 NEW DA
SET DA=+X
SET $PIECE(^ENG(6920,DA,4),U,2)=ENDA
+6 DO ACC
+7 QUIT
+8 ;
POWO ; IFCAP entry point from File 442
+1 ;May be activated in conjunction with a future IFCAP patch
QUIT
+2 ;
SRV ;Service pointer
+1 ;Don't overwrite
IF $DATA(^ENG(6914,DA,3))
IF $PIECE(^(3),U,2)]""
QUIT
+2 SET $PIECE(^ENG(6914,DA,3),U,2)=ENPO("SRV")
SET ^ENG(6914,"AC",ENPO("SRV"),DA)=""
+3 QUIT
+4 ;
CMRNOM ;Subheader on CMR
+1 if '$DATA(D0)
QUIT
IF '$DATA(ENCMR)
SET ENCMR=$SELECT($DATA(^ENG(6914,D0,2)):$PIECE(^(2),U,9),1:0)
if ENCMR=""
SET ENCMR=0
IF $DATA(^ENG(6914.1,ENCMR,0))
SET ENCMR(0)=$PIECE(^(0),U,5)
IF ENCMR(0)]""
IF $DATA(^DIC(49,ENCMR(0),0))
WRITE !,?13,$PIECE(^(0),U)," SERVICE"
DO CMRRO
WRITE !!
+2 IF $DATA(^ENG(6914,D0,2))
IF $PIECE(^(2),U,9)'=ENCMR
SET ENCMR=$PIECE(^(2),U,9)
if ENCMR=""
SET ENCMR=0
IF $DATA(^ENG(6914.1,ENCMR,0))
SET ENCMR(0)=$PIECE(^(0),U,5)
IF ENCMR(0)]""
IF $DATA(^DIC(49,ENCMR(0),0))
WRITE !,?13,$PIECE(^(0),U)," SERVICE"
DO CMRRO
WRITE !!
+3 IF '$DATA(ENNOMEN)
SET ENNOMEN=$SELECT($DATA(^ENG(6914,D0,2)):$PIECE(^(2),U,8),1:0)
if ENNOMEN=""
SET ENNOMEN=0
if $DATA(^ENCSN(6917,ENNOMEN,0))
DO CMRPRNT
QUIT
+4 IF $DATA(^ENG(6914,D0,2))
IF $PIECE(^(2),U,8)=ENNOMEN
QUIT
+5 IF '$DATA(^ENG(6914,D0,2))
KILL ENNOMEN
QUIT
+6 SET ENNOMEN=$SELECT($PIECE(^ENG(6914,D0,2),U,8)]"":$PIECE(^(2),U,8),1:0)
if $DATA(^ENCSN(6917,ENNOMEN,0))
DO CMRPRNT
+7 QUIT
CMRPRNT NEW X,DIWL,DIWR,DIWF
KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=IOM
SET DIWF="W"
+1 WRITE !!,"CATEGORY STOCK NUMBER: ",$PIECE(^ENCSN(6917,ENNOMEN,0),U)
FOR ENNX=0:0
SET ENNX=$ORDER(^ENCSN(6917,ENNOMEN,1,ENNX))
if ENNX'>0
QUIT
IF $DATA(^(ENNX,0))
SET X=^(0)
DO ^DIWP
+2 DO ^DIWW
KILL ENNX
+3 QUIT
CMRRO ; CMR Responsible Official
+1 NEW ENRO,DIERR
+2 SET ENRO=$$GET1^DIQ(6914.1,ENCMR,1)
+3 IF ENRO]""
WRITE !,?13,"Responsible Official: ",ENRO
+4 QUIT
+5 ;
WA ;Count the number of WORK ACTIONS
+1 ;called by the input transform of File 6920 Subfile 6920.035 Field .01
+2 NEW I,J,COUNT
SET COUNT=0
+3 FOR I=0:0
SET I=$ORDER(^ENG(6920,DA,8,I))
if I'>0
QUIT
SET COUNT=COUNT+1
SET J=$PIECE(^(I,0),U)
if J=X
QUIT
+4 if COUNT<4
QUIT
if J=X
QUIT
+5 DO EN^DDIOL(" Can't have more than four WORK ACTIONS.")
+6 KILL X
+7 QUIT
+8 ;
ASN ;Count the number of ALTERNATE STATION NUMBERS
+1 ;called by the input transform of File 6910 Subfile 6910.012 Field .01
+2 NEW I,J,COUNT
SET (COUNT,I)=0
+3 FOR
SET I=$ORDER(^DIC(6910,DA,3,I))
if 'I
QUIT
SET COUNT=COUNT+1
SET J=$PIECE(^(I,0),U)
if J=X
QUIT
+4 if COUNT<30
QUIT
if J=X
QUIT
+5 DO EN^DDIOL(" Can't have more than thirty (30) ALTERNATE STATION NUMBERS.")
+6 KILL X
+7 QUIT
+8 ;ENLIB2
