133 lines
4.7 KiB
Mathematica
133 lines
4.7 KiB
Mathematica
RMPRPIU3 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT DELETE UILITY ;3/8/01
|
|
;;3.0;PROSTHETICS;**61,117**;Feb 09, 1996
|
|
Q
|
|
;
|
|
; DEL - Delete a Stock 'Issue to Patient' Transaction
|
|
; Deletes the 2319 record in file 660
|
|
; the patient issue record in 661.63
|
|
; Creates a type 8 'Return In' transaction
|
|
; Brings back issue quantity into stock
|
|
; Updates running balance
|
|
;
|
|
; Inputs:
|
|
; RMPR60 - array of data fields for 660 file record...
|
|
; RMPR60("IEN") must be set to the ien of 660 rec.
|
|
; being deleted.
|
|
; RMPR60("IEN") - IEN of 660 record being deleted
|
|
;
|
|
; Outputs:
|
|
; RMPRERR - 0 - no problems
|
|
; 11 - problem reading 660 rec. to delete
|
|
; 12 - problem reading 661.6 rec. to delete
|
|
; 29 - problem with 660 rec. delete
|
|
; 39 - problem with 661.6,661.63 rec. delete
|
|
; 49 - problem with 661.6 return rec. creation
|
|
; 59 - problem with bringing back into stock
|
|
;
|
|
DEL(RMPR60) ;
|
|
N RMPRERR,RMPRC60,RMPRC60I,RMPRC1,RMPRC1I,RMPRC6,RMPRC6I
|
|
N RMPRC5,RMPRC11,RMPRRET,RMPR7R
|
|
S RMPRERR=0
|
|
;
|
|
; STEP 1
|
|
; read in existing 660 and 661.6 recs.
|
|
S RMPRC60("IEN")=RMPR60("IEN")
|
|
S RMPRERR=$$GET^RMPRPIX2(.RMPRC60,.RMPRC1) ;read in current 660 rec
|
|
I RMPRERR S RMPRERR=11 G DELX
|
|
S RMPRERR=$$ETOI^RMPRPIX2(.RMPRC60,.RMPRC1,.RMPRC60I,.RMPRC1I)
|
|
I RMPRERR S RMPRERR=11 G DELX
|
|
S RMPRC6("IEN")=RMPRC60("TRANS IEN")
|
|
S RMPRERR=$$GET^RMPRPIX6(.RMPRC6) ;read in current 661.6 rec
|
|
I RMPRERR S RMPRERR=12 G DELX
|
|
S RMPRERR=$$ETOI^RMPRPIX6(.RMPRC6,.RMPRC6I)
|
|
I RMPRERR S RMPRERR=12 G DELX
|
|
S RMPRC5("IEN")=RMPRC6I("LOCATION")
|
|
S RMPRC11("STATION")=RMPRC6I("STATION")
|
|
S RMPRC11("STATION IEN")=RMPRC6I("STATION")
|
|
S RMPRC11("HCPCS")=RMPRC6I("HCPCS")
|
|
S RMPRC11("ITEM")=RMPRC6I("ITEM")
|
|
S RMST1=RMPRC6I("STATION"),RMHC1=RMPRC6I("HCPCS")
|
|
S RMLO1=RMPRC6I("LOCATION"),RMIT1=RMPRC6I("ITEM")
|
|
;
|
|
; STEP 2
|
|
; Delete the 660 record
|
|
S RMPRERR=$$DEL^RMPRPIX2(.RMPR60)
|
|
I RMPRERR S RMPRERR=29 G DELX ;err 29 if 660 delete problem
|
|
;
|
|
; STEP 3
|
|
; get 661.63 information
|
|
K RMDTTIM
|
|
S RM6613I=$O(^RMPR(661.63,"B",RMPRC6("IEN"),0))
|
|
I $G(RM6613I),$D(^RMPR(661.63,RM6613I,0)) D
|
|
.S RM63DAT=$G(^RMPR(661.63,RM6613I,0))
|
|
.S RMDTTIM=$P(RM63DAT,U,6)
|
|
.Q:'$G(RMDTTIM)
|
|
.S RMPRRET("DATE&TIME")=RMDTTIM
|
|
.S RMPRRET("QUANTITY")=$P(RM63DAT,U,12)
|
|
.S RMPRRET("VALUE")=$P(RM63DAT,U,10)
|
|
.S RMPRRET("UNIT")=$P(RM63DAT,U,11)
|
|
.S RMPRRET("VENDOR")=$P(RM63DAT,U,9)
|
|
.S RMPRRET("LOCATION")=$P(RM63DAT,U,8)
|
|
; Delete 661.63 Patient Issue record
|
|
S RMPRERR=$$DEL^RMPRPIX3(.RMPRC6)
|
|
I RMPRERR S RMPRERR=39
|
|
;
|
|
; STEP 4
|
|
; Create a Return to Stock Record
|
|
S RMPRRET("SEQUENCE")=1
|
|
S RMPRRET("TRAN TYPE")=8
|
|
S RMPRRET("COMMENT")=""
|
|
S RMPRRET("USER")=$G(DUZ)
|
|
I '$D(RMPRRET("QUANTITY")) S RMPRRET("QUANTITY")=RMPRC60I("QUANTITY")
|
|
I '$D(RMPRRET("VALUE")) S RMPRRET("VALUE")=$G(RMPRC60I("COST"))
|
|
I '$D(RMPRRET("UNIT")) S RMPRRET("UNIT")=$G(RMPRC60I("UNIT"))
|
|
I '$D(RMPRRET("VENDOR")) S RMPRRET("VENDOR")=$G(RMPRC60I("VENDOR"))
|
|
I '$D(RMPRRET("LOCATION")) S RMPRRET("LOCATION")=$G(RMPRC5("IEN"))
|
|
S RMPRERR=$$CRE^RMPRPIX6(.RMPRRET,.RMPRC11)
|
|
I RMPRERR S RMPRERR=49
|
|
;
|
|
; STEP 5
|
|
; Bring back into current stock
|
|
D NOW^%DTC
|
|
S RMPR7R("STATION")=RMPRC11("STATION")
|
|
S RMPR7R("HCPCS")=RMPRC11("HCPCS")
|
|
S RMPR7R("ITEM")=RMPRC11("ITEM")
|
|
S RMPR7R("LOCATION")=RMPRC5("IEN")
|
|
S RMPR7R("VENDOR")=RMPRRET("VENDOR")
|
|
S RMPR7R("DATE&TIME")=% S:$G(RMPRRET("DATE&TIME"))'="" RMPR7R("DATE&TIME")=RMPRRET("DATE&TIME")
|
|
S RMPR7R("SEQUENCE")=RMPRRET("SEQUENCE")
|
|
S RMPR7R("QUANTITY")=RMPRRET("QUANTITY")
|
|
S RMPR7R("VALUE")=RMPRRET("VALUE")
|
|
S RMPR7R("UNIT")=$G(RMPRRET("UNIT"))
|
|
I $G(RMDTTIM),$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=71
|
|
.S RMPR7R("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM,1,0))
|
|
.I '$G(RMPR7R("IEN")) S RMPRERR=1 Q
|
|
.S RMDA7=$G(^RMPR(661.7,RMPR7R("IEN"),0))
|
|
.S RMDAVAL=$P(RMDA7,U,8),RMDAQUA=$P(RMDA7,U,7)
|
|
.S RMPR7R("QUANTITY")=RMPR7R("QUANTITY")+RMDAQUA
|
|
.S RMPR7R("VALUE")=RMPR7R("VALUE")+RMDAVAL
|
|
.S RMPRERR=0
|
|
.S RMPR7R("DATE&TIME")=RMDTTIM
|
|
.S RMPRERR=$$UPD^RMPRPIX7(.RMPR7R,.RMPRC11)
|
|
I $G(RMDTTIM),'$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=72
|
|
.S RMPRERR=0
|
|
.S RMPR7R("DATE&TIME")=RMDTTIM
|
|
.S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPRC11)
|
|
I '$G(RMDTTIM) D I RMPRERR S RMPRERR=73
|
|
.;create an entry
|
|
.S RMPRERR=0
|
|
.S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPRC11)
|
|
;update 661.9
|
|
S RMPR9("STA")=RMPRC6I("STATION")
|
|
S RMPR9("HCP")=RMPRC6I("HCPCS")
|
|
S RMPR9("ITE")=RMPRC6I("ITEM")
|
|
S RMPR9("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
|
|
S RMPR9("TQTY")=RMPRC6I("QUANTITY")
|
|
S RMPR9("TCST")=RMPRC6I("VALUE")
|
|
S RMPRERR=0
|
|
S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9)
|
|
I RMPRERR S RMPRERR=59
|
|
;
|
|
;exit
|
|
DELX Q RMPRERR
|