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

ENWONEW.m

Go to the documentation of this file.
  1. ENWONEW ;(WASH ISC)/DH-Work Order Entry ;8.28.97
  1. ;;7.0;ENGINEERING;**1,35,42,43**;Aug 17, 1993
  1. WARD ; Entry point for Electronic Work Requests
  1. N SHOPKEY,CODE,NUMBER,DONE,WARD,DA,DIC,DIE,DR
  1. S U="^",DONE=0,WARD=1
  1. I $D(^DIC(6910,1,0)),$P(^(0),U,6)]"" S SHOPKEY=$P(^(0),U,6)
  1. E S DIC="^DIC(6922,",DIC(0)="AEQ",DIC("S")="I Y#100>89" D ^DIC K DIC("S") S:Y>0 SHOPKEY=+Y
  1. Q:'$D(SHOPKEY)
  1. S DR=$S($D(^DIE("B","ENZWOWARD")):"[ENZWOWARD]",1:"[ENWOWARD]")
  1. D PROCS
  1. K ENBARCD
  1. Q
  1. ;
  1. ENG ; Entry point for Work Orders to be entered by Facility Management
  1. N CODE,NUMBER,DONE,WARD,SHOPKEY,ENDONE,DA,DIC,DIE,DR
  1. S U="^",(DONE,WARD)=0 S:$D(ENSHKEY) SHOPKEY=ENSHKEY
  1. I '$D(SHOPKEY) S DIC="^DIC(6922,",DIC(0)="AEQ" D ^DIC S:Y>0 SHOPKEY=+Y
  1. Q:'$D(SHOPKEY)
  1. S DR=$S($D(^DIE("B","ENZWONEW")):"[ENZWONEW]",1:"[ENWONEW]")
  1. D PROCS
  1. K ENBARCD
  1. Q
  1. ;
  1. PROCS ;Main process (work order entry)
  1. N ENDA F D Q:DONE
  1. . W !!,"Want to enter a new work order?"
  1. . S DIR(0)="Y",DIR("B")=$S($D(CODE):"NO",1:"YES")
  1. . D ^DIR K DIR I Y'>0 S DONE=1 Q
  1. . S NUMBER="" D WONUM W:NUMBER]"" !,"WORK ORDER #: ",NUMBER
  1. . I NUMBER="" S DONE=1 D
  1. .. W !!,*7,"Can't seem to add to Work Order File."
  1. .. W !,"Please try again later or contact IRM Service."
  1. . Q:NUMBER=""
  1. . S ENDA=DA L +^ENG(6920,ENDA)
  1. . D WOFILL,WOEDIT D:NUMBER'="" WOPRNT L -^ENG(6920,ENDA)
  1. Q
  1. ;
  1. WONUM ;Find next sequence number & use it
  1. ;Work order # returned in NUMBER, null if unsuccessful
  1. I '$D(DT) S %DT="",X="T" D ^%DT S DT=+Y
  1. Q:SHOPKEY'>0 I '$D(^DIC(6922,SHOPKEY,0)) Q
  1. S CODE=$P(^DIC(6922,SHOPKEY,0),U,2)_$E(DT,2,7)_"-"
  1. L +^ENG(6920,"B"):20 Q:'$T
  1. 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
  1. K DD,DO S DIC="^ENG(6920,",DIC(0)="LX" D FILE^DICN S DA=+Y S:DA'>0 NUMBER=""
  1. L -^ENG(6920,"B")
  1. Q
  1. ;
  1. WOFILL ;Fill in known fields
  1. N DR
  1. S DIE="^ENG(6920,",DR="1///N;.05///"_NUMBER_";7.5////"_DUZ_";9///"_SHOPKEY
  1. D ^DIE
  1. Q:'WARD
  1. S DR="2///C;7///"_$E($P(^VA(200,DUZ,0),U),1,15)
  1. I $D(^VA(200,DUZ,.13)),$P(^(.13),U,2)]"" S DR=DR_";8///"_$P(^(.13),U,2)
  1. D ^DIE
  1. Q
  1. ;
  1. WOEDIT ;Edit newly created work order (if desired)
  1. D ^DIE
  1. 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
  1. I '$D(^ENG(6920,DA,1)) W !," Work Order DELETED.",*7 S DIK="^ENG(6920," D ^DIK K DIK S NUMBER="" Q
  1. I $P(^ENG(6920,DA,1),U,2)="" W !," Work Order DELETED.",*7 S DIK="^ENG(6920," D ^DIK K DIK S NUMBER="" Q
  1. I 'WARD D Q:ENDONE
  1. . W !!,"Do you want to CLOSE this work order now?"
  1. . S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
  1. . S ENDONE=$S(Y'>0:0,1:1)
  1. . I ENDONE D Q
  1. .. N DR
  1. .. S DR=$S($D(^DIE("B","ENZWONEWCLOSE")):"[ENZWONEWCLOSE]",1:"[ENWONEWCLOSE]")
  1. .. D ^DIE
  1. W !!,"Edit this new work order?"
  1. S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR Q:Y'>0
  1. I WARD D ^DIE Q
  1. D EDIT1^ENWOD
  1. Q
  1. ;
  1. WOPRNT ;Print new work order (if desired)
  1. N AUTOPRT,DEVICE
  1. I $D(^ENG(6910.2,1,0)),$P(^(0),U,2)]"" S:$P(^(0),U,2)'="N" AUTOPRT=$P(^(0),U,2)
  1. 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
  1. I $D(AUTOPRT) D
  1. . I AUTOPRT="L" D
  1. .. S DEVICE="" D AUTODEV^ENWONEW2
  1. .. I DEVICE="" D HOME^%ZIS Q
  1. .. I DEVICE="HOME" D Q
  1. ... I $D(IO("S")) S IOP=ION,%ZIS="" D ^%ZIS
  1. ... D PRT1^ENWOD
  1. ... D HOLD^ENWOD2 K ENWO,ENDSTAT,ENX,ENINV
  1. ... D ^%ZISC
  1. .. S ZTRTN="PRT1^ENWOD",ZTDESC="Work Order Auto Print (Long)"
  1. .. S ZTDTH=$H
  1. .. D TASK
  1. . I AUTOPRT="S" D
  1. .. S DEVICE="" D AUTODEV^ENWONEW2
  1. .. I DEVICE="" D HOME^%ZIS Q
  1. .. N IOINLOW,IOINHI D ZIS^ENUTL
  1. .. I DEVICE="HOME" D Q
  1. ... I $D(IO("S")) S IOP=ION,%ZIS="" D ^%ZIS
  1. ... D FDAT4^ENWOP3 D ^%ZISC
  1. ... K EN,ENAC,ENDPR,ENEQ,ENLOC,ENPRI,ENRDA,ENRQR
  1. ... K ENSTAT,ENTEC,ENWOR,ENY
  1. .. S ZTRTN="FDAT4^ENWOP3",ZTDESC="Work Order Auto Print (Short)"
  1. .. S ZTDTH=$H
  1. .. D TASK
  1. I WARD D Q
  1. . W !,"Want to print this new work order?"
  1. . S DIR(0)="Y",DIR("B")="NO" D ^DIR Q:Y'>0
  1. . K IO("Q") S %ZIS="Q" D ^%ZIS I POP D HOME^%ZIS Q
  1. . I '$D(IO("Q")) D PRT1^ENEWOD Q
  1. . D
  1. .. S ZTRTN="PRT1^ENEWOD",ZTDESC="Electronic Work Order"
  1. .. D TASK
  1. .. K IO("Q")
  1. I '$D(AUTOPRT) D
  1. . W !,"Print this work order?"
  1. . S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:Y'>0
  1. . D DEV^ENLIB I POP D HOME^%ZIS Q
  1. . I '$D(IO("Q")) D PRT1^ENWOD Q
  1. . D
  1. .. S ZTRTN="PRT1^ENWOD",ZTDESC="Engineering Work Order"
  1. .. D TASK
  1. .. K IO("Q")
  1. Q
  1. ;
  1. TASK ;Print work order in background
  1. S ZTIO=ION,ZTSAVE("DA")="",ZTSAVE("EN*")=""
  1. D ^%ZTLOAD K ZTSK,ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE D HOME^%ZIS
  1. Q
  1. ;ENWONEW