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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIU3 4942 printed Sep 23, 2025@20:12:25 Page 2
RMPRPIU3 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT DELETE UILITY ;3/8/01
+1 ;;3.0;PROSTHETICS;**61,117**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ; DEL - Delete a Stock 'Issue to Patient' Transaction
+5 ; Deletes the 2319 record in file 660
+6 ; the patient issue record in 661.63
+7 ; Creates a type 8 'Return In' transaction
+8 ; Brings back issue quantity into stock
+9 ; Updates running balance
+10 ;
+11 ; Inputs:
+12 ; RMPR60 - array of data fields for 660 file record...
+13 ; RMPR60("IEN") must be set to the ien of 660 rec.
+14 ; being deleted.
+15 ; RMPR60("IEN") - IEN of 660 record being deleted
+16 ;
+17 ; Outputs:
+18 ; RMPRERR - 0 - no problems
+19 ; 11 - problem reading 660 rec. to delete
+20 ; 12 - problem reading 661.6 rec. to delete
+21 ; 29 - problem with 660 rec. delete
+22 ; 39 - problem with 661.6,661.63 rec. delete
+23 ; 49 - problem with 661.6 return rec. creation
+24 ; 59 - problem with bringing back into stock
+25 ;
DEL(RMPR60) ;
+1 NEW RMPRERR,RMPRC60,RMPRC60I,RMPRC1,RMPRC1I,RMPRC6,RMPRC6I
+2 NEW RMPRC5,RMPRC11,RMPRRET,RMPR7R
+3 SET RMPRERR=0
+4 ;
+5 ; STEP 1
+6 ; read in existing 660 and 661.6 recs.
+7 SET RMPRC60("IEN")=RMPR60("IEN")
+8 ;read in current 660 rec
SET RMPRERR=$$GET^RMPRPIX2(.RMPRC60,.RMPRC1)
+9 IF RMPRERR
SET RMPRERR=11
GOTO DELX
+10 SET RMPRERR=$$ETOI^RMPRPIX2(.RMPRC60,.RMPRC1,.RMPRC60I,.RMPRC1I)
+11 IF RMPRERR
SET RMPRERR=11
GOTO DELX
+12 SET RMPRC6("IEN")=RMPRC60("TRANS IEN")
+13 ;read in current 661.6 rec
SET RMPRERR=$$GET^RMPRPIX6(.RMPRC6)
+14 IF RMPRERR
SET RMPRERR=12
GOTO DELX
+15 SET RMPRERR=$$ETOI^RMPRPIX6(.RMPRC6,.RMPRC6I)
+16 IF RMPRERR
SET RMPRERR=12
GOTO DELX
+17 SET RMPRC5("IEN")=RMPRC6I("LOCATION")
+18 SET RMPRC11("STATION")=RMPRC6I("STATION")
+19 SET RMPRC11("STATION IEN")=RMPRC6I("STATION")
+20 SET RMPRC11("HCPCS")=RMPRC6I("HCPCS")
+21 SET RMPRC11("ITEM")=RMPRC6I("ITEM")
+22 SET RMST1=RMPRC6I("STATION")
SET RMHC1=RMPRC6I("HCPCS")
+23 SET RMLO1=RMPRC6I("LOCATION")
SET RMIT1=RMPRC6I("ITEM")
+24 ;
+25 ; STEP 2
+26 ; Delete the 660 record
+27 SET RMPRERR=$$DEL^RMPRPIX2(.RMPR60)
+28 ;err 29 if 660 delete problem
IF RMPRERR
SET RMPRERR=29
GOTO DELX
+29 ;
+30 ; STEP 3
+31 ; get 661.63 information
+32 KILL RMDTTIM
+33 SET RM6613I=$ORDER(^RMPR(661.63,"B",RMPRC6("IEN"),0))
+34 IF $GET(RM6613I)
IF $DATA(^RMPR(661.63,RM6613I,0))
Begin DoDot:1
+35 SET RM63DAT=$GET(^RMPR(661.63,RM6613I,0))
+36 SET RMDTTIM=$PIECE(RM63DAT,U,6)
+37 if '$GET(RMDTTIM)
QUIT
+38 SET RMPRRET("DATE&TIME")=RMDTTIM
+39 SET RMPRRET("QUANTITY")=$PIECE(RM63DAT,U,12)
+40 SET RMPRRET("VALUE")=$PIECE(RM63DAT,U,10)
+41 SET RMPRRET("UNIT")=$PIECE(RM63DAT,U,11)
+42 SET RMPRRET("VENDOR")=$PIECE(RM63DAT,U,9)
+43 SET RMPRRET("LOCATION")=$PIECE(RM63DAT,U,8)
End DoDot:1
+44 ; Delete 661.63 Patient Issue record
+45 SET RMPRERR=$$DEL^RMPRPIX3(.RMPRC6)
+46 IF RMPRERR
SET RMPRERR=39
+47 ;
+48 ; STEP 4
+49 ; Create a Return to Stock Record
+50 SET RMPRRET("SEQUENCE")=1
+51 SET RMPRRET("TRAN TYPE")=8
+52 SET RMPRRET("COMMENT")=""
+53 SET RMPRRET("USER")=$GET(DUZ)
+54 IF '$DATA(RMPRRET("QUANTITY"))
SET RMPRRET("QUANTITY")=RMPRC60I("QUANTITY")
+55 IF '$DATA(RMPRRET("VALUE"))
SET RMPRRET("VALUE")=$GET(RMPRC60I("COST"))
+56 IF '$DATA(RMPRRET("UNIT"))
SET RMPRRET("UNIT")=$GET(RMPRC60I("UNIT"))
+57 IF '$DATA(RMPRRET("VENDOR"))
SET RMPRRET("VENDOR")=$GET(RMPRC60I("VENDOR"))
+58 IF '$DATA(RMPRRET("LOCATION"))
SET RMPRRET("LOCATION")=$GET(RMPRC5("IEN"))
+59 SET RMPRERR=$$CRE^RMPRPIX6(.RMPRRET,.RMPRC11)
+60 IF RMPRERR
SET RMPRERR=49
+61 ;
+62 ; STEP 5
+63 ; Bring back into current stock
+64 DO NOW^%DTC
+65 SET RMPR7R("STATION")=RMPRC11("STATION")
+66 SET RMPR7R("HCPCS")=RMPRC11("HCPCS")
+67 SET RMPR7R("ITEM")=RMPRC11("ITEM")
+68 SET RMPR7R("LOCATION")=RMPRC5("IEN")
+69 SET RMPR7R("VENDOR")=RMPRRET("VENDOR")
+70 SET RMPR7R("DATE&TIME")=%
if $GET(RMPRRET("DATE&TIME"))'=""
SET RMPR7R("DATE&TIME")=RMPRRET("DATE&TIME")
+71 SET RMPR7R("SEQUENCE")=RMPRRET("SEQUENCE")
+72 SET RMPR7R("QUANTITY")=RMPRRET("QUANTITY")
+73 SET RMPR7R("VALUE")=RMPRRET("VALUE")
+74 SET RMPR7R("UNIT")=$GET(RMPRRET("UNIT"))
+75 IF $GET(RMDTTIM)
IF $DATA(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM))
Begin DoDot:1
+76 SET RMPR7R("IEN")=$ORDER(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM,1,0))
+77 IF '$GET(RMPR7R("IEN"))
SET RMPRERR=1
QUIT
+78 SET RMDA7=$GET(^RMPR(661.7,RMPR7R("IEN"),0))
+79 SET RMDAVAL=$PIECE(RMDA7,U,8)
SET RMDAQUA=$PIECE(RMDA7,U,7)
+80 SET RMPR7R("QUANTITY")=RMPR7R("QUANTITY")+RMDAQUA
+81 SET RMPR7R("VALUE")=RMPR7R("VALUE")+RMDAVAL
+82 SET RMPRERR=0
+83 SET RMPR7R("DATE&TIME")=RMDTTIM
+84 SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7R,.RMPRC11)
End DoDot:1
IF RMPRERR
SET RMPRERR=71
+85 IF $GET(RMDTTIM)
IF '$DATA(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM))
Begin DoDot:1
+86 SET RMPRERR=0
+87 SET RMPR7R("DATE&TIME")=RMDTTIM
+88 SET RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPRC11)
End DoDot:1
IF RMPRERR
SET RMPRERR=72
+89 IF '$GET(RMDTTIM)
Begin DoDot:1
+90 ;create an entry
+91 SET RMPRERR=0
+92 SET RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPRC11)
End DoDot:1
IF RMPRERR
SET RMPRERR=73
+93 ;update 661.9
+94 SET RMPR9("STA")=RMPRC6I("STATION")
+95 SET RMPR9("HCP")=RMPRC6I("HCPCS")
+96 SET RMPR9("ITE")=RMPRC6I("ITEM")
+97 SET RMPR9("RDT")=$PIECE(RMPRC6I("DATE&TIME"),".",1)
+98 SET RMPR9("TQTY")=RMPRC6I("QUANTITY")
+99 SET RMPR9("TCST")=RMPRC6I("VALUE")
+100 SET RMPRERR=0
+101 SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9)
+102 IF RMPRERR
SET RMPRERR=59
+103 ;
+104 ;exit
DELX QUIT RMPRERR
