source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENARG23.m@ 1042

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

initial load of WorldVistAEHR
File size: 5.8 KB
Line 
1ENARG23 ;(WIRMFO)/SAB-ARCHIVE EQUIPMENT INVENTORY ;1/10/2001
2 ;;7.0;ENGINEERING;**40,68**;Aug 17, 1993
3 Q
43 ; loop thru found list and move equipment inventory to global
5 ; input ENDA (ien of Archive Log entry)
6 S ENJ=$O(^ENAR(6919.3,ENJ)) Q:ENJ'?1.N
7 S ENZ=^ENAR(6919.3,ENJ,0)
8 G 3:'$D(^ENG(6914,ENZ,0))
9 ; node 0
10 S ENB=$G(^ENG(6914,ENZ,0))
11 ; use station number from equipment record if available
12 S ENA(0)=$P($G(^ENG(6914,ENZ,9)),U,5)
13 S ENA=$S(ENA(0)]"":ENA(0),1:ENSTA)_"-"_$P(ENB,U) ; add station #
14 S $P(ENB,U)=ENA
15 S ENB(6)=$P(ENB,U,6) I ENB(6)]"" S ENB(6)=$$GET1^DIQ(6914,ENZ,.5) I ENB(6)]"" S $P(ENB,U,6)=ENB(6)
16 S:ENB]"" ^ENAR(6919.3,ENJ,0)=ENB
17 S:$P(ENB,U)]"" ^ENAR(6919.3,"B",$P(ENB,U),ENJ)=""
18 K ENB
19 ; node 1
20 S ENB=$G(^ENG(6914,ENZ,1))
21 I $P(ENB,U,5)]"" S $P(ENB,U,5)="" ; don't archive MODEL(C) field
22 I $P(ENB,U,6)]"" S $P(ENB,U,6)="" ; don't archive SERIAL #(C) field
23 S ENB(1)=$P(ENB,U,1) I ENB(1)]"" S ENB(1)=$P($G(^ENG(6911,ENB(1),0)),U) I ENB(1)]"" S $P(ENB,U,1)=ENB(1)
24 S ENB(4)=$P(ENB,U,4) I ENB(4)]"" S ENB(4)=$P($G(^ENG("MFG",ENB(4),0)),U) I ENB(4)]"" S $P(ENB,U,4)=ENB(4)
25 S:ENB]"" ^ENAR(6919.3,ENJ,1)=ENB
26 K ENB
27 ; node 2
28 S ENB=$G(^ENG(6914,ENZ,2))
29 S ENB(1)=$P(ENB,U,1) I ENB(1)]"" S ENB(1)=$$GET1^DIQ(6914,ENZ,10) I ENB(1)]"" S $P(ENB,U,1)=ENB(1)
30 S ENB(8)=$P(ENB,U,8) I ENB(8)]"" S ENB(8)=$P($G(^ENCSN(6917,ENB(8),0)),U) I ENB(8)]"" S $P(ENB,U,8)=ENB(8)
31 S ENB(9)=$P(ENB,U,9) I ENB(9)]"" S ENB(9)=$P($G(^ENG(6914.1,ENB(9),0)),U) I ENB(9)]"" S $P(ENB,U,9)=ENB(9)
32 S ENB(14)=$P(ENB,U,14) I ENB(14)]"" S ENB(14)=$$GET1^DIQ(6914,ENZ,13.5) I ENB(14)]"" S $P(ENB,U,14)=ENB(14)
33 S:ENB]"" ^ENAR(6919.3,ENJ,2)=ENB
34 K ENB
35 ; node 3
36 S ENB=$G(^ENG(6914,ENZ,3))
37 S ENB(2)=$P(ENB,U,2) I ENB(2)]"" S ENB(2)=$$GET1^DIQ(6914,ENZ,21) I ENB(2)]"" S $P(ENB,U,2)=ENB(2)
38 S ENB(5)=$P(ENB,U,5) I ENB(5)]"" S ENB(5)=$P($G(^ENG("SP",ENB(5),0)),U) I ENB(5)]"" S $P(ENB,U,5)=ENB(5)
39 S ENB(12)=$P(ENB,U,12) I ENB(12)]"" S ENB(12)=$P($G(^ENG(6914.8,ENB(12),0)),U,2) I ENB(12)]"" S $P(ENB,U,12)=ENB(12) ; save disp meth name (not code)
40 S:ENB]"" ^ENAR(6919.3,ENJ,3)=ENB
41 K ENB
42 ; node 7
43 S ENB=$G(^ENG(6914,ENZ,7))
44 S:ENB]"" ^ENAR(6919.3,ENJ,7)=ENB
45 K ENB
46 ; node 8
47 S ENB=$G(^ENG(6914,ENZ,8))
48 S ENB(4)=$P(ENB,U,4) I ENB(4)]"" S ENB(4)=$$GET1^DIQ(6914,ENZ,36) I ENB(4)]"" S $P(ENB,U,4)=ENB(4)
49 S ENB(6)=$P(ENB,U,6) I ENB(6)]"" S ENB(6)=$P($G(^ENG(6914.3,ENB(6),0)),U) I ENB(6)]"" S $P(ENB,U,6)=ENB(6)
50 S:ENB]"" ^ENAR(6919.3,ENJ,8)=ENB
51 K ENB
52 ; node 9
53 S ENB=$G(^ENG(6914,ENZ,9))
54 S ENB(6)=$P(ENB,U,6) I ENB(6)]"" S ENB(6)=$P($G(^ENG(6914.4,ENB(6),0)),U) I ENB(6)]"" S $P(ENB,U,6)=ENB(6)
55 S ENB(7)=$P(ENB,U,7) I ENB(7)]"" S ENB(7)=$P($G(^ENG(6914.6,ENB(7),0)),U) I ENB(7)]"" S $P(ENB,U,7)=ENB(7)
56 S ENB(8)=$P(ENB,U,8) I ENB(8)]"" S ENB(8)=$P($G(^ENG(6914.7,ENB(8),0)),U) I ENB(8)]"" S $P(ENB,U,8)=ENB(8)
57 I $P(ENB,U,10)]"" S $P(ENB,U,10)="" ; don't archive DATE OF FAP CO field
58 S:ENB]"" ^ENAR(6919.3,ENJ,9)=ENB
59 K ENB
60 ; responsible shop multiple
61 I $O(^ENG(6914,ENZ,4,0)) D
62 . S ^ENAR(6919.3,ENJ,4,0)="^6919.31A^"_$P($G(^ENG(6914,ENZ,4,0)),U,3,4)
63 . S ENZ(1)=0 F S ENZ(1)=$O(^ENG(6914,ENZ,4,ENZ(1))) Q:'ENZ(1) D
64 . . S ENB=$G(^ENG(6914,ENZ,4,ENZ(1),0))
65 . . S ENB(1)=$P(ENB,U,1) I ENB(1)]"" S ENB(1)=$P($G(^DIC(6922,ENB(1),0)),U) I ENB(1)]"" S $P(ENB,U,1)=ENB(1)
66 . . S ENB(2)=$P(ENB,U,2) I ENB(2)]"" S ENB(2)=$P($G(^ENG("EMP",ENB(2),0)),U) I ENB(2)]"" S $P(ENB,U,2)=ENB(2)
67 . . S:ENB]"" ^ENAR(6919.3,ENJ,4,ENZ(1),0)=ENB
68 . . S:$P(ENB,U)]"" ^ENAR(6919.3,ENJ,4,"B",$P(ENB,U),ENZ(1))=""
69 . . S ENB=$G(^ENG(6914,ENZ,4,ENZ(1),1))
70 . . S:ENB]"" ^ENAR(6919.3,ENJ,4,ENZ(1),1)=ENB
71 . . ; frequency multiple
72 . . I $O(^ENG(6914,ENZ,4,ENZ(1),2,0)) D
73 . . . S ^ENAR(6919.3,ENJ,4,ENZ(1),2,0)="^6919.313S^"_$P($G(^ENG(6914,ENZ,4,ENZ(1),2,0)),U,3,4)
74 . . . S ENZ(2)=0
75 . . . F S ENZ(2)=$O(^ENG(6914,ENZ,4,ENZ(1),2,ENZ(2))) Q:'ENZ(2) D
76 . . . . S ENB=$G(^ENG(6914,ENZ,4,ENZ(1),2,ENZ(2),0))
77 . . . . S ENB(5)=$P(ENB,U,5) I ENB(5)]"" S ENB(5)=$P($G(^ENG(6914.2,ENB(5),0)),U) I ENB(5)]"" S $P(ENB,U,5)=ENB(5)
78 . . . . S:ENB]"" ^ENAR(6919.3,ENJ,4,ENZ(1),2,ENZ(2),0)=ENB
79 ; comments wp
80 I $O(^ENG(6914,ENZ,5,0)) D
81 . S ^ENAR(6919.3,ENJ,5,0)=$G(^ENG(6914,ENZ,5,0))
82 . S ENZ(1)=0 F S ENZ(1)=$O(^ENG(6914,ENZ,5,ENZ(1))) Q:'ENZ(1) D
83 . . S ^ENAR(6919.3,ENJ,5,ENZ(1),0)=$G(^ENG(6914,ENZ,5,ENZ(1),0))
84 ; equipment history multiple
85 I $O(^ENG(6914,ENZ,6,0)) D
86 . S ^ENAR(6919.3,ENJ,6,0)="^6919.33A^"_$P($G(^ENG(6914,ENZ,6,0)),U,3,4)
87 . S ENZ(1)=0 F S ENZ(1)=$O(^ENG(6914,ENZ,6,ENZ(1))) Q:'ENZ(1) D
88 . . S ENB=$G(^ENG(6914,ENZ,6,ENZ(1),0))
89 . . S:ENB]"" ^ENAR(6919.3,ENJ,6,ENZ(1),0)=ENB
90 ; spex wp
91 I $O(^ENG(6914,ENZ,10,0)) D
92 . S ^ENAR(6919.3,ENJ,10,0)=$G(^ENG(6914,ENZ,10,0))
93 . S ENZ(1)=0 F S ENZ(1)=$O(^ENG(6914,ENZ,10,ENZ(1))) Q:'ENZ(1) D
94 . . S ^ENAR(6919.3,ENJ,10,ENZ(1),0)=$G(^ENG(6914,ENZ,10,ENZ(1),0))
95 ; original bar code id multiple
96 I $O(^ENG(6914,ENZ,12,0)) D
97 . S ^ENAR(6919.3,ENJ,12,0)="^6919.35^"_$P($G(^ENG(6914,ENZ,12,0)),U,3,4)
98 . S ENZ(1)=0 F S ENZ(1)=$O(^ENG(6914,ENZ,12,ENZ(1))) Q:'ENZ(1) D
99 . . S ENB=$G(^ENG(6914,ENZ,12,ENZ(1),0))
100 . . S:ENB]"" ^ENAR(6919.3,ENJ,12,ENZ(1),0)=ENB
101 ;
102 ;STORE STN-ENTRY # (ENA) IN ARCHIVE LOG (ENDA) MULTIPLE
103 I ENDA D
104 . S X=$G(^ENG(6919,ENDA,3,0))
105 . I X="" S X="^6919.02"
106 . S $P(X,U,3)=$P(X,U,3)+1
107 . S $P(X,U,4)=$P(X,U,4)+1
108 . S ^ENG(6919,ENDA,3,0)=X
109 . S ^ENG(6919,ENDA,3,ENJ,0)=ENA
110 . S ^ENG(6919,"AE",$P(ENA,"-",2),ENDA,ENJ)=""
111 ;
112 ;PURGE SYSTEM EQUIPMENT INV.
113 ; first close any open work orders
114 S ENTXT(1)="Automatically closed when equipment record was archived."
115 S DA=0 F S DA=$O(^ENG(6920,"G",ENZ,DA)) Q:'DA I $P($G(^ENG(6920,DA,5)),U,2)="" D
116 . D WP^DIE(6920,DA_",",40,"A","ENTXT")
117 . S DIE="^ENG(6920,",DR="36///T;32///^S X=""COMPLETED"""
118 . D ^DIE
119 K DIE,DR,ENTXT
120 ; now delete equipment record
121 S DIK="^ENG(6914,",DA=ENZ D ^DIK K DIK
122 S ENI=ENI+1 W:ENI#16=0 "."
123 G 3
124 ;
125OUT K EN,ENA,ENB,ENI,ENJ,ENK,ENZ,I,J,K,X,X1,X2,Z,%X,%Y Q
126 ;ENARG23
Note: See TracBrowser for help on using the repository browser.