ENWONEW ;(WASH ISC)/DH-Work Order Entry ;8.28.97
;;7.0;ENGINEERING;**1,35,42,43**;Aug 17, 1993
WARD ; Entry point for Electronic Work Requests
N SHOPKEY,CODE,NUMBER,DONE,WARD,DA,DIC,DIE,DR
S U="^",DONE=0,WARD=1
I $D(^DIC(6910,1,0)),$P(^(0),U,6)]"" S SHOPKEY=$P(^(0),U,6)
E S DIC="^DIC(6922,",DIC(0)="AEQ",DIC("S")="I Y#100>89" D ^DIC K DIC("S") S:Y>0 SHOPKEY=+Y
Q:'$D(SHOPKEY)
S DR=$S($D(^DIE("B","ENZWOWARD")):"[ENZWOWARD]",1:"[ENWOWARD]")
D PROCS
K ENBARCD
Q
;
ENG ; Entry point for Work Orders to be entered by Facility Management
N CODE,NUMBER,DONE,WARD,SHOPKEY,ENDONE,DA,DIC,DIE,DR
S U="^",(DONE,WARD)=0 S:$D(ENSHKEY) SHOPKEY=ENSHKEY
I '$D(SHOPKEY) S DIC="^DIC(6922,",DIC(0)="AEQ" D ^DIC S:Y>0 SHOPKEY=+Y
Q:'$D(SHOPKEY)
S DR=$S($D(^DIE("B","ENZWONEW")):"[ENZWONEW]",1:"[ENWONEW]")
D PROCS
K ENBARCD
Q
;
PROCS ;Main process (work order entry)
N ENDA F D Q:DONE
. W !!,"Want to enter a new work order?"
. S DIR(0)="Y",DIR("B")=$S($D(CODE):"NO",1:"YES")
. D ^DIR K DIR I Y'>0 S DONE=1 Q
. S NUMBER="" D WONUM W:NUMBER]"" !,"WORK ORDER #: ",NUMBER
. I NUMBER="" S DONE=1 D
.. W !!,*7,"Can't seem to add to Work Order File."
.. W !,"Please try again later or contact IRM Service."
. Q:NUMBER=""
. S ENDA=DA L +^ENG(6920,ENDA)
. D WOFILL,WOEDIT D:NUMBER'="" WOPRNT L -^ENG(6920,ENDA)
Q
;
WONUM ;Find next sequence number & use it
;Work order # returned in NUMBER, null if unsuccessful
I '$D(DT) S %DT="",X="T" D ^%DT S DT=+Y
Q:SHOPKEY'>0 I '$D(^DIC(6922,SHOPKEY,0)) Q
S CODE=$P(^DIC(6922,SHOPKEY,0),U,2)_$E(DT,2,7)_"-"
L +^ENG(6920,"B"):20 Q:'$T
F I=1:1 S X=CODE_$S(I<10:"00"_I,I<100:"0"_I,1:I) I '$D(^ENG(6920,"B",X)),'$D(^ENG(6920,"H",X)) S NUMBER=X Q
K DD,DO S DIC="^ENG(6920,",DIC(0)="LX" D FILE^DICN S DA=+Y S:DA'>0 NUMBER=""
L -^ENG(6920,"B")
Q
;
WOFILL ;Fill in known fields
N DR
S DIE="^ENG(6920,",DR="1///N;.05///"_NUMBER_";7.5////"_DUZ_";9///"_SHOPKEY
D ^DIE
Q:'WARD
S DR="2///C;7///"_$E($P(^VA(200,DUZ,0),U),1,15)
I $D(^VA(200,DUZ,.13)),$P(^(.13),U,2)]"" S DR=DR_";8///"_$P(^(.13),U,2)
D ^DIE
Q
;
WOEDIT ;Edit newly created work order (if desired)
D ^DIE
I $D(DTOUT) W !," FileMan has timed out due to inactivity. Work Order DELETED.",*7 S DIK="^ENG(6920," D ^DIK K DIK,DTOUT S NUMBER="" Q
I '$D(^ENG(6920,DA,1)) W !," Work Order DELETED.",*7 S DIK="^ENG(6920," D ^DIK K DIK S NUMBER="" Q
I $P(^ENG(6920,DA,1),U,2)="" W !," Work Order DELETED.",*7 S DIK="^ENG(6920," D ^DIK K DIK S NUMBER="" Q
I 'WARD D Q:ENDONE
. W !!,"Do you want to CLOSE this work order now?"
. S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
. S ENDONE=$S(Y'>0:0,1:1)
. I ENDONE D Q
.. N DR
.. S DR=$S($D(^DIE("B","ENZWONEWCLOSE")):"[ENZWONEWCLOSE]",1:"[ENWONEWCLOSE]")
.. D ^DIE
W !!,"Edit this new work order?"
S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR Q:Y'>0
I WARD D ^DIE Q
D EDIT1^ENWOD
Q
;
WOPRNT ;Print new work order (if desired)
N AUTOPRT,DEVICE
I $D(^ENG(6910.2,1,0)),$P(^(0),U,2)]"" S:$P(^(0),U,2)'="N" AUTOPRT=$P(^(0),U,2)
I '$D(ENBARCD) S ENBARCD=0 I $D(^ENG(6910.2,"B","PRINT BAR CODES ON W.O.")) S I=$O(^("PRINT BAR CODES ON W.O.",0)) I I>0,$P(^ENG(6910.2,I,0),U,2)="Y" S ENBARCD=1
I $D(AUTOPRT) D
. I AUTOPRT="L" D
.. S DEVICE="" D AUTODEV^ENWONEW2
.. I DEVICE="" D HOME^%ZIS Q
.. I DEVICE="HOME" D Q
... I $D(IO("S")) S IOP=ION,%ZIS="" D ^%ZIS
... D PRT1^ENWOD
... D HOLD^ENWOD2 K ENWO,ENDSTAT,ENX,ENINV
... D ^%ZISC
.. S ZTRTN="PRT1^ENWOD",ZTDESC="Work Order Auto Print (Long)"
.. S ZTDTH=$H
.. D TASK
. I AUTOPRT="S" D
.. S DEVICE="" D AUTODEV^ENWONEW2
.. I DEVICE="" D HOME^%ZIS Q
.. N IOINLOW,IOINHI D ZIS^ENUTL
.. I DEVICE="HOME" D Q
... I $D(IO("S")) S IOP=ION,%ZIS="" D ^%ZIS
... D FDAT4^ENWOP3 D ^%ZISC
... K EN,ENAC,ENDPR,ENEQ,ENLOC,ENPRI,ENRDA,ENRQR
... K ENSTAT,ENTEC,ENWOR,ENY
.. S ZTRTN="FDAT4^ENWOP3",ZTDESC="Work Order Auto Print (Short)"
.. S ZTDTH=$H
.. D TASK
I WARD D Q
. W !,"Want to print this new work order?"
. S DIR(0)="Y",DIR("B")="NO" D ^DIR Q:Y'>0
. K IO("Q") S %ZIS="Q" D ^%ZIS I POP D HOME^%ZIS Q
. I '$D(IO("Q")) D PRT1^ENEWOD Q
. D
.. S ZTRTN="PRT1^ENEWOD",ZTDESC="Electronic Work Order"
.. D TASK
.. K IO("Q")
I '$D(AUTOPRT) D
. W !,"Print this work order?"
. S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:Y'>0
. D DEV^ENLIB I POP D HOME^%ZIS Q
. I '$D(IO("Q")) D PRT1^ENWOD Q
. D
.. S ZTRTN="PRT1^ENWOD",ZTDESC="Engineering Work Order"
.. D TASK
.. K IO("Q")
Q
;
TASK ;Print work order in background
S ZTIO=ION,ZTSAVE("DA")="",ZTSAVE("EN*")=""
D ^%ZTLOAD K ZTSK,ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE D HOME^%ZIS
Q
;ENWONEW
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENWONEW 4700 printed Oct 16, 2024@17:57:09 Page 2
ENWONEW ;(WASH ISC)/DH-Work Order Entry ;8.28.97
+1 ;;7.0;ENGINEERING;**1,35,42,43**;Aug 17, 1993
WARD ; Entry point for Electronic Work Requests
+1 NEW SHOPKEY,CODE,NUMBER,DONE,WARD,DA,DIC,DIE,DR
+2 SET U="^"
SET DONE=0
SET WARD=1
+3 IF $DATA(^DIC(6910,1,0))
IF $PIECE(^(0),U,6)]""
SET SHOPKEY=$PIECE(^(0),U,6)
+4 IF '$TEST
SET DIC="^DIC(6922,"
SET DIC(0)="AEQ"
SET DIC("S")="I Y#100>89"
DO ^DIC
KILL DIC("S")
if Y>0
SET SHOPKEY=+Y
+5 if '$DATA(SHOPKEY)
QUIT
+6 SET DR=$SELECT($DATA(^DIE("B","ENZWOWARD")):"[ENZWOWARD]",1:"[ENWOWARD]")
+7 DO PROCS
+8 KILL ENBARCD
+9 QUIT
+10 ;
ENG ; Entry point for Work Orders to be entered by Facility Management
+1 NEW CODE,NUMBER,DONE,WARD,SHOPKEY,ENDONE,DA,DIC,DIE,DR
+2 SET U="^"
SET (DONE,WARD)=0
if $DATA(ENSHKEY)
SET SHOPKEY=ENSHKEY
+3 IF '$DATA(SHOPKEY)
SET DIC="^DIC(6922,"
SET DIC(0)="AEQ"
DO ^DIC
if Y>0
SET SHOPKEY=+Y
+4 if '$DATA(SHOPKEY)
QUIT
+5 SET DR=$SELECT($DATA(^DIE("B","ENZWONEW")):"[ENZWONEW]",1:"[ENWONEW]")
+6 DO PROCS
+7 KILL ENBARCD
+8 QUIT
+9 ;
PROCS ;Main process (work order entry)
+1 NEW ENDA
FOR
Begin DoDot:1
+2 WRITE !!,"Want to enter a new work order?"
+3 SET DIR(0)="Y"
SET DIR("B")=$SELECT($DATA(CODE):"NO",1:"YES")
+4 DO ^DIR
KILL DIR
IF Y'>0
SET DONE=1
QUIT
+5 SET NUMBER=""
DO WONUM
if NUMBER]""
WRITE !,"WORK ORDER #: ",NUMBER
+6 IF NUMBER=""
SET DONE=1
Begin DoDot:2
+7 WRITE !!,*7,"Can't seem to add to Work Order File."
+8 WRITE !,"Please try again later or contact IRM Service."
End DoDot:2
+9 if NUMBER=""
QUIT
+10 SET ENDA=DA
LOCK +^ENG(6920,ENDA)
+11 DO WOFILL
DO WOEDIT
if NUMBER'=""
DO WOPRNT
LOCK -^ENG(6920,ENDA)
End DoDot:1
if DONE
QUIT
+12 QUIT
+13 ;
WONUM ;Find next sequence number & use it
+1 ;Work order # returned in NUMBER, null if unsuccessful
+2 IF '$DATA(DT)
SET %DT=""
SET X="T"
DO ^%DT
SET DT=+Y
+3 if SHOPKEY'>0
QUIT
IF '$DATA(^DIC(6922,SHOPKEY,0))
QUIT
+4 SET CODE=$PIECE(^DIC(6922,SHOPKEY,0),U,2)_$EXTRACT(DT,2,7)_"-"
+5 LOCK +^ENG(6920,"B"):20
if '$TEST
QUIT
+6 FOR I=1:1
SET X=CODE_$SELECT(I<10:"00"_I,I<100:"0"_I,1:I)
IF '$DATA(^ENG(6920,"B",X))
IF '$DATA(^ENG(6920,"H",X))
SET NUMBER=X
QUIT
+7 KILL DD,DO
SET DIC="^ENG(6920,"
SET DIC(0)="LX"
DO FILE^DICN
SET DA=+Y
if DA'>0
SET NUMBER=""
+8 LOCK -^ENG(6920,"B")
+9 QUIT
+10 ;
WOFILL ;Fill in known fields
+1 NEW DR
+2 SET DIE="^ENG(6920,"
SET DR="1///N;.05///"_NUMBER_";7.5////"_DUZ_";9///"_SHOPKEY
+3 DO ^DIE
+4 if 'WARD
QUIT
+5 SET DR="2///C;7///"_$EXTRACT($PIECE(^VA(200,DUZ,0),U),1,15)
+6 IF $DATA(^VA(200,DUZ,.13))
IF $PIECE(^(.13),U,2)]""
SET DR=DR_";8///"_$PIECE(^(.13),U,2)
+7 DO ^DIE
+8 QUIT
+9 ;
WOEDIT ;Edit newly created work order (if desired)
+1 DO ^DIE
+2 IF $DATA(DTOUT)
WRITE !," FileMan has timed out due to inactivity. Work Order DELETED.",*7
SET DIK="^ENG(6920,"
DO ^DIK
KILL DIK,DTOUT
SET NUMBER=""
QUIT
+3 IF '$DATA(^ENG(6920,DA,1))
WRITE !," Work Order DELETED.",*7
SET DIK="^ENG(6920,"
DO ^DIK
KILL DIK
SET NUMBER=""
QUIT
+4 IF $PIECE(^ENG(6920,DA,1),U,2)=""
WRITE !," Work Order DELETED.",*7
SET DIK="^ENG(6920,"
DO ^DIK
KILL DIK
SET NUMBER=""
QUIT
+5 IF 'WARD
Begin DoDot:1
+6 WRITE !!,"Do you want to CLOSE this work order now?"
+7 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+8 SET ENDONE=$SELECT(Y'>0:0,1:1)
+9 IF ENDONE
Begin DoDot:2
+10 NEW DR
+11 SET DR=$SELECT($DATA(^DIE("B","ENZWONEWCLOSE")):"[ENZWONEWCLOSE]",1:"[ENWONEWCLOSE]")
+12 DO ^DIE
End DoDot:2
QUIT
End DoDot:1
if ENDONE
QUIT
+13 WRITE !!,"Edit this new work order?"
+14 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if Y'>0
QUIT
+15 IF WARD
DO ^DIE
QUIT
+16 DO EDIT1^ENWOD
+17 QUIT
+18 ;
WOPRNT ;Print new work order (if desired)
+1 NEW AUTOPRT,DEVICE
+2 IF $DATA(^ENG(6910.2,1,0))
IF $PIECE(^(0),U,2)]""
if $PIECE(^(0),U,2)'="N"
SET AUTOPRT=$PIECE(^(0),U,2)
+3 IF '$DATA(ENBARCD)
SET ENBARCD=0
IF $DATA(^ENG(6910.2,"B","PRINT BAR CODES ON W.O."))
SET I=$ORDER(^("PRINT BAR CODES ON W.O.",0))
IF I>0
IF $PIECE(^ENG(6910.2,I,0),U,2)="Y"
SET ENBARCD=1
+4 IF $DATA(AUTOPRT)
Begin DoDot:1
+5 IF AUTOPRT="L"
Begin DoDot:2
+6 SET DEVICE=""
DO AUTODEV^ENWONEW2
+7 IF DEVICE=""
DO HOME^%ZIS
QUIT
+8 IF DEVICE="HOME"
Begin DoDot:3
+9 IF $DATA(IO("S"))
SET IOP=ION
SET %ZIS=""
DO ^%ZIS
+10 DO PRT1^ENWOD
+11 DO HOLD^ENWOD2
KILL ENWO,ENDSTAT,ENX,ENINV
+12 DO ^%ZISC
End DoDot:3
QUIT
+13 SET ZTRTN="PRT1^ENWOD"
SET ZTDESC="Work Order Auto Print (Long)"
+14 SET ZTDTH=$HOROLOG
+15 DO TASK
End DoDot:2
+16 IF AUTOPRT="S"
Begin DoDot:2
+17 SET DEVICE=""
DO AUTODEV^ENWONEW2
+18 IF DEVICE=""
DO HOME^%ZIS
QUIT
+19 NEW IOINLOW,IOINHI
DO ZIS^ENUTL
+20 IF DEVICE="HOME"
Begin DoDot:3
+21 IF $DATA(IO("S"))
SET IOP=ION
SET %ZIS=""
DO ^%ZIS
+22 DO FDAT4^ENWOP3
DO ^%ZISC
+23 KILL EN,ENAC,ENDPR,ENEQ,ENLOC,ENPRI,ENRDA,ENRQR
+24 KILL ENSTAT,ENTEC,ENWOR,ENY
End DoDot:3
QUIT
+25 SET ZTRTN="FDAT4^ENWOP3"
SET ZTDESC="Work Order Auto Print (Short)"
+26 SET ZTDTH=$HOROLOG
+27 DO TASK
End DoDot:2
End DoDot:1
+28 IF WARD
Begin DoDot:1
+29 WRITE !,"Want to print this new work order?"
+30 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
if Y'>0
QUIT
+31 KILL IO("Q")
SET %ZIS="Q"
DO ^%ZIS
IF POP
DO HOME^%ZIS
QUIT
+32 IF '$DATA(IO("Q"))
DO PRT1^ENEWOD
QUIT
+33 Begin DoDot:2
+34 SET ZTRTN="PRT1^ENEWOD"
SET ZTDESC="Electronic Work Order"
+35 DO TASK
+36 KILL IO("Q")
End DoDot:2
End DoDot:1
QUIT
+37 IF '$DATA(AUTOPRT)
Begin DoDot:1
+38 WRITE !,"Print this work order?"
+39 SET DIR(0)="Y"
SET DIR("B")="YES"
DO ^DIR
if Y'>0
QUIT
+40 DO DEV^ENLIB
IF POP
DO HOME^%ZIS
QUIT
+41 IF '$DATA(IO("Q"))
DO PRT1^ENWOD
QUIT
+42 Begin DoDot:2
+43 SET ZTRTN="PRT1^ENWOD"
SET ZTDESC="Engineering Work Order"
+44 DO TASK
+45 KILL IO("Q")
End DoDot:2
End DoDot:1
+46 QUIT
+47 ;
TASK ;Print work order in background
+1 SET ZTIO=ION
SET ZTSAVE("DA")=""
SET ZTSAVE("EN*")=""
+2 DO ^%ZTLOAD
KILL ZTSK,ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE
DO HOME^%ZIS
+3 QUIT
+4 ;ENWONEW
