source: FOIAVistA/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACI2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1QACI2 ; 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
3EN ; 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 ;
17EN0 ; 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 ;
71ENLDSTA(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 ;
89STAERR ; 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 ;
Note: See TracBrowser for help on using the repository browser.