RMPRPIXA ;HINCIO/ODJ - FILE 661.6 API ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
; SRCH
SRCH(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPRFIND,RMPREOF) ;
N RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4
S RMPRRET=0
S RMPREOF=0
I RMPRXREF="XHDS" D G SRCHX
. S RMPRK1=$G(RMPR("HCPCS"))
. S RMPRK2=$G(RMPR("DATE&TIME"))
. S RMPRK3=$G(RMPR("SEQUENCE"))
. S RMPRK4=$G(RMPR("IEN"))
. S RMPRFIND=0
. I RMPRK1="" D
.. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT)
.. Q
. E D
.. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1)) D Q
... S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
... Q
.. S RMPRFIND=1
.. Q
. I RMPRK1="" S RMPREOF=1 Q
. S RMPR("HCPCS")=RMPRK1
. I RMPRLEV="HCPCS" Q
. S RMPRFIND=0
. I RMPRK2="" D
.. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
.. Q
. E D
.. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2)) D Q
... S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
... Q
.. S RMPRFIND=1
.. Q
. I RMPRK2="" S RMPREOF=1 Q
. S RMPR("DATE&TIME")=RMPRK2
. I RMPRLEV="DATE&TIME" Q
. S RMPRFIND=0
. I RMPRK3="" D
.. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
.. Q
. E D
.. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3)) D Q
... S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
... Q
.. S RMPRFIND=1
.. Q
. I RMPRK3="" S RMPREOF=1 Q
. S RMPR("SEQUENCE")=RMPRK3
. I RMPRLEV="SEQUENCE" Q
. S RMPRFIND=0
. I RMPRK4="" D
.. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
.. Q
. E D
.. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4)) D Q
... S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
... Q
.. S RMPRFIND=1
.. Q
. I RMPRK4="" S RMPREOF=1 Q
. S RMPR("IEN")=RMPRK4
. Q
SRCHX Q RMPRRET
;
; NEXT
NEXT(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPROLD,RMPREOF) ;
N RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7
I $G(RMPRT)'=-1 S RMPRT=1
S RMPRRET=0,RMPREOF=0
;
; HCPCS, Date&Time, Sequence X-ref
I RMPRXREF="XHDS" D G NEXTX
. S RMPRK1=$G(RMPR("HCPCS"))
. S RMPRK2=$G(RMPR("DATE&TIME"))
. S RMPRK3=$G(RMPR("SEQUENCE"))
. S RMPRK4=$G(RMPR("IEN"))
. I RMPRLEV="HCPCS" D Q:RMPREOF
.. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
.. I RMPRK1="" S RMPREOF=1 K RMPROLD Q
.. S (RMPRK2,RMPRK3,RMPRK4)=""
.. Q
. I RMPRLEV="DATE&TIME",RMPRK1'="" D
.. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
.. I RMPRK2="" S RMPREOF=1
.. S (RMPRK3,RMPRK4)=""
.. Q
. I RMPRLEV="SEQUENCE",RMPRK2'="" D
.. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
.. I RMPRK3="" S RMPREOF=1
.. S RMPRK4=""
.. Q
. I RMPRLEV="",RMPRK3'="" D
.. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
.. I RMPRK4="" S RMPREOF=1
.. Q
. K RMPROLD
. I RMPREOF D
.. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
.. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
.. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1
.. Q
. I RMPRK1="",RMPREOF Q
. S RMPREOF=0
. M RMPROLD=RMPR
. I RMPRK1="" S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT)
. I RMPRK2="" S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
. I RMPRK3="" S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
. I RMPRK3="" W !,"*** HCPCS = ",RMPRK1,!,"*** DATE = ",RMPRK2,!,"*** is not in file #661.6",!,"*** Please investigate!!!!" Q
. I RMPRK4="" S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
. S RMPR("HCPCS")=RMPRK1
. S RMPR("DATE&TIME")=RMPRK2
. S RMPR("DATE")=$P(RMPRK2,".",1)
. S RMPR("TIME")=$P(RMPRK2,".",2)
. S RMPR("SEQUENCE")=RMPRK3
. S RMPR("IEN")=RMPRK4
. Q
;
; Station, Trans. Type, HCPCS, Item, Date&Time, Sequence X-ref.
I RMPRXREF="ASTHIDS" D G NEXTX
. S RMPRK1=$G(RMPR("STATION"))
. S RMPRK2=$G(RMPR("TRAN TYPE"))
. S RMPRK3=$G(RMPR("HCPCS"))
. S RMPRK4=$G(RMPR("ITEM"))
. S RMPRK5=$G(RMPR("DATE&TIME"))
. S RMPRK6=$G(RMPR("SEQUENCE"))
. S RMPRK7=$G(RMPR("IEN"))
. I RMPRLEV="STATION" D Q:RMPREOF
.. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
.. I RMPRK1="" S RMPREOF=1 K RMPROLD Q
.. S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
.. Q
. I RMPRLEV="TRAN TYPE",RMPRK1'="" D
.. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
.. I RMPRK2="" S RMPREOF=1
.. S (RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
.. Q
. I RMPRLEV="HCPCS",RMPRK2'="" D
.. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
.. I RMPRK3="" S RMPREOF=1
.. S (RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
.. Q
. I RMPRLEV="ITEM",RMPRK3'="" D
.. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
.. I RMPRK4="" S RMPREOF=1
.. S (RMPRK5,RMPRK6,RMPRK7)=""
.. Q
. I RMPRLEV="DATE&TIME",RMPRK4'="" D
.. S RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
.. I RMPRK5="" S RMPREOF=1
.. S (RMPRK6,RMPRK7)=""
.. Q
. I RMPRLEV="SEQUENCE",RMPRK5'="" D
.. S RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
.. I RMPRK6="" S RMPREOF=1
.. S RMPRK7=""
.. Q
. I RMPRLEV="",RMPRK6'="" D
.. S RMPRK7=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7),RMPRT)
.. I RMPRK7="" S RMPREOF=1
.. Q
. K RMPROLD
. I RMPREOF D
.. I RMPRK7="" S:RMPRK6'="" RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
.. I RMPRK6="" S:RMPRK5'="" RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
.. I RMPRK5="" S:RMPRK4'="" RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
.. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
.. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
.. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1
.. Q
. I RMPRK1="",RMPREOF Q
. M RMPROLD=RMPR
. I RMPRK1="" S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT)
. I RMPRK2="" S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
. I RMPRK3="" S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
. I RMPRK4="" S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
. I RMPRK5="" S RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,""),RMPRT)
. I RMPRK6="" S RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,""),RMPRT)
. I RMPRK7="" S RMPRK7=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,""),RMPRT)
. S RMPR("STATION")=RMPRK1
. S RMPR("TRAN TYPE")=RMPRK2
. S RMPR("HCPCS")=RMPRK3
. S RMPR("ITEM")=RMPRK4
. S RMPR("DATE&TIME")=RMPRK5
. S RMPR("SEQUENCE")=RMPRK6
. S RMPR("IEN")=RMPRK7
. Q
NEXTX Q RMPRRET
;
; CRE
CRE(RMPR616,RMPR6111) ;
N RMPRRET,RMPRIENA,RMPRFDA,RMPRFME,X,Y,%
N %,%H,%I,X
S RMPRRET=0
;
; Get DATE&TIME for transaction and lock the file
S RMPR616("DATE&TIME")=""
F D Q:RMPR616("DATE&TIME")'=""
. D NOW^%DTC
. I $D(^RMPR(661.6,"XHDS",RMPR616("HCPCS"),%,1)) H (1+$R(3)) Q
. L +^RMPR(661.6,"XHDS",RMPR616("HCPCS"),%):0 E Q
. S RMPR616("DATE&TIME")=%
. Q
S RMPRFDA(661.6,"+1,",.01)=RMPR6111("HCPCS")
S RMPRFDA(661.6,"+1,",2)=RMPR616("DATE&TIME")
S RMPRFDA(661.6,"+1,",3)=RMPR616("SEQUENCE")
S RMPRFDA(661.6,"+1,",4)=RMPR616("TRAN TYPE")
S RMPRFDA(661.6,"+1,",5)=RMPR616("QUANTITY")
S RMPRFDA(661.6,"+1,",6)=RMPR616("VALUE")
S RMPRFDA(661.6,"+1,",8)=RMPR616("COMMENT")
S RMPRFDA(661.6,"+1,",9)=RMPR616("USER")
S RMPRFDA(661.6,"+1,",11)=RMPR6111("ITEM")
S RMPRFDA(661.6,"+1,",12)=RMPR616("VENDOR")
S RMPRFDA(661.6,"+1,",13)=RMPR6111("STATION")
S RMPRFDA(661.6,"+1,",14)=RMPR616("LOCATION")
D UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
L -^RMPR(661.6,"XHDS",RMPR616("HCPCS"),RMPR616("DATE&TIME"))
I $D(RMPRFME) S RMPRRET=1 G CREX
S RMPR616("IEN")=RMPRIENA(1)
CREX Q RMPRRET
;
; GET
GET(RMPR) ;
N RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP
S RMPRRET=0
I $G(RMPR("IEN"))="" D
. I $G(RMPR("HCPCS"))="" S RMPRRET=1 Q
. I $G(RMPR("DATE&TIME"))="" S RMPRRET=2 Q
. S RMPRKEY("HCPCS")=RMPR("HCPCS")
. S RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
. S RMPRERR=$$NEXT(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
. I RMPRERR S RMPRRET=3 Q
. I RMPRKEY("SEQUENCE")'=1 S RMPRRET=4 Q
. S RMPR("IEN")=RMPRKEY("IEN")
. Q
I RMPRRET G GETX
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.6,RMPRIEN,"*","","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRRET=5 G GETX
S RMPR("HCPCS")=RMPROUP(661.6,RMPRIEN,.01)
S RMPR("DATE&TIME")=RMPROUP(661.6,RMPRIEN,2)
S RMPR("SEQUENCE")=RMPROUP(661.6,RMPRIEN,3)
S RMPR("TRAN TYPE")=RMPROUP(661.6,RMPRIEN,4)
S RMPR("QUANTITY")=RMPROUP(661.6,RMPRIEN,5)
S RMPR("VALUE")=RMPROUP(661.6,RMPRIEN,6)
S RMPR("COMMENT")=RMPROUP(661.6,RMPRIEN,8)
S RMPR("USER")=RMPROUP(661.6,RMPRIEN,9)
S RMPR("ITEM")=RMPROUP(661.6,RMPRIEN,11)
S RMPR("VENDOR")=RMPROUP(661.6,RMPRIEN,12)
S RMPR("STATION")=RMPROUP(661.6,RMPRIEN,13)
S RMPR("LOCATION")=RMPROUP(661.6,RMPRIEN,14)
GETX Q RMPRRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIXA 9083 printed Nov 22, 2024@17:46:39 Page 2
RMPRPIXA ;HINCIO/ODJ - FILE 661.6 API ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ; SRCH
SRCH(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPRFIND,RMPREOF) ;
+1 NEW RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4
+2 SET RMPRRET=0
+3 SET RMPREOF=0
+4 IF RMPRXREF="XHDS"
Begin DoDot:1
+5 SET RMPRK1=$GET(RMPR("HCPCS"))
+6 SET RMPRK2=$GET(RMPR("DATE&TIME"))
+7 SET RMPRK3=$GET(RMPR("SEQUENCE"))
+8 SET RMPRK4=$GET(RMPR("IEN"))
+9 SET RMPRFIND=0
+10 IF RMPRK1=""
Begin DoDot:2
+11 SET RMPRK1=$ORDER(^RMPR(661.6,RMPRXREF,""),RMPRT)
+12 QUIT
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 IF '$DATA(^RMPR(661.6,RMPRXREF,RMPRK1))
Begin DoDot:3
+15 SET RMPRK1=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
+16 QUIT
End DoDot:3
QUIT
+17 SET RMPRFIND=1
+18 QUIT
End DoDot:2
+19 IF RMPRK1=""
SET RMPREOF=1
QUIT
+20 SET RMPR("HCPCS")=RMPRK1
+21 IF RMPRLEV="HCPCS"
QUIT
+22 SET RMPRFIND=0
+23 IF RMPRK2=""
Begin DoDot:2
+24 SET RMPRK2=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
+25 QUIT
End DoDot:2
+26 IF '$TEST
Begin DoDot:2
+27 IF '$DATA(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2))
Begin DoDot:3
+28 SET RMPRK2=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
+29 QUIT
End DoDot:3
QUIT
+30 SET RMPRFIND=1
+31 QUIT
End DoDot:2
+32 IF RMPRK2=""
SET RMPREOF=1
QUIT
+33 SET RMPR("DATE&TIME")=RMPRK2
+34 IF RMPRLEV="DATE&TIME"
QUIT
+35 SET RMPRFIND=0
+36 IF RMPRK3=""
Begin DoDot:2
+37 SET RMPRK3=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
+38 QUIT
End DoDot:2
+39 IF '$TEST
Begin DoDot:2
+40 IF '$DATA(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3))
Begin DoDot:3
+41 SET RMPRK3=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
+42 QUIT
End DoDot:3
QUIT
+43 SET RMPRFIND=1
+44 QUIT
End DoDot:2
+45 IF RMPRK3=""
SET RMPREOF=1
QUIT
+46 SET RMPR("SEQUENCE")=RMPRK3
+47 IF RMPRLEV="SEQUENCE"
QUIT
+48 SET RMPRFIND=0
+49 IF RMPRK4=""
Begin DoDot:2
+50 SET RMPRK4=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
+51 QUIT
End DoDot:2
+52 IF '$TEST
Begin DoDot:2
+53 IF '$DATA(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4))
Begin DoDot:3
+54 SET RMPRK4=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
+55 QUIT
End DoDot:3
QUIT
+56 SET RMPRFIND=1
+57 QUIT
End DoDot:2
+58 IF RMPRK4=""
SET RMPREOF=1
QUIT
+59 SET RMPR("IEN")=RMPRK4
+60 QUIT
End DoDot:1
GOTO SRCHX
SRCHX QUIT RMPRRET
+1 ;
+2 ; NEXT
NEXT(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPROLD,RMPREOF) ;
+1 NEW RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7
+2 IF $GET(RMPRT)'=-1
SET RMPRT=1
+3 SET RMPRRET=0
SET RMPREOF=0
+4 ;
+5 ; HCPCS, Date&Time, Sequence X-ref
+6 IF RMPRXREF="XHDS"
Begin DoDot:1
+7 SET RMPRK1=$GET(RMPR("HCPCS"))
+8 SET RMPRK2=$GET(RMPR("DATE&TIME"))
+9 SET RMPRK3=$GET(RMPR("SEQUENCE"))
+10 SET RMPRK4=$GET(RMPR("IEN"))
+11 IF RMPRLEV="HCPCS"
Begin DoDot:2
+12 SET RMPRK1=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
+13 IF RMPRK1=""
SET RMPREOF=1
KILL RMPROLD
QUIT
+14 SET (RMPRK2,RMPRK3,RMPRK4)=""
+15 QUIT
End DoDot:2
if RMPREOF
QUIT
+16 IF RMPRLEV="DATE&TIME"
IF RMPRK1'=""
Begin DoDot:2
+17 SET RMPRK2=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
+18 IF RMPRK2=""
SET RMPREOF=1
+19 SET (RMPRK3,RMPRK4)=""
+20 QUIT
End DoDot:2
+21 IF RMPRLEV="SEQUENCE"
IF RMPRK2'=""
Begin DoDot:2
+22 SET RMPRK3=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
+23 IF RMPRK3=""
SET RMPREOF=1
+24 SET RMPRK4=""
+25 QUIT
End DoDot:2
+26 IF RMPRLEV=""
IF RMPRK3'=""
Begin DoDot:2
+27 SET RMPRK4=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
+28 IF RMPRK4=""
SET RMPREOF=1
+29 QUIT
End DoDot:2
+30 KILL RMPROLD
+31 IF RMPREOF
Begin DoDot:2
+32 IF RMPRK4=""
if RMPRK3'=""
SET RMPRK3=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
+33 IF RMPRK3=""
if RMPRK2'=""
SET RMPRK2=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
+34 IF RMPRK2=""
if RMPRK1'=""
SET RMPRK1=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
if RMPRK1=""
SET RMPREOF=1
+35 QUIT
End DoDot:2
+36 IF RMPRK1=""
IF RMPREOF
QUIT
+37 SET RMPREOF=0
+38 MERGE RMPROLD=RMPR
+39 IF RMPRK1=""
SET RMPRK1=$ORDER(^RMPR(661.6,RMPRXREF,""),RMPRT)
+40 IF RMPRK2=""
SET RMPRK2=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
+41 IF RMPRK3=""
SET RMPRK3=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
+42 IF RMPRK3=""
WRITE !,"*** HCPCS = ",RMPRK1,!,"*** DATE = ",RMPRK2,!,"*** is not in file #661.6",!,"*** Please investigate!!!!"
QUIT
+43 IF RMPRK4=""
SET RMPRK4=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
+44 SET RMPR("HCPCS")=RMPRK1
+45 SET RMPR("DATE&TIME")=RMPRK2
+46 SET RMPR("DATE")=$PIECE(RMPRK2,".",1)
+47 SET RMPR("TIME")=$PIECE(RMPRK2,".",2)
+48 SET RMPR("SEQUENCE")=RMPRK3
+49 SET RMPR("IEN")=RMPRK4
+50 QUIT
End DoDot:1
GOTO NEXTX
+51 ;
+52 ; Station, Trans. Type, HCPCS, Item, Date&Time, Sequence X-ref.
+53 IF RMPRXREF="ASTHIDS"
Begin DoDot:1
+54 SET RMPRK1=$GET(RMPR("STATION"))
+55 SET RMPRK2=$GET(RMPR("TRAN TYPE"))
+56 SET RMPRK3=$GET(RMPR("HCPCS"))
+57 SET RMPRK4=$GET(RMPR("ITEM"))
+58 SET RMPRK5=$GET(RMPR("DATE&TIME"))
+59 SET RMPRK6=$GET(RMPR("SEQUENCE"))
+60 SET RMPRK7=$GET(RMPR("IEN"))
+61 IF RMPRLEV="STATION"
Begin DoDot:2
+62 SET RMPRK1=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
+63 IF RMPRK1=""
SET RMPREOF=1
KILL RMPROLD
QUIT
+64 SET (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
+65 QUIT
End DoDot:2
if RMPREOF
QUIT
+66 IF RMPRLEV="TRAN TYPE"
IF RMPRK1'=""
Begin DoDot:2
+67 SET RMPRK2=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
+68 IF RMPRK2=""
SET RMPREOF=1
+69 SET (RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
+70 QUIT
End DoDot:2
+71 IF RMPRLEV="HCPCS"
IF RMPRK2'=""
Begin DoDot:2
+72 SET RMPRK3=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
+73 IF RMPRK3=""
SET RMPREOF=1
+74 SET (RMPRK4,RMPRK5,RMPRK6,RMPRK7)=""
+75 QUIT
End DoDot:2
+76 IF RMPRLEV="ITEM"
IF RMPRK3'=""
Begin DoDot:2
+77 SET RMPRK4=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
+78 IF RMPRK4=""
SET RMPREOF=1
+79 SET (RMPRK5,RMPRK6,RMPRK7)=""
+80 QUIT
End DoDot:2
+81 IF RMPRLEV="DATE&TIME"
IF RMPRK4'=""
Begin DoDot:2
+82 SET RMPRK5=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
+83 IF RMPRK5=""
SET RMPREOF=1
+84 SET (RMPRK6,RMPRK7)=""
+85 QUIT
End DoDot:2
+86 IF RMPRLEV="SEQUENCE"
IF RMPRK5'=""
Begin DoDot:2
+87 SET RMPRK6=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
+88 IF RMPRK6=""
SET RMPREOF=1
+89 SET RMPRK7=""
+90 QUIT
End DoDot:2
+91 IF RMPRLEV=""
IF RMPRK6'=""
Begin DoDot:2
+92 SET RMPRK7=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7),RMPRT)
+93 IF RMPRK7=""
SET RMPREOF=1
+94 QUIT
End DoDot:2
+95 KILL RMPROLD
+96 IF RMPREOF
Begin DoDot:2
+97 IF RMPRK7=""
if RMPRK6'=""
SET RMPRK6=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT)
+98 IF RMPRK6=""
if RMPRK5'=""
SET RMPRK5=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT)
+99 IF RMPRK5=""
if RMPRK4'=""
SET RMPRK4=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT)
+100 IF RMPRK4=""
if RMPRK3'=""
SET RMPRK3=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT)
+101 IF RMPRK3=""
if RMPRK2'=""
SET RMPRK2=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT)
+102 IF RMPRK2=""
if RMPRK1'=""
SET RMPRK1=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT)
if RMPRK1=""
SET RMPREOF=1
+103 QUIT
End DoDot:2
+104 IF RMPRK1=""
IF RMPREOF
QUIT
+105 MERGE RMPROLD=RMPR
+106 IF RMPRK1=""
SET RMPRK1=$ORDER(^RMPR(661.6,RMPRXREF,""),RMPRT)
+107 IF RMPRK2=""
SET RMPRK2=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT)
+108 IF RMPRK3=""
SET RMPRK3=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT)
+109 IF RMPRK4=""
SET RMPRK4=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT)
+110 IF RMPRK5=""
SET RMPRK5=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,""),RMPRT)
+111 IF RMPRK6=""
SET RMPRK6=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,""),RMPRT)
+112 IF RMPRK7=""
SET RMPRK7=$ORDER(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,""),RMPRT)
+113 SET RMPR("STATION")=RMPRK1
+114 SET RMPR("TRAN TYPE")=RMPRK2
+115 SET RMPR("HCPCS")=RMPRK3
+116 SET RMPR("ITEM")=RMPRK4
+117 SET RMPR("DATE&TIME")=RMPRK5
+118 SET RMPR("SEQUENCE")=RMPRK6
+119 SET RMPR("IEN")=RMPRK7
+120 QUIT
End DoDot:1
GOTO NEXTX
NEXTX QUIT RMPRRET
+1 ;
+2 ; CRE
CRE(RMPR616,RMPR6111) ;
+1 NEW RMPRRET,RMPRIENA,RMPRFDA,RMPRFME,X,Y,%
+2 NEW %,%H,%I,X
+3 SET RMPRRET=0
+4 ;
+5 ; Get DATE&TIME for transaction and lock the file
+6 SET RMPR616("DATE&TIME")=""
+7 FOR
Begin DoDot:1
+8 DO NOW^%DTC
+9 IF $DATA(^RMPR(661.6,"XHDS",RMPR616("HCPCS"),%,1))
HANG (1+$RANDOM(3))
QUIT
+10 LOCK +^RMPR(661.6,"XHDS",RMPR616("HCPCS"),%):0
IF '$TEST
QUIT
+11 SET RMPR616("DATE&TIME")=%
+12 QUIT
End DoDot:1
if RMPR616("DATE&TIME")'=""
QUIT
+13 SET RMPRFDA(661.6,"+1,",.01)=RMPR6111("HCPCS")
+14 SET RMPRFDA(661.6,"+1,",2)=RMPR616("DATE&TIME")
+15 SET RMPRFDA(661.6,"+1,",3)=RMPR616("SEQUENCE")
+16 SET RMPRFDA(661.6,"+1,",4)=RMPR616("TRAN TYPE")
+17 SET RMPRFDA(661.6,"+1,",5)=RMPR616("QUANTITY")
+18 SET RMPRFDA(661.6,"+1,",6)=RMPR616("VALUE")
+19 SET RMPRFDA(661.6,"+1,",8)=RMPR616("COMMENT")
+20 SET RMPRFDA(661.6,"+1,",9)=RMPR616("USER")
+21 SET RMPRFDA(661.6,"+1,",11)=RMPR6111("ITEM")
+22 SET RMPRFDA(661.6,"+1,",12)=RMPR616("VENDOR")
+23 SET RMPRFDA(661.6,"+1,",13)=RMPR6111("STATION")
+24 SET RMPRFDA(661.6,"+1,",14)=RMPR616("LOCATION")
+25 DO UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
+26 LOCK -^RMPR(661.6,"XHDS",RMPR616("HCPCS"),RMPR616("DATE&TIME"))
+27 IF $DATA(RMPRFME)
SET RMPRRET=1
GOTO CREX
+28 SET RMPR616("IEN")=RMPRIENA(1)
CREX QUIT RMPRRET
+1 ;
+2 ; GET
GET(RMPR) ;
+1 NEW RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP
+2 SET RMPRRET=0
+3 IF $GET(RMPR("IEN"))=""
Begin DoDot:1
+4 IF $GET(RMPR("HCPCS"))=""
SET RMPRRET=1
QUIT
+5 IF $GET(RMPR("DATE&TIME"))=""
SET RMPRRET=2
QUIT
+6 SET RMPRKEY("HCPCS")=RMPR("HCPCS")
+7 SET RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
+8 SET RMPRERR=$$NEXT(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
+9 IF RMPRERR
SET RMPRRET=3
QUIT
+10 IF RMPRKEY("SEQUENCE")'=1
SET RMPRRET=4
QUIT
+11 SET RMPR("IEN")=RMPRKEY("IEN")
+12 QUIT
End DoDot:1
+13 IF RMPRRET
GOTO GETX
+14 SET RMPRIEN=RMPR("IEN")_","
+15 DO GETS^DIQ(661.6,RMPRIEN,"*","","RMPROUP","RMPRFME")
+16 IF $DATA(RMPRFME)
SET RMPRRET=5
GOTO GETX
+17 SET RMPR("HCPCS")=RMPROUP(661.6,RMPRIEN,.01)
+18 SET RMPR("DATE&TIME")=RMPROUP(661.6,RMPRIEN,2)
+19 SET RMPR("SEQUENCE")=RMPROUP(661.6,RMPRIEN,3)
+20 SET RMPR("TRAN TYPE")=RMPROUP(661.6,RMPRIEN,4)
+21 SET RMPR("QUANTITY")=RMPROUP(661.6,RMPRIEN,5)
+22 SET RMPR("VALUE")=RMPROUP(661.6,RMPRIEN,6)
+23 SET RMPR("COMMENT")=RMPROUP(661.6,RMPRIEN,8)
+24 SET RMPR("USER")=RMPROUP(661.6,RMPRIEN,9)
+25 SET RMPR("ITEM")=RMPROUP(661.6,RMPRIEN,11)
+26 SET RMPR("VENDOR")=RMPROUP(661.6,RMPRIEN,12)
+27 SET RMPR("STATION")=RMPROUP(661.6,RMPRIEN,13)
+28 SET RMPR("LOCATION")=RMPROUP(661.6,RMPRIEN,14)
GETX QUIT RMPRRET
