PPPDIC4 ;BHM/DB - STATION NUMBER FIX ROUTINE;JUN 12 1997
 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**17,21**; APR 7 1995
 ;
 ;
 K ^UTILITY("DIQ1",$J)
 W !,"I will now update your PPP DOMAIN XREF file (#1020.8), with the correct",!,"station numbers from the INSTITUTION file (#4).",!
 S SITE=0
1 S SITE=$S('$D(SITE):$O(^PPP(1020.8,0)),1:$O(^PPP(1020.8,SITE))) G DONE:SITE'>0 S DIC=4,DA=SITE,DR="99",DIQ(0)="E",DIQ="PPPTMP" D EN^DIQ1 W "."
 S STATION=$G(PPPTMP(4,SITE,99,"E")) I $G(STATION)'="" S DIE="^PPP(1020.8,",DR="12///^S X=STATION",DA=SITE D ^DIE
 G 1
DONE W !,"Finished Updating.",! K SITE,STATION,DIE,DR,DA,DIC,PPPTMP,^UTILITY("DIQ1",$J)
 Q