source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIU1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1RMPRPIU1 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT UPDATE UILITY ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; MOD - Modify a Stock 'Issue to Patient' Transaction
6 ;
7 ; Inputs:
8 ; RMPR60 - array of data fields for 660 file record...
9 ; RMPR60("IEN") must be set to the ien of 660 rec.
10 ; being modified.
11 ; The other elements should ONLY be set if modifying.
12 ; RMPR60("IEN") - IEN of 660 record being modified
13 ; RMPR60("PATIENT IEN")- Prosthetic Patient
14 ; (.01 field ptr to ^RMPR(665,)
15 ; RMPR60("ISSUE TYPE") - Type of Issue (fld 2 - see FM set of codes)
16 ; RMPR60("QUANTITY") - Number of items issued (fld 5)
17 ; RMPR60("IFCAP ITEM") - IFCAP item (fld 4 ptr to ^RMPR(661,)
18 ; RMPR60("VENDOR IEN") - Item Vendor (fld 7 ptr to ^PRC(440,)
19 ; RMPR60("SERIAL NUM") - Serial Number (fld 9)
20 ; RMPR60("REQ TYPE") - Request Type (fld 11 - see FM set of codes)
21 ; RMPR60("REMARKS") - Comments (fld 16)
22 ; RMPR60("LOT NUM") - Lot number (fld 21)
23 ; RMPR60("CPT MOD") - CPT modifier string (fld 4.7)
24 ; RMPR60("COST") - Total value of issue (fld 14)
25 ; RMPR60("CPT IEN") - field 21 ptr to ^ICPT
26 ; RMPR60("SITE IEN") - ptr to prosthetic site param file 669.9
27 ; RMPR60("PAT CAT") - Patient category
28 ; (fld 62 see FM set of codes)
29 ; RMPR60("SPEC CAT") - fld 63
30 ;
31 ; RMPR11 - array of data fields for 661.11 record
32 ; If any changes then RMPR11("HCPCS"), RMPR11("ITEM")
33 ; and RMPR11("DESCRIPTION") must be set, otherwise only
34 ; set those fields which are being changed.
35 ; RMPR11("STATION") - Station ien
36 ; RMPR11("HCPCS") - HCPCS code
37 ; RMPR11("ITEM") - Item number
38 ; RMPR11("UNIT") - Unit (optional)
39 ; RMPR11("DESCRIPTION") - Item description
40 ; RMPR11("SOURCE") - V - VA, C - Commercial
41 ;
42 ; RMPR5 - array of data fields for 661.5 record
43 ; only set if modifying stock location
44 ; RMPR5("IEN") - Location ien (ptr to ^RMPR(661.5,)
45 ;
46MOD(RMPR60,RMPR11,RMPR5) ;
47 N RMPRERR,RMPR6,RMPR9,RMPR1,RMPRCSTK,RMPR,RMPRQDIF,RMPRVDIF,RMPRC5
48 N RMPRC6,RMPRC60,RMPRC11,RMPRC1,RMPRC6I,RMPRC60I,RMPRC1I,RMPRIREV
49 S RMPRERR=0
50 S:$D(RMPR11("STATION")) RMPR11("STATION IEN")=RMPR11("STATION")
51 ;
52 ; STEP 1
53 ; read in existing 660 and 661.6 recs.
54 S RMPRC60("IEN")=RMPR60("IEN")
55 M:$D(RMPR11) RMPRC11=RMPR11
56 S:$D(RMPR5("IEN")) RMPRC5("IEN")=RMPR5("IEN")
57 S RMPRERR=$$GET^RMPRPIX2(.RMPRC60,.RMPRC11) ;660 rec
58 I RMPRERR S RMPRERR=11 G MODX^RMPRPIU2
59 S RMPRERR=$$ETOI^RMPRPIX2(.RMPRC60,.RMPRC11,.RMPRC60I,.RMPRC1I)
60 I RMPRERR S RMPRERR=11 G MODX^RMPRPIU2
61 S RMPRC6("IEN")=RMPRC60("TRANS IEN")
62 S RMPRERR=$$GET^RMPRPIX6(.RMPRC6) ;661.6 rec
63 I RMPRERR S RMPRERR=12 G MODX^RMPRPIU2
64 S RMPRERR=$$ETOI^RMPRPIX6(.RMPRC6,.RMPRC6I)
65 I RMPRERR S RMPRERR=12 G MODX^RMPRPIU2
66 S:'$D(RMPR5("IEN")) RMPRC5("IEN")=RMPRC6I("LOCATION")
67 I '$D(RMPR11("STATION IEN")) D
68 . S RMPRC11("STATION")=RMPRC6I("STATION")
69 . S RMPRC11("STATION IEN")=RMPRC6I("STATION")
70 . Q
71 S:'$D(RMPR11("HCPCS")) RMPRC11("HCPCS")=RMPRC6I("HCPCS")
72 S:'$D(RMPR11("ITEM")) RMPRC11("ITEM")=RMPRC6I("ITEM")
73 S RMPRC60("VENDOR IEN")=$S('$D(RMPR60("VENDOR IEN")):RMPRC6I("VENDOR"),1:RMPR60("VENDOR IEN"))
74 S RMPRQDIF=""
75 I $D(RMPR60("QUANTITY")) S RMPRQDIF=RMPR60("QUANTITY")-RMPRC60I("QUANTITY")
76 S RMPRVDIF=""
77 I $D(RMPR60("COST")) S RMPRVDIF=RMPR60("COST")-RMPRC60I("COST")
78 ;
79 ; STEP 2
80 ; if HCPCS, Item, Location, Vendor, Quanity or Cost has changed
81 ; then need to go to the complex update rules at MOD3
82 ; otherwise just update the 660
83 S RMPRIREV=1 ;set if HCPCS, Item, Vendor or Location modified
84 I RMPRC6I("HCPCS")'=RMPRC11("HCPCS") G MOD3
85 I RMPRC6I("ITEM")'=RMPRC11("ITEM") G MOD3
86 I RMPRC6I("VENDOR")'=RMPRC60("VENDOR IEN") G MOD3
87 I RMPRC6I("LOCATION")'=RMPRC5("IEN") G MOD3
88 S RMPRIREV=0 ;only qty. or cost may have changed
89 I +RMPRQDIF G MOD3
90 I +RMPRVDIF G MOD3
91 ;
92 ; if we get here just update 660 and exit
93 S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11)
94 G MODX^RMPRPIU2
95 ;
96 ; if we get here then update is complex
97MOD3 G MOD3^RMPRPIU2
98 ;
99 ; REVI - bring back Issue transaction into stock
100REVI(RMPRC6I) ;
101 Q $$REVI^RMPRPIU2(.RMPRC6I)
Note: See TracBrowser for help on using the repository browser.