source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIX2.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 6.1 KB
Line 
1RMPRPIX2 ;HINCIO/ODJ - APIs for 660 file (Patient 2319) ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; CRE - Create a 2319 record for a stock issue (file 660)
6 ;
7 ; Inputs:
8 ;
9 ; Outputs:
10 ;
11CRE(RMPR60,RMPR6111) ;
12 N RMPRFDA,RMPRFME,RMPRIEN,RMPRRET,X,Y,RMPR699,RMPRTMP,RMPRI,RMPRJ
13 N RMPR611,RMPR611I,RMPRERR,RMPRTMP
14 S RMPRRET=0
15 S RMPR611("HCPCS")=RMPR6111("HCPCS")
16 S RMPRRET=$$HPACT^RMPRPIX1(.RMPR611)
17 I RMPRRET S RMPRRET=1 G CREX
18 S RMPRRET=$$HPETOI^RMPRPIX1(.RMPR611,.RMPR611I)
19 I RMPRRET S RMPRRET=1 G CREX
20 ;S RMPR60("CPT IEN")=RMPR611I("CPT CODE")
21 S RMPRFDA(660,"+1,",.01)=RMPR60("ENTRY DATE")
22 S RMPRFDA(660,"+1,",.02)=RMPR60("PATIENT IEN")
23 S RMPRFDA(660,"+1,",1)=RMPR60("REQ DATE")
24 S RMPRFDA(660,"+1,",2)=RMPR60("ISSUE TYPE")
25 S RMPRFDA(660,"+1,",4)=$G(RMPR60("IFCAP ITEM"))
26 S RMPRFDA(660,"+1,",5)=RMPR60("QUANTITY")
27 S RMPRFDA(660,"+1,",78)=$G(RMPR60("UNIT"))
28 S RMPRFDA(660,"+1,",7)=RMPR60("VENDOR IEN")
29 S RMPRFDA(660,"+1,",8)=RMPR6111("STATION IEN")
30 S RMPRFDA(660,"+1,",9)=$G(RMPR60("SERIAL NUM"))
31 S RMPRFDA(660,"+1,",10)=RMPR60("DELIV DATE")
32 S RMPRFDA(660,"+1,",11)=$G(RMPR60("REQ TYPE"))
33 S RMPRFDA(660,"+1,",12)=$G(RMPR60("SOURCE"))
34 S RMPRFDA(660,"+1,",14)=RMPR60("COST")
35 S RMPRFDA(660,"+1,",16)=$G(RMPR60("REMARKS"))
36 S RMPRFDA(660,"+1,",4.1)=RMPR60("CPT IEN")
37 S RMPRFDA(660,"+1,",21)=$G(RMPR60("LOT NUM"))
38 S RMPRFDA(660,"+1,",27)=$G(RMPR60("USER"))
39 ;
40 ; for the type 1 rec.
41 S RMPRFDA(660,"+1,",24)=RMPR611("SHORT DESC")
42 S RMPRFDA(660,"+1,",4.5)=RMPR60("HCPCS")
43 ;S RMPRFDA(660,"+1,",4.5)=RMPR611("IEN")
44 S RMPRFDA(660,"+1,",4.7)=RMPR60("CPT MOD")
45 S RMPRFDA(660,"+1,",4.6)=RMPR60("TRANS IEN")
46 S RMPRFDA(660,"+1,",39)=RMPR60("DATE OF SERVICE")
47 ;
48 ; for the type 2 rec.
49 S RMPRFDA(660,"+1,",37)=RMPR6111("HCPCS")_"-"_RMPR6111("ITEM")
50 S RMPRFDA(660,"+1,",38)=RMPR6111("DESCRIPTION")
51 ;
52 ; for the type AM rec.
53 S RMPRFDA(660,"+1,",62)=RMPR60("PAT CAT")
54 S RMPRFDA(660,"+1,",63)=$G(RMPR60("SPEC CAT"))
55 ;
56 ; for the type AMS rec.
57 S RMPR699("IEN")=RMPR60("SITE IEN")
58 S RMPRFDA(660,"+1,",68)=RMPR60("GROUPER")
59 ;
60 ; for the type DES rec.
61 S RMPRERR=$$HCDES(.RMPR611,.RMPRTMP)
62 I RMPRERR S RMPRRET=2 G CREX
63 S RMPRFDA(660,"+1,",28)="RMPRTMP"
64 D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
65 I $D(RMPRFME) S RMPRRET=99 G CREX
66 S RMPR60("IEN")=RMPRIEN(1)
67CREX Q RMPRRET
68 ;
69 ; UPD - Update existing 660 rec.
70UPD(RMPR60,RMPR6111) ;
71 N RMPRFDA,RMPRFME,RMPRERR,RMPRI,X,Y,DA,RMPR611,RMPR611I,RMPRTMP
72 S RMPRERR=0
73 I $G(RMPR60("IEN"))="" S RMPRERR=1 G UPDX
74 S RMPRI=RMPR60("IEN")_","
75 I $D(RMPR6111("HCPCS")) D
76 . S RMPR611("HCPCS")=RMPR6111("HCPCS")
77 . S RMPRERR=$$HPACT^RMPRPIX1(.RMPR611)
78 . Q:RMPRERR
79 . S RMPRERR=$$HPETOI^RMPRPIX1(.RMPR611,.RMPR611I)
80 . Q:RMPRERR
81 . S RMPRERR=$$HCDES(.RMPR611,.RMPRTMP)
82 . Q:RMPRERR
83 . S RMPRFDA(660,RMPRI,28)="RMPRTMP"
84 . Q
85 I RMPRERR S RMPRERR=1 G UPDX
86 S:$D(RMPR60("ENTRY DATE")) RMPRFDA(660,RMPRI,.01)=RMPR60("ENTRY DATE")
87 S:$D(RMPR60("PATIENT IEN")) RMPRFDA(660,RMPRI,.02)=RMPR60("PATIENT IEN")
88 S:$D(RMPR60("REQ DATE")) RMPRFDA(660,RMPRI,1)=RMPR60("REQ DATE")
89 S:$D(RMPR60("ISSUE TYPE")) RMPRFDA(660,RMPRI,2)=RMPR60("ISSUE TYPE")
90 S:$D(RMPR60("IFCAP ITEM")) RMPRFDA(660,RMPRI,4)=RMPR60("IFCAP ITEM")
91 S:$D(RMPR60("QUANTITY")) RMPRFDA(660,RMPRI,5)=RMPR60("QUANTITY")
92 S:$D(RMPR6111("UNIT")) RMPRFDA(660,RMPRI,78)=RMPR6111("UNIT")
93 S:$D(RMPR60("VENDOR IEN")) RMPRFDA(660,RMPRI,7)=RMPR60("VENDOR IEN")
94 S:$D(RMPR6111("STATION IEN")) RMPRFDA(660,RMPRI,8)=RMPR6111("STATION IEN")
95 S:$D(RMPR60("SERIAL NUM")) RMPRFDA(660,RMPRI,9)=RMPR60("SERIAL NUM")
96 S:$D(RMPR60("DELIV DATE")) RMPRFDA(660,RMPRI,10)=RMPR60("DELIV DATE")
97 S:$D(RMPR60("DATE OF SERVICE")) RMPRFDA(660,RMPRI,39)=RMPR60("DATE OF SERVICE")
98 S:$D(RMPR60("REQ TYPE")) RMPRFDA(660,RMPRI,11)=RMPR60("REQ TYPE")
99 S:$D(RMPR60("SOURCE")) RMPRFDA(660,RMPRI,12)=RMPR60("SOURCE")
100 S:$D(RMPR60("COST")) RMPRFDA(660,RMPRI,14)=RMPR60("COST")
101 S:$D(RMPR60("REMARKS")) RMPRFDA(660,RMPRI,16)=RMPR60("REMARKS")
102 S:$D(RMPR60("TRANS IEN")) RMPRFDA(660,RMPRI,4.6)=RMPR60("TRANS IEN")
103 S:$D(RMPR60("CPT IEN")) RMPRFDA(660,RMPRI,4.1)=RMPR60("CPT IEN")
104 S:$D(RMPR60("LOT NUM")) RMPRFDA(660,RMPRI,21)=RMPR60("LOT NUM")
105 ;
106 ; for the type 1 rec.
107 S:$D(RMPR611("SHORT DESC")) RMPRFDA(660,RMPRI,24)=RMPR611("SHORT DESC")
108 S:$D(RMPR60("HCPCS")) RMPRFDA(660,RMPRI,4.5)=RMPR60("HCPCS")
109 ;S:$D(RMPR611("IEN")) RMPRFDA(660,RMPRI,4.5)=RMPR611("IEN")
110 S:$D(RMPR60("CPT MOD")) RMPRFDA(660,RMPRI,4.7)=RMPR60("CPT MOD")
111 ;
112 ; for the type 2 rec.
113 S:$D(RMPR6111("HCPCS")) RMPRFDA(660,RMPRI,37)=RMPR6111("HCPCS")_"-"_RMPR6111("ITEM")
114 S:$D(RMPR6111("DESCRIPTION")) RMPRFDA(660,RMPRI,38)=RMPR6111("DESCRIPTION")
115 ;
116 ; for the type AM rec.
117 S:$D(RMPR60("PAT CAT")) RMPRFDA(660,RMPRI,62)=RMPR60("PAT CAT")
118 S:$D(RMPR60("SPEC CAT")) RMPRFDA(660,RMPRI,63)=RMPR60("SPEC CAT")
119 D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
120 I $D(RMPRFME) S RMPRERR=1
121UPDX Q RMPRERR
122 ;
123 ; Update AMIS grouper
124AMGR(RMPR699) ;
125 N RMPRFDA,RMPRIEN,RMPRFME,X,Y,RMPRRET
126 S RMPRRET=0
127 S RMPRIEN=RMPR699("IEN")_","
128 L +^RMPR(669.9,RMPR699("IEN"))
129 S RMPR699("AMIS GROUPER")=$P(^RMPR(669.9,RMPR699("IEN"),0),"^",7)
130 S RMPR699("AMIS GROUPER")=RMPR699("AMIS GROUPER")-1
131 S RMPRFDA(669.9,RMPRIEN,11)=RMPR699("AMIS GROUPER")
132 D FILE^DIE("","RMPRFDA","RMPRFME")
133 I $D(RMPRFME) S RMPRRET=1
134 L -^RMPR(669.9,RMPR699("IEN"))
135 Q RMPRRET
136 ;
137 ; Read description for HCPCS
138HCDES(RMPR611,RMPRFDA) ;
139 N RMPRIEN,RMPRFME,RMPRRET,RMPRTMP,RMPRI,RMPRJ
140 K RMPRFDA
141 S RMPRRET=0
142 S RMPRIEN=RMPR611("IEN")_","
143 D GETS^DIQ(661.1,RMPRIEN,"**","","RMPRTMP","RMPRFME")
144 I $D(RMPRFME) S RMPRRET=1 G HCDESX
145 S RMPRJ=0,RMPRI=""
146 F S RMPRI=$O(RMPRTMP(661.18,RMPRI)) Q:RMPRI="" D
147 . S RMPRJ=RMPRJ+1
148 . S RMPRFDA(RMPRJ)=RMPRTMP(661.18,RMPRI,.01)
149 . Q
150HCDESX Q RMPRRET
151 ;
152 ; DEL - Delete a record
153DEL(RMPR60) ;
154 N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
155 S RMPRERR=0
156 I $G(RMPR60("IEN"))="" S RMPRERR=1 G DELX
157 S RMPRIEN=RMPR60("IEN")_","
158 S RMPRFDA(660,RMPRIEN,.01)="@"
159 D FILE^DIE("","RMPRFDA","RMPRFME")
160 I $D(RMPRFME) S RMPRERR=1
161DELX Q RMPRERR
162 ;
163 ; GET - read in 660 record
164GET(RMPR60,RMPR11) ;
165 S RMPRERR=$$GET^RMPRPIXC(.RMPR60,.RMPR11)
166GETX Q RMPRERR
167 ;
168 ; ETOI - convert external to internal form
169ETOI(RMPR60,RMPR11,RMPR60I,RMPR11I) ;
170 S RMPRERR=$$ETOI^RMPRPIXC(.RMPR60,.RMPR11,.RMPR60I,.RMPR11I)
171ETOIX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.