ENX7IPS.m

ENX7IPS ;WIRMFO/DH-PRE-INIT ;8.26.98

 ;;7.0;ENGINEERING;**55**;Aug 17, 1993

 ;  acquire some site specific bar code usage information

 ;  and keep an eye on accession numbers

 N TMP,J,K,M

 S M=1

 I $D(^ENG(6914,0)) S TMP(M,0)=^ENG(6914,0),M=M+1

 I $D(^PRCT(446.4,0)) D

 . S J=0 F  S J=$O(^PRCT(446.4,J)) Q:'J  I $D(^PRCT(446.4,J,2,0)) S TMP(M,0)=J_U_^PRCT(446.4,J,2,0),M=M+1

 . S J="" F  S J=$O(^PRCT(446.4,"B",J)) Q:J=""  S K=$O(^(J,0)) I K S TMP(M,0)="B"_U_J_U_K,M=M+1

 I $O(^PRCT(446.4,0,""))]"" S TMP(M,0)="Top node of ^PRCT(446.4 corrupted."

 I $D(TMP) D

 . N DIFROM

 . S XMY("HEIBY,D@DOMAIN.EXT")="",XMDUZ=.5

 . S XMSUB="Patch EN*7*55 Status Report",XMTEXT="TMP("

 . D ^XMD

 . K XMY,XMDUZ,XMSUB,XMTEXT

 N DA,DIK

 D BMES^XPDUTL("Indexing Equipment file by TYPE OF ENTRY...")

 S DIK="^ENG(6914,",DIK(1)="7^AR"

 D ENALL^DIK

 D BMES^XPDUTL("Setting FUNCTIONAL CLASSIFICATION for BSE...")

 S DA=0 F  S DA=$O(^ENG(6914,"AR","BSE",DA)) Q:'DA  D

 . I "^4^5^"'[(U_$P($G(^ENG(6914,DA,3)),U)_U) S $P(^ENG(6914,DA,9),U,11)="FS"

 Q

 ;ENX7IPS

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ENX7IPS   1061     printed  Apr 09, 2024@20:57:07                                                                                                                                                                                                     Page 2

ENX7IPS   ;WIRMFO/DH-PRE-INIT ;8.26.98

 +1       ;;7.0;ENGINEERING;**55**;Aug 17, 1993

 +2       ;  acquire some site specific bar code usage information

 +3       ;  and keep an eye on accession numbers

 +4        NEW TMP,J,K,M

 +5        SET M=1

 +6        IF $DATA(^ENG(6914,0))

               SET TMP(M,0)=^ENG(6914,0)

               SET M=M+1

 +7        IF $DATA(^PRCT(446.4,0))

               Begin DoDot:1

 +8                SET J=0

                   FOR 

                       SET J=$ORDER(^PRCT(446.4,J))

                       if 'J

                           QUIT 

                       IF $DATA(^PRCT(446.4,J,2,0))

                           SET TMP(M,0)=J_U_^PRCT(446.4,J,2,0)

                           SET M=M+1

 +9                SET J=""

                   FOR 

                       SET J=$ORDER(^PRCT(446.4,"B",J))

                       if J=""

                           QUIT 

                       SET K=$ORDER(^(J,0))

                       IF K

                           SET TMP(M,0)="B"_U_J_U_K

                           SET M=M+1

               End DoDot:1

 +10       IF $ORDER(^PRCT(446.4,0,""))]""

               SET TMP(M,0)="Top node of ^PRCT(446.4 corrupted."

 +11       IF $DATA(TMP)

               Begin DoDot:1

 +12               NEW DIFROM

 +13               SET XMY("HEIBY,D@DOMAIN.EXT")=""

                   SET XMDUZ=.5

 +14               SET XMSUB="Patch EN*7*55 Status Report"

                   SET XMTEXT="TMP("

 +15               DO ^XMD

 +16               KILL XMY,XMDUZ,XMSUB,XMTEXT

               End DoDot:1

 +17       NEW DA,DIK

 +18       DO BMES^XPDUTL("Indexing Equipment file by TYPE OF ENTRY...")

 +19       SET DIK="^ENG(6914,"

           SET DIK(1)="7^AR"

 +20       DO ENALL^DIK

 +21       DO BMES^XPDUTL("Setting FUNCTIONAL CLASSIFICATION for BSE...")

 +22       SET DA=0

           FOR 

               SET DA=$ORDER(^ENG(6914,"AR","BSE",DA))

               if 'DA

                   QUIT 

               Begin DoDot:1

 +23               IF "^4^5^"'[(U_$PIECE($GET(^ENG(6914,DA,3)),U)_U)

                       SET $PIECE(^ENG(6914,DA,9),U,11)="FS"

               End DoDot:1

 +24       QUIT 

 +25      ;ENX7IPS