source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29BG.m@ 824

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

revised back to 6/30/08 version

File size: 2.7 KB
Line 
1RMPR29BG ;OI-HINES/SPS -OWL BASE HCPCS ENTER/EDIT/DELETE RPC;12/27/2004
2 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
3A1(RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN) ;roll and scroll entry point
4 G A2
5EN(RESULTS,RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN,RMBD,RMHTECH,RMPRTXT) ;RPC entry point
6A2 ;
7 N J,L,RESULTS,RMIE16C,RMIE16F
8 S RESULTS(0)=""
9 K ^TMP($J)
10 ; If no Tech assigned then self assign here
11 I +$P(^RMPR(664.1,RMIE1,0),U,16)'>0 S $P(^(0),U,16)=DUZ,$P(^(0),U,17)="A",$P(^(7),U,1)=DT,$P(^(7),U,3)=DUZ
12 ;
13 I RMAED="D" G DEL
14 ;
15 S RMERR=0
16 S ^TMP("SPS",0)=RMAED_U_RMPRSITE_U_RMIE1_U_RMIE16_U_RMITM_U_RMQTY_U_RMUI_U_RMTT_U_RMPC_U_RMSN_U_RMHCPC_U_RMCPTM_U_RMVEN
17 S RMIE16F=$O(^RMPR(664.1,RMIE1,2,0))
18 I RMIE16F>0 S:RMIE16'=RMIE16F RMTT=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7),RMPC=$P(^(0),U,8)
19 I RMIE16=RMIE16F D:RMTT'=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7)!(RMPC'=$P(^(0),U,8))
20 . S RMIE16C="" F S RMIE16C=$O(^RMPR(664.1,RMIE1,2,RMIE16C)) Q:RMIE16C="" D
21 .. Q:RMIE16C=RMIE16
22 .. Q:'$D(^RMPR(664.1,RMIE1,2,RMIE16C,0))
23 .. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,7)=RMTT
24 .. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,8)=RMPC
25 I RMIE16="" S RMIE16="+1,"_RMIE1
26 E S RMIE16E=RMIE16,RMIE16=RMIE16_","_RMIE1
27 S RMDAT(664.16,RMIE16_",",.01)=RMITM
28 S RMDAT(664.16,RMIE16_",",2)=RMQTY
29 S RMDAT(664.16,RMIE16_",",3)=RMUI
30 S RMDAT(664.16,RMIE16_",",6.5)=RMBD
31 S RMDAT(664.16,RMIE16_",",8)=RMTT
32 S RMDAT(664.16,RMIE16_",",9)=RMPC
33 S RMDAT(664.16,RMIE16_",",12)=RMSN
34 S RMDAT(664.16,RMIE16_",",13)=RMHCPC
35 S RMDAT(664.16,RMIE16_",",13.1)=RMCPTM
36 S RMDAT(664.16,RMIE16_",",13.2)=RMHTECH
37 S RMDAT(664.16,RMIE16_",",15)=RMVEN
38 D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
39 L -^RMPR(664.1,RMIE1)
40 I $D(RMERROR) S RMERR=1 G ERR
41 S J=""
42 F S J=$O(RMPRTXT(J)) Q:J="" D
43 . S L=J+1,RMPRTXTF(L)=RMPRTXT(J)
44 I '$D(RMIEN(1)) S RMIEN(1)=RMIE16E
45 D WP^DIE(664.16,RMIEN(1)_","_RMIE1_",",7,,"RMPRTXTF","RMWPERR")
46 I $D(RMWPERR) S ^TMP("SPS","WP")=RMWPERR("DIERR","1","TEXT","1")
47 ;
48 S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA
49QUIT K RMAED,RMBD,RMTECH,RMDAT,RMIE16E,RMIE2,RMPRDA,RMPRTXT,RMPRTXTF,RMERROR
50 K RMERR,RMAED,RMPRSITE,RMIE1,RMIE16,RMIEN,RMITM,RMQTY,RMUI,RMTT,RMPC
51 K RMSN,RMHCPC,RMCPTM,RMVEN,RMWPERR,RMHTK
52 Q
53ERR S RESUTLS(0)=1_RMERROR("DIERR",1,"TEXT",1)
54 S ^TMP("SPS",1)=1_RMERROR("DIERR",1,"TEXT",1)
55 G QUIT
56 Q
57DEL ;
58 S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,5)
59 S DIK="^RMPR(660," D ^DIK
60 K DA,DIK
61 S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,6)
62 S DIK="^RMPR(664.2," D ^DIK
63 K DA,DIK
64 S DA(1)=RMIE1,DA=RMIE16,DIK="^RMPR(664.1,"_DA(1)_",2," D ^DIK
65 K DA,DIK
66 S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA
67 L -^RMPR(664.1,RMIE1)
68 G QUIT
69 Q
70EN1(RESULTS,DA) ;Broker entry to kill WO
71 ;DA is passed
72 S DIK="^RMPR(664.1," D ^DIK
73 K DIK
74 Q
Note: See TracBrowser for help on using the repository browser.