RORRP030 ;HCIOFO/SG - RPC: PATIENT DELETE ;11/29/05 3:04pm
;;1.5;CLINICAL CASE REGISTRIES;**10,18**;Feb 17, 2006;Build 25
;*************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*18 APR 2012 C RAY Added logic to immediately delete
; patients in auto confirm registries
; Deletion is logged
;***********************************************************************
; This routine uses the following IAs:
;
; #2053 FILE^DIE (supported)
Q
;
;***** MARKS THE PATIENT'S RECORD AS DELETED FROM THE REGISTRY
; RPC: [ROR PATIENT DELETE]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; RORDFN IEN of the patient
;
; [FORCE] Deprecated
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; Otherwise, the following codes can be returned in the RESULTS(0):
;
; 0 The record cannot be deleted
; 9 The record has been marked as deleted
;
DELETE(RESULTS,REGIEN,RORDFN,FORCE) ;
N IENS,RC,REGNAME,RORFDA,RORMSG,TMP,DIERR,RORPARM,REGLST
D CLEAR^RORERR("DELETE^RORRP030",1)
K RESULTS S RESULTS(0)=0
;
;--- Get the registry description/name
S TMP=$$REGNAME^RORUTL01(REGIEN)
I TMP="" D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-1,,,RORDFN)
S REGNAME=$S($P(TMP,U,2)'="":$P(TMP,U,2),1:$P(TMP,U))
;
;--- Get IENS of the registry record
S IENS=$$PRRIEN^RORUTL01(RORDFN,REGIEN)_","
I IENS'>0 D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-97,,,RORDFN,REGNAME)
;--- non-CCR registries delete immediately and log -- Patch 18
I $D(^ROR(798.1,"C",1,REGIEN)) D S RESULTS(0)=9 Q
. S RORPARM("LOG")=1
. S REGLST(REGNAME)=REGIEN
. S RC=$$OPEN^RORLOG(.REGLST,,"PATIENT DELETION")
. D LOG^RORERR(-90,,RORDFN,$G(REGNAME))
. N DA,DIK S DIK=$$ROOT^DILFD(798),DA=+IENS D ^DIK
. D CLOSE^RORLOG()
;
;-- CCR registries mark as deleted
;Patch 10: mark any deleted record as deleted (don't delete pending record immediately)
D
. ;--- Mark the record as deleted
. S RORFDA(798,IENS,3)=5
. D FILE^DIE(,"RORFDA","RORMSG")
. I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC)
. . S RC=$$DBS^RORERR("RORMSG",-9,,RORDFN,798,IENS)
;---
S RESULTS(0)=9
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP030 2710 printed Apr 09, 2024@20:47:58 Page 2
RORRP030 ;HCIOFO/SG - RPC: PATIENT DELETE ;11/29/05 3:04pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**10,18**;Feb 17, 2006;Build 25
+2 ;*************************************************************************
+3 ; --- ROUTINE MODIFICATION LOG ---
+4 ;
+5 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+6 ;----------- ---------- ----------- ----------------------------------------
+7 ;ROR*1.5*18 APR 2012 C RAY Added logic to immediately delete
+8 ; patients in auto confirm registries
+9 ; Deletion is logged
+10 ;***********************************************************************
+11 ; This routine uses the following IAs:
+12 ;
+13 ; #2053 FILE^DIE (supported)
+14 QUIT
+15 ;
+16 ;***** MARKS THE PATIENT'S RECORD AS DELETED FROM THE REGISTRY
+17 ; RPC: [ROR PATIENT DELETE]
+18 ;
+19 ; .RESULTS Reference to a local variable where the results
+20 ; are returned to.
+21 ;
+22 ; REGIEN Registry IEN
+23 ;
+24 ; RORDFN IEN of the patient
+25 ;
+26 ; [FORCE] Deprecated
+27 ;
+28 ; Return Values:
+29 ;
+30 ; A negative value of the first "^"-piece of the RESULTS(0)
+31 ; indicates an error (see the RPCSTK^RORERR procedure for more
+32 ; details).
+33 ;
+34 ; Otherwise, the following codes can be returned in the RESULTS(0):
+35 ;
+36 ; 0 The record cannot be deleted
+37 ; 9 The record has been marked as deleted
+38 ;
DELETE(RESULTS,REGIEN,RORDFN,FORCE) ;
+1 NEW IENS,RC,REGNAME,RORFDA,RORMSG,TMP,DIERR,RORPARM,REGLST
+2 DO CLEAR^RORERR("DELETE^RORRP030",1)
+3 KILL RESULTS
SET RESULTS(0)=0
+4 ;
+5 ;--- Get the registry description/name
+6 SET TMP=$$REGNAME^RORUTL01(REGIEN)
+7 IF TMP=""
Begin DoDot:1
+8 SET RC=$$ERROR^RORERR(-1,,,RORDFN)
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+9 SET REGNAME=$SELECT($PIECE(TMP,U,2)'="":$PIECE(TMP,U,2),1:$PIECE(TMP,U))
+10 ;
+11 ;--- Get IENS of the registry record
+12 SET IENS=$$PRRIEN^RORUTL01(RORDFN,REGIEN)_","
+13 IF IENS'>0
Begin DoDot:1
+14 SET RC=$$ERROR^RORERR(-97,,,RORDFN,REGNAME)
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+15 ;--- non-CCR registries delete immediately and log -- Patch 18
+16 IF $DATA(^ROR(798.1,"C",1,REGIEN))
Begin DoDot:1
+17 SET RORPARM("LOG")=1
+18 SET REGLST(REGNAME)=REGIEN
+19 SET RC=$$OPEN^RORLOG(.REGLST,,"PATIENT DELETION")
+20 DO LOG^RORERR(-90,,RORDFN,$GET(REGNAME))
+21 NEW DA,DIK
SET DIK=$$ROOT^DILFD(798)
SET DA=+IENS
DO ^DIK
+22 DO CLOSE^RORLOG()
End DoDot:1
SET RESULTS(0)=9
QUIT
+23 ;
+24 ;-- CCR registries mark as deleted
+25 ;Patch 10: mark any deleted record as deleted (don't delete pending record immediately)
+26 Begin DoDot:1
+27 ;--- Mark the record as deleted
+28 SET RORFDA(798,IENS,3)=5
+29 DO FILE^DIE(,"RORFDA","RORMSG")
+30 IF $GET(DIERR)
Begin DoDot:2
+31 SET RC=$$DBS^RORERR("RORMSG",-9,,RORDFN,798,IENS)
End DoDot:2
DO RPCSTK^RORERR(.RESULTS,RC)
End DoDot:1
+32 ;---
+33 SET RESULTS(0)=9
+34 QUIT
