ENBCPM9 ;(WASH ISC)/DH-Bar Coded PMI, Gen Regular WO ;1.16.97
;;7.0;ENGINEERING;**1,14,35**;Aug 17, 1993
NEWWO N SHOPKEY,CODE,NUMBER,DA,WARD,ENDA
S SHOPKEY=ENSHKEY
F EN1=0:0 S EN1=$O(^ENG(6920,"G",ENEQ,EN1)) Q:EN1'>0 I $D(^ENG(6920,EN1,2)),$P(^(2),U)=SHOPKEY,$E($P(^(0),U),1,3)'="PM-" Q:'$D(^(5)) Q:$P(^(5),U,2)=""
I EN1>0 D D XCPTN^ENBCPM2 Q
. S NUMBER=$P(^ENG(6920,EN1,0),U)
. S ENMSG(0,2)="Regular work order "_NUMBER_" is open."
. I $D(^ENG(6920,EN1,1)),$P(^(1),U)=.5 Q
. I ENTIME>0 S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
D WONUM^ENWONEW
I NUMBER="" D XCPTN^ENBCPM2 Q
S ENMSG(0,2)="Regular work order "_NUMBER_" has been generated."
S DIE="^ENG(6920,",DR=".05///^S X=NUMBER;1///^S X=DT;2///^S X=""C"";6///^S X=PROBLEM;7.5////^S X=.5;9////^S X=ENSHKEY;16////^S X=ENTEC;17///^S X=""A"";18///^S X=ENEQ;32///^S X=""PENDING"""
D ^DIE
S ^ENG(6920,DA,8,0)="^6920.035PA^1^1",DIE="^ENG(6920,DA(1),8,",(ENDA,DA(1))=DA,DA=1,DR=".01///^S X=""GENERAL REPAIR (In-house)""" D ^DIE K DA,DIE S DA=ENDA,DIE="^ENG(6920,"
I ENLOC]"" D
. I $D(^ENG("SP","B",ENLOC)) S DR="3///^S X=ENLOC" D ^DIE Q
. I ENLOC["E" D
.. S ENLOC(0)=ENLOC F S ENLOC(0)=$P(ENLOC(0),"E")_"e"_$P(ENLOC(0),"E",2,99) I $D(^ENG("SP","B",ENLOC(0)))!(ENLOC(0)'["E") Q
.. I $D(^ENG("SP","B",ENLOC(0))) S DR="3///^S X=ENLOC(0)" D ^DIE
.. Q
I $D(^ENG(6910.2,1,0)) S ENAUTO=$P(^(0),U,2) D K ENAUTO
. I ENAUTO]"","LS"[ENAUTO D
.. S ENAUTO(0)=$P(^DIC(6922,SHOPKEY,0),U,3)
.. I ENAUTO(0)]"",$D(^%ZIS(1,ENAUTO(0),0)) S WARD=0 D WOPRNT^ENWONEW
. Q
I ENTIME>0 D
. I $D(^ENG(6920,DA,7,1,0)) S $P(^(0),U,2)=ENTIME
. S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
D XCPTN^ENBCPM2
Q
;ENBCPM9
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENBCPM9 1722 printed Apr 09, 2024@20:57:21 Page 2
ENBCPM9 ;(WASH ISC)/DH-Bar Coded PMI, Gen Regular WO ;1.16.97
+1 ;;7.0;ENGINEERING;**1,14,35**;Aug 17, 1993
NEWWO NEW SHOPKEY,CODE,NUMBER,DA,WARD,ENDA
+1 SET SHOPKEY=ENSHKEY
+2 FOR EN1=0:0
SET EN1=$ORDER(^ENG(6920,"G",ENEQ,EN1))
if EN1'>0
QUIT
IF $DATA(^ENG(6920,EN1,2))
IF $PIECE(^(2),U)=SHOPKEY
IF $EXTRACT($PIECE(^(0),U),1,3)'="PM-"
if '$DATA(^(5))
QUIT
if $PIECE(^(5),U,2)=""
QUIT
+3 IF EN1>0
Begin DoDot:1
+4 SET NUMBER=$PIECE(^ENG(6920,EN1,0),U)
+5 SET ENMSG(0,2)="Regular work order "_NUMBER_" is open."
+6 IF $DATA(^ENG(6920,EN1,1))
IF $PIECE(^(1),U)=.5
QUIT
+7 IF ENTIME>0
SET PMTOT(ENSHKEY,ENTEC)=$GET(PMTOT(ENSHKEY,ENTEC))+ENTIME
End DoDot:1
DO XCPTN^ENBCPM2
QUIT
+8 DO WONUM^ENWONEW
+9 IF NUMBER=""
DO XCPTN^ENBCPM2
QUIT
+10 SET ENMSG(0,2)="Regular work order "_NUMBER_" has been generated."
+11 SET DIE="^ENG(6920,"
SET DR=".05///^S X=NUMBER;1///^S X=DT;2///^S X=""C"";6///^S X=PROBLEM;7.5////^S X=.5;9////^S X=ENSHKEY;16////^S X=ENTEC;17///^S X=""A"";18///^S X=ENEQ;32///^S X=""PENDING"""
+12 DO ^DIE
+13 SET ^ENG(6920,DA,8,0)="^6920.035PA^1^1"
SET DIE="^ENG(6920,DA(1),8,"
SET (ENDA,DA(1))=DA
SET DA=1
SET DR=".01///^S X=""GENERAL REPAIR (In-house)"""
DO ^DIE
KILL DA,DIE
SET DA=ENDA
SET DIE="^ENG(6920,"
+14 IF ENLOC]""
Begin DoDot:1
+15 IF $DATA(^ENG("SP","B",ENLOC))
SET DR="3///^S X=ENLOC"
DO ^DIE
QUIT
+16 IF ENLOC["E"
Begin DoDot:2
+17 SET ENLOC(0)=ENLOC
FOR
SET ENLOC(0)=$PIECE(ENLOC(0),"E")_"e"_$PIECE(ENLOC(0),"E",2,99)
IF $DATA(^ENG("SP","B",ENLOC(0)))!(ENLOC(0)'["E")
QUIT
+18 IF $DATA(^ENG("SP","B",ENLOC(0)))
SET DR="3///^S X=ENLOC(0)"
DO ^DIE
+19 QUIT
End DoDot:2
End DoDot:1
+20 IF $DATA(^ENG(6910.2,1,0))
SET ENAUTO=$PIECE(^(0),U,2)
Begin DoDot:1
+21 IF ENAUTO]""
IF "LS"[ENAUTO
Begin DoDot:2
+22 SET ENAUTO(0)=$PIECE(^DIC(6922,SHOPKEY,0),U,3)
+23 IF ENAUTO(0)]""
IF $DATA(^%ZIS(1,ENAUTO(0),0))
SET WARD=0
DO WOPRNT^ENWONEW
End DoDot:2
+24 QUIT
End DoDot:1
KILL ENAUTO
+25 IF ENTIME>0
Begin DoDot:1
+26 IF $DATA(^ENG(6920,DA,7,1,0))
SET $PIECE(^(0),U,2)=ENTIME
+27 SET PMTOT(ENSHKEY,ENTEC)=$GET(PMTOT(ENSHKEY,ENTEC))+ENTIME
End DoDot:1
+28 DO XCPTN^ENBCPM2
+29 QUIT
+30 ;ENBCPM9
