118 lines
3.7 KiB
Mathematica
118 lines
3.7 KiB
Mathematica
RORSET01 ;HCIOFO/SG - REGISTRY SETUP ROUTINE ; 1/27/06 11:00am
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
;***** HEPC REGISTRY SETUP
|
|
;
|
|
N RORERROR ; Error processing data
|
|
N RORLOG ; Log subsystem constants & variables
|
|
N RORPARM ; Application parameters
|
|
;
|
|
N LSNAME,RC,REGNAME,RORHDT,RORMNTSK,RORREG,RORSUSP,TMP
|
|
N ZTCPU,ZTDESC,ZTIO,ZTKIL,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
|
|
S RORPARM("ERR")=1 ; Enable error processing
|
|
S RORPARM("SETUP")=1 ; Registry setup indicator
|
|
;
|
|
;--- IEN and name of the registry
|
|
S RORREG=$$SELREG^RORUTL18(.REGNAME) G:RORREG<0 ERROR
|
|
Q:'RORREG
|
|
S $P(RORREG,U,2)=REGNAME,LSNAME=REGNAME
|
|
;
|
|
;--- Check the Lab Search
|
|
S RC=$$LABSRCH^RORSETU2(LSNAME)
|
|
S RC=$S(RC=-55:$$LSCONF^RORSETU1(LSNAME),RC<0:RC,1:1)
|
|
Q:'RC G:RC<0 ERROR
|
|
;
|
|
;--- Request setup parameters
|
|
S RC=$$ASKPARMS^RORSETU1(.RORMNTSK,.RORSUSP)
|
|
I RC<0 Q:(RC=-71)!(RC=-72) G ERROR
|
|
;
|
|
;--- Schedule the setup task
|
|
S ZTRTN="TASK^RORSET01",ZTIO=""
|
|
S ZTDESC="Registry Setup ("_$P(RORREG,U,2)_")"
|
|
F TMP="RORMNTSK","RORREG","RORSUSP" S ZTSAVE(TMP)=""
|
|
D ^%ZTLOAD
|
|
Q
|
|
ERROR ;--- Display the errors
|
|
D DSPSTK^RORERR()
|
|
Q
|
|
;
|
|
;***** REPLACES THE SELECTION RULES
|
|
;
|
|
; RORREG Registry IEN and registry name separated by the '^'
|
|
; (RegistryIEN^RegistryName).
|
|
; FROM,TO Codes of the rule groups (1-regular, 2-historical)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
RULES(RORREG,FROM,TO) ;
|
|
;;VA HEPC PTF^VA HEPC PTF HIST
|
|
;;VA HEPC VISIT^VA HEPC VISIT HIST
|
|
;
|
|
N I,IEN,IENS,NAMES,RC,RORFDA,RORMSG
|
|
S IENS=","_(+RORREG)_",",RC=0
|
|
;--- Replace the selection rules
|
|
F I=1,2 D Q:RC<0
|
|
. S NAMES=$P($T(RULES+I),";;",2) Q:NAMES?."^"
|
|
. S IEN=$$FIND1^DIC(798.13,IENS,"UX",$P(NAMES,U,FROM),"B",,"RORMSG")
|
|
. Q:IEN=0
|
|
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.13)
|
|
. Q:RC<0
|
|
. S RORFDA(798.13,IEN_IENS,.01)=$P(NAMES,U,TO)
|
|
. D FILE^DIE(,"RORFDA","RORMSG")
|
|
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.13,IEN_IENS)
|
|
Q $S(RC<0:RC,1:0)
|
|
;
|
|
;***** ENTRY POINT OF THE REGISTRY SETUP TASK
|
|
;
|
|
; RORMNTSK Maximum number of the registry update subtasks
|
|
; RORREG RegistryIEN^RegistryName
|
|
; RORSUSP Task suspension time frame (StartTime^EndTime)
|
|
;
|
|
TASK ;
|
|
N RORERROR ; Error processing data
|
|
N RORLOG ; Log subsystem constants & variables
|
|
N RORPARM ; Application parameters
|
|
;
|
|
N RC,REGLST,REGNAME,TMP
|
|
S RORPARM("DEVELOPER")=1 ; Enable modifications
|
|
S RORPARM("ERR")=1 ; Enable error processing
|
|
S RORPARM("LOG")=1 ; Enable event recording
|
|
S RORPARM("SETUP")=1 ; Registry setup indicator
|
|
;
|
|
S REGNAME=$P(RORREG,U,2),REGLST(REGNAME)=+RORREG
|
|
;--- Open a new log
|
|
S RC=$$OPEN^RORLOG(.REGLST,8,"REGISTRY SETUP STARTED")
|
|
D
|
|
. ;--- Replace the selection rules with historical ones
|
|
. I REGNAME="VA HEPC" S RC=$$RULES(RORREG,1,2) Q:RC<0
|
|
. ;--- Populate the registry
|
|
. S RC=$$UPDATE^RORUPD(.REGLST,$G(RORMNTSK),$G(RORSUSP),"E") Q:RC<0
|
|
. D LOG^RORLOG(2,"The registry has been populated.")
|
|
. ;--- Convert the ICR 2.1 records
|
|
. I REGNAME="VA HIV" D Q:RC<0
|
|
. . S RC=$$CONVERT^RORUPD62(RORREG)
|
|
. . ;--- Update number of patients in registry parameters
|
|
. . S TMP=$$UPDDEM^RORUPD51(.REGLST)
|
|
. ;--- Setup the registry
|
|
. S RC=$$PREPARE^RORSETU2(RORREG) Q:RC<0
|
|
;
|
|
;--- Restore the regular selection rules
|
|
D:REGNAME="VA HEPC"
|
|
. S TMP=$$RULES(RORREG,2,1) I TMP<0 S:RC'<0 RC=TMP
|
|
;--- Close the log
|
|
S TMP="REGISTRY SETUP "_$S(RC<0:"ABORTED",1:"COMPLETED")
|
|
D CLOSE^RORLOG(TMP)
|
|
;
|
|
;--- Send the notification e-mail
|
|
S:RC'<0 TMP=$$SENDINFO^RORUTL17(+RORREG,,"EP")
|
|
;--- Send an alert to the originator of the task
|
|
S TMP=$S(RC<0:-43,1:-41)
|
|
D ALERT^RORKIDS(DUZ,TMP,$P(RORREG,U,2),,"registry setup")
|
|
;
|
|
;--- Cleanup
|
|
I RC'<0 D S ZTREQ="@"
|
|
. K ^XTMP("RORUPDR"_+RORREG)
|
|
Q
|