ENXIP68.m

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 ---ENXIP68   2500     printed  Feb 18, 2025@23:23:18                                                                                                                                                                                                     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