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

172 lines
6.1 KiB
Mathematica

RMPRPIX2 ;HINCIO/ODJ - APIs for 660 file (Patient 2319) ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
; CRE - Create a 2319 record for a stock issue (file 660)
;
; Inputs:
;
; Outputs:
;
CRE(RMPR60,RMPR6111) ;
N RMPRFDA,RMPRFME,RMPRIEN,RMPRRET,X,Y,RMPR699,RMPRTMP,RMPRI,RMPRJ
N RMPR611,RMPR611I,RMPRERR,RMPRTMP
S RMPRRET=0
S RMPR611("HCPCS")=RMPR6111("HCPCS")
S RMPRRET=$$HPACT^RMPRPIX1(.RMPR611)
I RMPRRET S RMPRRET=1 G CREX
S RMPRRET=$$HPETOI^RMPRPIX1(.RMPR611,.RMPR611I)
I RMPRRET S RMPRRET=1 G CREX
;S RMPR60("CPT IEN")=RMPR611I("CPT CODE")
S RMPRFDA(660,"+1,",.01)=RMPR60("ENTRY DATE")
S RMPRFDA(660,"+1,",.02)=RMPR60("PATIENT IEN")
S RMPRFDA(660,"+1,",1)=RMPR60("REQ DATE")
S RMPRFDA(660,"+1,",2)=RMPR60("ISSUE TYPE")
S RMPRFDA(660,"+1,",4)=$G(RMPR60("IFCAP ITEM"))
S RMPRFDA(660,"+1,",5)=RMPR60("QUANTITY")
S RMPRFDA(660,"+1,",78)=$G(RMPR60("UNIT"))
S RMPRFDA(660,"+1,",7)=RMPR60("VENDOR IEN")
S RMPRFDA(660,"+1,",8)=RMPR6111("STATION IEN")
S RMPRFDA(660,"+1,",9)=$G(RMPR60("SERIAL NUM"))
S RMPRFDA(660,"+1,",10)=RMPR60("DELIV DATE")
S RMPRFDA(660,"+1,",11)=$G(RMPR60("REQ TYPE"))
S RMPRFDA(660,"+1,",12)=$G(RMPR60("SOURCE"))
S RMPRFDA(660,"+1,",14)=RMPR60("COST")
S RMPRFDA(660,"+1,",16)=$G(RMPR60("REMARKS"))
S RMPRFDA(660,"+1,",4.1)=RMPR60("CPT IEN")
S RMPRFDA(660,"+1,",21)=$G(RMPR60("LOT NUM"))
S RMPRFDA(660,"+1,",27)=$G(RMPR60("USER"))
;
; for the type 1 rec.
S RMPRFDA(660,"+1,",24)=RMPR611("SHORT DESC")
S RMPRFDA(660,"+1,",4.5)=RMPR60("HCPCS")
;S RMPRFDA(660,"+1,",4.5)=RMPR611("IEN")
S RMPRFDA(660,"+1,",4.7)=RMPR60("CPT MOD")
S RMPRFDA(660,"+1,",4.6)=RMPR60("TRANS IEN")
S RMPRFDA(660,"+1,",39)=RMPR60("DATE OF SERVICE")
;
; for the type 2 rec.
S RMPRFDA(660,"+1,",37)=RMPR6111("HCPCS")_"-"_RMPR6111("ITEM")
S RMPRFDA(660,"+1,",38)=RMPR6111("DESCRIPTION")
;
; for the type AM rec.
S RMPRFDA(660,"+1,",62)=RMPR60("PAT CAT")
S RMPRFDA(660,"+1,",63)=$G(RMPR60("SPEC CAT"))
;
; for the type AMS rec.
S RMPR699("IEN")=RMPR60("SITE IEN")
S RMPRFDA(660,"+1,",68)=RMPR60("GROUPER")
;
; for the type DES rec.
S RMPRERR=$$HCDES(.RMPR611,.RMPRTMP)
I RMPRERR S RMPRRET=2 G CREX
S RMPRFDA(660,"+1,",28)="RMPRTMP"
D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
I $D(RMPRFME) S RMPRRET=99 G CREX
S RMPR60("IEN")=RMPRIEN(1)
CREX Q RMPRRET
;
; UPD - Update existing 660 rec.
UPD(RMPR60,RMPR6111) ;
N RMPRFDA,RMPRFME,RMPRERR,RMPRI,X,Y,DA,RMPR611,RMPR611I,RMPRTMP
S RMPRERR=0
I $G(RMPR60("IEN"))="" S RMPRERR=1 G UPDX
S RMPRI=RMPR60("IEN")_","
I $D(RMPR6111("HCPCS")) D
. S RMPR611("HCPCS")=RMPR6111("HCPCS")
. S RMPRERR=$$HPACT^RMPRPIX1(.RMPR611)
. Q:RMPRERR
. S RMPRERR=$$HPETOI^RMPRPIX1(.RMPR611,.RMPR611I)
. Q:RMPRERR
. S RMPRERR=$$HCDES(.RMPR611,.RMPRTMP)
. Q:RMPRERR
. S RMPRFDA(660,RMPRI,28)="RMPRTMP"
. Q
I RMPRERR S RMPRERR=1 G UPDX
S:$D(RMPR60("ENTRY DATE")) RMPRFDA(660,RMPRI,.01)=RMPR60("ENTRY DATE")
S:$D(RMPR60("PATIENT IEN")) RMPRFDA(660,RMPRI,.02)=RMPR60("PATIENT IEN")
S:$D(RMPR60("REQ DATE")) RMPRFDA(660,RMPRI,1)=RMPR60("REQ DATE")
S:$D(RMPR60("ISSUE TYPE")) RMPRFDA(660,RMPRI,2)=RMPR60("ISSUE TYPE")
S:$D(RMPR60("IFCAP ITEM")) RMPRFDA(660,RMPRI,4)=RMPR60("IFCAP ITEM")
S:$D(RMPR60("QUANTITY")) RMPRFDA(660,RMPRI,5)=RMPR60("QUANTITY")
S:$D(RMPR6111("UNIT")) RMPRFDA(660,RMPRI,78)=RMPR6111("UNIT")
S:$D(RMPR60("VENDOR IEN")) RMPRFDA(660,RMPRI,7)=RMPR60("VENDOR IEN")
S:$D(RMPR6111("STATION IEN")) RMPRFDA(660,RMPRI,8)=RMPR6111("STATION IEN")
S:$D(RMPR60("SERIAL NUM")) RMPRFDA(660,RMPRI,9)=RMPR60("SERIAL NUM")
S:$D(RMPR60("DELIV DATE")) RMPRFDA(660,RMPRI,10)=RMPR60("DELIV DATE")
S:$D(RMPR60("DATE OF SERVICE")) RMPRFDA(660,RMPRI,39)=RMPR60("DATE OF SERVICE")
S:$D(RMPR60("REQ TYPE")) RMPRFDA(660,RMPRI,11)=RMPR60("REQ TYPE")
S:$D(RMPR60("SOURCE")) RMPRFDA(660,RMPRI,12)=RMPR60("SOURCE")
S:$D(RMPR60("COST")) RMPRFDA(660,RMPRI,14)=RMPR60("COST")
S:$D(RMPR60("REMARKS")) RMPRFDA(660,RMPRI,16)=RMPR60("REMARKS")
S:$D(RMPR60("TRANS IEN")) RMPRFDA(660,RMPRI,4.6)=RMPR60("TRANS IEN")
S:$D(RMPR60("CPT IEN")) RMPRFDA(660,RMPRI,4.1)=RMPR60("CPT IEN")
S:$D(RMPR60("LOT NUM")) RMPRFDA(660,RMPRI,21)=RMPR60("LOT NUM")
;
; for the type 1 rec.
S:$D(RMPR611("SHORT DESC")) RMPRFDA(660,RMPRI,24)=RMPR611("SHORT DESC")
S:$D(RMPR60("HCPCS")) RMPRFDA(660,RMPRI,4.5)=RMPR60("HCPCS")
;S:$D(RMPR611("IEN")) RMPRFDA(660,RMPRI,4.5)=RMPR611("IEN")
S:$D(RMPR60("CPT MOD")) RMPRFDA(660,RMPRI,4.7)=RMPR60("CPT MOD")
;
; for the type 2 rec.
S:$D(RMPR6111("HCPCS")) RMPRFDA(660,RMPRI,37)=RMPR6111("HCPCS")_"-"_RMPR6111("ITEM")
S:$D(RMPR6111("DESCRIPTION")) RMPRFDA(660,RMPRI,38)=RMPR6111("DESCRIPTION")
;
; for the type AM rec.
S:$D(RMPR60("PAT CAT")) RMPRFDA(660,RMPRI,62)=RMPR60("PAT CAT")
S:$D(RMPR60("SPEC CAT")) RMPRFDA(660,RMPRI,63)=RMPR60("SPEC CAT")
D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=1
UPDX Q RMPRERR
;
; Update AMIS grouper
AMGR(RMPR699) ;
N RMPRFDA,RMPRIEN,RMPRFME,X,Y,RMPRRET
S RMPRRET=0
S RMPRIEN=RMPR699("IEN")_","
L +^RMPR(669.9,RMPR699("IEN"))
S RMPR699("AMIS GROUPER")=$P(^RMPR(669.9,RMPR699("IEN"),0),"^",7)
S RMPR699("AMIS GROUPER")=RMPR699("AMIS GROUPER")-1
S RMPRFDA(669.9,RMPRIEN,11)=RMPR699("AMIS GROUPER")
D FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRRET=1
L -^RMPR(669.9,RMPR699("IEN"))
Q RMPRRET
;
; Read description for HCPCS
HCDES(RMPR611,RMPRFDA) ;
N RMPRIEN,RMPRFME,RMPRRET,RMPRTMP,RMPRI,RMPRJ
K RMPRFDA
S RMPRRET=0
S RMPRIEN=RMPR611("IEN")_","
D GETS^DIQ(661.1,RMPRIEN,"**","","RMPRTMP","RMPRFME")
I $D(RMPRFME) S RMPRRET=1 G HCDESX
S RMPRJ=0,RMPRI=""
F S RMPRI=$O(RMPRTMP(661.18,RMPRI)) Q:RMPRI="" D
. S RMPRJ=RMPRJ+1
. S RMPRFDA(RMPRJ)=RMPRTMP(661.18,RMPRI,.01)
. Q
HCDESX Q RMPRRET
;
; DEL - Delete a record
DEL(RMPR60) ;
N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
S RMPRERR=0
I $G(RMPR60("IEN"))="" S RMPRERR=1 G DELX
S RMPRIEN=RMPR60("IEN")_","
S RMPRFDA(660,RMPRIEN,.01)="@"
D FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=1
DELX Q RMPRERR
;
; GET - read in 660 record
GET(RMPR60,RMPR11) ;
S RMPRERR=$$GET^RMPRPIXC(.RMPR60,.RMPR11)
GETX Q RMPRERR
;
; ETOI - convert external to internal form
ETOI(RMPR60,RMPR11,RMPR60I,RMPR11I) ;
S RMPRERR=$$ETOI^RMPRPIXC(.RMPR60,.RMPR11,.RMPR60I,.RMPR11I)
ETOIX Q RMPRERR