source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIX4.m@ 677

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1RMPRPIX4 ;HINCIO/ODJ - PIP RE-ORDER FILE 661.4 APIs ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** CRE - Create HCPCS Item re-order record
6CRE(RMPR4,RMPR11,RMPR5) ;
7 N RMPRCRE,RMPRFDA,RMPRIEN,RMPRFME
8 S RMPRCRE=0
9 I $G(RMPR11("HCPCS"))="" S RMPRCRE=1 G CREX
10 I $G(RMPR11("ITEM"))="" S RMPRCRE=2 G CREX
11 I $G(RMPR11("STATION IEN"))="" S RMPRCRE=3 G CREX
12 I $G(RMPR5("IEN"))="" S RMPRCRE=4 G CREX
13 L +^RMPR(661.4)
14 S RMPRFDA(661.4,"+1,",.01)=RMPR11("HCPCS")
15 S RMPRFDA(661.4,"+1,",2)=RMPR11("ITEM")
16 S RMPRFDA(661.4,"+1,",3)=RMPR11("STATION IEN")
17 S RMPRFDA(661.4,"+1,",4)=RMPR4("RE-ORDER QTY")
18 S RMPRFDA(661.4,"+1,",7)=RMPR5("IEN")
19 D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
20 L -^RMPR(661.4)
21 I $D(RMPRFME) S RMPRCRE=5 G CREX
22 S RMPR4("IEN")=RMPRIEN(1)
23CREX Q RMPRCRE
24 ;
25 ;***** GET - read prosthetic re-order record
26GET(RMPR4,RMPR11,RMPR5) ;
27 N RMPRERR,RMPRIEN,X,Y,DA,RMPROUP,RMPRFME
28 S RMPRERR=0
29 I $G(RMPR4("IEN"))="" S RMPRERR=1 G GETX
30 S RMPRIEN=RMPR4("IEN")_","
31 D GETS^DIQ(661.4,RMPRIEN,"*","","RMPROUP","RMPRFME")
32 I $D(RMPRFME) S RMPRERR=99 G GETX
33 S RMPR11("HCPCS")=RMPROUP(661.4,RMPRIEN,.01)
34 S RMPR11("ITEM")=RMPROUP(661.4,RMPRIEN,2)
35 S RMPR11("STATION")=RMPROUP(661.4,RMPRIEN,3)
36 S RMPR4("RE-ORDER QTY")=RMPROUP(661.4,RMPRIEN,4)
37 S RMPR5("LOCATION")=RMPROUP(661.4,RMPRIEN,7)
38GETX Q RMPRERR
39 ;
40 ;***** UPD - update prosthetic re-order record
41UPD(RMPR4,RMPR11,RMPR5) ;
42 N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
43 S RMPRERR=0
44 I $G(RMPR4("IEN"))="" S RMPRERR=1 G UPDX
45 S RMPRIEN=RMPR4("IEN")_","
46 S:$D(RMPRSTN("IEN")) RMPRFDA(661.4,RMPRIEN,3)=RMPRSTN("IEN")
47 S:$D(RMPR11("HCPCS")) RMPRFDA(661.4,RMPRIEN,.01)=RMPR11("HCPCS")
48 S:$D(RMPR11("ITEM")) RMPRFDA(661.4,RMPRIEN,2)=RMPR11("ITEM")
49 S:$D(RMPR5("IEN")) RMPRFDA(661.4,RMPRIEN,7)=RMPR5("IEN")
50 S:$D(RMPR4("RE-ORDER QTY")) RMPRFDA(661.4,RMPRIEN,4)=RMPR4("RE-ORDER QTY")
51 D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
52 I $D(RMPRFME) S RMPRERR=2
53UPDX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.