source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUJ.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1RMPRPIUJ ;HINES OIFO/ODJ - CONVERT OLD PIP TO NEW PIP ;3/8/05 11:47
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 ; DBIA #10090 - Read Access to entire file #4.
4 Q
5 ;
6 ;***** LOCN - Convert Locations in 661.3 to new 661.5 file
7 ; A GENERIC location will be created as a scratch
8 ; area.
9 ; Duplicate location names will not be allowed.
10 ; Build map file in ^TMP($J,"LOCN" which maps old
11 ; to new location iens.
12 ;
13LOCN N RMPRSTN,RMPRLCN,RMPRTOD,RMPRL,RMPRCNT,RMPRREC,RMPRERR,RMPR5,RMPRI
14 N X,Y,DA
15 I '$D(IO("Q")) D
16 . W !,"Creating Locations in file 661.5 "
17 . Q
18 K ^TMP($J,"LOCN")
19 D NOW^%DTC
20 S RMPRTOD=X ; today's date
21 ;
22 ; Init RMPR5
23 S RMPR5("STATUS")="A" ;active status
24 S RMPR5("STATUS DATE")=RMPRTOD ;status date is today's date
25 S RMPR5("USER")=""
26 S RMPRDUZ=$$GETUSR^RMPRPIU0(DUZ)
27 I $G(DUZ)'="",(RMPRDUZ'="") S RMPR5("USER")=DUZ
28 ;
29 ; Loop on Locations 661.3
30 S RMPRL=0
31LOC1 S RMPRL=$O(^RMPR(661.3,RMPRL))
32 I '+RMPRL G LOCNX ;exit if no more Locations
33 I '$D(IO("Q")) D
34 . W:$X=79 ! W "."
35 . Q
36 S RMPRREC=$G(^RMPR(661.3,RMPRL,0))
37 K RMPR5("IEN")
38 S RMPR5("STATION")=$P(RMPRREC,"^",3) ; Station
39 I RMPR5("STATION")="" G LOC1 ;ignore if null Station
40 I '$D(^DIC(4,RMPR5("STATION"),0)) G LOC1 ;ignore if bad ptr.
41 ;
42 ; Create GENERIC stock location if 1st location @ Station
43 I '$D(^RMPR(661.5,"XSL",RMPR5("STATION"))) D
44 . S RMPR5("NAME")="GENERIC"
45 . S RMPR5("ADDRESS")="GENERIC STOCK LOCATION (SYSTEM)"
46 . S RMPRERR=$$CRE^RMPRPIX5(.RMPR5)
47 . K RMPR5("IEN")
48 . Q
49 ;
50 ; Create Location
51 S RMPR5("NAME")=$P(RMPRREC,"^",1)
52 S RMPR5("ADDRESS")=$P(RMPRREC,"^",2)
53 ;
54 ; Check for duplicate location name and force to be unique
55 I $D(^RMPR(661.5,"XSL",RMPR5("STATION"),RMPR5("NAME"))) D
56 . S RMPRCNT=2
57 . F D Q:'$D(^RMPR(661.5,"XSL",RMPR5("STATION"),RMPR5("NAME")))
58 .. S RMPR5("NAME")=RMPR5("NAME")_" ("_RMPRCNT_")"
59 .. S RMPRCNT=1+RMPRCNT
60 .. Q
61 . Q
62 ;
63 ; Create Location in new 661.5 file
64 S RMPRERR=$$CRE^RMPRPIX5(.RMPR5)
65 S ^TMP($J,"LOCN",RMPRL)=RMPR5("IEN") ; map old to new Locn. ien
66 ;
67 G LOC1 ;next Location
68 ;
69 ;exit
70LOCNX Q
71 ;
72UNIT ;update UNIT of issue #661.7
73 N RI,RMDA,RMU,RHC,RIT,RST,R11DA,R11
74 F RI=0:0 S RI=$O(^RMPR(661.7,RI)) Q:RI'>0 S RMDA=$G(^RMPR(661.7,RI,0)) D
75 .S RMU=$P(RMDA,U,9)
76 .Q:$G(RMU)
77 .S RHC=$P(RMDA,U,1),RIT=$P(RMDA,U,4),RST=$P(RMDA,U,5)
78 .S R11=$O(^RMPR(661.11,"ASHI",RST,RHC,RIT,0))
79 .Q:'$G(R11)
80 .Q:'$D(^RMPR(661.11,R11,0))
81 .S R11DA=$G(^RMPR(661.11,R11,0)),RMU=$P(R11DA,U,6)
82 .Q:'$G(RMU)
83 .S $P(^RMPR(661.7,RI,0),U,9)=RMU
84 Q
Note: See TracBrowser for help on using the repository browser.