| 1 | PPPP37 ;BHM/DB - Correct Domain name enties ;6FEB03 | 
|---|
| 2 | ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**37**;APR 7, 1995 | 
|---|
| 3 | W @IOF,!!,"PPP DOMAIN NAME CONVERSION UTILITY",!!!,"Current Name",?40,"New Name ",! F X=1:1:(IOM-4) W "=" | 
|---|
| 4 | S PPPIEN=0 | 
|---|
| 5 | 1 S PPPIEN=$O(^PPP(1020.8,PPPIEN)) G 2:PPPIEN'>0 S PPPDOMNM=$P($G(^PPP(1020.8,PPPIEN,0)),"^",2) W !,$G(PPPDOMNM) | 
|---|
| 6 | K X1 | 
|---|
| 7 | I $G(PPPDOMNM)[".MED" W ?40,"--" G 1 | 
|---|
| 8 | I $G(PPPDOMNM)'="",PPPDOMNM'[".MED" S X1=$P(PPPDOMNM,".",1),X2=$P(PPPDOMNM,".",2,99) | 
|---|
| 9 | I $G(X1)="" G 1 | 
|---|
| 10 | S X3=X1_".MED."_X2 W ?40,X3 | 
|---|
| 11 | S $P(^PPP(1020.8,PPPIEN,0),"^",2)=X3 | 
|---|
| 12 | G 1 | 
|---|
| 13 | 2 ;re-index 'C' X-REF | 
|---|
| 14 | W !,"Re-indexing" | 
|---|
| 15 | K ^PPP(1020.8,"C") K DIK S DIK(1)=".02^C",DIK="^PPP(1020.8," D ENALL^DIK | 
|---|
| 16 | S PPPIEN=0 K ^PPP(1020.128,"A") | 
|---|
| 17 | W !,"Correcting entries in (#1020.128)" | 
|---|
| 18 | 3 S PPPIEN=$O(^PPP(1020.128,PPPIEN)) G DONE:PPPIEN'>0 | 
|---|
| 19 | S PPPDOMNM=$P($G(^PPP(1020.128,PPPIEN,0)),"^",2) | 
|---|
| 20 | I $G(PPPDOMNM)[".MED" W ?40,"--" G 3 | 
|---|
| 21 | I $G(PPPDOMNM)'="",PPPDOMNM'[".MED" S X1=$P(PPPDOMNM,".",1),X2=$P(PPPDOMNM,".",2,99),X3=X1_".MED."_X2 W !,PPPDOMNM,?40,X3 S $P(^PPP(1020.128,PPPIEN,0),"^",2)=X3 | 
|---|
| 22 | G 3 | 
|---|
| 23 | DONE W !,"Re-indexing" K DIK S DIK(1)=".01^A",DIK="^PPP(1020.128," D ENALL^DIK K DIK | 
|---|
| 24 | EXITQ K PPPDOMNM,PPPIEN,X,X1,X2,X3,Y Q | 
|---|