source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENBCPM9.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 1.6 KB
RevLine 
[613]1ENBCPM9 ;(WASH ISC)/DH-Bar Coded PMI, Gen Regular WO ;1.16.97
2 ;;7.0;ENGINEERING;**1,14,35**;Aug 17, 1993
3NEWWO N SHOPKEY,CODE,NUMBER,DA,WARD,ENDA
4 S SHOPKEY=ENSHKEY
5 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)=""
6 I EN1>0 D D XCPTN^ENBCPM2 Q
7 . S NUMBER=$P(^ENG(6920,EN1,0),U)
8 . S ENMSG(0,2)="Regular work order "_NUMBER_" is open."
9 . I $D(^ENG(6920,EN1,1)),$P(^(1),U)=.5 Q
10 . I ENTIME>0 S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
11 D WONUM^ENWONEW
12 I NUMBER="" D XCPTN^ENBCPM2 Q
13 S ENMSG(0,2)="Regular work order "_NUMBER_" has been generated."
14 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"""
15 D ^DIE
16 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,"
17 I ENLOC]"" D
18 . I $D(^ENG("SP","B",ENLOC)) S DR="3///^S X=ENLOC" D ^DIE Q
19 . I ENLOC["E" D
20 .. 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
21 .. I $D(^ENG("SP","B",ENLOC(0))) S DR="3///^S X=ENLOC(0)" D ^DIE
22 .. Q
23 I $D(^ENG(6910.2,1,0)) S ENAUTO=$P(^(0),U,2) D K ENAUTO
24 . I ENAUTO]"","LS"[ENAUTO D
25 .. S ENAUTO(0)=$P(^DIC(6922,SHOPKEY,0),U,3)
26 .. I ENAUTO(0)]"",$D(^%ZIS(1,ENAUTO(0),0)) S WARD=0 D WOPRNT^ENWONEW
27 . Q
28 I ENTIME>0 D
29 . I $D(^ENG(6920,DA,7,1,0)) S $P(^(0),U,2)=ENTIME
30 . S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
31 D XCPTN^ENBCPM2
32 Q
33 ;ENBCPM9
Note: See TracBrowser for help on using the repository browser.