RORTSITE ;HCIOFO/SG - PREPARE TEST SITES FOR GOING LIVE ; 5/10/02 11:43am
;;1.0;CLINICAL CASE REGISTRIES;;May 14, 2002
;
Q
;
;***** PREPARE TEST SITE
START ;
N RORERROR ; Error processing data
N RORLOG ; Log subsystem constants & variables
N RORPARM ; Application parameters
;
N DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RC,REGIEN,X,Y
K DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Prepare the site for going live"
D ^DIR W ! Q:$D(DIRUT)!'$G(Y)
;
S RORPARM("DEBUG")=2 ; Debug mode (display messages)
S RORPARM("ERR")=1 ; Enable error processing
S RORPARM("LOG")=1 ; Enable error recording
D INIT^RORUTL01("ROR",1)
;
S REGIEN=$$REGIEN^RORUTL02("VA HEPC")
I REGIEN<0 D:REGIEN>-3 G ERROR
. S RC=$$ERROR^RORERR(REGIEN,"START^RORTSITE")
;
W !,"Updating registry records...",!
S RC=$$RECORDS(REGIEN,.DATE) G:RC<0 ERROR
W "Processed records: "_+RC_", Errors: "_+$P(RC,U,2),!
;
W !,"Updating registry parameters..."
G:$$REGPARM(REGIEN,DATE)<0 ERROR
W !,"Ok",!
Q
;
;***** DISPLAYS THE ERRORS
ERROR ;
D DSPSTK^RORERR()
Q
;
;***** PREPARE REGISTRY RECORDS
RECORDS(REGIEN,BNDRYDT) ;
N CNT,DATE,ECNT,IEN,IENS,LD1,PATIEN,RC,ROOT,RORBUF,RORFDA,RORMSG,TMP
S ROOT=$$ROOT^DILFD(798,,1)
;--- Get the lag period
S LD1=$$GET1^DIQ(798.1,REGIEN_",",15.1,,,"RORMSG")
S RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE") Q:RC<0 RC
;--- Calculate the date
S BNDRYDT=$$FMADD^XLFDT($$DT^XLFDT,-$S(LD1>0:LD1,1:1)-1)
;--- Store the date into the records of the registry
S IEN="",(CNT,ECNT)=0
F S IEN=$O(@ROOT@("AC",REGIEN,IEN)) Q:IEN="" D
. S CNT=CNT+1 W:'(CNT#10) *13,CNT
. S IENS=IEN_",",DATE=BNDRYDT
. K RORBUF,RORMSG
. D GETS^DIQ(798,IENS,"2;8","EI","RORBUF","RORMSG")
. I $G(DIERR) D S ECNT=ECNT+1 Q
. . S RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE")
. ;--- Check the inactivation date if the record is not active
. I '$G(RORBUF(798,IENS,8,"E")) D S:DATE>TMP DATE=TMP
. . S TMP=$G(RORBUF(798,IENS,2,"I"))
. ;--- Update the record
. S RORFDA(798,IENS,3)=1 ; NEW PATIENT
. S RORFDA(798,IENS,4)=1 ; UPDATE DEMOGRAPHICS
. S RORFDA(798,IENS,5)=1 ; UPDATE LOCAL REGISTRY DATA
. S RORFDA(798,IENS,9.1)=DATE ; DATA ACKNOWLEDGED UNTIL
. S RORFDA(798,IENS,9.2)=DATE ; DATA EXTRACTED UNTIL
. S RORFDA(798,IENS,10)="@" ; MESSAGE ID
. D FILE^DIE(,"RORFDA","RORMSG")
. I $G(DIERR) D S ECNT=ECNT+1 Q
. . S RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE")
W:IEN="" *13
Q $S(RC<0:-9,1:CNT_U_ECNT)
;
;***** PREPARE REGISTRY PARAMETERS
REGPARM(REGIEN,DATE) ;
N IENS,RC,RORFDA,RORMSG
S IENS=REGIEN_","
S RORFDA(798.1,IENS,2)=2960101 ; DATA EXTRACTED UNTIL
S RORFDA(798.1,IENS,2.1)="@" ; LAST BATCH ID
S RORFDA(798.1,IENS,2.2)="@" ; AWAITING ACKNOWLEDGEMENT
S RORFDA(798.1,IENS,2.3)="@" ; LAST MESSAGE ID
S RORFDA(798.1,IENS,15.9)=1 ; DAYS TO WAIT FOR ACK
S RORFDA(798.1,IENS,21.02)=DATE ; HDT END DATE
S RORFDA(798.1,IENS,21.05)=$$NOW^XLFDT ; HDT DATE/TIME
S RORFDA(798.1,IENS,25)=1 ; ENABLE PROTOCOLS
D FILE^DIE(,"RORFDA","RORMSG")
Q $$DBS^RORERR("RORMSG",-9,"REGPARM^RORTSITE",,798.1,IENS)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORTSITE 3307 printed Dec 13, 2024@01:43:28 Page 2
RORTSITE ;HCIOFO/SG - PREPARE TEST SITES FOR GOING LIVE ; 5/10/02 11:43am
+1 ;;1.0;CLINICAL CASE REGISTRIES;;May 14, 2002
+2 ;
+3 QUIT
+4 ;
+5 ;***** PREPARE TEST SITE
START ;
+1 ; Error processing data
NEW RORERROR
+2 ; Log subsystem constants & variables
NEW RORLOG
+3 ; Application parameters
NEW RORPARM
+4 ;
+5 NEW DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RC,REGIEN,X,Y
+6 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+7 SET DIR("A")="Prepare the site for going live"
+8 DO ^DIR
WRITE !
if $DATA(DIRUT)!'$GET(Y)
QUIT
+9 ;
+10 ; Debug mode (display messages)
SET RORPARM("DEBUG")=2
+11 ; Enable error processing
SET RORPARM("ERR")=1
+12 ; Enable error recording
SET RORPARM("LOG")=1
+13 DO INIT^RORUTL01("ROR",1)
+14 ;
+15 SET REGIEN=$$REGIEN^RORUTL02("VA HEPC")
+16 IF REGIEN<0
if REGIEN>-3
Begin DoDot:1
+17 SET RC=$$ERROR^RORERR(REGIEN,"START^RORTSITE")
End DoDot:1
GOTO ERROR
+18 ;
+19 WRITE !,"Updating registry records...",!
+20 SET RC=$$RECORDS(REGIEN,.DATE)
if RC<0
GOTO ERROR
+21 WRITE "Processed records: "_+RC_", Errors: "_+$PIECE(RC,U,2),!
+22 ;
+23 WRITE !,"Updating registry parameters..."
+24 if $$REGPARM(REGIEN,DATE)<0
GOTO ERROR
+25 WRITE !,"Ok",!
+26 QUIT
+27 ;
+28 ;***** DISPLAYS THE ERRORS
ERROR ;
+1 DO DSPSTK^RORERR()
+2 QUIT
+3 ;
+4 ;***** PREPARE REGISTRY RECORDS
RECORDS(REGIEN,BNDRYDT) ;
+1 NEW CNT,DATE,ECNT,IEN,IENS,LD1,PATIEN,RC,ROOT,RORBUF,RORFDA,RORMSG,TMP
+2 SET ROOT=$$ROOT^DILFD(798,,1)
+3 ;--- Get the lag period
+4 SET LD1=$$GET1^DIQ(798.1,REGIEN_",",15.1,,,"RORMSG")
+5 SET RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE")
if RC<0
QUIT RC
+6 ;--- Calculate the date
+7 SET BNDRYDT=$$FMADD^XLFDT($$DT^XLFDT,-$SELECT(LD1>0:LD1,1:1)-1)
+8 ;--- Store the date into the records of the registry
+9 SET IEN=""
SET (CNT,ECNT)=0
+10 FOR
SET IEN=$ORDER(@ROOT@("AC",REGIEN,IEN))
if IEN=""
QUIT
Begin DoDot:1
+11 SET CNT=CNT+1
if '(CNT#10)
WRITE *13,CNT
+12 SET IENS=IEN_","
SET DATE=BNDRYDT
+13 KILL RORBUF,RORMSG
+14 DO GETS^DIQ(798,IENS,"2;8","EI","RORBUF","RORMSG")
+15 IF $GET(DIERR)
Begin DoDot:2
+16 SET RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE")
End DoDot:2
SET ECNT=ECNT+1
QUIT
+17 ;--- Check the inactivation date if the record is not active
+18 IF '$GET(RORBUF(798,IENS,8,"E"))
Begin DoDot:2
+19 SET TMP=$GET(RORBUF(798,IENS,2,"I"))
End DoDot:2
if DATE>TMP
SET DATE=TMP
+20 ;--- Update the record
+21 ; NEW PATIENT
SET RORFDA(798,IENS,3)=1
+22 ; UPDATE DEMOGRAPHICS
SET RORFDA(798,IENS,4)=1
+23 ; UPDATE LOCAL REGISTRY DATA
SET RORFDA(798,IENS,5)=1
+24 ; DATA ACKNOWLEDGED UNTIL
SET RORFDA(798,IENS,9.1)=DATE
+25 ; DATA EXTRACTED UNTIL
SET RORFDA(798,IENS,9.2)=DATE
+26 ; MESSAGE ID
SET RORFDA(798,IENS,10)="@"
+27 DO FILE^DIE(,"RORFDA","RORMSG")
+28 IF $GET(DIERR)
Begin DoDot:2
+29 SET RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE")
End DoDot:2
SET ECNT=ECNT+1
QUIT
End DoDot:1
+30 if IEN=""
WRITE *13
+31 QUIT $SELECT(RC<0:-9,1:CNT_U_ECNT)
+32 ;
+33 ;***** PREPARE REGISTRY PARAMETERS
REGPARM(REGIEN,DATE) ;
+1 NEW IENS,RC,RORFDA,RORMSG
+2 SET IENS=REGIEN_","
+3 ; DATA EXTRACTED UNTIL
SET RORFDA(798.1,IENS,2)=2960101
+4 ; LAST BATCH ID
SET RORFDA(798.1,IENS,2.1)="@"
+5 ; AWAITING ACKNOWLEDGEMENT
SET RORFDA(798.1,IENS,2.2)="@"
+6 ; LAST MESSAGE ID
SET RORFDA(798.1,IENS,2.3)="@"
+7 ; DAYS TO WAIT FOR ACK
SET RORFDA(798.1,IENS,15.9)=1
+8 ; HDT END DATE
SET RORFDA(798.1,IENS,21.02)=DATE
+9 ; HDT DATE/TIME
SET RORFDA(798.1,IENS,21.05)=$$NOW^XLFDT
+10 ; ENABLE PROTOCOLS
SET RORFDA(798.1,IENS,25)=1
+11 DO FILE^DIE(,"RORFDA","RORMSG")
+12 QUIT $$DBS^RORERR("RORMSG",-9,"REGPARM^RORTSITE",,798.1,IENS)
