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