Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPIU3

RMPRPIU3.m

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