source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENWOINV.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.3 KB
Line 
1ENWOINV ;(WIRMFO)/DLM/DH/SAB-EQUIPMENT TO WORK ORDER LINKAGE ;2.27.97
2 ;;7.0;ENGINEERING;**35**;Aug 17, 1993
3 Q
4 ;
5ST ; Mumps x-ref set logic: WORK ORDER file EQUIPMENT ID# field
6 ; Expects IEN to Work Order File as loc var DA
7 N ENDVTYP,ENINN,ENMAN,ENT1,ENT3,ENTWO,ENWON,ENX
8 S ENWON=DA,ENINN=$P($G(^ENG(6920,ENWON,3)),U,8)
9 Q:ENINN="" ; no Equipment Inv. file IEN
10 S ENTWO=$G(^ENG(6920,ENWON,3))
11 S ENT1=$G(^ENG(6914,ENINN,1)),ENT3=$G(^ENG(6914,ENINN,3))
12 S ENDVTYP=$$GET1^DIQ(6914,ENINN,6)
13 S ENMAN=$$GET1^DIQ(6914,ENINN,1,"I")
14 S ^ENG(6920,ENWON,3)=$P(ENT3,U,6)_U_ENDVTYP_U_U_$P(ENT3,U,2)_U_$P(ENT3,U,7)_U_$P(ENT1,U,2)_U_$P(ENT1,U,3)_U_ENINN_U_ENMAN_U_$P(ENTWO,U,10,99)
15 S ENTWO=^ENG(6920,ENWON,3)
16 S:$P(ENTWO,U)]"" ^ENG(6920,"E",$E($P(ENTWO,U),1,30),ENWON)=""
17 S:$P(ENTWO,U,5)]"" ^ENG(6920,"F",$E($P(ENTWO,U,5),1,30),ENWON)=""
18 I $P(^ENG(6920,ENWON,0),U,4)="" S ENX=$P(ENT3,U,5) I ENX]"" S $P(^(0),U,4)=ENX,^ENG(6920,"C",ENX,ENWON)=""
19 Q
20 ;
21KI ; Mumps x-ref kill logic: WORK ORDER file EQUIPMENT ID# field
22 ; Expects IEN to Work Order File as loc var DA
23 N ENTWO,ENWON
24 S ENWON=DA,ENTWO=$G(^ENG(6920,ENWON,3))
25 K:$P(ENTWO,U)]"" ^ENG(6920,"E",$E($P(ENTWO,U,1),1,30),ENWON)
26 K:$P(ENTWO,U,5)]"" ^ENG(6920,"F",$E($P(ENTWO,U,5),1,30),ENWON)
27 S ^ENG(6920,ENWON,3)="^^^^^^^"_$P(ENTWO,U,8)_"^^"_$P(ENTWO,U,10,99)
28 Q
29 ;
30 ;ENWOINV
Note: See TracBrowser for help on using the repository browser.