| [613] | 1 | RORUPD50 ;HCIOFO/SG - UPDATE THE PATIENT IN THE REGISTRIES ; 8/2/05 9:14am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** ADDS THE PATIENT TO THE REGISTRY
|
|---|
| 7 | ;
|
|---|
| 8 | ; PATIEN Patient IEN
|
|---|
| 9 | ; REGIEN Registry IEN
|
|---|
| 10 | ;
|
|---|
| 11 | ; [ROR8RULS] Closed root of a local array containing list of
|
|---|
| 12 | ; triggered selection rules:
|
|---|
| 13 | ; @ROR8RULS@(RuleIEN)=Date
|
|---|
| 14 | ; If this parameter is not defined or equals to
|
|---|
| 15 | ; an empty string, selection rules are loaded from
|
|---|
| 16 | ; corresponding sub-node of the ^TMP("RORUPD",$J,"U").
|
|---|
| 17 | ;
|
|---|
| 18 | ; [[.]DOD] Date of death. If this parameter is undefined,
|
|---|
| 19 | ; its value will be taken from the ROR PATIENT file.
|
|---|
| 20 | ; If you are going to call this function several times
|
|---|
| 21 | ; for the same patient (for different registries),
|
|---|
| 22 | ; pass a reference to undefined local variable (the
|
|---|
| 23 | ; DOD will be read from the file only once).
|
|---|
| 24 | ;
|
|---|
| 25 | ; Return values:
|
|---|
| 26 | ; <0 Error code
|
|---|
| 27 | ; 0 Ok
|
|---|
| 28 | ; 1 Patient has already existed in the registry
|
|---|
| 29 | ;
|
|---|
| 30 | ADD(PATIEN,REGIEN,ROR8RULS,DOD) ;
|
|---|
| 31 | N I,IENS,IENS01,RC,RORFDA,RORIEN,RORMSG,RULEIEN,TMP
|
|---|
| 32 | ;--- Quit if the patient is already in the registry
|
|---|
| 33 | Q:$$PRRIEN^RORUTL01(PATIEN,REGIEN)>0 1
|
|---|
| 34 | ;
|
|---|
| 35 | ;--- Prepare registry data
|
|---|
| 36 | K RORFDA S IENS="+1,"
|
|---|
| 37 | S RORFDA(798,IENS,.01)=PATIEN ; Patient Name
|
|---|
| 38 | S RORFDA(798,IENS,.02)=REGIEN ; Registry
|
|---|
| 39 | S RORFDA(798,IENS,3)=4 ; Pending
|
|---|
| 40 | S RORFDA(798,IENS,4)=1 ; Update Demographics
|
|---|
| 41 | S RORFDA(798,IENS,5)=1 ; Update Local Data
|
|---|
| 42 | S RORFDA(798,IENS,11)=1 ; Don't Send
|
|---|
| 43 | ;--- Get the date of death
|
|---|
| 44 | S:'($D(DOD)#10) DOD=$$GET1^DIQ(798.4,PATIEN_",",.351,"I",,"RORMSG")
|
|---|
| 45 | ;--- Load list of triggered rules
|
|---|
| 46 | S:$G(ROR8RULS)="" ROR8RULS=$NA(@RORUPDPI@("U",PATIEN,2,REGIEN))
|
|---|
| 47 | S RULEIEN=""
|
|---|
| 48 | F I=1:1 S RULEIEN=$O(@ROR8RULS@(RULEIEN)) Q:RULEIEN="" D
|
|---|
| 49 | . S IENS01="+"_(1000+I)_","_IENS
|
|---|
| 50 | . S RORFDA(798.01,IENS01,.01)=RULEIEN ; SELECTION RULE
|
|---|
| 51 | . S TMP=$P(@ROR8RULS@(RULEIEN),U)\1
|
|---|
| 52 | . S:TMP>0 RORFDA(798.01,IENS01,1)=TMP ; DATE
|
|---|
| 53 | . S TMP=+$P(@ROR8RULS@(RULEIEN),U,2)
|
|---|
| 54 | . S:TMP>0 RORFDA(798.01,IENS01,2)=TMP ; LOCATION
|
|---|
| 55 | ;
|
|---|
| 56 | ;--- Registry update transaction
|
|---|
| 57 | S RC=0 D
|
|---|
| 58 | . ;--- Call "before update" entry point
|
|---|
| 59 | . S ENTRY=$G(RORUPD("UPD",REGIEN,1))
|
|---|
| 60 | . I ENTRY'="" X "S RC="_ENTRY_"(.RORFDA,PATIEN,REGIEN)" Q:RC<0
|
|---|
| 61 | . ;--- Make sure that the DON'T SEND flag is set for 'test' patient
|
|---|
| 62 | . S:$$TESTPAT^RORUTL01(PATIEN) RORFDA(798,IENS,11)=1
|
|---|
| 63 | . ;--- Update the registry
|
|---|
| 64 | . D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
|
|---|
| 65 | . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9) Q
|
|---|
| 66 | . ;--- Call "after update" entry point
|
|---|
| 67 | . S ENTRY=$G(RORUPD("UPD",REGIEN,2))
|
|---|
| 68 | . I ENTRY'="" X "S RC="_ENTRY_"(RORIEN(1),PATIEN,REGIEN)" Q:RC<0
|
|---|
| 69 | Q:RC'<0 0
|
|---|
| 70 | ;
|
|---|
| 71 | ;--- Rollback the update in case of error(s)
|
|---|
| 72 | N DA,DIK
|
|---|
| 73 | S DIK=$$ROOT^DILFD(798),DA=$G(RORIEN(1))
|
|---|
| 74 | D:DA>0 ^DIK
|
|---|
| 75 | Q RC
|
|---|
| 76 | ;
|
|---|
| 77 | ;***** ADDS PATIENT DATA TO THE 'ROR PATIENT' FILE
|
|---|
| 78 | ;
|
|---|
| 79 | ; PATIEN Patient IEN
|
|---|
| 80 | ;
|
|---|
| 81 | ; Return values:
|
|---|
| 82 | ; <0 Error code
|
|---|
| 83 | ; 0 Ok
|
|---|
| 84 | ; 1 Patient data have already existed
|
|---|
| 85 | ;
|
|---|
| 86 | ADDPDATA(PATIEN) ;
|
|---|
| 87 | N IENS,RC,RORBUF,RORPAT,RORIEN,RORMSG
|
|---|
| 88 | ;--- Try to find patient data
|
|---|
| 89 | D FIND^DIC(798.4,,"@","QUX",PATIEN,1,"B",,,"RORBUF","RORMSG")
|
|---|
| 90 | Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.4)
|
|---|
| 91 | ;--- Patient data already exists in the file
|
|---|
| 92 | Q:$G(RORBUF("DILIST",0)) 1
|
|---|
| 93 | ;--- Check if the patient record in the file #2 is valid
|
|---|
| 94 | S RC=$$CHKPTR^RORUTL05(PATIEN) Q:RC<0 RC
|
|---|
| 95 | ;--- Prepare patient data
|
|---|
| 96 | S IENS="+1,"
|
|---|
| 97 | S RC=$$PATDATA^RORUPD52(PATIEN_",",.RORPAT,IENS) Q:RC<0 RC
|
|---|
| 98 | S RORIEN(1)=PATIEN ; IEN of the new record
|
|---|
| 99 | S RORPAT(798.4,IENS,.01)=PATIEN ; Patient Name
|
|---|
| 100 | ;--- Add the patient record to the file
|
|---|
| 101 | D UPDATE^DIE(,"RORPAT","RORIEN","RORMSG")
|
|---|
| 102 | I $G(DIERR) D Q:RC
|
|---|
| 103 | . S RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,798.4)
|
|---|
| 104 | Q 0
|
|---|
| 105 | ;
|
|---|
| 106 | ;***** ADDS THE PATIENT TO MARKED REGISTRIES
|
|---|
| 107 | ;
|
|---|
| 108 | ; PATIEN Patient IEN
|
|---|
| 109 | ;
|
|---|
| 110 | ; Return values:
|
|---|
| 111 | ; <0 Error code
|
|---|
| 112 | ; 0 Patient should not be added to the registry
|
|---|
| 113 | ; >0 Patient has been added to the registry
|
|---|
| 114 | ;
|
|---|
| 115 | UPDREG(PATIEN) ;
|
|---|
| 116 | N DOD,ENTRY,INCTVDT,RC,REGIEN
|
|---|
| 117 | ;--- Check if patient should be added to any registry
|
|---|
| 118 | Q:$D(@RORUPDPI@("U",PATIEN,2))<10 0
|
|---|
| 119 | ;--- Add patient data
|
|---|
| 120 | S RC=$$ADDPDATA(PATIEN) Q:RC<0 RC
|
|---|
| 121 | ;--- Update all marked registries
|
|---|
| 122 | S REGIEN="",RC=0
|
|---|
| 123 | F D Q:REGIEN="" S RC=$$ADD(PATIEN,REGIEN,,.DOD) Q:RC<0
|
|---|
| 124 | . S REGIEN=$O(@RORUPDPI@("U",PATIEN,2,REGIEN))
|
|---|
| 125 | Q $S(RC<0:RC,1:1)
|
|---|
