RORUPD50 ;HCIOFO/SG - UPDATE THE PATIENT IN THE REGISTRIES ;8/2/05 9:14am
;;1.5;CLINICAL CASE REGISTRIES;**10,14,18**;Feb 17, 2006;Build 25
;
; This routine uses the following IAs:
;
; #2051 FIND^DIC (supported)
; #10013 ^DIK (supported)
; #2056 $$GET1^DIQ (supported)
; #2055 $$ROOT^DILFD (supported)
; #2053 UPDATE^DIE (supported)
; #2053 FILE^DIE (supported)
Q
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*14 APR 2011 A SAUNDERS ADD: add patient as confirmed if they
; are in the "ROR HCV CONFIRM" array,
; created in HCV^RORUPD04.
;ROR*1.5*18 APR 2012 C RAY Added logic to set confirm date to
; date of oldest selection rule
;******************************************************************************
;******************************************************************************
;
;***** ADDS THE PATIENT TO THE REGISTRY
;
; PATIEN Patient IEN
; REGIEN Registry IEN
;
; [ROR8RULS] Closed root of a local array containing list of
; triggered selection rules:
; @ROR8RULS@(RuleIEN)=Date
; If this parameter is not defined or equals to
; an empty string, selection rules are loaded from
; corresponding sub-node of the ^TMP("RORUPD",$J,"U").
;
; [[.]DOD] Date of death. If this parameter is undefined,
; its value will be taken from the ROR PATIENT file.
; If you are going to call this function several times
; for the same patient (for different registries),
; pass a reference to undefined local variable (the
; DOD will be read from the file only once).
;
; Return values:
; <0 Error code
; 0 Ok
; 1 Patient has already existed in the registry
;
;NOTE: Patch 14 includes functionality to automatically confirm a HEPC patient
;into the registry if the patient had a positive test result for any 1 of
;the 9 new HCV LOINCS added with the patch.
;
ADD(PATIEN,REGIEN,ROR8RULS,DOD) ;
N I,IENS,IENS01,RC,RORFDA,RORIEN,RORMSG,RULEIEN,TMP,ROREDT
;--- Quit if the patient is already in the registry
Q:$$PRRIEN^RORUTL01(PATIEN,REGIEN)>0 1
;
;--- Prepare registry data
K RORFDA S IENS="+1,"
S RORFDA(798,IENS,.01)=PATIEN ; Patient Name
S RORFDA(798,IENS,.02)=REGIEN ; Registry
;set status confirmed if registry is auto-confirm
S RORFDA(798,IENS,3)=$S($D(^ROR(798.1,"C",1,+REGIEN)):0,1:4) ;patch 18 cdate set to now ; Pending
;add patient as "confirmed" if patient had + HCV test (HEPC registry only)
I REGIEN=1,$D(^TMP("ROR HCV CONFIRM",$J,PATIEN)) S RORFDA(798,IENS,3)=0 ;Confirmed
S RORFDA(798,IENS,4)=1 ; Update Demographics
S RORFDA(798,IENS,5)=1 ; Update Local Data
I $$TESTPAT^RORUTL01(PATIEN) S RORFDA(798,IENS,11)=1 ; Don't Send = 1 if test patient
;--- Get the date of death
S:'($D(DOD)#10) DOD=$$GET1^DIQ(798.4,PATIEN_",",.351,"I",,"RORMSG")
;--- Load list of triggered rules
S:$G(ROR8RULS)="" ROR8RULS=$NA(@RORUPDPI@("U",PATIEN,2,REGIEN))
S RULEIEN="",ROREDT=DT ;new variable for earliest rule date
F I=1:1 S RULEIEN=$O(@ROR8RULS@(RULEIEN)) Q:RULEIEN="" D
. S IENS01="+"_(1000+I)_","_IENS
. S RORFDA(798.01,IENS01,.01)=RULEIEN ; SELECTION RULE
. S TMP=$P(@ROR8RULS@(RULEIEN),U)\1
. ;--- Get date if earliest rule
. I TMP>0 D
. . S RORFDA(798.01,IENS01,1)=TMP
. . S ROREDT=$S(TMP<ROREDT:TMP,1:ROREDT)
. S TMP=+$P(@ROR8RULS@(RULEIEN),U,2)
. S:TMP>0 RORFDA(798.01,IENS01,2)=TMP ; LOCATION
;
;--- Registry update transaction
S RC=0 D
. ;--- Call "before update" entry point
. S ENTRY=$G(RORUPD("UPD",REGIEN,1))
. I ENTRY'="" X "S RC="_ENTRY_"(.RORFDA,PATIEN,REGIEN)" Q:RC<0
. ;--- Make sure that the DON'T SEND flag is set for 'test' patient
. S:$$TESTPAT^RORUTL01(PATIEN) RORFDA(798,IENS,11)=1
. ;--- Update the registry
. D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
. I $G(RORMSG("DIERR")) S RC=$$DBS^RORERR("RORMSG",-9) Q
. ;--- Overwrite triggered Confirmation date for Auto confirm registries
. I $D(^ROR(798.1,"C",1,REGIEN)) D
. . K RORFDA,RORMSG S RORFDA(798,RORIEN(1)_",",2)=ROREDT
. . D FILE^DIE(,"RORFDA","RORMSG")
. . I $G(RORMSG("DIERR")) S RC=$$DBS^RORERR("RORMSG",-9) Q
. ;--- Call "after update" entry point
. S ENTRY=$G(RORUPD("UPD",REGIEN,2))
. I ENTRY'="" X "S RC="_ENTRY_"(RORIEN(1),PATIEN,REGIEN)" Q:RC<0
Q:RC'<0 0
;
;--- Rollback the update in case of error(s)
N DA,DIK
S DIK=$$ROOT^DILFD(798),DA=$G(RORIEN(1))
D:DA>0 ^DIK
Q RC
;
;***** ADDS PATIENT DATA TO THE 'ROR PATIENT' FILE
;
; PATIEN Patient IEN
;
; Return values:
; <0 Error code
; 0 Ok
; 1 Patient data have already existed
;
ADDPDATA(PATIEN) ;
N IENS,RC,RORBUF,RORPAT,RORIEN,RORMSG
;--- Try to find patient data
D FIND^DIC(798.4,,"@","QUX",PATIEN,1,"B",,,"RORBUF","RORMSG")
Q:$G(RORMSG("DIERR")) $$DBS^RORERR("RORMSG",-9,,,798.4)
;--- Patient data already exists in the file
Q:$G(RORBUF("DILIST",0)) 1
;--- Check if the patient record in the file #2 is valid
S RC=$$CHKPTR^RORUTL05(PATIEN) Q:RC<0 RC
;--- Prepare patient data
S IENS="+1,"
S RC=$$PATDATA^RORUPD52(PATIEN_",",.RORPAT,IENS) Q:RC<0 RC
S RORIEN(1)=PATIEN ; IEN of the new record
S RORPAT(798.4,IENS,.01)=PATIEN ; Patient Name
;--- Add the patient record to the file
D UPDATE^DIE(,"RORPAT","RORIEN","RORMSG")
I $G(RORMSG("DIERR")) D Q:RC
. S RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,798.4)
Q 0
;
;***** ADDS THE PATIENT TO MARKED REGISTRIES
;
; PATIEN Patient IEN
;
; Return values:
; <0 Error code
; 0 Patient should not be added to the registry
; >0 Patient has been added to the registry
;
UPDREG(PATIEN) ;
N DOD,ENTRY,INCTVDT,RC,REGIEN
;--- Check if patient should be added to any registry
Q:$D(@RORUPDPI@("U",PATIEN,2))<10 0
;--- Add patient data
S RC=$$ADDPDATA(PATIEN) Q:RC<0 RC
;--- Update all marked registries
S REGIEN="",RC=0
F D Q:REGIEN="" S RC=$$ADD(PATIEN,REGIEN,,.DOD) Q:RC<0
. S REGIEN=$O(@RORUPDPI@("U",PATIEN,2,REGIEN))
Q $S(RC<0:RC,1:1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD50 6752 printed Oct 16, 2024@17:44:37 Page 2
RORUPD50 ;HCIOFO/SG - UPDATE THE PATIENT IN THE REGISTRIES ;8/2/05 9:14am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**10,14,18**;Feb 17, 2006;Build 25
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #2051 FIND^DIC (supported)
+6 ; #10013 ^DIK (supported)
+7 ; #2056 $$GET1^DIQ (supported)
+8 ; #2055 $$ROOT^DILFD (supported)
+9 ; #2053 UPDATE^DIE (supported)
+10 ; #2053 FILE^DIE (supported)
+11 QUIT
+12 ;******************************************************************************
+13 ;******************************************************************************
+14 ; --- ROUTINE MODIFICATION LOG ---
+15 ;
+16 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+17 ;----------- ---------- ----------- ----------------------------------------
+18 ;ROR*1.5*14 APR 2011 A SAUNDERS ADD: add patient as confirmed if they
+19 ; are in the "ROR HCV CONFIRM" array,
+20 ; created in HCV^RORUPD04.
+21 ;ROR*1.5*18 APR 2012 C RAY Added logic to set confirm date to
+22 ; date of oldest selection rule
+23 ;******************************************************************************
+24 ;******************************************************************************
+25 ;
+26 ;***** ADDS THE PATIENT TO THE REGISTRY
+27 ;
+28 ; PATIEN Patient IEN
+29 ; REGIEN Registry IEN
+30 ;
+31 ; [ROR8RULS] Closed root of a local array containing list of
+32 ; triggered selection rules:
+33 ; @ROR8RULS@(RuleIEN)=Date
+34 ; If this parameter is not defined or equals to
+35 ; an empty string, selection rules are loaded from
+36 ; corresponding sub-node of the ^TMP("RORUPD",$J,"U").
+37 ;
+38 ; [[.]DOD] Date of death. If this parameter is undefined,
+39 ; its value will be taken from the ROR PATIENT file.
+40 ; If you are going to call this function several times
+41 ; for the same patient (for different registries),
+42 ; pass a reference to undefined local variable (the
+43 ; DOD will be read from the file only once).
+44 ;
+45 ; Return values:
+46 ; <0 Error code
+47 ; 0 Ok
+48 ; 1 Patient has already existed in the registry
+49 ;
+50 ;NOTE: Patch 14 includes functionality to automatically confirm a HEPC patient
+51 ;into the registry if the patient had a positive test result for any 1 of
+52 ;the 9 new HCV LOINCS added with the patch.
+53 ;
ADD(PATIEN,REGIEN,ROR8RULS,DOD) ;
+1 NEW I,IENS,IENS01,RC,RORFDA,RORIEN,RORMSG,RULEIEN,TMP,ROREDT
+2 ;--- Quit if the patient is already in the registry
+3 if $$PRRIEN^RORUTL01(PATIEN,REGIEN)>0
QUIT 1
+4 ;
+5 ;--- Prepare registry data
+6 KILL RORFDA
SET IENS="+1,"
+7 ; Patient Name
SET RORFDA(798,IENS,.01)=PATIEN
+8 ; Registry
SET RORFDA(798,IENS,.02)=REGIEN
+9 ;set status confirmed if registry is auto-confirm
+10 ;patch 18 cdate set to now ; Pending
SET RORFDA(798,IENS,3)=$SELECT($DATA(^ROR(798.1,"C",1,+REGIEN)):0,1:4)
+11 ;add patient as "confirmed" if patient had + HCV test (HEPC registry only)
+12 ;Confirmed
IF REGIEN=1
IF $DATA(^TMP("ROR HCV CONFIRM",$JOB,PATIEN))
SET RORFDA(798,IENS,3)=0
+13 ; Update Demographics
SET RORFDA(798,IENS,4)=1
+14 ; Update Local Data
SET RORFDA(798,IENS,5)=1
+15 ; Don't Send = 1 if test patient
IF $$TESTPAT^RORUTL01(PATIEN)
SET RORFDA(798,IENS,11)=1
+16 ;--- Get the date of death
+17 if '($DATA(DOD)#10)
SET DOD=$$GET1^DIQ(798.4,PATIEN_",",.351,"I",,"RORMSG")
+18 ;--- Load list of triggered rules
+19 if $GET(ROR8RULS)=""
SET ROR8RULS=$NAME(@RORUPDPI@("U",PATIEN,2,REGIEN))
+20 ;new variable for earliest rule date
SET RULEIEN=""
SET ROREDT=DT
+21 FOR I=1:1
SET RULEIEN=$ORDER(@ROR8RULS@(RULEIEN))
if RULEIEN=""
QUIT
Begin DoDot:1
+22 SET IENS01="+"_(1000+I)_","_IENS
+23 ; SELECTION RULE
SET RORFDA(798.01,IENS01,.01)=RULEIEN
+24 SET TMP=$PIECE(@ROR8RULS@(RULEIEN),U)\1
+25 ;--- Get date if earliest rule
+26 IF TMP>0
Begin DoDot:2
+27 SET RORFDA(798.01,IENS01,1)=TMP
+28 SET ROREDT=$SELECT(TMP<ROREDT:TMP,1:ROREDT)
End DoDot:2
+29 SET TMP=+$PIECE(@ROR8RULS@(RULEIEN),U,2)
+30 ; LOCATION
if TMP>0
SET RORFDA(798.01,IENS01,2)=TMP
End DoDot:1
+31 ;
+32 ;--- Registry update transaction
+33 SET RC=0
Begin DoDot:1
+34 ;--- Call "before update" entry point
+35 SET ENTRY=$GET(RORUPD("UPD",REGIEN,1))
+36 IF ENTRY'=""
XECUTE "S RC="_ENTRY_"(.RORFDA,PATIEN,REGIEN)"
if RC<0
QUIT
+37 ;--- Make sure that the DON'T SEND flag is set for 'test' patient
+38 if $$TESTPAT^RORUTL01(PATIEN)
SET RORFDA(798,IENS,11)=1
+39 ;--- Update the registry
+40 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+41 IF $GET(RORMSG("DIERR"))
SET RC=$$DBS^RORERR("RORMSG",-9)
QUIT
+42 ;--- Overwrite triggered Confirmation date for Auto confirm registries
+43 IF $DATA(^ROR(798.1,"C",1,REGIEN))
Begin DoDot:2
+44 KILL RORFDA,RORMSG
SET RORFDA(798,RORIEN(1)_",",2)=ROREDT
+45 DO FILE^DIE(,"RORFDA","RORMSG")
+46 IF $GET(RORMSG("DIERR"))
SET RC=$$DBS^RORERR("RORMSG",-9)
QUIT
End DoDot:2
+47 ;--- Call "after update" entry point
+48 SET ENTRY=$GET(RORUPD("UPD",REGIEN,2))
+49 IF ENTRY'=""
XECUTE "S RC="_ENTRY_"(RORIEN(1),PATIEN,REGIEN)"
if RC<0
QUIT
End DoDot:1
+50 if RC'<0
QUIT 0
+51 ;
+52 ;--- Rollback the update in case of error(s)
+53 NEW DA,DIK
+54 SET DIK=$$ROOT^DILFD(798)
SET DA=$GET(RORIEN(1))
+55 if DA>0
DO ^DIK
+56 QUIT RC
+57 ;
+58 ;***** ADDS PATIENT DATA TO THE 'ROR PATIENT' FILE
+59 ;
+60 ; PATIEN Patient IEN
+61 ;
+62 ; Return values:
+63 ; <0 Error code
+64 ; 0 Ok
+65 ; 1 Patient data have already existed
+66 ;
ADDPDATA(PATIEN) ;
+1 NEW IENS,RC,RORBUF,RORPAT,RORIEN,RORMSG
+2 ;--- Try to find patient data
+3 DO FIND^DIC(798.4,,"@","QUX",PATIEN,1,"B",,,"RORBUF","RORMSG")
+4 if $GET(RORMSG("DIERR"))
QUIT $$DBS^RORERR("RORMSG",-9,,,798.4)
+5 ;--- Patient data already exists in the file
+6 if $GET(RORBUF("DILIST",0))
QUIT 1
+7 ;--- Check if the patient record in the file #2 is valid
+8 SET RC=$$CHKPTR^RORUTL05(PATIEN)
if RC<0
QUIT RC
+9 ;--- Prepare patient data
+10 SET IENS="+1,"
+11 SET RC=$$PATDATA^RORUPD52(PATIEN_",",.RORPAT,IENS)
if RC<0
QUIT RC
+12 ; IEN of the new record
SET RORIEN(1)=PATIEN
+13 ; Patient Name
SET RORPAT(798.4,IENS,.01)=PATIEN
+14 ;--- Add the patient record to the file
+15 DO UPDATE^DIE(,"RORPAT","RORIEN","RORMSG")
+16 IF $GET(RORMSG("DIERR"))
Begin DoDot:1
+17 SET RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,798.4)
End DoDot:1
if RC
QUIT
+18 QUIT 0
+19 ;
+20 ;***** ADDS THE PATIENT TO MARKED REGISTRIES
+21 ;
+22 ; PATIEN Patient IEN
+23 ;
+24 ; Return values:
+25 ; <0 Error code
+26 ; 0 Patient should not be added to the registry
+27 ; >0 Patient has been added to the registry
+28 ;
UPDREG(PATIEN) ;
+1 NEW DOD,ENTRY,INCTVDT,RC,REGIEN
+2 ;--- Check if patient should be added to any registry
+3 if $DATA(@RORUPDPI@("U",PATIEN,2))<10
QUIT 0
+4 ;--- Add patient data
+5 SET RC=$$ADDPDATA(PATIEN)
if RC<0
QUIT RC
+6 ;--- Update all marked registries
+7 SET REGIEN=""
SET RC=0
+8 FOR
Begin DoDot:1
+9 SET REGIEN=$ORDER(@RORUPDPI@("U",PATIEN,2,REGIEN))
End DoDot:1
if REGIEN=""
QUIT
SET RC=$$ADD(PATIEN,REGIEN,,.DOD)
if RC<0
QUIT
+10 QUIT $SELECT(RC<0:RC,1:1)
