ENEQ3 ;WIRMFO/DH,SAB-Equipment Entry Functions ;3.31.98
;;7.0;ENGINEERING;**25,29,35,52**;Aug 17, 1993
EQMAS ; Multiple Equipment Subsequent (Similar) Records
; in
; ENDAOLD - ien of record to be copied from
; ENMA( - array containing info on how FA Document and
; incoming inspection w.o. should be handled
; ENBULL( - (optional) array of mail group info
; out
; ENNXL - ien of new record, 0 if unsuccessful
N EN
S ENNXL=0
; lock master
L +^ENG(6914,ENDAOLD):10 I '$T D Q
. W $C(7),!,"Another user is editing Entry# ",ENDAOLD,". Can't proceed."
. S DIR(0)="E" D ^DIR K DIR
; create new record
D ENR^ENEQ1 I 'ENNXL D L -^ENG(6914,ENDAOLD) Q
. W $C(7),!,ENERR S DIR(0)="E" D ^DIR K DIR,ENERR
; lock new record
L +^ENG(6914,ENNXL):10 I '$T D L -^ENG(6914,ENDAOLD) Q
. W $C(7),!,"Another user is editing Entry# ",ENNXL,". Can't proceed."
. S DIR(0)="E" D ^DIR K DIR
;
; copy master into local array
M EN=^ENG(6914,ENDAOLD)
; modify local array for new record
; set up .01 and triggered fields
S $P(EN(0),U)=ENNXL
S $P(EN(0),U,5,6)=$P(^ENG(6914,ENNXL,0),U,5,6)
; remove data that should not be copied
I $D(EN(1)) S $P(EN(1),U,3)=""
I $D(EN(2)) F ENI=7,13 S $P(EN(2),U,ENI)=""
I $D(EN(3)) F ENI=6,7,10,14 S $P(EN(3),U,ENI)=""
K EN(6)
I $D(EN(9)) S $P(EN(9),U,10)=""
; move local array to new record
M ^ENG(6914,ENNXL)=EN K EN
; re-index new record
S DIK="^ENG(6914,",DA=ENNXL D IX1^DIK K DIK
; unlock master
L -^ENG(6914,ENDAOLD)
; user edit new record
W !!,"Equipment ID: ",ENNXL
S DIE="^ENG(6914,",DR="5;24;25;26",DA=ENNXL
I $P(^ENG(6914,ENDAOLD,0),U,3)]"" S DR=DR_";2" ; parent system
I $D(^ENG(6914,ENNXL,8)),$P(^(8),U,8)]"" S DR=DR_";51" ; replacing
D ^DIE I $D(Y)!$D(DTOUT),$P($G(^ENG(6914,DA,1)),U,3)']"" D Q
. W $C(7),!,"Time Out or '^' entered and Serial Number was left blank."
. W !,"Deleting last entry (",DA,")..."
. S DIK="^ENG(6914," D ^DIK K DIK L -^ENG(6914,DA)
. S ENNXL=0
I $G(ENMA("IIWO")) D IIWO^ENWONEW3(ENNXL)
I $G(ENMA("FAP")) S ENEQ("DA")=DA D ^ENFAACQ S DA=ENEQ("DA") K ENEQ("DA")
S DA=ENNXL D BULL
L -^ENG(6914,ENNXL)
Q
;
BULL ;X-mit new equipment bulletin if mail group established
; Input
; DA - ien of equipment entry
; optional ENBULL( - array indicating mail group availabliity
; undefined nodes not yet evaluated
; ENBULL = true(1) if 'EN NEW EQUIPMENT' established
; ENBULL(station number)=true(1) if
; 'EN NEW EQUIPMENT station number' established
Q:'$D(DA) Q:'$D(^ENG(6914,DA,0))
N ENSN,XMB,XMDUZ,XMY
; determine station number of equipment entry
S ENSN=$$GET1^DIQ(6914,DA,60)
; if blank use default station #
I ENSN="" S ENSN=$$GET1^DIQ(6910,1,1)
; get status of station specific mail group if not already done
I ENSN]"",'$D(ENBULL(ENSN)) S ENBULL(ENSN)=$$CHKMGRP("EN NEW EQUIPMENT "_ENSN)
; use station specific mail group if available
I ENSN]"",ENBULL(ENSN) S XMY("G.EN NEW EQUIPMENT "_ENSN)=""
; if station specific mail group not established then use generic group
I '$D(XMY) D
. ; get staus of generic mail group if not already done
. I $G(ENBULL)']"" S ENBULL=$$CHKMGRP("EN NEW EQUIPMENT")
. I ENBULL S XMY("G.EN NEW EQUIPMENT")=""
; send bulletin if a mail group is established
I $D(XMY) D
. S XMB="EN NEW EQUIPMENT"
. S XMB(1)=DA,XMB(2)=$P(^VA(200,DUZ,0),U),XMB(3)=$P(^ENG(6914,DA,0),U,2)
. F X=4,5 S XMB(X)=""
. I $D(^ENG(6914,DA,1)) S X=$P(^(1),U) S:X>0 XMB(4)=$P(^ENG(6911,X,0),U)
. I $D(^ENG(6914,DA,3)) S X=$P(^(3),U,2) S:X>0 XMB(5)=$P(^DIC(49,X,0),U)
. S:ENSN]"" XMB(6)=ENSN
. F X=4,5,6 S:XMB(X)="" XMB(X)="MISSING"
. S X="0^0"
. I $P($G(^ENG(6914,DA,0)),U,4)="NX",$P($G(^(8)),U,2) S $P(X,U)=1 ;CapNX
. I $P(X,U),+$$CHKFA^ENFAUTL(DA) S $P(X,U,2)=1 ; FAP
. S XMB(7)="Item is"_$S($P(X,U):"",1:" NOT")_" capitalized NX."
. I $P(X,U) S XMB(7)=XMB(7)_" It was"_$S($P(X,U,2):"",1:" NOT")_" reported to FAP."
. S XMDUZ="AEMS/MERS"
. D ^XMB
Q
CHKMGRP(ENMG) ; Check Mail Group Extrinsic Variable
; true if mail group exists and has at least one member
; Input Variable
; ENMG - name of mail group to check
N ENI,ENOK,ENQ
S ENOK=0 ; initialize result flag
; look for mail group
S ENI=$$FIND1^DIC(3.8,"","X",ENMG,"B")
; if found look for a member
I ENI D
. D LIST^DIC(3.81,","_ENI_",","","",1,"","","","","","ENQ")
. I $P(ENQ("DILIST",0),U) S ENOK=1 ; has at least one member
Q ENOK
;
LAST ;Last service episode (including PMI)
; called by ENG DJ SCREENs
; in: DA - ien of equipment entry
; out: displays date and work action of last service episode (if any)
N ENA,ENB,ENI,ENX
Q:'$D(DA)
Q:'$D(^ENG(6914,DA,6))
S ENI=0 F S ENI=$O(^ENG(6914,DA,6,ENI)) Q:'ENI S ENA=^(ENI,0) I $E($P(ENA,U,3))'="D" D Q
. S ENX="Last serviced: "_$E(ENA,4,5)_"/"_$E(ENA,6,7)_"/"_$E(ENA,2,3)
. S ENB=$P($P(ENA,U),"-",2) D:ENB]"" S ENX=ENX_" Work Action: "_ENB
. . I $D(^ENG(6920.1,"D",ENB)) S ENB(0)=$O(^(ENB,0))
. . I $D(ENB(0)),$D(^ENG(6920.1,ENB(0),0)) S ENB=$P(^(0),U)
. W !!,ENX
Q
;ENEQ3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQ3 5158 printed Nov 22, 2024@17:02:33 Page 2
ENEQ3 ;WIRMFO/DH,SAB-Equipment Entry Functions ;3.31.98
+1 ;;7.0;ENGINEERING;**25,29,35,52**;Aug 17, 1993
EQMAS ; Multiple Equipment Subsequent (Similar) Records
+1 ; in
+2 ; ENDAOLD - ien of record to be copied from
+3 ; ENMA( - array containing info on how FA Document and
+4 ; incoming inspection w.o. should be handled
+5 ; ENBULL( - (optional) array of mail group info
+6 ; out
+7 ; ENNXL - ien of new record, 0 if unsuccessful
+8 NEW EN
+9 SET ENNXL=0
+10 ; lock master
+11 LOCK +^ENG(6914,ENDAOLD):10
IF '$TEST
Begin DoDot:1
+12 WRITE $CHAR(7),!,"Another user is editing Entry# ",ENDAOLD,". Can't proceed."
+13 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+14 ; create new record
+15 DO ENR^ENEQ1
IF 'ENNXL
Begin DoDot:1
+16 WRITE $CHAR(7),!,ENERR
SET DIR(0)="E"
DO ^DIR
KILL DIR,ENERR
End DoDot:1
LOCK -^ENG(6914,ENDAOLD)
QUIT
+17 ; lock new record
+18 LOCK +^ENG(6914,ENNXL):10
IF '$TEST
Begin DoDot:1
+19 WRITE $CHAR(7),!,"Another user is editing Entry# ",ENNXL,". Can't proceed."
+20 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
LOCK -^ENG(6914,ENDAOLD)
QUIT
+21 ;
+22 ; copy master into local array
+23 MERGE EN=^ENG(6914,ENDAOLD)
+24 ; modify local array for new record
+25 ; set up .01 and triggered fields
+26 SET $PIECE(EN(0),U)=ENNXL
+27 SET $PIECE(EN(0),U,5,6)=$PIECE(^ENG(6914,ENNXL,0),U,5,6)
+28 ; remove data that should not be copied
+29 IF $DATA(EN(1))
SET $PIECE(EN(1),U,3)=""
+30 IF $DATA(EN(2))
FOR ENI=7,13
SET $PIECE(EN(2),U,ENI)=""
+31 IF $DATA(EN(3))
FOR ENI=6,7,10,14
SET $PIECE(EN(3),U,ENI)=""
+32 KILL EN(6)
+33 IF $DATA(EN(9))
SET $PIECE(EN(9),U,10)=""
+34 ; move local array to new record
+35 MERGE ^ENG(6914,ENNXL)=EN
KILL EN
+36 ; re-index new record
+37 SET DIK="^ENG(6914,"
SET DA=ENNXL
DO IX1^DIK
KILL DIK
+38 ; unlock master
+39 LOCK -^ENG(6914,ENDAOLD)
+40 ; user edit new record
+41 WRITE !!,"Equipment ID: ",ENNXL
+42 SET DIE="^ENG(6914,"
SET DR="5;24;25;26"
SET DA=ENNXL
+43 ; parent system
IF $PIECE(^ENG(6914,ENDAOLD,0),U,3)]""
SET DR=DR_";2"
+44 ; replacing
IF $DATA(^ENG(6914,ENNXL,8))
IF $PIECE(^(8),U,8)]""
SET DR=DR_";51"
+45 DO ^DIE
IF $DATA(Y)!$DATA(DTOUT)
IF $PIECE($GET(^ENG(6914,DA,1)),U,3)']""
Begin DoDot:1
+46 WRITE $CHAR(7),!,"Time Out or '^' entered and Serial Number was left blank."
+47 WRITE !,"Deleting last entry (",DA,")..."
+48 SET DIK="^ENG(6914,"
DO ^DIK
KILL DIK
LOCK -^ENG(6914,DA)
+49 SET ENNXL=0
End DoDot:1
QUIT
+50 IF $GET(ENMA("IIWO"))
DO IIWO^ENWONEW3(ENNXL)
+51 IF $GET(ENMA("FAP"))
SET ENEQ("DA")=DA
DO ^ENFAACQ
SET DA=ENEQ("DA")
KILL ENEQ("DA")
+52 SET DA=ENNXL
DO BULL
+53 LOCK -^ENG(6914,ENNXL)
+54 QUIT
+55 ;
BULL ;X-mit new equipment bulletin if mail group established
+1 ; Input
+2 ; DA - ien of equipment entry
+3 ; optional ENBULL( - array indicating mail group availabliity
+4 ; undefined nodes not yet evaluated
+5 ; ENBULL = true(1) if 'EN NEW EQUIPMENT' established
+6 ; ENBULL(station number)=true(1) if
+7 ; 'EN NEW EQUIPMENT station number' established
+8 if '$DATA(DA)
QUIT
if '$DATA(^ENG(6914,DA,0))
QUIT
+9 NEW ENSN,XMB,XMDUZ,XMY
+10 ; determine station number of equipment entry
+11 SET ENSN=$$GET1^DIQ(6914,DA,60)
+12 ; if blank use default station #
+13 IF ENSN=""
SET ENSN=$$GET1^DIQ(6910,1,1)
+14 ; get status of station specific mail group if not already done
+15 IF ENSN]""
IF '$DATA(ENBULL(ENSN))
SET ENBULL(ENSN)=$$CHKMGRP("EN NEW EQUIPMENT "_ENSN)
+16 ; use station specific mail group if available
+17 IF ENSN]""
IF ENBULL(ENSN)
SET XMY("G.EN NEW EQUIPMENT "_ENSN)=""
+18 ; if station specific mail group not established then use generic group
+19 IF '$DATA(XMY)
Begin DoDot:1
+20 ; get staus of generic mail group if not already done
+21 IF $GET(ENBULL)']""
SET ENBULL=$$CHKMGRP("EN NEW EQUIPMENT")
+22 IF ENBULL
SET XMY("G.EN NEW EQUIPMENT")=""
End DoDot:1
+23 ; send bulletin if a mail group is established
+24 IF $DATA(XMY)
Begin DoDot:1
+25 SET XMB="EN NEW EQUIPMENT"
+26 SET XMB(1)=DA
SET XMB(2)=$PIECE(^VA(200,DUZ,0),U)
SET XMB(3)=$PIECE(^ENG(6914,DA,0),U,2)
+27 FOR X=4,5
SET XMB(X)=""
+28 IF $DATA(^ENG(6914,DA,1))
SET X=$PIECE(^(1),U)
if X>0
SET XMB(4)=$PIECE(^ENG(6911,X,0),U)
+29 IF $DATA(^ENG(6914,DA,3))
SET X=$PIECE(^(3),U,2)
if X>0
SET XMB(5)=$PIECE(^DIC(49,X,0),U)
+30 if ENSN]""
SET XMB(6)=ENSN
+31 FOR X=4,5,6
if XMB(X)=""
SET XMB(X)="MISSING"
+32 SET X="0^0"
+33 ;CapNX
IF $PIECE($GET(^ENG(6914,DA,0)),U,4)="NX"
IF $PIECE($GET(^(8)),U,2)
SET $PIECE(X,U)=1
+34 ; FAP
IF $PIECE(X,U)
IF +$$CHKFA^ENFAUTL(DA)
SET $PIECE(X,U,2)=1
+35 SET XMB(7)="Item is"_$SELECT($PIECE(X,U):"",1:" NOT")_" capitalized NX."
+36 IF $PIECE(X,U)
SET XMB(7)=XMB(7)_" It was"_$SELECT($PIECE(X,U,2):"",1:" NOT")_" reported to FAP."
+37 SET XMDUZ="AEMS/MERS"
+38 DO ^XMB
End DoDot:1
+39 QUIT
CHKMGRP(ENMG) ; Check Mail Group Extrinsic Variable
+1 ; true if mail group exists and has at least one member
+2 ; Input Variable
+3 ; ENMG - name of mail group to check
+4 NEW ENI,ENOK,ENQ
+5 ; initialize result flag
SET ENOK=0
+6 ; look for mail group
+7 SET ENI=$$FIND1^DIC(3.8,"","X",ENMG,"B")
+8 ; if found look for a member
+9 IF ENI
Begin DoDot:1
+10 DO LIST^DIC(3.81,","_ENI_",","","",1,"","","","","","ENQ")
+11 ; has at least one member
IF $PIECE(ENQ("DILIST",0),U)
SET ENOK=1
End DoDot:1
+12 QUIT ENOK
+13 ;
LAST ;Last service episode (including PMI)
+1 ; called by ENG DJ SCREENs
+2 ; in: DA - ien of equipment entry
+3 ; out: displays date and work action of last service episode (if any)
+4 NEW ENA,ENB,ENI,ENX
+5 if '$DATA(DA)
QUIT
+6 if '$DATA(^ENG(6914,DA,6))
QUIT
+7 SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6914,DA,6,ENI))
if 'ENI
QUIT
SET ENA=^(ENI,0)
IF $EXTRACT($PIECE(ENA,U,3))'="D"
Begin DoDot:1
+8 SET ENX="Last serviced: "_$EXTRACT(ENA,4,5)_"/"_$EXTRACT(ENA,6,7)_"/"_$EXTRACT(ENA,2,3)
+9 SET ENB=$PIECE($PIECE(ENA,U),"-",2)
if ENB]""
Begin DoDot:2
+10 IF $DATA(^ENG(6920.1,"D",ENB))
SET ENB(0)=$ORDER(^(ENB,0))
+11 IF $DATA(ENB(0))
IF $DATA(^ENG(6920.1,ENB(0),0))
SET ENB=$PIECE(^(0),U)
End DoDot:2
SET ENX=ENX_" Work Action: "_ENB
+12 WRITE !!,ENX
End DoDot:1
QUIT
+13 QUIT
+14 ;ENEQ3
