| 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 |  ;
 | 
|---|