source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORTSITE.m@ 770

Last change on this file since 770 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1RORTSITE ;HCIOFO/SG - PREPARE TEST SITES FOR GOING LIVE ; 5/10/02 11:43am
2 ;;1.0;CLINICAL CASE REGISTRIES;;May 14, 2002
3 ;
4 Q
5 ;
6 ;***** PREPARE TEST SITE
7START ;
8 N RORERROR ; Error processing data
9 N RORLOG ; Log subsystem constants & variables
10 N RORPARM ; Application parameters
11 ;
12 N DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RC,REGIEN,X,Y
13 K DIR S DIR(0)="Y",DIR("B")="NO"
14 S DIR("A")="Prepare the site for going live"
15 D ^DIR W ! Q:$D(DIRUT)!'$G(Y)
16 ;
17 S RORPARM("DEBUG")=2 ; Debug mode (display messages)
18 S RORPARM("ERR")=1 ; Enable error processing
19 S RORPARM("LOG")=1 ; Enable error recording
20 D INIT^RORUTL01("ROR",1)
21 ;
22 S REGIEN=$$REGIEN^RORUTL02("VA HEPC")
23 I REGIEN<0 D:REGIEN>-3 G ERROR
24 . S RC=$$ERROR^RORERR(REGIEN,"START^RORTSITE")
25 ;
26 W !,"Updating registry records...",!
27 S RC=$$RECORDS(REGIEN,.DATE) G:RC<0 ERROR
28 W "Processed records: "_+RC_", Errors: "_+$P(RC,U,2),!
29 ;
30 W !,"Updating registry parameters..."
31 G:$$REGPARM(REGIEN,DATE)<0 ERROR
32 W !,"Ok",!
33 Q
34 ;
35 ;***** DISPLAYS THE ERRORS
36ERROR ;
37 D DSPSTK^RORERR()
38 Q
39 ;
40 ;***** PREPARE REGISTRY RECORDS
41RECORDS(REGIEN,BNDRYDT) ;
42 N CNT,DATE,ECNT,IEN,IENS,LD1,PATIEN,RC,ROOT,RORBUF,RORFDA,RORMSG,TMP
43 S ROOT=$$ROOT^DILFD(798,,1)
44 ;--- Get the lag period
45 S LD1=$$GET1^DIQ(798.1,REGIEN_",",15.1,,,"RORMSG")
46 S RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE") Q:RC<0 RC
47 ;--- Calculate the date
48 S BNDRYDT=$$FMADD^XLFDT($$DT^XLFDT,-$S(LD1>0:LD1,1:1)-1)
49 ;--- Store the date into the records of the registry
50 S IEN="",(CNT,ECNT)=0
51 F S IEN=$O(@ROOT@("AC",REGIEN,IEN)) Q:IEN="" D
52 . S CNT=CNT+1 W:'(CNT#10) *13,CNT
53 . S IENS=IEN_",",DATE=BNDRYDT
54 . K RORBUF,RORMSG
55 . D GETS^DIQ(798,IENS,"2;8","EI","RORBUF","RORMSG")
56 . I $G(DIERR) D S ECNT=ECNT+1 Q
57 . . S RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE")
58 . ;--- Check the inactivation date if the record is not active
59 . I '$G(RORBUF(798,IENS,8,"E")) D S:DATE>TMP DATE=TMP
60 . . S TMP=$G(RORBUF(798,IENS,2,"I"))
61 . ;--- Update the record
62 . S RORFDA(798,IENS,3)=1 ; NEW PATIENT
63 . S RORFDA(798,IENS,4)=1 ; UPDATE DEMOGRAPHICS
64 . S RORFDA(798,IENS,5)=1 ; UPDATE LOCAL REGISTRY DATA
65 . S RORFDA(798,IENS,9.1)=DATE ; DATA ACKNOWLEDGED UNTIL
66 . S RORFDA(798,IENS,9.2)=DATE ; DATA EXTRACTED UNTIL
67 . S RORFDA(798,IENS,10)="@" ; MESSAGE ID
68 . D FILE^DIE(,"RORFDA","RORMSG")
69 . I $G(DIERR) D S ECNT=ECNT+1 Q
70 . . S RC=$$DBS^RORERR("RORMSG",-9,"RECORDS^RORTSITE")
71 W:IEN="" *13
72 Q $S(RC<0:-9,1:CNT_U_ECNT)
73 ;
74 ;***** PREPARE REGISTRY PARAMETERS
75REGPARM(REGIEN,DATE) ;
76 N IENS,RC,RORFDA,RORMSG
77 S IENS=REGIEN_","
78 S RORFDA(798.1,IENS,2)=2960101 ; DATA EXTRACTED UNTIL
79 S RORFDA(798.1,IENS,2.1)="@" ; LAST BATCH ID
80 S RORFDA(798.1,IENS,2.2)="@" ; AWAITING ACKNOWLEDGEMENT
81 S RORFDA(798.1,IENS,2.3)="@" ; LAST MESSAGE ID
82 S RORFDA(798.1,IENS,15.9)=1 ; DAYS TO WAIT FOR ACK
83 S RORFDA(798.1,IENS,21.02)=DATE ; HDT END DATE
84 S RORFDA(798.1,IENS,21.05)=$$NOW^XLFDT ; HDT DATE/TIME
85 S RORFDA(798.1,IENS,25)=1 ; ENABLE PROTOCOLS
86 D FILE^DIE(,"RORFDA","RORMSG")
87 Q $$DBS^RORERR("RORMSG",-9,"REGPARM^RORTSITE",,798.1,IENS)
Note: See TracBrowser for help on using the repository browser.