ENWONEW3 ;WIRMFO/SAB-Incoming Inspection Work Order ;12.18.97
;;7.0;ENGINEERING;**35,47**;Aug 17, 1993
;
IIWO(ENEQ) ; Generate Incoming Inspection Work Order
; called from ENEQ1, ENEQ3
; In
; ENEQ - equipment entry #
; ENMA("IIWO") - (optional) flag; true when multi equip entry
; ENMA("IIWO","DA") - (optional) w.o. ien generated for 1st equip
; ENMA("IIWO","ION") - (optional) device ion used with 1st equip w.o.
; ENMA("IIWO","QDT") - (optional) queued date/time of 1st w.o. print
; Out
; ENDA - work order ien
; ENWO - work order number
; also when $G(ENMA("IIWO")) true and device selected for output
; ENION - device ion used for (auto)print
; ENQDT - queued date/time when output queued
;
N AUTOPRT,DA,DIC,DIE,DR,ENEDPM,ENI,ENJ,ENTEC,ENX
N NUMBER,SHOPDEV,SHOPKEY,WARD
K ENION,ENQDT S (ENDA,ENWO)=""
; determine user privileges
S ENEDPM=$D(^XUSEC("ENEDPM",DUZ))
; determine shop of work order
I $G(ENMA("IIWO","DA")) S SHOPKEY=$P($G(^ENG(6920,ENMA("IIWO","DA"),2)),U)
E D
. S SHOPKEY=$P(^DIC(6910,1,0),U,13) ; incoming inspection section
. I SHOPKEY="" D ; or responsible shop
. . S ENI=$O(^ENG(6914,ENEQ,4,0))
. . I ENI S SHOPKEY=$P(^ENG(6914,ENEQ,4,ENI,0),U)
. I SHOPKEY="" S SHOPKEY=$P(^DIC(6910,1,0),U,6) ; or temp w.o. section
. ; ask shop if blank or user holds key
. I SHOPKEY=""!ENEDPM F D Q:SHOPKEY]""
. . S DIC="^DIC(6922,",DIC(0)="AQEM"
. . I SHOPKEY S DIC("B")=$P($G(^DIC(6922,SHOPKEY,0)),U)
. . I 'ENEDPM S DIC("S")="I Y#100>89" ; restrict to receiving areas
. . D ^DIC K DIC
. . I $D(DTOUT)!$D(DUOUT) S SHOPKEY="^" Q
. . I Y>0 S SHOPKEY=+Y Q
. . W !,"Shop required. Enter '^' if you don't want to create a W.O.",!
I SHOPKEY'>0 W !,"Unspecified Shop. Work Order was NOT created." G EXIT
;
; create work order
D WONUM^ENWONEW I NUMBER="" D G EXIT
. W $C(7),!,"Can't seem to add to Work Order File."
. W !,"You will need to manually create the incoming inspection W.O."
S ENDA=DA,ENWO=NUMBER
W !,"WORK ORDER #: ",NUMBER
; lock work order
L +^ENG(6920,DA):5 I '$T D G EXIT
. W $C(7),!,"Can't lock the new work order. Please contact IRM."
; populate work order
; with standard data for an electronic work order
S WARD=1 D WOFILL^ENWONEW S WARD=0
; with data for an incoming inspection work order
S DIE="^ENG(6920,"
S DR="6///Incoming Inspection"
S DR=DR_";17///AVERAGE"
S DR=DR_";32///"_$S(SHOPKEY#100>89:"PENDING",1:"IN PROGRESS")
I SHOPKEY#100>89 S DR=DR_";10///TODAY"
D ^DIE
K ENFDA S ENFDA(6920.035,"+2,"_DA_",",.01)="I1"
D UPDATE^DIE("E","ENFDA")
; with equipment related data
S DIE="^ENG(6920,"
S DR="18///"_ENEQ
S ENX=$$GET1^DIQ(6914,ENEQ,24) I ENX]"" S DR=DR_";3///"_ENX
D ^DIE
; with user specified data
S DIE="^ENG(6920,",DR=""
I $G(ENMA("IIWO","DA")) D
. ; copy comments from 1st work order
. I $D(^ENG(6920,ENMA("IIWO","DA"),6)) D
. . D WP^DIE(6920,DA_",",40,"","^ENG(6920,ENMA(""IIWO"",""DA""),6)")
. ; copy other user editable fields from 1st work order into DR
. S ENX=$P($G(^ENG(6920,ENMA("IIWO","DA"),2)),U,2) ; tech
. I ENX]"" S DR=DR_";16////"_ENX
. S ENX=$P($G(^ENG(6920,ENMA("IIWO","DA"),1)),U,3) ; contact
. I ENX]"" S DR=DR_";7////"_ENX
. S ENX=$P($G(^ENG(6920,ENMA("IIWO","DA"),1)),U,4) ; phone
. I ENX]"" S DR=DR_";8////"_ENX
I '$G(ENMA("IIWO","DA")) D
. ; build DR string for user editable fields
. ; determine responsible technician (if any)
. S ENI=$O(^ENG(6914,ENEQ,4,0))
. S ENJ=$S(ENI:$P(^ENG(6914,ENEQ,4,ENI,0),U,2),1:"")
. S ENTEC=$S(ENJ:$P($G(^ENG("EMP",ENJ,0)),U),1:"")
. I ENTEC]""!ENEDPM D
. . S DR=DR_";16"
. . I ENTEC]"" S DR=DR_"//"_$S(ENEDPM:"",1:"/")_ENTEC ; resp. tech
. S DR=DR_";7;8;40"
I $E(DR)=";" S DR=$E(DR,2,245)
D ^DIE
PRT ; print work order?
S ENI=$O(^ENG(6910.2,"B","AUTO PRINT NEW W.O.",0))
S AUTOPRT=$S(ENI:$P(^ENG(6910.2,ENI,0),U,2),1:"")
S SHOPDEV=$$GET1^DIQ(6922,SHOPKEY,2)
; if no user interaction required then call woprnt
I "^L^S^"[(U_AUTOPRT_U),SHOPDEV]"" S WARD=0 D WOPRNT^ENWONEW G PRTX
; if not autoprinted and shop is receiving area then skip
I SHOPKEY#100>89 G PRTX
; if subsequent equipment of multiple then use previous device (if any)
I $G(ENMA("IIWO","DA")) D G PRTX
. S IOP=$G(ENMA("IIWO","ION"))
. I IOP]"" S %ZIS="Q" D ^%ZIS Q:POP D PRTL
; if not autoprinted, not receiving area, and not subsequent then ask
S DIR(0)="Y",DIR("A")="Print this work order",DIR("B")="YES"
D ^DIR K DIR Q:Y'>0
D DEV^ENLIB I POP D HOME^%ZIS G PRTX
I $G(ENMA("IIWO")) S ENION=$S($D(IO("Q")):"Q;"_ION,1:ION)
D PRTL
PRTX ;
; unlock work order
L -^ENG(6920,DA)
EXIT ;
Q
;
PRTL ; Print W.O. Long Format
; determine required variables
N ENBARCD,ENWO
S ENBARCD=0
S ENI=$O(^ENG(6910.2,"B","PRINT BAR CODES ON W.O."))
I ENI,$P(^ENG(6910.2,ENI,0),U,2)="Y" S ENBARCD=1
S ENWO=$P(^ENG(6920,DA,0),U)
;
I $D(IO("Q")) D Q
. S ZTRTN="PRT1^ENWOD",ZTDESC="Enginering Work Order"
. S ZTIO=ION
. ; when subsequent entry during multiple use date/time of 1st for task
. I +$G(ENMA("IIWO","QDT")) S ZTDTH=ENMA("IIWO","QDT")
. F ENX="DA","ENBARCD","ENWO" S ZTSAVE(ENX)=""
. D ^%ZTLOAD
. ; when 1st of multiple entry return date/time queued
. I $G(ENMA("IIWO")),$G(ENION)]"" S ENQDT=$G(ZTSK("D"))
. D HOME^%ZIS K ZTSK
;
D PRT1^ENWOD
I $E(IOST,1,2)="C-" D HOLD^ENWOD2
K ENDSTAT,ENX,ENINV
Q
;
;ENWONEW3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENWONEW3 5476 printed Dec 13, 2024@01:56:24 Page 2
ENWONEW3 ;WIRMFO/SAB-Incoming Inspection Work Order ;12.18.97
+1 ;;7.0;ENGINEERING;**35,47**;Aug 17, 1993
+2 ;
IIWO(ENEQ) ; Generate Incoming Inspection Work Order
+1 ; called from ENEQ1, ENEQ3
+2 ; In
+3 ; ENEQ - equipment entry #
+4 ; ENMA("IIWO") - (optional) flag; true when multi equip entry
+5 ; ENMA("IIWO","DA") - (optional) w.o. ien generated for 1st equip
+6 ; ENMA("IIWO","ION") - (optional) device ion used with 1st equip w.o.
+7 ; ENMA("IIWO","QDT") - (optional) queued date/time of 1st w.o. print
+8 ; Out
+9 ; ENDA - work order ien
+10 ; ENWO - work order number
+11 ; also when $G(ENMA("IIWO")) true and device selected for output
+12 ; ENION - device ion used for (auto)print
+13 ; ENQDT - queued date/time when output queued
+14 ;
+15 NEW AUTOPRT,DA,DIC,DIE,DR,ENEDPM,ENI,ENJ,ENTEC,ENX
+16 NEW NUMBER,SHOPDEV,SHOPKEY,WARD
+17 KILL ENION,ENQDT
SET (ENDA,ENWO)=""
+18 ; determine user privileges
+19 SET ENEDPM=$DATA(^XUSEC("ENEDPM",DUZ))
+20 ; determine shop of work order
+21 IF $GET(ENMA("IIWO","DA"))
SET SHOPKEY=$PIECE($GET(^ENG(6920,ENMA("IIWO","DA"),2)),U)
+22 IF '$TEST
Begin DoDot:1
+23 ; incoming inspection section
SET SHOPKEY=$PIECE(^DIC(6910,1,0),U,13)
+24 ; or responsible shop
IF SHOPKEY=""
Begin DoDot:2
+25 SET ENI=$ORDER(^ENG(6914,ENEQ,4,0))
+26 IF ENI
SET SHOPKEY=$PIECE(^ENG(6914,ENEQ,4,ENI,0),U)
End DoDot:2
+27 ; or temp w.o. section
IF SHOPKEY=""
SET SHOPKEY=$PIECE(^DIC(6910,1,0),U,6)
+28 ; ask shop if blank or user holds key
+29 IF SHOPKEY=""!ENEDPM
FOR
Begin DoDot:2
+30 SET DIC="^DIC(6922,"
SET DIC(0)="AQEM"
+31 IF SHOPKEY
SET DIC("B")=$PIECE($GET(^DIC(6922,SHOPKEY,0)),U)
+32 ; restrict to receiving areas
IF 'ENEDPM
SET DIC("S")="I Y#100>89"
+33 DO ^DIC
KILL DIC
+34 IF $DATA(DTOUT)!$DATA(DUOUT)
SET SHOPKEY="^"
QUIT
+35 IF Y>0
SET SHOPKEY=+Y
QUIT
+36 WRITE !,"Shop required. Enter '^' if you don't want to create a W.O.",!
End DoDot:2
if SHOPKEY]""
QUIT
End DoDot:1
+37 IF SHOPKEY'>0
WRITE !,"Unspecified Shop. Work Order was NOT created."
GOTO EXIT
+38 ;
+39 ; create work order
+40 DO WONUM^ENWONEW
IF NUMBER=""
Begin DoDot:1
+41 WRITE $CHAR(7),!,"Can't seem to add to Work Order File."
+42 WRITE !,"You will need to manually create the incoming inspection W.O."
End DoDot:1
GOTO EXIT
+43 SET ENDA=DA
SET ENWO=NUMBER
+44 WRITE !,"WORK ORDER #: ",NUMBER
+45 ; lock work order
+46 LOCK +^ENG(6920,DA):5
IF '$TEST
Begin DoDot:1
+47 WRITE $CHAR(7),!,"Can't lock the new work order. Please contact IRM."
End DoDot:1
GOTO EXIT
+48 ; populate work order
+49 ; with standard data for an electronic work order
+50 SET WARD=1
DO WOFILL^ENWONEW
SET WARD=0
+51 ; with data for an incoming inspection work order
+52 SET DIE="^ENG(6920,"
+53 SET DR="6///Incoming Inspection"
+54 SET DR=DR_";17///AVERAGE"
+55 SET DR=DR_";32///"_$SELECT(SHOPKEY#100>89:"PENDING",1:"IN PROGRESS")
+56 IF SHOPKEY#100>89
SET DR=DR_";10///TODAY"
+57 DO ^DIE
+58 KILL ENFDA
SET ENFDA(6920.035,"+2,"_DA_",",.01)="I1"
+59 DO UPDATE^DIE("E","ENFDA")
+60 ; with equipment related data
+61 SET DIE="^ENG(6920,"
+62 SET DR="18///"_ENEQ
+63 SET ENX=$$GET1^DIQ(6914,ENEQ,24)
IF ENX]""
SET DR=DR_";3///"_ENX
+64 DO ^DIE
+65 ; with user specified data
+66 SET DIE="^ENG(6920,"
SET DR=""
+67 IF $GET(ENMA("IIWO","DA"))
Begin DoDot:1
+68 ; copy comments from 1st work order
+69 IF $DATA(^ENG(6920,ENMA("IIWO","DA"),6))
Begin DoDot:2
+70 DO WP^DIE(6920,DA_",",40,"","^ENG(6920,ENMA(""IIWO"",""DA""),6)")
End DoDot:2
+71 ; copy other user editable fields from 1st work order into DR
+72 ; tech
SET ENX=$PIECE($GET(^ENG(6920,ENMA("IIWO","DA"),2)),U,2)
+73 IF ENX]""
SET DR=DR_";16////"_ENX
+74 ; contact
SET ENX=$PIECE($GET(^ENG(6920,ENMA("IIWO","DA"),1)),U,3)
+75 IF ENX]""
SET DR=DR_";7////"_ENX
+76 ; phone
SET ENX=$PIECE($GET(^ENG(6920,ENMA("IIWO","DA"),1)),U,4)
+77 IF ENX]""
SET DR=DR_";8////"_ENX
End DoDot:1
+78 IF '$GET(ENMA("IIWO","DA"))
Begin DoDot:1
+79 ; build DR string for user editable fields
+80 ; determine responsible technician (if any)
+81 SET ENI=$ORDER(^ENG(6914,ENEQ,4,0))
+82 SET ENJ=$SELECT(ENI:$PIECE(^ENG(6914,ENEQ,4,ENI,0),U,2),1:"")
+83 SET ENTEC=$SELECT(ENJ:$PIECE($GET(^ENG("EMP",ENJ,0)),U),1:"")
+84 IF ENTEC]""!ENEDPM
Begin DoDot:2
+85 SET DR=DR_";16"
+86 ; resp. tech
IF ENTEC]""
SET DR=DR_"//"_$SELECT(ENEDPM:"",1:"/")_ENTEC
End DoDot:2
+87 SET DR=DR_";7;8;40"
End DoDot:1
+88 IF $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,245)
+89 DO ^DIE
PRT ; print work order?
+1 SET ENI=$ORDER(^ENG(6910.2,"B","AUTO PRINT NEW W.O.",0))
+2 SET AUTOPRT=$SELECT(ENI:$PIECE(^ENG(6910.2,ENI,0),U,2),1:"")
+3 SET SHOPDEV=$$GET1^DIQ(6922,SHOPKEY,2)
+4 ; if no user interaction required then call woprnt
+5 IF "^L^S^"[(U_AUTOPRT_U)
IF SHOPDEV]""
SET WARD=0
DO WOPRNT^ENWONEW
GOTO PRTX
+6 ; if not autoprinted and shop is receiving area then skip
+7 IF SHOPKEY#100>89
GOTO PRTX
+8 ; if subsequent equipment of multiple then use previous device (if any)
+9 IF $GET(ENMA("IIWO","DA"))
Begin DoDot:1
+10 SET IOP=$GET(ENMA("IIWO","ION"))
+11 IF IOP]""
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
DO PRTL
End DoDot:1
GOTO PRTX
+12 ; if not autoprinted, not receiving area, and not subsequent then ask
+13 SET DIR(0)="Y"
SET DIR("A")="Print this work order"
SET DIR("B")="YES"
+14 DO ^DIR
KILL DIR
if Y'>0
QUIT
+15 DO DEV^ENLIB
IF POP
DO HOME^%ZIS
GOTO PRTX
+16 IF $GET(ENMA("IIWO"))
SET ENION=$SELECT($DATA(IO("Q")):"Q;"_ION,1:ION)
+17 DO PRTL
PRTX ;
+1 ; unlock work order
+2 LOCK -^ENG(6920,DA)
EXIT ;
+1 QUIT
+2 ;
PRTL ; Print W.O. Long Format
+1 ; determine required variables
+2 NEW ENBARCD,ENWO
+3 SET ENBARCD=0
+4 SET ENI=$ORDER(^ENG(6910.2,"B","PRINT BAR CODES ON W.O."))
+5 IF ENI
IF $PIECE(^ENG(6910.2,ENI,0),U,2)="Y"
SET ENBARCD=1
+6 SET ENWO=$PIECE(^ENG(6920,DA,0),U)
+7 ;
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTRTN="PRT1^ENWOD"
SET ZTDESC="Enginering Work Order"
+10 SET ZTIO=ION
+11 ; when subsequent entry during multiple use date/time of 1st for task
+12 IF +$GET(ENMA("IIWO","QDT"))
SET ZTDTH=ENMA("IIWO","QDT")
+13 FOR ENX="DA","ENBARCD","ENWO"
SET ZTSAVE(ENX)=""
+14 DO ^%ZTLOAD
+15 ; when 1st of multiple entry return date/time queued
+16 IF $GET(ENMA("IIWO"))
IF $GET(ENION)]""
SET ENQDT=$GET(ZTSK("D"))
+17 DO HOME^%ZIS
KILL ZTSK
End DoDot:1
QUIT
+18 ;
+19 DO PRT1^ENWOD
+20 IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ENWOD2
+21 KILL ENDSTAT,ENX,ENINV
+22 QUIT
+23 ;
+24 ;ENWONEW3
