RMPRPCEP ;HCIOFO/RVD - Prosthetics/PCE DELETE 06/6/01
;;3.0;PROSTHETICS;**62**;Feb 09, 1996
;
; This routine contains the code for deleting a Prosthetic visit in PCE.
;
;DBIA #1889-B - this API is used to delete data from the VISIT file
; (9000010) and V files from PCE module
;
PCED(RMIE60) ;delete PCE visit.
D NEWVAR
S (RMLOCK,RMERR)=0
S RMSRC="PROSTHETICS DATA"
S RMPKG=$O(^DIC(9.4,"B","PROSTHETICS",0))
I 'RMPKG S RMERR=-1 G DELX
;
; get PCE IEn from file #660.
S RMPCE=$P($G(^RMPR(660,RMIE60,10)),U,12)
I 'RMPCE S RMERR=-1 G DELX
;
; Remove all workload data from the PCE visit file & related V files.
; check if the visit is already in PCE and remove workload,
; (sending RMPKG and RMSRC to ensure that only data that originally
; came from PROSTHETICS will be removed).
;
S RMCHK=$$DELVFILE^PXAPI("ALL",.RMPCE,RMPKG,RMSRC,0,0,"")
I RMCHK'=1 W !!,"*** Error in deleting PCE visit !!",! S RMERR=-1
;
DELX ;exit
Q RMERR
;
NEWVAR ; new variables
N RMCHK,RMPKG,RMSRC,RMPCE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPCEP 1056 printed Dec 13, 2024@02:35:47 Page 2
RMPRPCEP ;HCIOFO/RVD - Prosthetics/PCE DELETE 06/6/01
+1 ;;3.0;PROSTHETICS;**62**;Feb 09, 1996
+2 ;
+3 ; This routine contains the code for deleting a Prosthetic visit in PCE.
+4 ;
+5 ;DBIA #1889-B - this API is used to delete data from the VISIT file
+6 ; (9000010) and V files from PCE module
+7 ;
PCED(RMIE60) ;delete PCE visit.
+1 DO NEWVAR
+2 SET (RMLOCK,RMERR)=0
+3 SET RMSRC="PROSTHETICS DATA"
+4 SET RMPKG=$ORDER(^DIC(9.4,"B","PROSTHETICS",0))
+5 IF 'RMPKG
SET RMERR=-1
GOTO DELX
+6 ;
+7 ; get PCE IEn from file #660.
+8 SET RMPCE=$PIECE($GET(^RMPR(660,RMIE60,10)),U,12)
+9 IF 'RMPCE
SET RMERR=-1
GOTO DELX
+10 ;
+11 ; Remove all workload data from the PCE visit file & related V files.
+12 ; check if the visit is already in PCE and remove workload,
+13 ; (sending RMPKG and RMSRC to ensure that only data that originally
+14 ; came from PROSTHETICS will be removed).
+15 ;
+16 SET RMCHK=$$DELVFILE^PXAPI("ALL",.RMPCE,RMPKG,RMSRC,0,0,"")
+17 IF RMCHK'=1
WRITE !!,"*** Error in deleting PCE visit !!",!
SET RMERR=-1
+18 ;
DELX ;exit
+1 QUIT RMERR
+2 ;
NEWVAR ; new variables
+1 NEW RMCHK,RMPKG,RMSRC,RMPCE
+2 QUIT
