source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIU3.m@ 1780

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