RMPRPIUC ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01
 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
 Q
 ;
 ;
 ; Inputs:
 ;    RMPR11 - an array with the following elements...
 ;    RMPR11("STATION IEN")  - Station ien (ptr ^DIC(4,)
 ;    RMPR5F("IEN") - Location ien (ptr ^RMPR(661.5,)
 ;    RMPR11("HCPCS")        - HCPCS code (eg E0111)
 ;    RMPR11("ITEM")         - HCPCS Item number (eg 1)
 ;    RMPR("TRNF QTY")     - Quantity Transferred
 ;    RMPR("TRNF VALUE")   - Transfer Value
 ;    RMPR("VENDOR IEN")   - Vendor ien
 ;
 ; Outputs:
 ;    RMPRERR - function return...
 ;               0 - no errors
 ;               1 - null Station ien input
 ;               2 - null Location ien input
 ;               3 - null HCPCS code input
 ;               4 - null Item input
 ;               5 - transfer qty not greater than 0
 ;               6 - problem with 661.7 file
TRNF(RMPR11,RMPR5F,RMPR5T,RMPR) ;
 N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR7I,RMPRIBAL,RMPRVBAL
 N RMPRUVAL,RMPR7TI,RMPRTQTY,RMPRTVAL,RMPRTIEN,RMPR6
 S RMPRERR=0
 S RMPRK("STATION")=$G(RMPR11("STATION IEN"))
 I RMPRK("STATION")="" S RMPRERR=1 G TRNFX
 S RMPRK("UNIT")=$G(RMPR5F("UNIT"))
 S RMPRK("LOCATION")=$G(RMPR5F("IEN"))
 I RMPRK("LOCATION")="" S RMPRERR=2 G TRNFX
 S RMPRK("HCPCS")=$G(RMPR11("HCPCS"))
 I RMPRK("HCPCS")="" S RMPRERR=3 G TRNFX
 S RMPRK("ITEM")=$G(RMPR11("ITEM"))
 I RMPRK("ITEM")="" S RMPRERR=4 G TRNFX
 I '+$G(RMPR("TRNF QTY")) S RMPRERR=5 G TRNFX
 S RMPRIBAL=RMPR("TRNF QTY") ; init transfer qty. balance
 S RMPRVBAL=+$G(RMPR("TRNF VALUE")) ; init transfer value balance
 S RMPRUVAL=RMPRVBAL/RMPRIBAL ; unit cost per transferred item
 L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5F("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
 L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
 ;
 ; Loop on all records for Stn, Loc, HCPCS and Item until stock
 ; transferred
TRNFA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
 I RMPRERR S RMPRERR=6 G TRNFU
 I RMPREOF G TRNFU
 I RMPRK("ITEM")'=RMPROLD("ITEM") G TRNFU
 I RMPRK("HCPCS")'=RMPROLD("HCPCS") G TRNFU
 I RMPRK("LOCATION")'=RMPROLD("LOCATION") G TRNFU
 S RMPRK("UNIT")=$G(RMPROLD("UNIT"))
 I RMPRK("STATION")'=RMPROLD("STATION") G TRNFU
 K RMPR7 M RMPR7=RMPRK
 S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ; read in current stock rec.
 I RMPRERR S RMPRERR=6 G TRNFU
 K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
 S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
 S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
 I RMPR6("VENDOR IEN")'=RMPR("VENDOR IEN") G TRNFA
 K RMPR7TI,RMPR7I
 S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
 I RMPRERR S RMPRERR=6 G TRNFU
 S RMPR7TI("DATE&TIME")=RMPR7I("DATE&TIME")
 S RMPR7TI("SEQUENCE")=RMPR7I("SEQUENCE")
 K RMPR7I
 S RMPR7I("IEN")=RMPR7("IEN")
 S RMPR7I("QUANTITY")=RMPR7("QUANTITY")
 S RMPR7I("VALUE")=RMPR7("VALUE")
 ;
 ; If issued balance less than on-hand quantity then update
 ; the on-hand record
 I RMPRIBAL<RMPR7I("QUANTITY") D
 . S RMPR7I("QUANTITY")=RMPR7I("QUANTITY")-RMPRIBAL
 . S RMPR7I("VALUE")=RMPR7I("VALUE")-RMPRVBAL
 . S RMPRTQTY=RMPRIBAL
 . S RMPRTVAL=RMPRVBAL
 . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7I,)
 . S RMPRIBAL=0
 . Q
 ;
 ; If issued balance not less than on-hand quantity then delete
 ; the on-hand record
 E  D
 . S RMPRIBAL=RMPRIBAL-RMPR7I("QUANTITY")
 . S RMPRTQTY=RMPR7I("QUANTITY")
 . S RMPRTVAL=$J(RMPR7I("QUANTITY")*RMPRUVAL,0,2)
 . S RMPRVBAL=RMPRVBAL-RMPRTVAL
 . S RMPRERR=$$DEL^RMPRPIX7(.RMPR7I)
 . Q
 I RMPRERR S RMPRERR=6 G TRNFU
 ;
 ; Increase the 'TO' transfer record
 S RMPRTIEN=$O(^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR7TI("DATE&TIME"),RMPR7TI("SEQUENCE"),""))
 I RMPRTIEN="" D
 . S RMPR7TI("IEN")=""
 . S RMPR7TI("QUANTITY")=RMPRTQTY
 . S RMPR7TI("VALUE")=RMPRTVAL
 . S RMPR7TI("LOCATION")=RMPR5T("IEN")
 . S RMPR7TI("UNIT")=$G(RMPR5T("UNIT"))
 . S RMPRERR=$$CRE^RMPRPIX7(.RMPR7TI,.RMPR11)
 . I RMPRERR S RMPRERR=6
 . Q
 E  D
 . K RMPR7
 . S RMPR7("IEN")=RMPRTIEN
 . S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
 . I RMPRERR S RMPRERR=6 Q
 . K RMPR7TI
 . S RMPR7TI("IEN")=RMPRTIEN
 . S RMPR7TI("QUANTITY")=RMPR7("QUANTITY")+RMPRTQTY
 . S RMPR7TI("UNIT")=$G(RMPR5T("UNIT"))
 . S RMPR7TI("VALUE")=RMPR7("VALUE")+RMPRTVAL
 . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7TI,.RMPR11)
 . I RMPRERR S RMPRERR=6 Q
 . Q
 I RMPRERR G TRNFU
 G:RMPRIBAL TRNFA ; next stock rec. if still got transfer balance
 ;
 ; exit points
TRNFU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5F("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
 L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
TRNFX Q RMPRERR