source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUC.m@ 1747

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1RMPRPIUC ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;
6 ; Inputs:
7 ; RMPR11 - an array with the following elements...
8 ; RMPR11("STATION IEN") - Station ien (ptr ^DIC(4,)
9 ; RMPR5F("IEN") - Location ien (ptr ^RMPR(661.5,)
10 ; RMPR11("HCPCS") - HCPCS code (eg E0111)
11 ; RMPR11("ITEM") - HCPCS Item number (eg 1)
12 ; RMPR("TRNF QTY") - Quantity Transferred
13 ; RMPR("TRNF VALUE") - Transfer Value
14 ; RMPR("VENDOR IEN") - Vendor ien
15 ;
16 ; Outputs:
17 ; RMPRERR - function return...
18 ; 0 - no errors
19 ; 1 - null Station ien input
20 ; 2 - null Location ien input
21 ; 3 - null HCPCS code input
22 ; 4 - null Item input
23 ; 5 - transfer qty not greater than 0
24 ; 6 - problem with 661.7 file
25TRNF(RMPR11,RMPR5F,RMPR5T,RMPR) ;
26 N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR7I,RMPRIBAL,RMPRVBAL
27 N RMPRUVAL,RMPR7TI,RMPRTQTY,RMPRTVAL,RMPRTIEN,RMPR6
28 S RMPRERR=0
29 S RMPRK("STATION")=$G(RMPR11("STATION IEN"))
30 I RMPRK("STATION")="" S RMPRERR=1 G TRNFX
31 S RMPRK("UNIT")=$G(RMPR5F("UNIT"))
32 S RMPRK("LOCATION")=$G(RMPR5F("IEN"))
33 I RMPRK("LOCATION")="" S RMPRERR=2 G TRNFX
34 S RMPRK("HCPCS")=$G(RMPR11("HCPCS"))
35 I RMPRK("HCPCS")="" S RMPRERR=3 G TRNFX
36 S RMPRK("ITEM")=$G(RMPR11("ITEM"))
37 I RMPRK("ITEM")="" S RMPRERR=4 G TRNFX
38 I '+$G(RMPR("TRNF QTY")) S RMPRERR=5 G TRNFX
39 S RMPRIBAL=RMPR("TRNF QTY") ; init transfer qty. balance
40 S RMPRVBAL=+$G(RMPR("TRNF VALUE")) ; init transfer value balance
41 S RMPRUVAL=RMPRVBAL/RMPRIBAL ; unit cost per transferred item
42 L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5F("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
43 L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
44 ;
45 ; Loop on all records for Stn, Loc, HCPCS and Item until stock
46 ; transferred
47TRNFA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
48 I RMPRERR S RMPRERR=6 G TRNFU
49 I RMPREOF G TRNFU
50 I RMPRK("ITEM")'=RMPROLD("ITEM") G TRNFU
51 I RMPRK("HCPCS")'=RMPROLD("HCPCS") G TRNFU
52 I RMPRK("LOCATION")'=RMPROLD("LOCATION") G TRNFU
53 S RMPRK("UNIT")=$G(RMPROLD("UNIT"))
54 I RMPRK("STATION")'=RMPROLD("STATION") G TRNFU
55 K RMPR7 M RMPR7=RMPRK
56 S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ; read in current stock rec.
57 I RMPRERR S RMPRERR=6 G TRNFU
58 K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
59 S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
60 S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
61 I RMPR6("VENDOR IEN")'=RMPR("VENDOR IEN") G TRNFA
62 K RMPR7TI,RMPR7I
63 S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
64 I RMPRERR S RMPRERR=6 G TRNFU
65 S RMPR7TI("DATE&TIME")=RMPR7I("DATE&TIME")
66 S RMPR7TI("SEQUENCE")=RMPR7I("SEQUENCE")
67 K RMPR7I
68 S RMPR7I("IEN")=RMPR7("IEN")
69 S RMPR7I("QUANTITY")=RMPR7("QUANTITY")
70 S RMPR7I("VALUE")=RMPR7("VALUE")
71 ;
72 ; If issued balance less than on-hand quantity then update
73 ; the on-hand record
74 I RMPRIBAL<RMPR7I("QUANTITY") D
75 . S RMPR7I("QUANTITY")=RMPR7I("QUANTITY")-RMPRIBAL
76 . S RMPR7I("VALUE")=RMPR7I("VALUE")-RMPRVBAL
77 . S RMPRTQTY=RMPRIBAL
78 . S RMPRTVAL=RMPRVBAL
79 . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7I,)
80 . S RMPRIBAL=0
81 . Q
82 ;
83 ; If issued balance not less than on-hand quantity then delete
84 ; the on-hand record
85 E D
86 . S RMPRIBAL=RMPRIBAL-RMPR7I("QUANTITY")
87 . S RMPRTQTY=RMPR7I("QUANTITY")
88 . S RMPRTVAL=$J(RMPR7I("QUANTITY")*RMPRUVAL,0,2)
89 . S RMPRVBAL=RMPRVBAL-RMPRTVAL
90 . S RMPRERR=$$DEL^RMPRPIX7(.RMPR7I)
91 . Q
92 I RMPRERR S RMPRERR=6 G TRNFU
93 ;
94 ; Increase the 'TO' transfer record
95 S RMPRTIEN=$O(^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR7TI("DATE&TIME"),RMPR7TI("SEQUENCE"),""))
96 I RMPRTIEN="" D
97 . S RMPR7TI("IEN")=""
98 . S RMPR7TI("QUANTITY")=RMPRTQTY
99 . S RMPR7TI("VALUE")=RMPRTVAL
100 . S RMPR7TI("LOCATION")=RMPR5T("IEN")
101 . S RMPR7TI("UNIT")=$G(RMPR5T("UNIT"))
102 . S RMPRERR=$$CRE^RMPRPIX7(.RMPR7TI,.RMPR11)
103 . I RMPRERR S RMPRERR=6
104 . Q
105 E D
106 . K RMPR7
107 . S RMPR7("IEN")=RMPRTIEN
108 . S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
109 . I RMPRERR S RMPRERR=6 Q
110 . K RMPR7TI
111 . S RMPR7TI("IEN")=RMPRTIEN
112 . S RMPR7TI("QUANTITY")=RMPR7("QUANTITY")+RMPRTQTY
113 . S RMPR7TI("UNIT")=$G(RMPR5T("UNIT"))
114 . S RMPR7TI("VALUE")=RMPR7("VALUE")+RMPRTVAL
115 . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7TI,.RMPR11)
116 . I RMPRERR S RMPRERR=6 Q
117 . Q
118 I RMPRERR G TRNFU
119 G:RMPRIBAL TRNFA ; next stock rec. if still got transfer balance
120 ;
121 ; exit points
122TRNFU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5F("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
123 L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
124TRNFX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.