source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORSET01.m@ 1354

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