source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIU7.m@ 1076

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1RMPRPIU7 ;HINCIO/ODJ - PIP STOCK RECEIPT UPDATE UTILITY ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** REC - Create a Stock Receipt Transaction
6 ; implements business rules for Stock Receipt
7 ; called by RMPRPIY9
8 ;
9 ; Inputs:
10 ; RMPR6 - Transaction (661.6) array elements
11 ; RMPR6("VENDOR") - Vendor ien
12 ; RMPR6("QUANTITY") - Receipt quantity
13 ; RMPR6("VALUE") - Total $ value of received quantity
14 ; RMPR6("COMMENT") - (optional) comment
15 ;
16 ; RMPR11 - HCPCS Item (661.11) array elements
17 ; RMPR11("STATION IEN")
18 ; RMPR11("HCPCS")
19 ; RMPR11("ITEM")
20 ;
21 ; RMPR5 - Location (661.5) array elements
22 ; RMPR5("IEN") - Location ien (ptr ^RMPR(661.5,)
23 ;
24 ; RMPR4
25 ;
26 ; Outputs:
27 ; RMPR6("IEN")
28 ; RMPR4("IEN")
29 ; RMPRERR
30 ;
31REC(RMPR6,RMPR11,RMPR5) ;
32 N RMPRERR,RMPR6I,RMPR7,RMPR9
33 S RMPRERR=0
34 S RMPR6("COMMENT")=$G(RMPR6("COMMENT"))
35 S RMPR6("SEQUENCE")=1
36 S RMPR6("TRAN TYPE")=1
37 S RMPR6("LOCATION")=$G(RMPR5("IEN"))
38 S RMPR6("HCPCS")=$G(RMPR11("HCPCS"))
39 S RMPR6("ITEM")=$G(RMPR11("ITEM"))
40 S RMPR6("USER")=$G(DUZ)
41 I RMPR6("QUANTITY")=0 G RECX
42 ;
43 ; Lock current stock to prevent simultaneous access at HCPCS Item level
44 L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
45 ;
46 ; Create 661.6 Transaction record
47 S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
48 I RMPRERR S RMPRERR=19 G RECU ;error 19 problem with 661.6 create
49 ;
50 ; Create 661.7 Current Stock record
51 S RMPR7("DATE&TIME")=RMPR6("DATE&TIME")
52 S RMPR7("SEQUENCE")=RMPR6("SEQUENCE")
53 S RMPR7("QUANTITY")=RMPR6("QUANTITY")
54 S RMPR7("VALUE")=RMPR6("VALUE")
55 S RMPR7("LOCATION")=RMPR6("LOCATION")
56 S RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR11)
57 I RMPRERR S RMPRERR=29 G RECU ;error 29 problem with 661.7 create
58 ;
59 ; Update 661.9 Daily Running Balance record
60 S RMPR9("STA")=RMPR11("STATION")
61 S RMPR9("HCP")=RMPR11("HCPCS")
62 S RMPR9("ITE")=RMPR11("ITEM")
63 S RMPR9("RDT")=$P(RMPR6("DATE&TIME"),".",1)
64 S RMPR9("TQTY")=RMPR6("QUANTITY")
65 S RMPR9("TCST")=RMPR6("VALUE")
66 S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) ;error 49 problem with 661.9 update
67 I RMPRERR S RMPRERR=49 G RECU ;error 49 problem with 661.9 update
68 ;
69 ; Update 661.41 orders record
70 S RMPRERR=$$UPORD^RMPRPIU8(RMPR11("STATION IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("QUANTITY"),RMPR6("VENDOR"))
71 I RMPRERR S RMPRERR=59 G RECU ;error 59 problem with Orders update
72 ;
73 ; Exit points
74RECU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
75RECX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.