source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENXIP68.m@ 1450

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1ENXIP68 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;2/8/2001
2 ;;7.0;ENGINEERING;**68**;Aug 17, 1993
3 Q
4 ;
5PS ; post-install entry point
6 ; create KIDS checkpoints with call backs
7 N ENX,Y
8 F ENX="OBC" D
9 . S Y=$$NEWCP^XPDUTL(ENX,ENX_"^ENXIP68")
10 . I 'Y D BMES^XPDUTL("ERROR Creating "_ENX_" Checkpoint.")
11 Q
12 ;
13OBC ; Move ORIGINAL BAR CODE ID data (post-install)
14 N ENC,ENDA,ENOBC,XPDIDTOT,DA,DIK
15 ;
16 ; If field 28.1 not ORIGINAL BAR CODE ID then already done
17 I $$GET1^DID(6914,28.1,"","LABEL")'="ORIGINAL BAR CODE ID" D Q
18 . D BMES^XPDUTL(" ORIGINAL BAR CODE ID data already processed. Skipping step.")
19 ;
20 I '$D(^ENG(6914,"OEE")) D
21 .D BMES^XPDUTL(" No ORIGINAL BAR CODE ID data to move. Skipping step.")
22 E D
23 . ; must be some data to move
24 . ; loop through file 6914 - move data from 28.1 into new multiple
25 . D BMES^XPDUTL(" Moving ORIGINAL BAR CODE ID data in file 6914...")
26 . ; init variables
27 . S ENC("TOT")=$P($G(^ENG(6914,0)),U,4) ; total # of items to process
28 . I ENC("TOT")=0 S ENC("TOT")=1 ; avoid divide by zero error
29 . S ENC("EQU")=0 ; count of evaluated items
30 . S ENC("OBC")=0 ; count of ORIGINAL BAR CODE IDs moved
31 . S XPDIDTOT=ENC("TOT") ; set total for status bar
32 . S ENC("UPD")=5 ; initial % required to update status bar
33 . ; loop thru equipment
34 . S ENDA=0 F S ENDA=$O(^ENG(6914,ENDA)) Q:'ENDA D
35 . . S ENC("EQU")=ENC("EQU")+1
36 . . S ENC("%")=ENC("EQU")*100/ENC("TOT") ; calculate % complete
37 . . ; check if status bar should be updated
38 . . I ENC("%")>ENC("UPD") D
39 . . . D UPDATE^XPDID(ENC("EQU")) ; update status bar
40 . . . S ENC("UPD")=ENC("UPD")+5 ; increase update criteria by 5%
41 . . ; get single valued ORIGINAL BAR CODE ID
42 . . S ENOBC=$P($G(^ENG(6914,ENDA,3)),U,14)
43 . . Q:ENOBC="" ; nothing to move
44 . . Q:$O(^ENG(6914,ENDA,12,0)) ; unexpected - value in multiple
45 . . ; put original bar code id in multiple field
46 . . S ^ENG(6914,ENDA,12,0)="^6914.05^1^1"
47 . . S ^ENG(6914,ENDA,12,1,0)=ENOBC
48 . . S ^ENG(6914,ENDA,12,"B",ENOBC,1)=""
49 . . ; delete modifier from old location
50 . . S $P(^ENG(6914,ENDA,3),U,14)=""
51 . . K ^ENG(6914,"OEE",ENOBC,ENDA)
52 . . ; set whole file x-ref for new multiple
53 . . S ^ENG(6914,"OEE",ENOBC,ENDA,1)=""
54 . . ; increment counter
55 . . S ENC("OBC")=ENC("OBC")+1
56 . ;
57 . ; report results
58 . D MES^XPDUTL(" "_ENC("OBC")_" ORIGINAL BAR CODE IDs were moved.")
59 ;
60 ; delete field 28.1 from data dictionary
61 S DIK="^DD(6914,",DA=28.1,DA(1)=6914 D ^DIK
62 ;
63 Q
64 ;
65 ;ENXIP68
Note: See TracBrowser for help on using the repository browser.