VistA-FOIAVistA/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIXA.m

256 lines
8.6 KiB
Mathematica

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