source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPP37.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PPPP37 ;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
51 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
132 ;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)"
183 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
23DONE W !,"Re-indexing" K DIK S DIK(1)=".01^A",DIK="^PPP(1020.128," D ENALL^DIK K DIK
24EXITQ K PPPDOMNM,PPPIEN,X,X1,X2,X3,Y Q
Note: See TracBrowser for help on using the repository browser.