source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIXZ.m@ 1424

Last change on this file since 1424 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.2 KB
Line 
1RMPRPIXZ ;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
12KILL 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'
33ALOC 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.
47REMA 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
Note: See TracBrowser for help on using the repository browser.