source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIXC.m@ 896

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1RMPRPIXC ;HINCIO/ODJ - APIs for 660 file ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** GET - read in 660 patient 2319 record
6GET(RMPR60,RMPR11) ;
7 N RMPRI,RMPRA,RMPRFME,RMPRERR,RMPRLIN,RMPRC
8 S RMPRERR=0
9 I $G(RMPR60("IEN"))="" S RMPRERR=1 G GETX
10 S RMPRI=RMPR60("IEN")_","
11 D GETS^DIQ(660,RMPRI,"*","","RMPRA","RMPRFME")
12 I $D(RMPRFME) S RMPRERR=99 G GETX
13 S RMPR60("ENTRY DATE")=RMPRA(660,RMPRI,.01)
14 S RMPR60("PATIENT")=RMPRA(660,RMPRI,.02)
15 S RMPR60("REQ DATE")=RMPRA(660,RMPRI,1)
16 S RMPR60("ISSUE TYPE")=RMPRA(660,RMPRI,2)
17 S RMPR60("IFCAP ITEM")=RMPRA(660,RMPRI,4)
18 S RMPR60("QUANTITY")=RMPRA(660,RMPRI,5)
19 S RMPR11("UNIT")=RMPRA(660,RMPRI,78)
20 S RMPR60("UNIT")=RMPRA(660,RMPRI,78)
21 S RMPR60("VENDOR")=RMPRA(660,RMPRI,7)
22 S RMPR11("STATION")=RMPRA(660,RMPRI,8)
23 S RMPR60("SERIAL NUM")=RMPRA(660,RMPRI,9)
24 S RMPR60("DELIV DATE")=RMPRA(660,RMPRI,10)
25 S RMPR60("REQ TYPE")=RMPRA(660,RMPRI,11)
26 S RMPR11("SOURCE")=RMPRA(660,RMPRI,12)
27 S RMPR60("COST")=RMPRA(660,RMPRI,14)
28 S RMPR60("REMARKS")=RMPRA(660,RMPRI,16)
29 S RMPR11("CPT CODE")=RMPRA(660,RMPRI,4.1)
30 S RMPR60("LOT NUM")=RMPRA(660,RMPRI,21)
31 S RMPR60("USER")=RMPRA(660,RMPRI,27)
32 ;
33 ; for the type 1 rec.
34 S RMPR11("SHORT DESC")=RMPRA(660,RMPRI,24)
35 S RMPR11("IEN")=RMPRA(660,RMPRI,4.5)
36 S RMPR60("CPT MOD")=RMPRA(660,RMPRI,4.7)
37 ;S RMPR60("TRANS IEN")=RMPRA(660,RMPRI,4.6)
38 S RMPR60("TRANS IEN")=$P(^RMPR(660,RMPR60("IEN"),1),"^",5)
39 ;
40 ; for the type 2 rec.
41 S RMPR11("HCPCS-ITEM")=RMPRA(660,RMPRI,37)
42 S RMPR11("DESCRIPTION")=RMPRA(660,RMPRI,38)
43 ;
44 ; for the type AM rec.
45 S RMPR60("PAT CAT")=RMPRA(660,RMPRI,62)
46 S RMPR60("SPEC CAT")=RMPRA(660,RMPRI,63)
47 ;
48 ; for the type AMS rec.
49 S RMPR60("AMIS GROUPER")=RMPRA(660,RMPRI,68)
50 ;
51 ; 'DES'
52 S RMPRLIN="",RMPRC=0
53 F S RMPRLIN=$O(RMPRA(660,RMPRI,28,RMPRLIN)) Q:RMPRLIN="" D
54 . S RMPRC=RMPRC+1
55 . S RMPR60("DES",RMPRC)=RMPRA(660,RMPRI,28,RMPRLIN)
56 . Q
57GETX Q RMPRERR
58 ;
59 ;***** ETOI - convert external to internal form
60ETOI(RMPR60,RMPR11,RMPR60I,RMPR11I) ;
61 N RMPRERR,RMPRFDA,RMPRFDI,RMPRFME,RMPRI,X,Y,DA
62 S RMPRERR=0
63 S RMPRI=RMPR60("IEN")_","
64 D GETS^DIQ(660,RMPRI,"*","I","RMPRFDI","RMPRFME")
65 I $D(RMPRFME) S RMPRERR=99 G ETOIX
66 S RMPR60I("ENTRY DATE")=RMPRFDI(660,RMPRI,.01,"I")
67 S RMPR60I("PATIENT")=RMPRFDI(660,RMPRI,.02,"I")
68 S RMPR60I("REQ DATE")=RMPRFDI(660,RMPRI,1,"I")
69 S RMPR60I("ISSUE TYPE")=RMPRFDI(660,RMPRI,2,"I")
70 S RMPR60I("IFCAP ITEM")=$P(^RMPR(660,RMPR60("IEN"),0),"^",6) ;FM problem
71 S RMPR60I("QUANTITY")=RMPRFDI(660,RMPRI,5,"I")
72 S RMPR11I("UNIT")=RMPRFDI(660,RMPRI,78,"I")
73 S RMPR60I("UNIT")=RMPRFDI(660,RMPRI,78,"I")
74 S RMPR60I("VENDOR")=RMPRFDI(660,RMPRI,7,"I")
75 S RMPR11I("STATION")=RMPRFDI(660,RMPRI,8,"I")
76 S RMPR60I("SERIAL NUM")=RMPRFDI(660,RMPRI,9,"I")
77 S RMPR60I("DELIV DATE")=RMPRFDI(660,RMPRI,10,"I")
78 S RMPR60I("REQ TYPE")=RMPRFDI(660,RMPRI,11,"I")
79 S RMPR11I("SOURCE")=RMPRFDI(660,RMPRI,12,"I")
80 S RMPR60I("COST")=RMPRFDI(660,RMPRI,14,"I")
81 S RMPR60I("REMARKS")=RMPRFDI(660,RMPRI,16,"I")
82 S RMPR11I("CPT IEN")=RMPRFDI(660,RMPRI,4.1,"I")
83 S RMPR60I("LOT NUM")=RMPRFDI(660,RMPRI,21,"I")
84 ;
85 ; for the type 1 rec.
86 S RMPR11I("SHORT DESC")=RMPRFDI(660,RMPRI,24,"I")
87 S RMPR11I("IEN")=RMPRFDI(660,RMPRI,4.5,"I")
88 S RMPR60I("CPT MOD")=RMPRFDI(660,RMPRI,4.7,"I")
89 ;
90 ; for the type AM rec.
91 S RMPR60I("PAT CAT")=RMPRFDI(660,RMPRI,62,"I")
92 S RMPR60I("SPEC CAT")=RMPRFDI(660,RMPRI,63,"I")
93ETOIX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.