| 1 | RMPRPIXZ ;HINCIO/ODJ - MISC. ;3/8/01
|
|---|
| 2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ; Some miscellaneous routines to be used for testing only
|
|---|
| 6 | ; NOT FOR GENERAL USE
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | ; Clear down new PIP files
|
|---|
| 10 | ; Only use if need to re-run the old to new PIP file conversion
|
|---|
| 11 | ; utility in RMPRPIUG
|
|---|
| 12 | KILL N FIL,S,P62,I,P60
|
|---|
| 13 | ;
|
|---|
| 14 | ; Restore pointers to 661.2 in file 660
|
|---|
| 15 | S I=0
|
|---|
| 16 | F S I=$O(^RMPR(661.63,I)) Q:'+I D
|
|---|
| 17 | . S S=^RMPR(661.63,I,0)
|
|---|
| 18 | . S P62=$P(S,"^",3)
|
|---|
| 19 | . S P60=$P(S,"^",2)
|
|---|
| 20 | . S $P(^RMPR(660,P60,1),"^",5)=P62
|
|---|
| 21 | . Q
|
|---|
| 22 | ;
|
|---|
| 23 | ; Clear down new files
|
|---|
| 24 | F FIL=661.11,661.4,661.41,661.5,661.6,661.63,661.69,661.7,661.9 D
|
|---|
| 25 | . S S=^RMPR(FIL,0)
|
|---|
| 26 | . S $P(S,"^",3)=0,$P(S,"^",4)=0
|
|---|
| 27 | . K ^RMPR(FIL)
|
|---|
| 28 | . S ^RMPR(FIL,0)=S
|
|---|
| 29 | . Q
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | ; Make all Locations start with 'A'
|
|---|
| 33 | ALOC N NM,IEN,RMPR,RMPRE,FIL
|
|---|
| 34 | F FIL=661.3,661.5 D
|
|---|
| 35 | . S IEN=0
|
|---|
| 36 | . F S IEN=$O(^RMPR(FIL,IEN)) Q:'+IEN D
|
|---|
| 37 | .. S NM=$P(^RMPR(FIL,IEN,0),"^",1)
|
|---|
| 38 | .. W !,NM
|
|---|
| 39 | .. K RMPR
|
|---|
| 40 | .. S RMPR(FIL,IEN_",",.01)="A"_NM
|
|---|
| 41 | .. D FILE^DIE("","RMPR","RMPRE")
|
|---|
| 42 | .. Q
|
|---|
| 43 | . Q
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | ; Get rid of 1st char.
|
|---|
| 47 | REMA N NM,IEN,RMPR,RMPRE,FIL
|
|---|
| 48 | F FIL=661.3,661.5 D
|
|---|
| 49 | . S IEN=0
|
|---|
| 50 | . F S IEN=$O(^RMPR(FIL,IEN)) Q:'+IEN D
|
|---|
| 51 | .. S NM=$P(^RMPR(FIL,IEN,0),"^",1)
|
|---|
| 52 | .. W !,NM
|
|---|
| 53 | .. K RMPR
|
|---|
| 54 | .. S RMPR(FIL,IEN_",",.01)=$E(NM,2,$L(NM))
|
|---|
| 55 | .. D FILE^DIE("","RMPR","RMPRE")
|
|---|
| 56 | .. Q
|
|---|
| 57 | . Q
|
|---|
| 58 | Q
|
|---|
