RMPR29BG ;OI-HINES/SPS -OWL BASE HCPCS ENTER/EDIT/DELETE RPC;12/27/2004
;;3.0;PROSTHETICS;**75,142**;Feb 09, 1996;Build 2
A1(RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN) ;roll and scroll entry point
G A2
EN(RESULTS,RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN,RMBD,RMHTECH,RMPRTXT) ;RPC entry point
A2 ;
N J,L,RESULTS,RMIE16C,RMIE16F,R6641,RSITE
S RESULTS(0)=""
K ^TMP($J)
; If no Tech assigned then self assign here
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
;
I RMAED="D" G DEL
;
S RMERR=0
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
S RMIE16F=$O(^RMPR(664.1,RMIE1,2,0))
S R6641=$G(^RMPR(664.1,RMIE1,0))
S RSITE=$P(R6641,U,15),RSITE=$O(^RMPR(669.9,"C",RSITE,0))
I RSITE'=RMPRSITE S RMPRSITE=RSITE
I RMIE16F>0 S:RMIE16'=RMIE16F RMTT=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7),RMPC=$P(^(0),U,8)
I RMIE16=RMIE16F D:RMTT'=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7)!(RMPC'=$P(^(0),U,8))
. S RMIE16C="" F S RMIE16C=$O(^RMPR(664.1,RMIE1,2,RMIE16C)) Q:RMIE16C="" D
.. Q:RMIE16C=RMIE16
.. Q:'$D(^RMPR(664.1,RMIE1,2,RMIE16C,0))
.. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,7)=RMTT
.. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,8)=RMPC
I RMIE16="" S RMIE16="+1,"_RMIE1
E S RMIE16E=RMIE16,RMIE16=RMIE16_","_RMIE1
S RMDAT(664.16,RMIE16_",",.01)=RMITM
S RMDAT(664.16,RMIE16_",",2)=RMQTY
S RMDAT(664.16,RMIE16_",",3)=RMUI
S RMDAT(664.16,RMIE16_",",6.5)=RMBD
S RMDAT(664.16,RMIE16_",",8)=RMTT
S RMDAT(664.16,RMIE16_",",9)=RMPC
S RMDAT(664.16,RMIE16_",",12)=RMSN
S RMDAT(664.16,RMIE16_",",13)=RMHCPC
S RMDAT(664.16,RMIE16_",",13.1)=RMCPTM
S RMDAT(664.16,RMIE16_",",13.2)=RMHTECH
S RMDAT(664.16,RMIE16_",",15)=RMVEN
D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
L -^RMPR(664.1,RMIE1)
I $D(RMERROR) S RMERR=1 G ERR
S J=""
F S J=$O(RMPRTXT(J)) Q:J="" D
. S L=J+1,RMPRTXTF(L)=RMPRTXT(J)
I '$D(RMIEN(1)) S RMIEN(1)=RMIE16E
D WP^DIE(664.16,RMIEN(1)_","_RMIE1_",",7,,"RMPRTXTF","RMWPERR")
I $D(RMWPERR) S ^TMP("SPS","WP")=RMWPERR("DIERR","1","TEXT","1")
;
S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA
QUIT K RMAED,RMBD,RMTECH,RMDAT,RMIE16E,RMIE2,RMPRDA,RMPRTXT,RMPRTXTF,RMERROR
K RMERR,RMAED,RMPRSITE,RMIE1,RMIE16,RMIEN,RMITM,RMQTY,RMUI,RMTT,RMPC
K RMSN,RMHCPC,RMCPTM,RMVEN,RMWPERR,RMHTK
Q
ERR S RESUTLS(0)=1_RMERROR("DIERR",1,"TEXT",1)
S ^TMP("SPS",1)=1_RMERROR("DIERR",1,"TEXT",1)
G QUIT
Q
DEL ;
S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,5)
I DA'="" D
. S DIK="^RMPR(660," D ^DIK
. K DA,DIK
S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,6)
I DA'="" D
. S DIK="^RMPR(664.2," D ^DIK
. K DA,DIK
S DA(1)=RMIE1,DA=RMIE16,DIK="^RMPR(664.1,"_DA(1)_",2," D ^DIK
K DA,DIK
S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA
L -^RMPR(664.1,RMIE1)
G QUIT
Q
EN1(RESULTS,DA) ;Broker entry to kill WO
;DA is passed
S DIK="^RMPR(664.1," D ^DIK
K DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29BG 3044 printed Apr 09, 2024@21:39:29 Page 2
RMPR29BG ;OI-HINES/SPS -OWL BASE HCPCS ENTER/EDIT/DELETE RPC;12/27/2004
+1 ;;3.0;PROSTHETICS;**75,142**;Feb 09, 1996;Build 2
A1(RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN) ;roll and scroll entry point
+1 GOTO A2
EN(RESULTS,RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN,RMBD,RMHTECH,RMPRTXT) ;RPC entry point
A2 ;
+1 NEW J,L,RESULTS,RMIE16C,RMIE16F,R6641,RSITE
+2 SET RESULTS(0)=""
+3 KILL ^TMP($JOB)
+4 ; If no Tech assigned then self assign here
+5 IF +$PIECE(^RMPR(664.1,RMIE1,0),U,16)'>0
SET $PIECE(^(0),U,16)=DUZ
SET $PIECE(^(0),U,17)="A"
SET $PIECE(^(7),U,1)=DT
SET $PIECE(^(7),U,3)=DUZ
+6 ;
+7 IF RMAED="D"
GOTO DEL
+8 ;
+9 SET RMERR=0
+10 SET ^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
+11 SET RMIE16F=$ORDER(^RMPR(664.1,RMIE1,2,0))
+12 SET R6641=$GET(^RMPR(664.1,RMIE1,0))
+13 SET RSITE=$PIECE(R6641,U,15)
SET RSITE=$ORDER(^RMPR(669.9,"C",RSITE,0))
+14 IF RSITE'=RMPRSITE
SET RMPRSITE=RSITE
+15 IF RMIE16F>0
if RMIE16'=RMIE16F
SET RMTT=$PIECE(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7)
SET RMPC=$PIECE(^(0),U,8)
+16 IF RMIE16=RMIE16F
if RMTT'=$PIECE(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7)!(RMPC'=$PIECE(^(0),U,8))
Begin DoDot:1
+17 SET RMIE16C=""
FOR
SET RMIE16C=$ORDER(^RMPR(664.1,RMIE1,2,RMIE16C))
if RMIE16C=""
QUIT
Begin DoDot:2
+18 if RMIE16C=RMIE16
QUIT
+19 if '$DATA(^RMPR(664.1,RMIE1,2,RMIE16C,0))
QUIT
+20 SET $PIECE(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,7)=RMTT
+21 SET $PIECE(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,8)=RMPC
End DoDot:2
End DoDot:1
+22 IF RMIE16=""
SET RMIE16="+1,"_RMIE1
+23 IF '$TEST
SET RMIE16E=RMIE16
SET RMIE16=RMIE16_","_RMIE1
+24 SET RMDAT(664.16,RMIE16_",",.01)=RMITM
+25 SET RMDAT(664.16,RMIE16_",",2)=RMQTY
+26 SET RMDAT(664.16,RMIE16_",",3)=RMUI
+27 SET RMDAT(664.16,RMIE16_",",6.5)=RMBD
+28 SET RMDAT(664.16,RMIE16_",",8)=RMTT
+29 SET RMDAT(664.16,RMIE16_",",9)=RMPC
+30 SET RMDAT(664.16,RMIE16_",",12)=RMSN
+31 SET RMDAT(664.16,RMIE16_",",13)=RMHCPC
+32 SET RMDAT(664.16,RMIE16_",",13.1)=RMCPTM
+33 SET RMDAT(664.16,RMIE16_",",13.2)=RMHTECH
+34 SET RMDAT(664.16,RMIE16_",",15)=RMVEN
+35 DO UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
+36 LOCK -^RMPR(664.1,RMIE1)
+37 IF $DATA(RMERROR)
SET RMERR=1
GOTO ERR
+38 SET J=""
+39 FOR
SET J=$ORDER(RMPRTXT(J))
if J=""
QUIT
Begin DoDot:1
+40 SET L=J+1
SET RMPRTXTF(L)=RMPRTXT(J)
End DoDot:1
+41 IF '$DATA(RMIEN(1))
SET RMIEN(1)=RMIE16E
+42 DO WP^DIE(664.16,RMIEN(1)_","_RMIE1_",",7,,"RMPRTXTF","RMWPERR")
+43 IF $DATA(RMWPERR)
SET ^TMP("SPS","WP")=RMWPERR("DIERR","1","TEXT","1")
+44 ;
+45 SET RMPRDA=RMIE1
DO INF^RMPRSIT
DO POST^RMPR29GA
QUIT KILL RMAED,RMBD,RMTECH,RMDAT,RMIE16E,RMIE2,RMPRDA,RMPRTXT,RMPRTXTF,RMERROR
+1 KILL RMERR,RMAED,RMPRSITE,RMIE1,RMIE16,RMIEN,RMITM,RMQTY,RMUI,RMTT,RMPC
+2 KILL RMSN,RMHCPC,RMCPTM,RMVEN,RMWPERR,RMHTK
+3 QUIT
ERR SET RESUTLS(0)=1_RMERROR("DIERR",1,"TEXT",1)
+1 SET ^TMP("SPS",1)=1_RMERROR("DIERR",1,"TEXT",1)
+2 GOTO QUIT
+3 QUIT
DEL ;
+1 SET DA=$PIECE(^RMPR(664.1,RMIE1,2,RMIE16,0),U,5)
+2 IF DA'=""
Begin DoDot:1
+3 SET DIK="^RMPR(660,"
DO ^DIK
+4 KILL DA,DIK
End DoDot:1
+5 SET DA=$PIECE(^RMPR(664.1,RMIE1,2,RMIE16,0),U,6)
+6 IF DA'=""
Begin DoDot:1
+7 SET DIK="^RMPR(664.2,"
DO ^DIK
+8 KILL DA,DIK
End DoDot:1
+9 SET DA(1)=RMIE1
SET DA=RMIE16
SET DIK="^RMPR(664.1,"_DA(1)_",2,"
DO ^DIK
+10 KILL DA,DIK
+11 SET RMPRDA=RMIE1
DO INF^RMPRSIT
DO POST^RMPR29GA
+12 LOCK -^RMPR(664.1,RMIE1)
+13 GOTO QUIT
+14 QUIT
EN1(RESULTS,DA) ;Broker entry to kill WO
+1 ;DA is passed
+2 SET DIK="^RMPR(664.1,"
DO ^DIK
+3 KILL DIK
+4 QUIT
