source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIX7.m@ 636

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1RMPRPIX7 ;HINCIO/ODJ - PIP CURRENT INVENTORY FILE 661.7 APIs ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; CRE - create a new 661.7 record
6CRE(RMPR617,RMPR6111) ;
7 N RMPRFDA,RMPRFME,RMPRRET,RMPRIENA,X,Y,DA
8 S RMPRRET=0
9 S RMPRFDA(661.7,"+1,",.01)=RMPR6111("HCPCS")
10 S RMPRFDA(661.7,"+1,",1)=RMPR617("DATE&TIME")
11 S RMPRFDA(661.7,"+1,",2)=RMPR617("SEQUENCE")
12 S RMPRFDA(661.7,"+1,",6)=RMPR617("QUANTITY")
13 S RMPRFDA(661.7,"+1,",7)=RMPR617("VALUE")
14 S RMPRFDA(661.7,"+1,",3)=RMPR6111("ITEM")
15 S RMPRFDA(661.7,"+1,",4)=RMPR6111("STATION")
16 S RMPRFDA(661.7,"+1,",5)=RMPR617("LOCATION")
17 S RMPRFDA(661.7,"+1,",8)=$G(RMPR617("UNIT"))
18 D UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
19 I $D(RMPRFME) S RMPRRET=1
20CREX Q RMPRRET
21 ;
22 ; UPD - Update existing record
23UPD(RMPR617,RMPR6111) ;
24 N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
25 S RMPRERR=0
26 I $G(RMPR617("IEN"))="" S RMPRERR=1 G UPDX
27 I $D(RMPR617("QUANTITY")),RMPR617("QUANTITY")<1 S DA=RMPR617("IEN"),DIK="^RMPR(661.7," D ^DIK G UPDX
28 S RMPRIEN=RMPR617("IEN")_","
29 S:$D(RMPR6111("HCPCS")) RMPRFDA(661.7,RMPRIEN,.01)=RMPR6111("HCPCS")
30 S:$D(RMPR617("DATE&TIME")) RMPRFDA(661.7,RMPRIEN,1)=RMPR617("DATE&TIME")
31 S:$D(RMPR617("SEQUENCE")) RMPRFDA(661.7,RMPRIEN,2)=RMPR617("SEQUENCE")
32 S:$D(RMPR617("QUANTITY")) RMPRFDA(661.7,RMPRIEN,6)=RMPR617("QUANTITY")
33 S:$D(RMPR617("VALUE")) RMPRFDA(661.7,RMPRIEN,7)=RMPR617("VALUE")
34 S:$D(RMPR6111("ITEM")) RMPRFDA(661.7,RMPRIEN,3)=RMPR6111("ITEM")
35 S:$D(RMPR6111("STATION")) RMPRFDA(661.7,RMPRIEN,4)=RMPR6111("STATION")
36 S:$D(RMPR617("LOCATION")) RMPRFDA(661.7,RMPRIEN,5)=RMPR617("LOCATION")
37 S:$G(RMPR617("UNIT")) RMPRFDA(661.7,RMPRIEN,8)=RMPR617("UNIT")
38 D FILE^DIE("","RMPRFDA","RMPRFME")
39 I $D(RMPRFME) S RMPRERR=1
40UPDX Q RMPRERR
41 ;
42 ; DEL - Delete a record
43DEL(RMPR617) ;
44 N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
45 S RMPRERR=0
46 I $G(RMPR617("IEN"))="" S RMPRERR=1 G UPDX
47 S RMPRIEN=RMPR617("IEN")_","
48 S RMPRFDA(661.7,RMPRIEN,.01)="@"
49 D FILE^DIE("","RMPRFDA","RMPRFME")
50 I $D(RMPRFME) S RMPRERR=1
51DELX Q RMPRERR
52 ;
53 ; GET - read in a 661.7 record
54GET(RMPR) ;
55 N RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP
56 S RMPRRET=0
57 I $G(RMPR("IEN"))="" D
58 . I $G(RMPR("HCPCS"))="" S RMPRRET=1 Q
59 . I $G(RMPR("DATE&TIME"))="" S RMPRRET=2 Q
60 . S RMPRKEY("HCPCS")=RMPR("HCPCS")
61 . S RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
62 . S RMPRERR=$$NEXT^RMPRPIXE(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
63 . I RMPRERR S RMPRRET=3 Q
64 . Q:'$D(RMPRKEY("SEQUENCE"))
65 . I RMPRKEY("SEQUENCE")'=1 S RMPRRET=4 Q
66 . S RMPR("IEN")=RMPRKEY("IEN")
67 . Q
68 I RMPRRET G GETX
69 S RMPRIEN=RMPR("IEN")_","
70 D GETS^DIQ(661.7,RMPRIEN,"*","","RMPROUP","RMPRFME")
71 I $D(RMPRFME) S RMPRRET=5 G GETX
72 S RMPR("HCPCS")=RMPROUP(661.7,RMPRIEN,.01)
73 S RMPR("DATE&TIME")=RMPROUP(661.7,RMPRIEN,1)
74 S RMPR("SEQUENCE")=RMPROUP(661.7,RMPRIEN,2)
75 S RMPR("QUANTITY")=RMPROUP(661.7,RMPRIEN,6)
76 S RMPR("VALUE")=RMPROUP(661.7,RMPRIEN,7)
77 S RMPR("ITEM")=RMPROUP(661.7,RMPRIEN,3)
78 S RMPR("STATION")=RMPROUP(661.7,RMPRIEN,4)
79 S RMPR("LOCATION")=RMPROUP(661.7,RMPRIEN,5)
80 S RMPR("UNIT")=RMPROUP(661.7,RMPRIEN,8)
81GETX Q RMPRRET
82 ;
83 ; ETOI - Convert external 661.7 record to internal form
84ETOI(RMPRE,RMPRI) ;
85 N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
86 S RMPRERR=0
87 S RMPRIEN=RMPRE("IEN")_","
88 D GETS^DIQ(661.7,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
89 I $D(RMPRFME) S RMPRERR=1 G ETOIX
90 S RMPRI("IEN")=RMPRE("IEN")
91 S RMPRI("HCPCS")=RMPRFDI(661.7,RMPRIEN,.01,"I")
92 S RMPRI("DATE&TIME")=RMPRFDI(661.7,RMPRIEN,1,"I")
93 S RMPRI("ITEM")=RMPRFDI(661.7,RMPRIEN,3,"I")
94 S RMPRI("SEQUENCE")=RMPRFDI(661.7,RMPRIEN,2,"I")
95 S RMPRI("STATION")=RMPRFDI(661.7,RMPRIEN,4,"I")
96 S RMPRI("LOCATION")=RMPRFDI(661.7,RMPRIEN,5,"I")
97 S RMPRI("UNIT")=RMPRFDI(661.7,RMPRIEN,8,"I")
98 S RMPRI("QUANTITY")=RMPRFDI(661.7,RMPRIEN,6,"I")
99 S RMPRI("VALUE")=RMPRFDI(661.7,RMPRIEN,7,"I")
100ETOIX Q RMPRERR
101 ;
102 ; RMUBA - read 661.7 records for total balance.
103BAL(RMPR11) ;
104 N I,J,K,RS,RL,RH,RI,RD,RMB7,RM7
105 S RMUB=0
106 S RS=RMPR11("STATION")
107 S RL=RMPR11("LOCATION")
108 S RH=RMPR11("HCPCS")
109 S RI=RMPR11("ITEM")
110 F RD=0:0 S RD=$O(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI,RD)) Q:RD'>0 F I=0:0 S I=$O(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI,RD,1,I)) Q:I'>0 D
111 .Q:I'>0
112 .Q:'$D(^RMPR(661.7,I,0))
113 .S RM7=^RMPR(661.7,I,0)
114 .S RMB7=$P(RM7,U,7)
115 .S RMUB=RMUB+RMB7
116 Q RMUB
Note: See TracBrowser for help on using the repository browser.