RORSET01.m

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 ---RORSET01   3911     printed  Feb 18, 2025@23:09:46                                                                                                                                                                                                    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