- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS70UTL 641 printed Mar 13, 2025@21:34:48 Page 2
- 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
