| 1 | RMPRPIUJ ;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 | ;
|
|---|
| 13 | LOCN 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
|
|---|
| 31 | LOC1 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
|
|---|
| 70 | LOCNX Q
|
|---|
| 71 | ;
|
|---|
| 72 | UNIT ;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
|
|---|
