1 | QACI2 ; OAKOIFO/TKW - DATA MIGRATION - BUILD SUPPORTING TABLE AND ROC DATA TO MIGRATE ;1/24/07 17:14
|
---|
2 | ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
|
---|
3 | EN ; Main entry point for building both legacy supporting table data
|
---|
4 | ; and ROC data to be migrated. Skip entries that have already
|
---|
5 | ; been migrated.
|
---|
6 | ;
|
---|
7 | I $P($G(^XTMP("QACMIGR","AUTO","C")),"^",2)=1 W !!,"*** CAUTION! Another user is trying to auto-close ROCs. Allow the process to",!,"finish before moving data. ***"
|
---|
8 | ; Make sure list of valid sites has been downloaded from the EMC
|
---|
9 | I '$D(^XTMP("QACMIGR","STDINSTITUTION")) D STAERR Q
|
---|
10 | I '$D(^XTMP("QACMIGR","AUTO","C")) W !!,"** No Contacts were Auto-Closed. **"
|
---|
11 | Q:$$ASK^QACI2A("")'=1
|
---|
12 | ; If called from ^QACI0 (pre-migration error report), QACI0 will be set to 1.
|
---|
13 | N QACI0 S QACI0=0
|
---|
14 | ; Kill Taskman task that rolls up data to Austin for VSSC reports, Put Patient Rep menus OUT OF ORDER
|
---|
15 | I '$$EN1^QACI5 Q
|
---|
16 | ;
|
---|
17 | EN0 ; Entry point from ^QACI0 (Just check for errors, don't save data to staging area for migration)
|
---|
18 | ; If called from ^QACI0, QACI0 will be set to 1.
|
---|
19 | ;
|
---|
20 | ; Get QA Site Parameter station number, and VISN Name
|
---|
21 | N PARENT,VISNNAME D PARVISN^QACI2A(.PARENT,.VISNNAME)
|
---|
22 | I VISNNAME="" W !!,"QA Site Parameter Station Number or VISN cannot be found!" Q
|
---|
23 | I $L(PARENT)'=3 W !!,"QA Site Parameter Station Number not 3 digits!" Q
|
---|
24 | ;
|
---|
25 | N TYPE,ROCIEN,ROC0,ROC2,ROC7,ROCNO,OLDROC,CONDATE,DFN,STATION,INFOBY,ENTBY,CC,EMPINV,FSOS,ROCISS,ISSIEN,PATSDT,HL,CE,MOC,MOCSTR,TS,PHONE,PHDESC,PATID,RESDATE,INTAPPL
|
---|
26 | N CURRDT,EDITEBY,EDITIBY,EDITDIV,EDITITXT,EDITRTXT,ITXTCNT,ITXTLN,ELIGSTAT,CATEGORY,CCNAME,PATSDUZ2,DOTCNT,PATSCNT,PATSERR,SRVRSTA,RLUPSTAT,QACDIV,DIK,DA,I,X
|
---|
27 | ; PATSDT will be current date in a format Oracle will recognize
|
---|
28 | S CURRDT=$$DT^XLFDT()
|
---|
29 | S PATSDT=$$FMTE^XLFDT(CURRDT,5)
|
---|
30 | ; Set header node for migration data. Data will be automatically purged in 30 days.
|
---|
31 | S $P(^XTMP("QACMIGR",0),"^",1,2)=$$FMADD^XLFDT(CURRDT,30)_"^"_CURRDT
|
---|
32 | S DOTCNT=199
|
---|
33 | ; Kill existing lists of data to be migrated and set counters to 0.
|
---|
34 | F TYPE="ROC","HL","USER","PT","CC","EMPINV","FSOS" D
|
---|
35 | . K ^XTMP("QACMIGR",TYPE,"U"),^("E")
|
---|
36 | . S PATSCNT(TYPE)=0 Q
|
---|
37 | ; Retrieve and save station data (IA #1518)
|
---|
38 | D I SRVRSTA="" W !!,"Server Station Number cannot be found!" Q
|
---|
39 | . S SRVRSTA=$$STA^XUAF4(+$$GET1^DIQ(8989.3,1,217,"I")) Q:SRVRSTA=""
|
---|
40 | . ; load list of divisions from MEDICAL CENTER DIVISION file for error checking
|
---|
41 | . F I=0:0 S I=$O(^DG(40.8,I)) Q:'I S X=$P($G(^(I,0)),"^",7) S:X QACDIV(X)=""
|
---|
42 | . ; Quit if only running CHK option.
|
---|
43 | . Q:QACI0
|
---|
44 | . ; Put VISN and Computing facility data from QAC SITE PARAMETERS into output global
|
---|
45 | . ; for ROC and Facility Service or Section.
|
---|
46 | . S ^XTMP("QACMIGR","FSOS","U",0)=VISNNAME
|
---|
47 | . S ^XTMP("QACMIGR","ROC","U",0)=VISNNAME_"^"_PARENT_"^"_SRVRSTA
|
---|
48 | . ; Save computing station number for server in ROC and User nodes
|
---|
49 | . S ^XTMP("QACMIGR","USER","U",0)=SRVRSTA
|
---|
50 | . S ^XTMP("QACMIGR","EMPINV","U",0)=SRVRSTA Q
|
---|
51 | I SRVRSTA'=PARENT W !!,"QA Site Parameter Station Number not the same as Computing Station!" Q
|
---|
52 | ; Build mapping lists for contacting_entity, method_of_contact, treatment_status.
|
---|
53 | D CEMOCTS^QACI2A
|
---|
54 | ; Build temporary list of valid Migrated Issue Codes
|
---|
55 | I '$G(^XTMP("QACMIGR","ISS","D")) D BLDISS^QACI2A
|
---|
56 | ;
|
---|
57 | ; Build Reference Tables Lists for Congressional Contact
|
---|
58 | D BLDCC^QACI2A(PARENT,.PATSCNT)
|
---|
59 | ;
|
---|
60 | ;
|
---|
61 | ; Read through ROCs, check for errors, and if QACI0'=1 move data to staging area.
|
---|
62 | D ^QACI20
|
---|
63 | ; If not called from ^QACI0, update the counts of migrated data.
|
---|
64 | I 'QACI0 D UPDCNT^QACI2E(.PATSCNT)
|
---|
65 | ; Update the counts of errors.
|
---|
66 | D UPDERRCT^QACI2E
|
---|
67 | ; Print error report
|
---|
68 | D ERRPT^QACI2E(QACI0)
|
---|
69 | Q
|
---|
70 | ;
|
---|
71 | ENLDSTA(PATSBY,QACSLIST) ; Load list of stations from sdsadm.std_institution table
|
---|
72 | ; PATSBY is set to 1 if this runs to completion, to 0 otherwise.
|
---|
73 | ; QACSLIST is an input array of station numbers
|
---|
74 | S PATSBY=0
|
---|
75 | I $O(QACSLIST(""))="" Q
|
---|
76 | K ^XTMP("QACMIGR","STDINSTITUTION")
|
---|
77 | ; Set header node for migration data. Data will be automatically purged in 30 days.
|
---|
78 | I '$D(^XTMP("QACMIGR")) D
|
---|
79 | . N CURRDT S CURRDT=$$DT^XLFDT()
|
---|
80 | . S $P(^XTMP("QACMIGR",0),"^",1,2)=$$FMADD^XLFDT(CURRDT,30)_"^"_CURRDT
|
---|
81 | . Q
|
---|
82 | N I,QACSTA S I=""
|
---|
83 | F S I=$O(QACSLIST(I)) Q:I="" S QACSTA=QACSLIST(I) D:QACSTA]""
|
---|
84 | . S ^XTMP("QACMIGR","STDINSTITUTION",QACSTA)=""
|
---|
85 | . Q
|
---|
86 | S PATSBY=1
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | STAERR ; Display error if national stations not downloaded from EMC
|
---|
90 | W !!,"*** You must first run the option to download the list of nationally ***",!
|
---|
91 | W "*** recognized stations. See the PATS Data Migration Guide. ***" Q
|
---|
92 | ;
|
---|
93 | ;
|
---|