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