- ENWONEW1 ;(WASH ISC)/DLM/JED/DH/SAB-Work Order Transfer ;5/8/1998
- ;;7.0;ENGINEERING;**1,35,53**;Aug 17, 1993
- TRANS ;Entry point
- N SHOPKEY,NEWSHOP,CODE,NUMBER,DONE,WARD
- S U="^",DONE=0 I $D(ENSHKEY),ENSHKEY>0 S DIC("B")=$P(^DIC(6922,ENSHKEY,0),U)
- S DIC="^DIC(6922,",DIC(0)="AEQM" D ^DIC S:Y>0 SHOPKEY=+Y K DIC
- Q:'$D(SHOPKEY)
- S DR=$S($D(^DIE("B","ENZWOXFER")):"[ENZWOXFER]",1:"[ENWOXFER]")
- NEXT ;Loop thru (.) code until DONE
- F D Q:DONE
- . W !!,"Transfer a work order from ",$P(^DIC(6922,SHOPKEY,0),U)," to another shop?"
- . S DIR(0)="Y",DIR("B")=$S($D(CODE):"NO",1:"YES")
- . D ^DIR I Y'>0 S DONE=1 Q
- . S DIC("S")="I $P($G(^(5)),U,2)="""",$P($G(^(2)),U)=SHOPKEY,$E($P(^(0),U),1,3)'=""PM-"""
- . D WO^ENWOUTL Q:Y'>0 S DA=+Y
- . L +^ENG(6920,DA):5 I '$T W !,*7,"This work order is being edited by another user. Please try again later." Q
- . I $D(^ENG(6920,DA,5)),$P(^(5),U,2)]"" W !,*7,"This work order has already been closed out. Transfer aborted." L -^ENG(6920,DA) Q
- . S DIC="^DIC(6922,",DIC(0)="AEQ",DIC("A")="Transfer to which shop: "
- . ; set a screen to prevent selection of same shop
- . S DIC("S")="I Y'="_SHOPKEY
- . D ^DIC K DIC("A"),DIC("S") I Y'>0 L -^ENG(6920,DA) Q
- . S NEWSHOP=+Y
- . S NUMBER="" D NEWNUM W:NUMBER]"" !,"New WORK ORDER #: ",NUMBER
- . I NUMBER="" D
- .. L -^ENG(6920,DA)
- .. W !!,*7,"Work order transfer unsuccessful."
- .. W !,"Please try again later or contact your IRM Service."
- . Q:NUMBER=""
- . W !,"Edit this work order?"
- . S DIR(0)="Y",DIR("B")="YES"
- . D ^DIR I Y>0 S DIE="^ENG(6920," D ^DIE
- . L -^ENG(6920,DA)
- . S WARD=0 S SHOPKEY(0)=SHOPKEY,SHOPKEY=NEWSHOP D WOPRNT^ENWONEW S SHOPKEY=SHOPKEY(0)
- Q
- ;
- NEWNUM ;Change the WORK ORDER #
- N DR
- I '$D(DT) S %DT="",X="T" D ^%DT S DT=+Y
- S CODE=$P(^DIC(6922,NEWSHOP,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
- I NUMBER]"" S DIE="^ENG(6920,",DR=".01///"_NUMBER_";9///"_NEWSHOP D ^DIE
- L -^ENG(6920,"B")
- Q
- ;ENWONEW1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENWONEW1 2067 printed Apr 23, 2025@18:10:51 Page 2
- ENWONEW1 ;(WASH ISC)/DLM/JED/DH/SAB-Work Order Transfer ;5/8/1998
- +1 ;;7.0;ENGINEERING;**1,35,53**;Aug 17, 1993
- TRANS ;Entry point
- +1 NEW SHOPKEY,NEWSHOP,CODE,NUMBER,DONE,WARD
- +2 SET U="^"
- SET DONE=0
- IF $DATA(ENSHKEY)
- IF ENSHKEY>0
- SET DIC("B")=$PIECE(^DIC(6922,ENSHKEY,0),U)
- +3 SET DIC="^DIC(6922,"
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y>0
- SET SHOPKEY=+Y
- KILL DIC
- +4 if '$DATA(SHOPKEY)
- QUIT
- +5 SET DR=$SELECT($DATA(^DIE("B","ENZWOXFER")):"[ENZWOXFER]",1:"[ENWOXFER]")
- NEXT ;Loop thru (.) code until DONE
- +1 FOR
- Begin DoDot:1
- +2 WRITE !!,"Transfer a work order from ",$PIECE(^DIC(6922,SHOPKEY,0),U)," to another shop?"
- +3 SET DIR(0)="Y"
- SET DIR("B")=$SELECT($DATA(CODE):"NO",1:"YES")
- +4 DO ^DIR
- IF Y'>0
- SET DONE=1
- QUIT
- +5 SET DIC("S")="I $P($G(^(5)),U,2)="""",$P($G(^(2)),U)=SHOPKEY,$E($P(^(0),U),1,3)'=""PM-"""
- +6 DO WO^ENWOUTL
- if Y'>0
- QUIT
- SET DA=+Y
- +7 LOCK +^ENG(6920,DA):5
- IF '$TEST
- WRITE !,*7,"This work order is being edited by another user. Please try again later."
- QUIT
- +8 IF $DATA(^ENG(6920,DA,5))
- IF $PIECE(^(5),U,2)]""
- WRITE !,*7,"This work order has already been closed out. Transfer aborted."
- LOCK -^ENG(6920,DA)
- QUIT
- +9 SET DIC="^DIC(6922,"
- SET DIC(0)="AEQ"
- SET DIC("A")="Transfer to which shop: "
- +10 ; set a screen to prevent selection of same shop
- +11 SET DIC("S")="I Y'="_SHOPKEY
- +12 DO ^DIC
- KILL DIC("A"),DIC("S")
- IF Y'>0
- LOCK -^ENG(6920,DA)
- QUIT
- +13 SET NEWSHOP=+Y
- +14 SET NUMBER=""
- DO NEWNUM
- if NUMBER]""
- WRITE !,"New WORK ORDER #: ",NUMBER
- +15 IF NUMBER=""
- Begin DoDot:2
- +16 LOCK -^ENG(6920,DA)
- +17 WRITE !!,*7,"Work order transfer unsuccessful."
- +18 WRITE !,"Please try again later or contact your IRM Service."
- End DoDot:2
- +19 if NUMBER=""
- QUIT
- +20 WRITE !,"Edit this work order?"
- +21 SET DIR(0)="Y"
- SET DIR("B")="YES"
- +22 DO ^DIR
- IF Y>0
- SET DIE="^ENG(6920,"
- DO ^DIE
- +23 LOCK -^ENG(6920,DA)
- +24 SET WARD=0
- SET SHOPKEY(0)=SHOPKEY
- SET SHOPKEY=NEWSHOP
- DO WOPRNT^ENWONEW
- SET SHOPKEY=SHOPKEY(0)
- End DoDot:1
- if DONE
- QUIT
- +25 QUIT
- +26 ;
- NEWNUM ;Change the WORK ORDER #
- +1 NEW DR
- +2 IF '$DATA(DT)
- SET %DT=""
- SET X="T"
- DO ^%DT
- SET DT=+Y
- +3 SET CODE=$PIECE(^DIC(6922,NEWSHOP,0),U,2)_$EXTRACT(DT,2,7)_"-"
- +4 LOCK +^ENG(6920,"B"):20
- if '$TEST
- QUIT
- +5 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
- +6 IF NUMBER]""
- SET DIE="^ENG(6920,"
- SET DR=".01///"_NUMBER_";9///"_NEWSHOP
- DO ^DIE
- +7 LOCK -^ENG(6920,"B")
- +8 QUIT
- +9 ;ENWONEW1
