PSS70UTL.m

PSS70UTL ;BIR/SJA-POST INSTALL ROUTINE FOR PSS*1*70 ; 01/21/00 13:30

 ;;1.0;PHARMACY DATA MANAGEMENT;**70**;09/30/97

 ;

 D BMES^XPDUTL("...Re-building the Synonym Multiple for GTIN barcode...")

 S (PSSD,CNT)=0 F  S PSSD=$O(^PSDRUG(PSSD)) Q:'PSSD  S B=0 F  S B=$O(^PSDRUG(PSSD,1,B)) Q:'B  S PSSY=$G(^PSDRUG(PSSD,1,B,0)) I $P(PSSY,"^") S PSSX=$P(PSSY,"^") D CHK

 Q

CHK I PSSX?16N!(PSSX?27.AN) D

 .I $E(PSSX,1,2)'="01" Q

 .I $L(PSSX)>26,$E(PSSX,17,18)'=17 Q

 .I $E(PSSX,5)=3 S PSSX=$E(PSSX,6,15) S CNT=CNT+1 W:'(CNT#10) "." D

 ..K DA,DD,DO,DIC S DIC="^PSDRUG(PSSD,1,",DIC(0)="L",DLAYGO=50.1,DA(1)=PSSD,X=PSSX D FILE^DICN K DD,DO

 Q

PSS70UTL  ;BIR/SJA-POST INSTALL ROUTINE FOR PSS*1*70 ; 01/21/00 13:30

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**70**;09/30/97

 +2       ;

 +3        DO BMES^XPDUTL("...Re-building the Synonym Multiple for GTIN barcode...")

 +4        SET (PSSD,CNT)=0

           FOR 

               SET PSSD=$ORDER(^PSDRUG(PSSD))

               IF 'PSSD

                   QUIT 

               SET B=0

               FOR 

                   SET B=$ORDER(^PSDRUG(PSSD,1,B))

                   IF 'B

                       QUIT 

                   SET PSSY=$GET(^PSDRUG(PSSD,1,B,0))

                   IF $PIECE(PSSY,"^")

                       SET PSSX=$PIECE(PSSY,"^")

                       DO CHK

 +5        QUIT 

CHK        IF PSSX?16N!(PSSX?27.AN)

               Begin DoDot:1

 +1                IF $EXTRACT(PSSX,1,2)'="01"

                       QUIT 

 +2                IF $LENGTH(PSSX)>26

                       IF $EXTRACT(PSSX,17,18)'=17

                           QUIT 

 +3                IF $EXTRACT(PSSX,5)=3

                       SET PSSX=$EXTRACT(PSSX,6,15)

                       SET CNT=CNT+1

                       IF '(CNT#10)

                           WRITE "."

                       Begin DoDot:2

 +4                        KILL DA,DD,DO,DIC

                           SET DIC="^PSDRUG(PSSD,1,"

                           SET DIC(0)="L"

                           SET DLAYGO=50.1

                           SET DA(1)=PSSD

                           SET X=PSSX

                           DO FILE^DICN

                           KILL DD,DO

                       End DoDot:2

               End DoDot:1

 +5        QUIT