source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUG.m@ 1351

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1RMPRPIUG ;HINCIO/ODJ - CONVERT OLD PIP TO NEW PIP ;7/30/02 08:19
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** CONV - Convert old PIP files to the new design (start)
6 ; Should be run as post init in patch 61
7 ; No re-start allowed and all Prosthetic Inventory
8 ; menu options including Stock Issue and quick edit
9 ; should be disabled.
10 ; If conversion needs to be re-run then you must call
11 ; KILL^RMPRPIXZ before running this utility.
12 ;
13CONV I $D(^RMPR(661.5,"B")) D G CONVX ;don't convert if 661.5 has a rec
14 . I '$D(IO("Q")) D
15 .. W !!
16 .. W "** File 661.5 already exists, aborting conversion, please log NOIS"
17 .. Q
18 . Q
19DUZ S RMPRDUZ=$$GETUSR^RMPRPIU0(DUZ)
20 I RMPRDUZ="" D G CONVX ;need valid DUZ
21 . I '$D(IO("Q")) D
22 .. W !!
23 .. W "** Need valid DUZ variable set"
24 .. Q
25 . Q
26 I '$D(IO("Q")) D
27 . W !,"PIP Old to New file conversion starting."
28 . Q
29 K ^TMP($J)
30 D LOCN^RMPRPIUJ ; create locations (old to new map in ^TMP($J,"LOCN")
31 D CONV^RMPRPIUI ; create commercial items that exist in 661.3
32 D CONV1A ; create current inventory (from 661.3)
33 D CONV^RMPRPIUH ; create issues (from 660 and 661.2)
34 D REC^RMPRPIUK ; create initial balancing reconciliations
35 D BAL^RMPRPIUK ; create balance history (661.9)
36 D UNIT^RMPRPIUJ ; update unit of issue (661.7)
37 K ^TMP($J)
38RENDX S DIK="^RMPR(661.11," D IXALL^DIK
39 I '$D(IO("Q")) D
40 . W !,"PIP Old to New file conversion complete.",!
41 . Q
42CONVX Q
43 ;
44 ; Convert current inventory based on file 661.3
45 ; Main Loop on location
46CONV1A N RMPRL,RMPRHREC,RMPRERR,RMPR5,RMPRI,RMPRREC,RMPRITM,X,Y,DA,RMPRSS
47 N RMPRH,RMPRHIEN,RMPR4,RMPR6,RMPR,RMPR11,RMPRSRC,RMPRTODT,RMPR41
48 I '$D(IO("Q")) D
49 . W !,"Creating Current Inventory - file 661.7 "
50 . Q
51 D NOW^%DTC S RMPRTODT=$P(%,".",1)
52 S RMPRL=0
53CONV1 S RMPRL=$O(^RMPR(661.3,RMPRL))
54 I '+RMPRL G CONV1AX
55 I '$D(^TMP($J,"LOCN",RMPRL)) G CONV1
56 S RMPR5("IEN")=^TMP($J,"LOCN",RMPRL)
57 S RMPRREC=^RMPR(661.3,RMPRL,0)
58 S RMPR5("STATION")=$P(RMPRREC,"^",3)
59 ;
60 ; Loop on the HCPCS node in 661.3
61 K ^TMP($J,"H")
62 S RMPRH=0
63CONV2 S RMPRH=$O(^RMPR(661.3,RMPRL,1,RMPRH))
64 I '$D(IO("Q")) D
65 . W:$X=79 ! W "."
66 . Q
67 I '+RMPRH D G CONV1
68 . D TMPH(.RMPR5)
69 . K ^TMP($J,"H")
70 . Q
71 S RMPRREC=$G(^RMPR(661.3,RMPRL,1,RMPRH,0))
72 S RMPRHIEN=$P(RMPRREC,"^",1) ;ien to 661.1
73 I RMPRHIEN="" G CONV2 ;ignore if null 661.1 ptr
74 I '$D(^RMPR(661.1,RMPRHIEN,0)) G CONV2 ;ignore if bad ptr
75 S RMPRHREC=^RMPR(661.1,RMPRHIEN,0)
76 K RMPR11
77 S RMPR11("STATION")=RMPR5("STATION")
78 S RMPR11("STATION IEN")=RMPR5("STATION")
79 S RMPR11("HCPCS")=$P(RMPRHREC,"^",1) ;get HCPCS code from 661.1
80 I RMPR11("HCPCS")="" G CONV2 ;ignore if null HCPCS code
81 ;
82 ; Loop on HCPCS Item node in 661.3
83 S RMPRI=0
84CONV3 S RMPRI=$O(^RMPR(661.3,RMPRL,1,RMPRH,1,RMPRI))
85 I '+RMPRI G CONV2
86 S RMPRREC=$G(^RMPR(661.3,RMPRL,1,RMPRH,1,RMPRI,0))
87 I $P($P(RMPRREC,"^",1),"-",1)'=RMPR11("HCPCS") G CONV3 ;bad HCPCS
88 S RMPR11("SOURCE")="C"
89 I $P(RMPRREC,"^",9)="V" S RMPR11("SOURCE")="V"
90 S RMPRITM=$P($P(RMPRREC,"^",1),"-",2)
91 I RMPRITM="" G CONV3
92 S RMPR11("UNIT")=$P(RMPRREC,"^",4)
93 S RMPR7("UNIT")=$P(RMPRREC,"^",4)
94 K RMPR6
95 S RMPR6("QUANTITY")=+$P(RMPRREC,"^",2)
96 S RMPR6("VALUE")=+$P(RMPRREC,"^",3)
97 S RMPR6("VALUE")=$J(RMPR6("VALUE"),0,2)
98 S RMPR6("VENDOR IEN")=$P(RMPRREC,"^",5)
99 K RMPR4
100 S RMPR4("RE-ORDER QTY")=+$P(RMPRREC,"^",6)
101 K RMPR41
102 S RMPR41("ORDER QTY")=+$P(RMPRREC,"^",11)
103 D GETITM^RMPRPIUH(.RMPR11,RMPRHIEN,RMPRITM)
104 ;
105 ; Create HCPCS Item Re-Order record 661.4
106 I '$D(^RMPR(661.4,"ASLHI",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))) D
107 . S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5)
108 . Q
109 ;
110 ; Save in Temp global for later update
111 I RMPR6("VENDOR IEN")="" G CONV3
112 I $D(^TMP($J,"H",RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("VENDOR IEN"))) D
113 . S RMPRSS=^TMP($J,"H",RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("VENDOR IEN"))
114 . S $P(RMPRSS,"^",1)=$P(RMPRSS,"^",1)+RMPR6("QUANTITY")
115 . S $P(RMPRSS,"^",2)=$P(RMPRSS,"^",2)+RMPR6("VALUE")
116 . Q
117 E D
118 . S RMPRSS=RMPR6("QUANTITY")
119 . S $P(RMPRSS,"^",2)=RMPR6("VALUE")
120 . Q
121 S RMPRSS=RMPRSS_U_$G(RMPR11("UNIT"))
122 S ^TMP($J,"H",RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("VENDOR IEN"))=RMPRSS
123 ;
124 ; If there is an order quantity then save it to file 661.41
125 I RMPR41("ORDER QTY")>0 D
126 . S RMPR41("VENDOR")=RMPR6("VENDOR IEN")
127 . S RMPR41("DATE ORDER")=RMPRTODT
128 . S RMPR41("STATUS")="O"
129 . S RMPRERR=$$CRE^RMPRPIXN(.RMPR41,.RMPR11)
130 . Q
131 G CONV3 ;next item in 661.3
132 ;
133 ; Process the ^TMP($J,"H") global just created
134TMPH(RMPR5) ;
135 N RMPRH,RMPRI,RMPRV,RMPR,RMPR11,RMPRERR,RMPRSS,RMPR6,RMPRUCST
136 S RMPRH=""
137 F S RMPRH=$O(^TMP($J,"H",RMPRH)) Q:RMPRH="" D
138 . S RMPRI=""
139 . F S RMPRI=$O(^TMP($J,"H",RMPRH,RMPRI)) Q:RMPRI="" D
140 .. S RMPRV=""
141 .. F S RMPRV=$O(^TMP($J,"H",RMPRH,RMPRI,RMPRV)) Q:RMPRV="" D
142 ... S RMPRSS=^TMP($J,"H",RMPRH,RMPRI,RMPRV)
143 ... K RMPR6
144 ... S RMPR6("QUANTITY")=+$P(RMPRSS,"^",1)
145 ... S RMPR6("VALUE")=+$P(RMPRSS,"^",2)
146 ... S RMPR6("UNIT")=+$P(RMPRSS,"^",3)
147 ... S RMPR6("VENDOR IEN")=RMPRV
148 ... K RMPR11
149 ... S RMPR11("STATION")=RMPR5("STATION")
150 ... S RMPR11("STATION IEN")=RMPR5("STATION")
151 ... S RMPR11("HCPCS")=RMPRH
152 ... S RMPR11("ITEM")=RMPRI
153 ... S RMPR11("UNIT")=$P(RMPRSS,U,3)
154 ... ;
155 ... ; If quantity<0 then create a reconciliation gain
156 ... ; of the amount followed by a 0 reconciliation
157 ... I RMPR6("QUANTITY")<0 D
158 .... K RMPR
159 .... S RMPR("QUANTITY")=0-RMPR6("QUANTITY")
160 .... S RMPR("VALUE")=$S(RMPR6("VALUE")<0:0-RMPR6("VALUE"),1:RMPR6("VALUE"))
161 .... S RMPR("NEW UNIT COST")=$J(RMPR("VALUE")/RMPR("QUANTITY"),0,2)
162 .... S RMPRUCST=RMPR("NEW UNIT COST")
163 .... S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
164 .... S RMPRERR=$$REC^RMPRPIU9(.RMPR,.RMPR11,.RMPR5)
165 .... K RMPR
166 .... S RMPR("QUANTITY")=0
167 .... S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
168 .... S RMPR("NEW UNIT COST")=RMPRUCST
169 .... S RMPRERR=$$REC^RMPRPIU9(.RMPR,.RMPR11,.RMPR5)
170 .... Q
171 ... ;
172 ... ; If +VE qty. just record as a gain
173 ... E D
174 .... S:RMPR6("VALUE")<0 RMPR6("VALUE")=0-RMPR6("VALUE")
175 .... S RMPR6("NEW UNIT COST")=0
176 .... S:RMPR6("QUANTITY") RMPR6("NEW UNIT COST")=$J(RMPR6("VALUE")/RMPR6("QUANTITY"),0,2)
177 .... S RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5)
178 .... Q
179 ... Q
180 .. Q
181 . Q
182TMPHX K ^TMP($J,"H")
183 Q
184 ;
185 ;exit
186CONV1AX K ^TMP($J,"H")
187 Q
Note: See TracBrowser for help on using the repository browser.