74 lines
2.8 KiB
Mathematica
74 lines
2.8 KiB
Mathematica
RMPRPIUI ;HINCIO/ODJ - CONVERT OLD PIP TO NEW PIP ;3/8/05 11:46
|
|
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
|
|
; DBIA #10090 - Read Access to entire file #4.
|
|
Q
|
|
;
|
|
;***** CONV - Convert Item records in 661.3 to 661.11
|
|
; In the current PIP file design a HCPC Item is held as
|
|
; free text in the form HCPCS-ITEM where HCPCS is the
|
|
; HCPCS code (.01 field in 661.1 eg E0111) and ITEM is
|
|
; the ien (ptr) to the item held on the ^RMPR(661.3,,3,)
|
|
; multiple.
|
|
; In the new design ITEM will be a number and not a pointer.
|
|
; In this first pass through HCPCS Items the ITEM number
|
|
; will be the same as ITEM ien for all commercial items.
|
|
; Non-commercial items will have a different ITEM number
|
|
; from their ITEM ien only where commercial and
|
|
; non-commercial items have used the same HCPCS-ITEM code.
|
|
; Non-commercial items will be ignored on this pass.
|
|
; Any item whose Source field is not V
|
|
; is assumed commercial.
|
|
;
|
|
CONV N RMPRHIEN,RMPRIIEN,RMPRHREC,RMPRIREC,RMPRHCPC,RMPRHIT,RMPRGBL
|
|
N RMPR1,RMPR2,RMPR3,RMPRL13,RMPRI13,RMPR11,RMPRERR
|
|
I '$D(IO("Q")) D
|
|
. W !,"Creating HCPCS Items in file 661.11 - 1st pass "
|
|
. Q
|
|
;
|
|
; Loop on HCPCS and Items as defined in the PSAS HCPCS file 661.1
|
|
S RMPRHIEN=0
|
|
HCPC S RMPRHIEN=$O(^RMPR(661.1,RMPRHIEN))
|
|
I '+RMPRHIEN G CONVX ;no more HCPCS so exit
|
|
I '$D(IO("Q")) D
|
|
. W:$X=79 ! W "."
|
|
. Q
|
|
S RMPRHREC=$G(^RMPR(661.1,RMPRHIEN,0)) ;HCPCS node
|
|
S RMPRIIEN=0
|
|
ITEM S RMPRIIEN=$O(^RMPR(661.1,RMPRHIEN,3,RMPRIIEN))
|
|
I '+RMPRIIEN G HCPC
|
|
S RMPRIREC=$G(^RMPR(661.1,RMPRHIEN,3,RMPRIIEN,0)) ;HCPCS Item node
|
|
S RMPRHCPC=$P(RMPRHREC,"^",1)
|
|
I RMPRHCPC="" G ITEM
|
|
S RMPRHIT=RMPRHCPC_"-"_RMPRIIEN
|
|
;
|
|
; create 661.11 rec if item in 661.3 (should be)
|
|
S RMPRGBL="^RMPR(661.3,""D"","""_RMPRHIT_""")"
|
|
LOCI S RMPRGBL=$Q(@RMPRGBL)
|
|
I $QS(RMPRGBL,1)'=661.3 G ITEM
|
|
I $QS(RMPRGBL,2)'="D" G ITEM
|
|
I $QS(RMPRGBL,3)'=RMPRHIT G ITEM
|
|
S RMPR1=$QS(RMPRGBL,4) G:RMPR1="" LOCI
|
|
S RMPR2=$QS(RMPRGBL,5) G:RMPR2="" LOCI
|
|
S RMPR3=$QS(RMPRGBL,6) G:RMPR3="" LOCI
|
|
S RMPRL13=$G(^RMPR(661.3,RMPR1,0))
|
|
S RMPRI13=$G(^RMPR(661.3,RMPR1,1,RMPR2,1,RMPR3,0))
|
|
;
|
|
; create 661.11 record
|
|
K RMPR11
|
|
S RMPR11("STATION")=$P(RMPRL13,"^",3) ;Station must be in DIC(4
|
|
I RMPR11("STATION")="" G LOCI
|
|
I '$D(^DIC(4,RMPR11("STATION"))) G LOCI
|
|
I $P(RMPRI13,"^",9)="V" G LOCI ;ignore non-commercial items on this pass
|
|
S RMPR11("SOURCE")="C"
|
|
S RMPR11("HCPCS")=RMPRHCPC
|
|
S RMPR11("ITEM")=RMPRIIEN
|
|
I $D(^RMPR(661.11,"ASHI",RMPR11("STATION"),RMPR11("HCPCS"),RMPR11("ITEM"))) G LOCI ;already defined
|
|
S RMPR11("UNIT")=$P(RMPRI13,"^",4)
|
|
S RMPR11("DESCRIPTION")=$P(RMPRIREC,"^",1)
|
|
S RMPR11("ITEM MASTER IEN")=""
|
|
S RMPRERR=$$CRE^RMPRPIX1(.RMPR11)
|
|
G LOCI
|
|
;
|
|
;exit
|
|
CONVX Q
|