source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIU9.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1RMPRPIU9 ;HINCIO/ODJ - PIP STOCK RECONCILE UPDATE UTILITY;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** REC - Create a Stock Reconciliation Transaction
6 ;
7 ; Inputs:
8 ; RMPR6 -
9 ; RMPR11 -
10 ; RMPR5 -
11 ;
12 ; Outputs:
13 ; RMPRERR -
14 ;
15REC(RMPR6,RMPR11,RMPR5) ;
16 N RMPRERR,RMPRCSTK,RMPRQGL,RMPRVGL,RMPRD,RMPRT,RMPR,RMPRUCST
17 S RMPRERR=0
18 ;
19 ; Lock the current stock 661.7 file at HCPCS Item level as we may be
20 ; reducing or increasing the quantity on hand
21 L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
22 ;
23 ; Get current quantity on hand
24 S RMPRCSTK("STATION IEN")=RMPR11("STATION IEN")
25 S RMPRCSTK("HCPCS")=RMPR11("HCPCS")
26 S RMPRCSTK("ITEM")=RMPR11("ITEM")
27 S RMPRCSTK("UNIT")=$G(RMPR11("UNIT"))
28 S RMPRCSTK("LOCATION IEN")=RMPR5("IEN")
29 S RMPRCSTK("VENDOR IEN")=RMPR6("VENDOR IEN")
30 S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
31 I RMPRERR S RMPRERR=11 G RECU ;error 11 - problem getting current qoh
32 S RMPRQGL=RMPR6("QUANTITY")-RMPRCSTK("QOH") ;gain/loss
33 S RMPRUCST=""
34 I $G(RMPR6("NEW UNIT COST"))'="" S RMPRUCST=RMPR6("NEW UNIT COST")
35 ;
36 ; If not showing any quantity on hand then use the unit cost
37 ; of the most recent receipt or reconciliation transaction
38 I RMPRUCST="",RMPRCSTK("QOH")=0 D
39 . F RMPRT=3,9 D Q:RMPRERR!(RMPRD'="")
40 .. S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),""),-1)
41 .. Q:RMPRD=""
42 .. K RMPR
43 .. S RMPR("IEN")=$QS($Q(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),RMPRD)),9)
44 .. S RMPRERR=$$GET^RMPRPIX6(.RMPR)
45 .. Q:RMPRERR
46 .. S:+RMPR("QUANTITY") RMPRUCST=RMPR("VALUE")/RMPR("QUANTITY")
47 .. Q
48 . Q
49 E D
50 . S:RMPRUCST="" RMPRUCST=RMPRCSTK("UNIT COST")
51 . Q
52 I RMPRUCST="" D
53 . S RMPRUCST=0
54 . I +RMPR6("QUANTITY"),+$G(RMPR6("VALUE")) D
55 .. S RMPRUCST=RMPR6("VALUE")/RMPR6("QUANTITY")
56 .. Q
57 . Q
58 I RMPRERR S RMPRERR=12 G RECU ;error 12 problem with cost
59 ;
60 ; calculate the gain/loss for value
61 S RMPRVGL=$J(RMPRQGL*RMPRUCST,0,2)
62 ;
63 ; Create a 661.6 Reconciliation Transaction record
64 S RMPR6("COMMENT")=$G(RMPR6("COMMENT"))
65 S RMPR6("SEQUENCE")=1
66 S RMPR6("TRAN TYPE")=9
67 S RMPR6("LOCATION")=RMPR5("IEN")
68 S RMPR6("USER")=$G(DUZ)
69 S RMPR6("VENDOR")=RMPR6("VENDOR IEN")
70 S RMPR6("VALUE")=$J(RMPR6("QUANTITY")*RMPRUCST,0,2)
71 K RMPR6("IEN")
72 S RMPR11("STATION")=RMPR11("STATION IEN")
73 S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
74 I RMPRERR S RMPRERR=61 G RECU ;error 61 if problem with 661.6
75 ;
76 ; Create 661.69 Gain/Loss record
77 K RMPR
78 S RMPR("TRANS IEN")=RMPR6("IEN")
79 S RMPR("GAIN/LOSS")=RMPRQGL
80 S RMPR("GAIN/LOSS VALUE")=RMPRVGL
81 S RMPRERR=$$CRE^RMPRPIXB(.RMPR)
82 I RMPRERR S RMPRERR=61 G RECU ;error 61 if problem with 661.69
83 ;
84 ; Adjust stock for gain/loss
85 I RMPRQGL=0 G RECU ;no gain loss so just exit
86 I RMPRQGL>0 G RECGN ;adjust for stock gain
87 ;
88 ; Adjust for stock loss
89RECLS K RMPR
90 S RMPR("STATION IEN")=RMPR11("STATION IEN")
91 S RMPR("LOCATION IEN")=RMPR5("IEN")
92 S RMPR("HCPCS")=RMPR11("HCPCS")
93 S RMPR("ITEM")=RMPR11("ITEM")
94 S RMPR("UNIT")=$G(RMPR11("UNIT"))
95 S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
96 S RMPR("ISSUED QTY")=0-RMPRQGL
97 S RMPR("ISSUED VALUE")=0-RMPRVGL
98 S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
99 I RMPRERR S RMPRERR=71 G RECU ;error 71 problem with adjusting
100 K RMPR
101 S RMPR("STA")=RMPR11("STATION IEN")
102 S RMPR("HCP")=RMPR11("HCPCS")
103 S RMPR("ITE")=RMPR11("ITEM")
104 S RMPR("RDT")=$P(RMPR6("DATE&TIME"),".",1)
105 S RMPR("TQTY")=RMPRQGL
106 S RMPR("TCST")=RMPRVGL
107 S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
108 I RMPRERR S RMPRERR=71
109 G RECU
110 ;
111 ; Adjust for stock gain
112RECGN K RMPR
113 S RMPR("STATION")=RMPR11("STATION IEN")
114 S RMPR("LOCATION")=RMPR5("IEN")
115 S RMPR("HCPCS")=RMPR11("HCPCS")
116 S RMPR("ITEM")=RMPR11("ITEM")
117 S RMPR("UNIT")=$G(RMPR11("UNIT"))
118 S RMPR("VENDOR")=RMPR6("VENDOR IEN")
119 S RMPR("QUANTITY")=RMPRQGL
120 S RMPR("VALUE")=RMPRVGL
121 S RMPR("DATE&TIME")=$G(RMPR6("DATE&TIME"))
122 S RMPR("SEQUENCE")=RMPR6("SEQUENCE")
123 S RMPRERR=$$REVI^RMPRPIU1(.RMPR)
124 I RMPRERR S RMPRERR=71
125 G RECU
126 ;
127 ; exit points
128RECU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
129RECX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.