source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI07.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1RMPRPI07 ;HINCIO/ODJ - PIP APIs ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; LOC - Build workfile for Quantity on hand by location
6LOC(RMPRNM,RMPRSTN,RMPRLOCA,RMPRSRC,RMPRSDT,RMPREDT) ;
7 N RMPRERR,RMPRL,RMPRALL,RMPRDT,RMPRI,RMPR6,RMPR6I,RMPRSTR,RMPR11
8 N RMPR11I,RMPR7,RMPREOF,RMPRDAYS,RMPR7I
9 N X1,X2,X
10 S RMPRERR=0
11 I $G(RMPRSTN)="" S RMPRERR=1 G LOCX
12 I $G(RMPRNM)="" S RMPRNM="RMPRPI07"
13 K ^TMP($J,RMPRNM)
14 S RMPRALL=$S($G(RMPRLOCA)="*":1,1:0)
15 I $G(RMPRSRC)="" S RMPRSRC="C"
16 I $G(RMPREDT)="" D NOW^%DTC S RMPREDT=X
17 I $G(RMPRSDT)="" D
18 . S X1=RMPREDT,X2=-89 D C^%DTC S RMPRSDT=X
19 . Q
20 S X2=RMPRSDT,X1=RMPREDT D ^%DTC S RMPRDAYS=X+1
21 ;
22 ; First loop on transaction file (661.6) for issues
23 S RMPRL=""
24LOC1 I RMPRALL D
25 . S RMPRL=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL))
26 . Q
27 E D
28 . S RMPRL=$O(RMPRLOCA(RMPRL))
29 . Q
30 I RMPRL="" G LOC11
31 I RMPRSDT="" D
32 . S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,""))
33 . Q
34 E D
35 . I $D(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRSDT)) S RMPRDT=RMPRSDT Q
36 . S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRSDT))
37 . Q
38LOC2 I RMPRDT="" G LOC1
39 I $P(RMPRDT,".",1)>RMPREDT G LOC1
40 S RMPRI=""
41LOC3 S RMPRI=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRDT,RMPRI))
42 I RMPRI="" D G LOC2
43 . S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRDT))
44 . Q
45 K RMPR6
46 S RMPR6("IEN")=RMPRI
47 S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
48 I RMPRERR S RMPRERR=1 G LOCX
49 S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I) ;read trans. rec. (661.6)
50 I RMPRERR S RMPRERR=2 G LOCX
51 I RMPR6I("TRAN TYPE")'=3 G LOC3 ;not patient issue
52 K RMPR11
53 S RMPR11("STATION")=RMPRSTN
54 S RMPR11("HCPCS")=RMPR6("HCPCS")
55 S RMPR11("ITEM")=RMPR6("ITEM")
56 S RMPRERR=$$GET^RMPRPIX1(.RMPR11) ;read in Item rec. (661.11)
57 I RMPRERR S RMPRERR=3 G LOCX
58 S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)
59 I RMPRERR S RMPRERR=4 G LOCX
60 I RMPR11I("SOURCE")'=RMPRSRC G LOC3 ;not required source
61 S RMPRSTR=$G(^TMP($J,RMPRNM,RMPRL,RMPR6("HCPCS"),RMPR11("DESCRIPTION"),RMPR6("ITEM")))
62 S $P(RMPRSTR,"^",1)=RMPR6("QUANTITY")+$P(RMPRSTR,"^",1)
63 S $P(RMPRSTR,"^",2)=RMPR6("VALUE")+$P(RMPRSTR,"^",2)
64 S ^TMP($J,RMPRNM,RMPRL,RMPR6("HCPCS"),RMPR11("DESCRIPTION"),RMPR6("ITEM"))=RMPRSTR
65 G LOC3
66 ;
67 ; Second loop on Current Stock (661.7) for quantity on hand
68 S RMPRL=""
69LOC11 I RMPRALL D
70 . S RMPRL=$O(^RMPR(661.7,"XSLHIDS",RMPRSTN,RMPRL))
71 . Q
72 E D
73 . S RMPRL=$O(RMPRLOCA(RMPRL))
74 . Q
75 I RMPRL="" G LOCX
76 K RMPR7I
77 S RMPR7I("STATION")=RMPRSTN
78 S RMPR7I("LOCATION")=RMPRL
79LOC12 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR7I,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
80 I RMPREOF G LOC11
81 I RMPR7I("STATION")'=RMPRSTN G LOC11
82 I RMPR7I("LOCATION")'=RMPRL G LOC11
83 K RMPR7
84 S RMPR7("IEN")=RMPR7I("IEN")
85 S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ;read in cur. stock rec.
86 K RMPR11,RMPR11I
87 S RMPR11("STATION")=RMPRSTN
88 S RMPR11("HCPCS")=RMPR7("HCPCS")
89 S RMPR11("ITEM")=RMPR7("ITEM")
90 S RMPRERR=$$GET^RMPRPIX1(.RMPR11) ;read in Item rec. (661.11)
91 I RMPRERR S RMPRERR=99 G LOCX
92 S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)
93 I RMPRERR S RMPRERR=99 G LOCX
94 I RMPR11I("SOURCE")'=RMPRSRC G LOC12 ;not required source
95 S RMPRSTR=$G(^TMP($J,RMPRNM,RMPRL,RMPR7("HCPCS"),RMPR11("DESCRIPTION"),RMPR7("ITEM")))
96 S $P(RMPRSTR,"^",5)=RMPR7("QUANTITY")+$P(RMPRSTR,"^",5)
97 S $P(RMPRSTR,"^",6)=RMPR7("VALUE")+$P(RMPRSTR,"^",6)
98 S ^TMP($J,RMPRNM,RMPRL,RMPR7("HCPCS"),RMPR11("DESCRIPTION"),RMPR7("ITEM"))=RMPRSTR
99 G LOC12
100LOCX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.