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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORSET01 3911 printed Dec 13, 2024@01:43:23 Page 2
RORSET01 ;HCIOFO/SG - REGISTRY SETUP ROUTINE ; 1/27/06 11:00am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ;***** HEPC REGISTRY SETUP
+4 ;
+5 ; Error processing data
NEW RORERROR
+6 ; Log subsystem constants & variables
NEW RORLOG
+7 ; Application parameters
NEW RORPARM
+8 ;
+9 NEW LSNAME,RC,REGNAME,RORHDT,RORMNTSK,RORREG,RORSUSP,TMP
+10 NEW ZTCPU,ZTDESC,ZTIO,ZTKIL,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
+11 ; Enable error processing
SET RORPARM("ERR")=1
+12 ; Registry setup indicator
SET RORPARM("SETUP")=1
+13 ;
+14 ;--- IEN and name of the registry
+15 SET RORREG=$$SELREG^RORUTL18(.REGNAME)
if RORREG<0
GOTO ERROR
+16 if 'RORREG
QUIT
+17 SET $PIECE(RORREG,U,2)=REGNAME
SET LSNAME=REGNAME
+18 ;
+19 ;--- Check the Lab Search
+20 SET RC=$$LABSRCH^RORSETU2(LSNAME)
+21 SET RC=$SELECT(RC=-55:$$LSCONF^RORSETU1(LSNAME),RC<0:RC,1:1)
+22 if 'RC
QUIT
if RC<0
GOTO ERROR
+23 ;
+24 ;--- Request setup parameters
+25 SET RC=$$ASKPARMS^RORSETU1(.RORMNTSK,.RORSUSP)
+26 IF RC<0
if (RC=-71)!(RC=-72)
QUIT
GOTO ERROR
+27 ;
+28 ;--- Schedule the setup task
+29 SET ZTRTN="TASK^RORSET01"
SET ZTIO=""
+30 SET ZTDESC="Registry Setup ("_$PIECE(RORREG,U,2)_")"
+31 FOR TMP="RORMNTSK","RORREG","RORSUSP"
SET ZTSAVE(TMP)=""
+32 DO ^%ZTLOAD
+33 QUIT
ERROR ;--- Display the errors
+1 DO DSPSTK^RORERR()
+2 QUIT
+3 ;
+4 ;***** REPLACES THE SELECTION RULES
+5 ;
+6 ; RORREG Registry IEN and registry name separated by the '^'
+7 ; (RegistryIEN^RegistryName).
+8 ; FROM,TO Codes of the rule groups (1-regular, 2-historical)
+9 ;
+10 ; Return Values:
+11 ; <0 Error code
+12 ; 0 Ok
+13 ;
RULES(RORREG,FROM,TO) ;
+1 ;;VA HEPC PTF^VA HEPC PTF HIST
+2 ;;VA HEPC VISIT^VA HEPC VISIT HIST
+3 ;
+4 NEW I,IEN,IENS,NAMES,RC,RORFDA,RORMSG
+5 SET IENS=","_(+RORREG)_","
SET RC=0
+6 ;--- Replace the selection rules
+7 FOR I=1,2
Begin DoDot:1
+8 SET NAMES=$PIECE($TEXT(RULES+I),";;",2)
if NAMES?."^"
QUIT
+9 SET IEN=$$FIND1^DIC(798.13,IENS,"UX",$PIECE(NAMES,U,FROM),"B",,"RORMSG")
+10 if IEN=0
QUIT
+11 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.13)
+12 if RC<0
QUIT
+13 SET RORFDA(798.13,IEN_IENS,.01)=$PIECE(NAMES,U,TO)
+14 DO FILE^DIE(,"RORFDA","RORMSG")
+15 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.13,IEN_IENS)
End DoDot:1
if RC<0
QUIT
+16 QUIT $SELECT(RC<0:RC,1:0)
+17 ;
+18 ;***** ENTRY POINT OF THE REGISTRY SETUP TASK
+19 ;
+20 ; RORMNTSK Maximum number of the registry update subtasks
+21 ; RORREG RegistryIEN^RegistryName
+22 ; RORSUSP Task suspension time frame (StartTime^EndTime)
+23 ;
TASK ;
+1 ; Error processing data
NEW RORERROR
+2 ; Log subsystem constants & variables
NEW RORLOG
+3 ; Application parameters
NEW RORPARM
+4 ;
+5 NEW RC,REGLST,REGNAME,TMP
+6 ; Enable modifications
SET RORPARM("DEVELOPER")=1
+7 ; Enable error processing
SET RORPARM("ERR")=1
+8 ; Enable event recording
SET RORPARM("LOG")=1
+9 ; Registry setup indicator
SET RORPARM("SETUP")=1
+10 ;
+11 SET REGNAME=$PIECE(RORREG,U,2)
SET REGLST(REGNAME)=+RORREG
+12 ;--- Open a new log
+13 SET RC=$$OPEN^RORLOG(.REGLST,8,"REGISTRY SETUP STARTED")
+14 Begin DoDot:1
+15 ;--- Replace the selection rules with historical ones
+16 IF REGNAME="VA HEPC"
SET RC=$$RULES(RORREG,1,2)
if RC<0
QUIT
+17 ;--- Populate the registry
+18 SET RC=$$UPDATE^RORUPD(.REGLST,$GET(RORMNTSK),$GET(RORSUSP),"E")
if RC<0
QUIT
+19 DO LOG^RORLOG(2,"The registry has been populated.")
+20 ;--- Convert the ICR 2.1 records
+21 IF REGNAME="VA HIV"
Begin DoDot:2
+22 SET RC=$$CONVERT^RORUPD62(RORREG)
+23 ;--- Update number of patients in registry parameters
+24 SET TMP=$$UPDDEM^RORUPD51(.REGLST)
End DoDot:2
if RC<0
QUIT
+25 ;--- Setup the registry
+26 SET RC=$$PREPARE^RORSETU2(RORREG)
if RC<0
QUIT
End DoDot:1
+27 ;
+28 ;--- Restore the regular selection rules
+29 if REGNAME="VA HEPC"
Begin DoDot:1
+30 SET TMP=$$RULES(RORREG,2,1)
IF TMP<0
if RC'<0
SET RC=TMP
End DoDot:1
+31 ;--- Close the log
+32 SET TMP="REGISTRY SETUP "_$SELECT(RC<0:"ABORTED",1:"COMPLETED")
+33 DO CLOSE^RORLOG(TMP)
+34 ;
+35 ;--- Send the notification e-mail
+36 if RC'<0
SET TMP=$$SENDINFO^RORUTL17(+RORREG,,"EP")
+37 ;--- Send an alert to the originator of the task
+38 SET TMP=$SELECT(RC<0:-43,1:-41)
+39 DO ALERT^RORKIDS(DUZ,TMP,$PIECE(RORREG,U,2),,"registry setup")
+40 ;
+41 ;--- Cleanup
+42 IF RC'<0
Begin DoDot:1
+43 KILL ^XTMP("RORUPDR"_+RORREG)
End DoDot:1
SET ZTREQ="@"
+44 QUIT
