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

ENEQ1.m

Go to the documentation of this file. 
  1. ENEQ1 ;WIRMFO/DH,SAB-Enter Equipment Records ;12.18.97
  1.  ;;7.0;ENGINEERING;**14,25,29,35,47**;Aug 17, 1993
  1.  ;
  1. EQAD ;New Inventory Entry Point
  1.  S END=0
  1.  N IOINLOW,IOINHI D ZIS^ENUTL
  1.  D ASKEDM G:END EQADX
  1.  ;
  1.  F  D  Q:END
  1.  . W @IOF,!!!
  1.  . S DIR(0)="Y",DIR("A")="Enter a new equipment inventory item"
  1.  . S DIR("B")="NO"
  1.  . S DIR("?")="Enter 'Y' to add a new Equipment Record."
  1.  . W @IOF,!!! D ^DIR K DIR I 'Y S END=1 Q
  1.  . D ASKSER Q:END  Q:'$D(ENSERIAL)
  1.  . D ADDEQ
  1. EQADX ;
  1.  K DA,DIC,DIE,DIK,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
  1.  K END,ENDA,ENDR,ENNXL,ENSCRN
  1.  Q
  1.  ;
  1. EQMAD ;Multiple Inventory Entry Point 
  1.  S END=0,ENMA=1
  1.  N IOINLOW,IOINHI D ZIS^ENUTL
  1.  W @IOF,!!!
  1.  S DIR(0)="Y",DIR("A")="Enter multiple equipment inventory items"
  1.  S DIR("B")="NO"
  1.  S DIR("?",1)="This option allows a rapid entry of multiple items which"
  1.  S DIR("?",2)="are alike; e.g. 25 new electric beds."
  1.  S DIR("?")="Enter YES or NO"
  1.  D ^DIR K DIR G:'Y EQMADX
  1.  ;
  1.  D ASKEDM G:END EQMADX
  1.  ;
  1.  W !!,"Proceed by entering the first item in full"
  1.  S DIR(0)="E" D ^DIR K DIR G:$D(DIRUT) EQMADX
  1.  ;
  1.  D ASKSER G:END EQMADX G:'$D(ENSERIAL) EQMAD
  1.  ;
  1.  D ADDEQ I 'ENNXL G EQMADX
  1.  ;
  1.  W @IOF,!!!,"For each additional equipment entry enter:"
  1.  W !," SERIAL #, LOCATION, VA PM NUMBER, and LOCAL IDENTIFIER (if any)."
  1.  F  D  Q:END
  1.  . W !!
  1.  . S DIR(0)="Y",DIR("A")="Enter another item",DIR("B")="YES"
  1.  . S DIR("?")="Enter YES to add another similar equipment item"
  1.  . D ^DIR K DIR I 'Y S END=1 Q
  1.  . S ENDAOLD=ENNXL
  1.  . D EQMAS^ENEQ3 I 'ENNXL S ENNXL=ENDAOLD
  1.  . K ENDAOLD
  1.  ;
  1. EQMADX ;
  1.  K DA,DIC,DIE,DIK,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
  1.  K END,ENDA,ENDR,ENMA,ENNXL,ENSCRN
  1.  Q
  1.  ;
  1. ASKEDM ; ask edit method (screen or template)
  1.  ; out
  1.  ;   ENSCRN - flag: true when screen entry
  1.  ;   ENDR   - input template when ENSCRN = 0
  1.  ;   END    - true when timeout or '^'
  1.  S DIR(0)="Y",DIR("A")="Screen entry",DIR("B")="YES"
  1.  S DIR("?")="Enter 'Y' for screen handler, 'N' for standard FileMan."
  1.  D ^DIR K DIR S:$D(DIRUT) END=1 S ENSCRN=Y
  1.  S:ENSCRN=0 ENDR=$S($D(^DIE("B","ENZEQENTER")):"[ENZ",1:"[EN")_"EQENTER]"
  1.  Q
  1.  ;
  1. ASKSER ; ask serial # and check file for duplicates
  1.  ; out
  1.  ;   ENSERIAL - contains entered serial # or
  1.  ;              undefined if user did not reconfirm after a match
  1.  ;   END - true when timeout or '^'
  1.  N DA,ENI,ENMATCH,ENX
  1.  ; ask serial #
  1.  S ENSERIAL=""
  1.  W !!,"Please enter SERIAL # if available. Otherwise press <return>."
  1.  S DIR(0)="6914,5" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S END=1 Q
  1.  S ENSERIAL=Y
  1.  Q:ENSERIAL=""
  1.  ; look for matches
  1.  S ENX=$$UP^XLFSTR($TR(ENSERIAL," !""#$%&'()*+,-./:;<=>?@[\]^_`{|}~",""))
  1.  S ENX=$E(ENX_" ",1,30)
  1.  S ENI=0 F  S ENI=$O(^ENG(6914,"FC",ENX,ENI)) Q:'ENI  S ENMATCH(ENI)=""
  1.  ; if match show list, reconfirm
  1.  I $D(ENMATCH) D
  1.  . W !,"List of existing equipment with a similar Serial #"
  1.  . W !,?2,"Entry #",?14,"Manufacturer"
  1.  . S ENI=0 F  S ENI=$O(ENMATCH(ENI)) Q:'ENI  D
  1.  . . W !,?2,ENI,?14,$E($$GET1^DIQ(6914,ENI,1),1,60)
  1.  . . W !,?4,"Mod: ",$$GET1^DIQ(6914,ENI,4)
  1.  . . W ?40,"Ser #: ",$$GET1^DIQ(6914,ENI,5)
  1.  . S DIR(0)="Y",DIR("A")="Do you still want to add this new record"
  1.  . S DIR("B")="NO" D ^DIR K DIR S:$D(DIRUT) END=1 I 'Y K ENSERIAL
  1.  Q
  1.  ;
  1. ADDEQ ; add new equipment item
  1.  ; in
  1.  ;   ENSERIAL (optional) contains serial #
  1.  ;   ENMA (optional) flag, true if multiple equipment entry
  1.  ; out
  1.  ;   ENNXL - ien of new equipment record, 0 if unsuccessful
  1.  ;   also when $G(ENMA) true
  1.  ;       ENMA("FAP") - flag, true if FA Document generated
  1.  ;       ENMA("IIWO") - flag, true if Incom. Insp. W.O. generated
  1.  ;       also when $G(ENMA("IIWO")) true
  1.  ;           ENMA("IIWO","DA") - ien of created w.o.
  1.  ;           ENMA("IIWO","ION") - ION where w.o. printed
  1.  ;           ENMA("IIWO","QDT") - queued date/time if w.o. tasked
  1.  ; create new record
  1.  D ENR I 'ENNXL W $C(7),!,ENERR S DIR(0)="E" D ^DIR K DIR,ENERR Q
  1.  ; lock new record
  1.  L +^ENG(6914,ENNXL):1 I '$T D   Q
  1.  . W !!,$C(7),"Another user is editing Entry # ",ENNXL,". Can't proceed."
  1.  ; populate serial #
  1.  I $G(ENSERIAL)]"" S DIE="^ENG(6914,",DR="5////"_ENSERIAL,DA=ENNXL D ^DIE
  1.  ; user edit new record
  1.  I ENSCRN D
  1.  . S DJSC="ENEQ1",(DJDN,ENDA,DA)=ENNXL
  1.  . D EN^ENJ W IOINLOW
  1.  . K DJD0,DJDIS,DJDN,DJLG,DJSC,DJSW2
  1.  I 'ENSCRN S DIE="^ENG(6914,",DR=ENDR,DA=ENNXL D ^DIE
  1.  ; enter PM schedule
  1.  I $D(^XUSEC("ENEDPM",DUZ)) D
  1.  . S DIR(0)="Y",DIR("B")="YES"
  1.  . S DIR("A")="Would you like to include this item in the PM program"
  1.  . D ^DIR K DIR Q:'Y
  1.  . N ENXP
  1.  . S DIE="^ENG(6914,",(DA,ENDA)=ENNXL,ENXP=1
  1.  . I $D(^ENG(6914,DA,4)) D DINV^ENEQPMP3 Q:X="^"
  1.  . D XNPMSE^ENEQPMP
  1.  ; generate incoming inspection W.O.?
  1.  S ENI=$O(^ENG(6910.2,"B","ASK INCOMING INSPECTION W.O.",0))
  1.  I ENI,$P(^ENG(6910.2,ENI,0),U,2) D
  1.  . S DIR(0)="Y",DIR("A")="Create an Incoming Inspection Work Order"
  1.  . S DIR("B")=$S($P(^ENG(6910.2,ENI,0),U,2)=2:"YES",1:"NO")
  1.  . D ^DIR K DIR S:$G(ENMA) ENMA("IIWO")=$S(Y>0:1,1:0)
  1.  . I Y D IIWO^ENWONEW3(ENNXL) I $G(ENMA) D
  1.  . . S ENMA("IIWO","DA")=ENDA
  1.  . . S ENMA("IIWO","ION")=$G(ENION)
  1.  . . S ENMA("IIWO","QDT")=$G(ENQDT)
  1.  . . K ENDA,ENION,ENQDT
  1.  ; generate FA Document?
  1.  I $D(^XUSEC("ENFACS",DUZ)),$P(^ENG(6914,ENNXL,0),U,4)="NX",$P($G(^(8)),U,2) D
  1.  . W !!,"This Equipment Record is both NONEXPENDABLE and CAPITALIZED."
  1.  . W:$G(ENMA) !,"The same will be true of other records created using this option."
  1.  . S DIR(0)="Y",DIR("A")="Do you wish to send an FA document to Austin"
  1.  . S DIR("B")="YES"
  1.  . D ^DIR K DIR S:$G(ENMA) ENMA("FAP")=$S(Y>0:1,1:0)
  1.  . I Y  S ENEQ("DA")=ENNXL D ^ENFAACQ K ENEQ("DA")
  1.  ; generate new equipment bulletin
  1.  S DA=ENNXL D BULL^ENEQ3
  1.  ; unlock entry
  1.  L -^ENG(6914,ENNXL)
  1.  Q
  1.  ;
  1. ENR ; create entry with next available ien
  1.  ; out
  1.  ;   DA,ENNXL - ien of new entry, 0 when unsuccessful
  1.  ;   ENERR    - error message if unsuccessful
  1.  S (DA,ENNXL)=0 K ENERR
  1.  I '$D(ZTQUEUED) W !,"...Setting up new equipment record"
  1.  N DD,DIC,DINUM,DO,X,Y
  1.  L +^ENG(6914,0):10
  1.  I '$T S ENERR="SORRY, CAN'T LOCK ^ENG(6914,0) GLOBAL, TRY LATER" Q
  1.  ;
  1.  S ENNXL=$P(^ENG(6914,0),"^",3)
  1.  F  S ENNXL=ENNXL+1 Q:'$D(^ENG(6914,ENNXL,0))
  1.  ;
  1.  S DIC="^ENG(6914,",DIC(0)="LX",(DA,X,DINUM)=ENNXL
  1.  K DD,DO D FILE^DICN
  1.  S:Y'>0 (DA,ENNXL)=0,ENERR="Unable to add new record at this time..."
  1.  L -^ENG(6914,0)
  1.  Q
  1.  ;
  1.  ;ENEQ1