Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ENEQ3

ENEQ3.m

Go to the documentation of this file. 
  1. ENEQ3 ;WIRMFO/DH,SAB-Equipment Entry Functions ;3.31.98
  1.  ;;7.0;ENGINEERING;**25,29,35,52**;Aug 17, 1993
  1. EQMAS ; Multiple Equipment Subsequent (Similar) Records
  1.  ; in
  1.  ;   ENDAOLD - ien of record to be copied from
  1.  ;   ENMA(   - array containing info on how FA Document and
  1.  ;             incoming inspection w.o. should be handled
  1.  ;   ENBULL( - (optional) array of mail group info
  1.  ; out
  1.  ;   ENNXL   - ien of new record, 0 if unsuccessful
  1.  N EN
  1.  S ENNXL=0
  1.  ; lock master
  1.  L +^ENG(6914,ENDAOLD):10 I '$T D  Q
  1.  . W $C(7),!,"Another user is editing Entry# ",ENDAOLD,". Can't proceed."
  1.  . S DIR(0)="E" D ^DIR K DIR
  1.  ; create new record
  1.  D ENR^ENEQ1 I 'ENNXL D  L -^ENG(6914,ENDAOLD) Q
  1.  . W $C(7),!,ENERR S DIR(0)="E" D ^DIR K DIR,ENERR
  1.  ; lock new record
  1.  L +^ENG(6914,ENNXL):10 I '$T D  L -^ENG(6914,ENDAOLD) Q
  1.  . W $C(7),!,"Another user is editing Entry# ",ENNXL,". Can't proceed."
  1.  . S DIR(0)="E" D ^DIR K DIR
  1.  ;
  1.  ; copy master into local array
  1.  M EN=^ENG(6914,ENDAOLD)
  1.  ; modify local array for new record
  1.  ;   set up .01 and triggered fields
  1.  S $P(EN(0),U)=ENNXL
  1.  S $P(EN(0),U,5,6)=$P(^ENG(6914,ENNXL,0),U,5,6)
  1.  ;   remove data that should not be copied
  1.  I $D(EN(1)) S $P(EN(1),U,3)=""
  1.  I $D(EN(2)) F ENI=7,13 S $P(EN(2),U,ENI)=""
  1.  I $D(EN(3)) F ENI=6,7,10,14 S $P(EN(3),U,ENI)=""
  1.  K EN(6)
  1.  I $D(EN(9)) S $P(EN(9),U,10)=""
  1.  ; move local array to new record
  1.  M ^ENG(6914,ENNXL)=EN K EN
  1.  ; re-index new record
  1.  S DIK="^ENG(6914,",DA=ENNXL D IX1^DIK K DIK
  1.  ; unlock master
  1.  L -^ENG(6914,ENDAOLD)
  1.  ; user edit new record
  1.  W !!,"Equipment ID: ",ENNXL
  1.  S DIE="^ENG(6914,",DR="5;24;25;26",DA=ENNXL
  1.  I $P(^ENG(6914,ENDAOLD,0),U,3)]"" S DR=DR_";2" ; parent system
  1.  I $D(^ENG(6914,ENNXL,8)),$P(^(8),U,8)]"" S DR=DR_";51" ; replacing
  1.  D ^DIE I $D(Y)!$D(DTOUT),$P($G(^ENG(6914,DA,1)),U,3)']"" D  Q
  1.  . W $C(7),!,"Time Out or '^' entered and Serial Number was left blank."
  1.  . W !,"Deleting last entry (",DA,")..."
  1.  . S DIK="^ENG(6914," D ^DIK K DIK L -^ENG(6914,DA)
  1.  . S ENNXL=0
  1.  I $G(ENMA("IIWO")) D IIWO^ENWONEW3(ENNXL)
  1.  I $G(ENMA("FAP")) S ENEQ("DA")=DA D ^ENFAACQ S DA=ENEQ("DA") K ENEQ("DA")
  1.  S DA=ENNXL D BULL
  1.  L -^ENG(6914,ENNXL)
  1.  Q
  1.  ;
  1. BULL ;X-mit new equipment bulletin if mail group established
  1.  ; Input
  1.  ;   DA - ien of equipment entry
  1.  ;   optional ENBULL( - array indicating mail group availabliity
  1.  ;                      undefined nodes not yet evaluated
  1.  ;            ENBULL = true(1) if 'EN NEW EQUIPMENT' established
  1.  ;            ENBULL(station number)=true(1) if
  1.  ;               'EN NEW EQUIPMENT station number' established 
  1.  Q:'$D(DA)  Q:'$D(^ENG(6914,DA,0))
  1.  N ENSN,XMB,XMDUZ,XMY
  1.  ; determine station number of equipment entry
  1.  S ENSN=$$GET1^DIQ(6914,DA,60)
  1.  ; if blank use default station #
  1.  I ENSN="" S ENSN=$$GET1^DIQ(6910,1,1)
  1.  ; get status of station specific mail group if not already done
  1.  I ENSN]"",'$D(ENBULL(ENSN)) S ENBULL(ENSN)=$$CHKMGRP("EN NEW EQUIPMENT "_ENSN)
  1.  ; use station specific mail group if available
  1.  I ENSN]"",ENBULL(ENSN) S XMY("G.EN NEW EQUIPMENT "_ENSN)=""
  1.  ; if station specific mail group not established then use generic group
  1.  I '$D(XMY) D
  1.  . ; get staus of generic mail group if not already done
  1.  . I $G(ENBULL)']"" S ENBULL=$$CHKMGRP("EN NEW EQUIPMENT")
  1.  . I ENBULL S XMY("G.EN NEW EQUIPMENT")=""
  1.  ; send bulletin if a mail group is established
  1.  I $D(XMY) D
  1.  . S XMB="EN NEW EQUIPMENT"
  1.  . S XMB(1)=DA,XMB(2)=$P(^VA(200,DUZ,0),U),XMB(3)=$P(^ENG(6914,DA,0),U,2)
  1.  . F X=4,5 S XMB(X)=""
  1.  . I $D(^ENG(6914,DA,1)) S X=$P(^(1),U) S:X>0 XMB(4)=$P(^ENG(6911,X,0),U)
  1.  . I $D(^ENG(6914,DA,3)) S X=$P(^(3),U,2) S:X>0 XMB(5)=$P(^DIC(49,X,0),U)
  1.  . S:ENSN]"" XMB(6)=ENSN
  1.  . F X=4,5,6 S:XMB(X)="" XMB(X)="MISSING"
  1.  . S X="0^0"
  1.  . I $P($G(^ENG(6914,DA,0)),U,4)="NX",$P($G(^(8)),U,2) S $P(X,U)=1 ;CapNX
  1.  . I $P(X,U),+$$CHKFA^ENFAUTL(DA) S $P(X,U,2)=1 ; FAP
  1.  . S XMB(7)="Item is"_$S($P(X,U):"",1:" NOT")_" capitalized NX."
  1.  . I $P(X,U) S XMB(7)=XMB(7)_" It was"_$S($P(X,U,2):"",1:" NOT")_" reported to FAP."
  1.  . S XMDUZ="AEMS/MERS"
  1.  . D ^XMB
  1.  Q
  1. CHKMGRP(ENMG) ; Check Mail Group Extrinsic Variable
  1.  ; true if mail group exists and has at least one member
  1.  ; Input Variable
  1.  ;   ENMG - name of mail group to check
  1.  N ENI,ENOK,ENQ
  1.  S ENOK=0 ; initialize result flag
  1.  ; look for mail group
  1.  S ENI=$$FIND1^DIC(3.8,"","X",ENMG,"B")
  1.  ; if found look for a member
  1.  I ENI D
  1.  . D LIST^DIC(3.81,","_ENI_",","","",1,"","","","","","ENQ")
  1.  . I $P(ENQ("DILIST",0),U) S ENOK=1 ; has at least one member
  1.  Q ENOK
  1.  ;
  1. LAST ;Last service episode (including PMI)
  1.  ; called by ENG DJ SCREENs
  1.  ; in:  DA - ien of equipment entry
  1.  ; out: displays date and work action of last service episode (if any)
  1.  N ENA,ENB,ENI,ENX
  1.  Q:'$D(DA)
  1.  Q:'$D(^ENG(6914,DA,6))
  1.  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
  1.  . S ENX="Last serviced: "_$E(ENA,4,5)_"/"_$E(ENA,6,7)_"/"_$E(ENA,2,3)
  1.  . S ENB=$P($P(ENA,U),"-",2) D:ENB]""  S ENX=ENX_"   Work Action: "_ENB
  1.  . . I $D(^ENG(6920.1,"D",ENB)) S ENB(0)=$O(^(ENB,0))
  1.  . . I $D(ENB(0)),$D(^ENG(6920.1,ENB(0),0)) S ENB=$P(^(0),U)
  1.  . W !!,ENX
  1.  Q
  1.  ;ENEQ3