- 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 Feb 18, 2025@23:10:08 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)