source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUT.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1RMPRPIUT ;HINCIO/ODJ - STOCK TRANSFER TRANSACTION ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** TRNF - create stock transfer transaction.
6 ; implements business rules for transferring stock
7 ; from one location to another.
8 ;
9 ; Inputs:
10 ; RMPR - array with following elements...
11 ; RMPR("QUANTITY")
12 ; RMPR("VENDOR IEN")
13 ;
14 ; RMPR5F - array with 'From' Location data elements (661.5)...
15 ; RMPR5F("IEN") - ien of 'From' Location
16 ;
17 ; RMPR5T - array with 'To' Location data elements (661.5)...
18 ; RMPR5T("IEN") - ien of 'To' Location
19 ;
20 ; RMPR11 - array with HCPCS Item data elements (661.11)...
21 ; RMPR11("STATION IEN") - Station number (ptr DIC(4,)
22 ; RMPR11("HCPCS") - HCPCS Code
23 ; RMPR11("ITEM") - HCPCS Item number
24 ;
25 ; Outputs:
26 ; RMPRERR - error status returned by function
27 ; 0 - no problems
28 ; 1 - insufficient stock level at 'From' Location
29 ; 19 - problem getting current stock level
30 ; 29 - problem creating 'From' transfer
31 ; 39 - problem creating 'To' transfer
32 ;
33TRNF(RMPR,RMPR5F,RMPR5T,RMPR11) ;
34 N RMPRERR,RMPR6,RMPR7,RMPR7E,RMPR4,RMPRTCOS
35 S RMPRERR=0
36 S RMPR11("STATION")=RMPR11("STATION IEN")
37 S RMPR7("STATION IEN")=RMPR11("STATION IEN")
38 S RMPR7("LOCATION IEN")=RMPR5F("IEN")
39 S RMPR7("HCPCS")=RMPR11("HCPCS")
40 S RMPR7("ITEM")=RMPR11("ITEM")
41 S RMPR7("UNIT")=$G(RMPR5F("UNIT"))
42 S RMPR7("VENDOR IEN")=RMPR("VENDOR IEN")
43 ;
44 ; Lock file so that -ve stock not possible
45 L +^RMPR(661.7,"XSLHIDS",RMPR7("STATION IEN"),RMPR7("LOCATION IEN"),RMPR7("HCPCS"),RMPR7("ITEM"))
46 ;
47 ; Get item's total current stock for location and vendor
48 S RMPRERR=$$STOCK^RMPRPIUE(.RMPR7)
49 I RMPRERR S RMPRERR=19 G TRNFU ;error 19 problem getting cur. qty.
50 ;
51 ; If not enough available stock set error code 1 and exit
52 I RMPR("QUANTITY")>RMPR7("QOH") D G TRNFU
53 . S RMPRERR=1
54 . S RMPR("QOH")=RMPR7("QOH")
55 . Q
56 ;
57 ; Continue the transaction
58 S RMPR("STATION")=RMPR11("STATION IEN")
59 S RMPR("LOCATION")=RMPR5F("IEN")
60 S RMPR("HCPCS")=RMPR11("HCPCS")
61 S RMPR("ITEM")=RMPR11("ITEM")
62 S RMPRERR=$$QCOST(.RMPR,RMPR("QUANTITY"),.RMPRTCOS)
63 S RMPR("VALUE")=RMPRTCOS
64 ;
65 ; Create transfer 'OUT' transaction (661.6)
66 K RMPR6
67 S RMPR6("SEQUENCE")=1
68 S RMPR6("TRAN TYPE")=7
69 S RMPR6("COMMENT")=$G(RMPR("COMMENT"))
70 S RMPR6("QUANTITY")=0-RMPR("QUANTITY")
71 S RMPR6("VALUE")=0-RMPR("VALUE")
72 S RMPR6("USER")=RMPR("USER")
73 S RMPR6("LOCATION")=RMPR5F("IEN")
74 S RMPR6("UNIT")=$G(RMPR5F("UNIT"))
75 S RMPR6("VENDOR")=RMPR7("VENDOR IEN")
76 S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
77 I RMPRERR S RMPRERR=29 G TRNFU ;error 29 'From' transfer 661.6 problem
78 ;
79 ; Create transfer 'IN' transaction (661.6)
80 S RMPR6("QUANTITY")=RMPR("QUANTITY")
81 S RMPR6("VALUE")=RMPR("VALUE")
82 S RMPR6("LOCATION")=RMPR5T("IEN")
83 S RMPR6("UNIT")=$G(RMPR5T("UNIT"))
84 S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
85 I RMPRERR S RMPRERR=39 G TRNFU ;error 39 'To' transfer 661.6 problem
86 ;
87 ; See if need to create a PIP record in 661.4
88 I '$D(^RMPR(661.4,"ASLHI",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))) D
89 . K RMPR4
90 . S RMPR4("RE-ORDER QTY")=0
91 . S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5T)
92 . Q
93 I RMPRERR S RMPRERR=39 G TRNFU
94 ;
95 ; Update current stock
96 K RMPR7E
97 S RMPR7E("TRNF QTY")=RMPR("QUANTITY")
98 S RMPR7E("TRNF VALUE")=RMPR("VALUE")
99 S RMPR7E("VENDOR IEN")=RMPR("VENDOR IEN")
100 S RMPR7E("UNIT")=$G(RMPR("UNIT"))
101 S RMPRERR=$$TRNF^RMPRPIUC(.RMPR11,.RMPR5F,.RMPR5T,.RMPR7E)
102 I RMPRERR S RMPRERR=49 G TRNFU ;error 49 current stock update problem
103 ;
104 ; exit points
105TRNFU L -^RMPR(661.7,"XSLHIDS",RMPR7("STATION IEN"),RMPR7("LOCATION IEN"),RMPR7("HCPCS"),RMPR7("ITEM"))
106TRNFX Q RMPRERR
107 ;
108 ; Work out total cost of quantity based on FIFO principles
109QCOST(RMPRK,RMPRQTY,RMPRTCOS) ;
110 N RMPRERR,RMPR,RMPR6,RMPR7,RMPRVNDR,RMPRQ,RMPRUVAL,RMPROLD,RMPREOF
111 S RMPRERR=0
112 S RMPRTCOS=0
113 S RMPRQ=RMPRQTY
114 M RMPR=RMPRK
115 S RMPRVNDR=RMPRK("VENDOR IEN")
116QCOST1 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
117 I RMPRERR S RMPRERR=1 G QCOSTX
118 I RMPREOF G QCOSTX
119 I RMPR("STATION")'=RMPRK("STATION") G QCOSTX
120 I RMPR("LOCATION")'=RMPRK("LOCATION") G QCOSTX
121 I RMPR("HCPCS")'=RMPRK("HCPCS") G QCOSTX
122 I RMPR("ITEM")'=RMPRK("ITEM") G QCOSTX
123 K RMPR7 M RMPR7=RMPR
124 S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
125 I RMPRERR S RMPRERR=1 G QCOSTX
126 K RMPR6 M RMPR6=RMPR S RMPR6("IEN")=""
127 S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
128 S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
129 I RMPRERR S RMPRERR=1 G QCOSTX
130 I RMPR6("VENDOR IEN")'=RMPRVNDR G QCOST1
131 S RMPRUVAL=$J(RMPR7("VALUE")/RMPR7("QUANTITY"),"",2)
132 S RMPRTCOS=RMPRTCOS+(RMPRQ*RMPRUVAL)
133 I RMPR7("QUANTITY")<RMPRQ S RMPRQ=RMPRQ-RMPR7("QUANTITY") G QCOST1
134QCOSTX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.