| 1 | ENARG21 ;(WIRMFO)/JED/DH/SAB-ARCHIVE WORK ORDERS ;2.25.97
|
|---|
| 2 | ;;7.0;ENGINEERING;**40**;Aug 17, 1993
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | 1 ; loop thru found list and move work orders to global
|
|---|
| 6 | S ENJ=$O(^ENAR(6919.1,ENJ)) Q:ENJ'?1.N
|
|---|
| 7 | S ENZ=^ENAR(6919.1,ENJ,0)
|
|---|
| 8 | G 1:'$D(^ENG(6920,ENZ,0))
|
|---|
| 9 | F ENK=0:1:5 S ENA(ENK)=$G(^ENG(6920,ENZ,ENK)),ENB(ENK)=""
|
|---|
| 10 | S ENB(0)=ENSTA_"-"_$P(ENA(0),U,1)_U_$P(ENA(0),U,6)
|
|---|
| 11 | S ENB(0,3)=$P(ENA(1),U) I ENB(0,3)]"" S $P(ENB(0),U,3)=$S($D(^VA(200,ENB(0,3),0)):$P(^(0),U),1:ENB(0,3))
|
|---|
| 12 | S $P(ENB(1),U,1,4)=$P(ENA(0),U,2,5),$P(ENB(1),U,5,7)=$P(ENA(1),U,2,4),$P(ENB(1),U,8)=$P(ENA(3),U,4),$P(ENB(1),U,9,11)=$P(ENA(2),U,1,3),$P(ENB(1),U,12)=$P(ENA(4),U)
|
|---|
| 13 | S $P(ENB(2),U,1,3)=$P(ENA(3),U,1,3),$P(ENB(2),U,4,5)=$P(ENA(3),U,6,7),$P(ENB(2),U,6)=$P(ENA(3),U,5),$P(ENB(2),U,7)=$P(ENA(3),U,8)
|
|---|
| 14 | S $P(ENB(4),U,2)=$P(ENA(5),U,5),$P(ENB(4),U,3)=$P(ENA(4),U,2),$P(ENB(4),U,4,5)=$P(ENA(5),U,3,4),$P(ENB(4),U,6)=$P(ENA(5),U,6),$P(ENB(4),U,7)=$P(ENA(4),U,4),$P(ENB(4),U,8)=$P(ENA(5),U,2)
|
|---|
| 15 | S ENB(1,3)=$P(ENB(1),U,3) I ENB(1,3)>0,$D(^ENG("SP",ENB(1,3),0)) S $P(ENB(1),U,3)=$P(^(0),U)
|
|---|
| 16 | S ENB(1,8)=$P(ENB(1),U,8) I ENB(1,8)>0,$D(^DIC(49,ENB(1,8),0)) S $P(ENB(1),U,8)=$P(^(0),U)
|
|---|
| 17 | S ENB(1,9)=$P(ENB(1),U,9) I ENB(1,9)>0,$D(^DIC(6922,ENB(1,9),0)) S $P(ENB(1),U,9)=$P(^(0),U)
|
|---|
| 18 | S ENB(1,10)=$P(ENB(1),U,10) I ENB(1,10)>0,$D(^ENG("EMP",ENB(1,10),0)) S $P(ENB(1),U,10)=$P(^(0),U)
|
|---|
| 19 | S ENB(4,2)=$P(ENB(4),U,2) I ENB(4,2)>0,$D(^DIC(6921,ENB(4,2),0)) S $P(ENB(4),U,2)=$P(^(0),U)
|
|---|
| 20 | S ENB(4,3)=$P(ENB(4),U,3) I ENB(4,3)>0,$D(^PRCS(410,ENB(4,3),0)) S $P(ENB(4),U,3)=$P(^(0),U)
|
|---|
| 21 | I $P(ENB(2),U,3)="" S ENB(2,3)=$P(ENA(3),U,9) I ENB(2,3)'="",$D(^ENG("MFG",ENB(2,3),0)) S $P(ENB(2),U,3)=$P(^(0),U)
|
|---|
| 22 | S ^ENAR(6919.1,"B",$P(ENB(0),U),ENJ)=""
|
|---|
| 23 | F ENK=0:1:4 S:ENB(ENK)'="" ^ENAR(6919.1,ENJ,ENK)=ENB(ENK)
|
|---|
| 24 | I $D(^ENG(6920,ENZ,7,0)) S X=^(0),^ENAR(6919.1,ENJ,3,0)="^6919.11A^"_$P(X,U,3,4),ENZ(1)=0 F ENK=1:1 S ENZ(1)=$O(^ENG(6920,ENZ,7,ENZ(1))) Q:ENZ(1)="" S X(ENZ(1))=^(ENZ(1),0) D W S ^ENAR(6919.1,ENJ,3,ENZ(1),0)=X(ENZ(1)) K X
|
|---|
| 25 | I $D(^ENG(6920,ENZ,8,0)) S X=^(0),^ENAR(6919.1,ENJ,8,0)="^6919.13A^"_$P(X,U,3,4),ENZ(1)=0 F ENK=1:1 S ENZ(1)=$O(^ENG(6920,ENZ,8,ENZ(1))) Q:ENZ(1)="" S X(ENZ(1))=^(ENZ(1),0) D WA S ^ENAR(6919.1,ENJ,8,ENZ(1),0)=X(ENZ(1)) K X
|
|---|
| 26 | I $D(^ENG(6920,ENZ,6,0)) S X=^(0),^ENAR(6919.1,ENJ,5,0)=X,ENZ(1)=0 F ENK=1:1 S ENZ(1)=$O(^ENG(6920,ENZ,6,ENZ(1))) Q:ENZ(1)="" S X1=^(ENZ(1),0),^ENAR(6919.1,ENJ,5,ENK,0)=X1
|
|---|
| 27 | S ENSTAT=$P(ENA(4),U,3),^ENAR(6919.1,ENJ,6)=$S(ENSTAT=5:"DISAPPROVED",1:"COMPLETED")_U_$P(ENA(5),U,8)_U_$P(ENA(5),U,7)
|
|---|
| 28 | ;PURGE SYSTEM WORK ORDER
|
|---|
| 29 | S DIK="^ENG(6920,",DA=ENZ D ^DIK K DIK
|
|---|
| 30 | S ENI=ENI+1 W:ENI#16=0 "."
|
|---|
| 31 | G 1
|
|---|
| 32 | ;
|
|---|
| 33 | W ; expand assigned tech multiple
|
|---|
| 34 | S X1=$P(X(ENZ(1)),U) I X1'="",$D(^ENG("EMP",X1,0)) S $P(X(ENZ(1)),U)=$P(^(0),U)
|
|---|
| 35 | S X2=$P(X(ENZ(1)),U,3) I X2'="",$D(^DIC(6922,X2,0)) S $P(X(ENZ(1)),U,3)=$P(^(0),U)
|
|---|
| 36 | Q
|
|---|
| 37 | WA ; expand work action multiple
|
|---|
| 38 | S X1=$P(X(ENZ(1)),U) I X1'="",$D(^ENG(6920.1,X1,0)) S $P(X(ENZ(1)),U)=$P(^(0),U)
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | OUT K EN,ENA,ENB,ENI,ENJ,ENK,ENZ,I,J,K,X,X1,X2,Z,%X,%Y
|
|---|
| 42 | Q
|
|---|
| 43 | ;ENARG21
|
|---|
