| [613] | 1 | RORSET01 ;HCIOFO/SG - REGISTRY SETUP ROUTINE ; 1/27/06 11:00am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | ;***** HEPC REGISTRY SETUP
|
|---|
| 5 | ;
|
|---|
| 6 | N RORERROR ; Error processing data
|
|---|
| 7 | N RORLOG ; Log subsystem constants & variables
|
|---|
| 8 | N RORPARM ; Application parameters
|
|---|
| 9 | ;
|
|---|
| 10 | N LSNAME,RC,REGNAME,RORHDT,RORMNTSK,RORREG,RORSUSP,TMP
|
|---|
| 11 | N ZTCPU,ZTDESC,ZTIO,ZTKIL,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
|
|---|
| 12 | S RORPARM("ERR")=1 ; Enable error processing
|
|---|
| 13 | S RORPARM("SETUP")=1 ; Registry setup indicator
|
|---|
| 14 | ;
|
|---|
| 15 | ;--- IEN and name of the registry
|
|---|
| 16 | S RORREG=$$SELREG^RORUTL18(.REGNAME) G:RORREG<0 ERROR
|
|---|
| 17 | Q:'RORREG
|
|---|
| 18 | S $P(RORREG,U,2)=REGNAME,LSNAME=REGNAME
|
|---|
| 19 | ;
|
|---|
| 20 | ;--- Check the Lab Search
|
|---|
| 21 | S RC=$$LABSRCH^RORSETU2(LSNAME)
|
|---|
| 22 | S RC=$S(RC=-55:$$LSCONF^RORSETU1(LSNAME),RC<0:RC,1:1)
|
|---|
| 23 | Q:'RC G:RC<0 ERROR
|
|---|
| 24 | ;
|
|---|
| 25 | ;--- Request setup parameters
|
|---|
| 26 | S RC=$$ASKPARMS^RORSETU1(.RORMNTSK,.RORSUSP)
|
|---|
| 27 | I RC<0 Q:(RC=-71)!(RC=-72) G ERROR
|
|---|
| 28 | ;
|
|---|
| 29 | ;--- Schedule the setup task
|
|---|
| 30 | S ZTRTN="TASK^RORSET01",ZTIO=""
|
|---|
| 31 | S ZTDESC="Registry Setup ("_$P(RORREG,U,2)_")"
|
|---|
| 32 | F TMP="RORMNTSK","RORREG","RORSUSP" S ZTSAVE(TMP)=""
|
|---|
| 33 | D ^%ZTLOAD
|
|---|
| 34 | Q
|
|---|
| 35 | ERROR ;--- Display the errors
|
|---|
| 36 | D DSPSTK^RORERR()
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | ;***** REPLACES THE SELECTION RULES
|
|---|
| 40 | ;
|
|---|
| 41 | ; RORREG Registry IEN and registry name separated by the '^'
|
|---|
| 42 | ; (RegistryIEN^RegistryName).
|
|---|
| 43 | ; FROM,TO Codes of the rule groups (1-regular, 2-historical)
|
|---|
| 44 | ;
|
|---|
| 45 | ; Return Values:
|
|---|
| 46 | ; <0 Error code
|
|---|
| 47 | ; 0 Ok
|
|---|
| 48 | ;
|
|---|
| 49 | RULES(RORREG,FROM,TO) ;
|
|---|
| 50 | ;;VA HEPC PTF^VA HEPC PTF HIST
|
|---|
| 51 | ;;VA HEPC VISIT^VA HEPC VISIT HIST
|
|---|
| 52 | ;
|
|---|
| 53 | N I,IEN,IENS,NAMES,RC,RORFDA,RORMSG
|
|---|
| 54 | S IENS=","_(+RORREG)_",",RC=0
|
|---|
| 55 | ;--- Replace the selection rules
|
|---|
| 56 | F I=1,2 D Q:RC<0
|
|---|
| 57 | . S NAMES=$P($T(RULES+I),";;",2) Q:NAMES?."^"
|
|---|
| 58 | . S IEN=$$FIND1^DIC(798.13,IENS,"UX",$P(NAMES,U,FROM),"B",,"RORMSG")
|
|---|
| 59 | . Q:IEN=0
|
|---|
| 60 | . S RC=$$DBS^RORERR("RORMSG",-9,,,798.13)
|
|---|
| 61 | . Q:RC<0
|
|---|
| 62 | . S RORFDA(798.13,IEN_IENS,.01)=$P(NAMES,U,TO)
|
|---|
| 63 | . D FILE^DIE(,"RORFDA","RORMSG")
|
|---|
| 64 | . S RC=$$DBS^RORERR("RORMSG",-9,,,798.13,IEN_IENS)
|
|---|
| 65 | Q $S(RC<0:RC,1:0)
|
|---|
| 66 | ;
|
|---|
| 67 | ;***** ENTRY POINT OF THE REGISTRY SETUP TASK
|
|---|
| 68 | ;
|
|---|
| 69 | ; RORMNTSK Maximum number of the registry update subtasks
|
|---|
| 70 | ; RORREG RegistryIEN^RegistryName
|
|---|
| 71 | ; RORSUSP Task suspension time frame (StartTime^EndTime)
|
|---|
| 72 | ;
|
|---|
| 73 | TASK ;
|
|---|
| 74 | N RORERROR ; Error processing data
|
|---|
| 75 | N RORLOG ; Log subsystem constants & variables
|
|---|
| 76 | N RORPARM ; Application parameters
|
|---|
| 77 | ;
|
|---|
| 78 | N RC,REGLST,REGNAME,TMP
|
|---|
| 79 | S RORPARM("DEVELOPER")=1 ; Enable modifications
|
|---|
| 80 | S RORPARM("ERR")=1 ; Enable error processing
|
|---|
| 81 | S RORPARM("LOG")=1 ; Enable event recording
|
|---|
| 82 | S RORPARM("SETUP")=1 ; Registry setup indicator
|
|---|
| 83 | ;
|
|---|
| 84 | S REGNAME=$P(RORREG,U,2),REGLST(REGNAME)=+RORREG
|
|---|
| 85 | ;--- Open a new log
|
|---|
| 86 | S RC=$$OPEN^RORLOG(.REGLST,8,"REGISTRY SETUP STARTED")
|
|---|
| 87 | D
|
|---|
| 88 | . ;--- Replace the selection rules with historical ones
|
|---|
| 89 | . I REGNAME="VA HEPC" S RC=$$RULES(RORREG,1,2) Q:RC<0
|
|---|
| 90 | . ;--- Populate the registry
|
|---|
| 91 | . S RC=$$UPDATE^RORUPD(.REGLST,$G(RORMNTSK),$G(RORSUSP),"E") Q:RC<0
|
|---|
| 92 | . D LOG^RORLOG(2,"The registry has been populated.")
|
|---|
| 93 | . ;--- Convert the ICR 2.1 records
|
|---|
| 94 | . I REGNAME="VA HIV" D Q:RC<0
|
|---|
| 95 | . . S RC=$$CONVERT^RORUPD62(RORREG)
|
|---|
| 96 | . . ;--- Update number of patients in registry parameters
|
|---|
| 97 | . . S TMP=$$UPDDEM^RORUPD51(.REGLST)
|
|---|
| 98 | . ;--- Setup the registry
|
|---|
| 99 | . S RC=$$PREPARE^RORSETU2(RORREG) Q:RC<0
|
|---|
| 100 | ;
|
|---|
| 101 | ;--- Restore the regular selection rules
|
|---|
| 102 | D:REGNAME="VA HEPC"
|
|---|
| 103 | . S TMP=$$RULES(RORREG,2,1) I TMP<0 S:RC'<0 RC=TMP
|
|---|
| 104 | ;--- Close the log
|
|---|
| 105 | S TMP="REGISTRY SETUP "_$S(RC<0:"ABORTED",1:"COMPLETED")
|
|---|
| 106 | D CLOSE^RORLOG(TMP)
|
|---|
| 107 | ;
|
|---|
| 108 | ;--- Send the notification e-mail
|
|---|
| 109 | S:RC'<0 TMP=$$SENDINFO^RORUTL17(+RORREG,,"EP")
|
|---|
| 110 | ;--- Send an alert to the originator of the task
|
|---|
| 111 | S TMP=$S(RC<0:-43,1:-41)
|
|---|
| 112 | D ALERT^RORKIDS(DUZ,TMP,$P(RORREG,U,2),,"registry setup")
|
|---|
| 113 | ;
|
|---|
| 114 | ;--- Cleanup
|
|---|
| 115 | I RC'<0 D S ZTREQ="@"
|
|---|
| 116 | . K ^XTMP("RORUPDR"_+RORREG)
|
|---|
| 117 | Q
|
|---|
