source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACI3.m@ 623

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1QACI3 ; OAKOIFO/TKW - DATA MIGRATION - VISTALINK RPC CODE ;7/27/05 16:18
2 ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
3EN(PATSBY,PATSNO,PATSLIST,PATSFLAG,PATSFRST) ;
4 ; Read list of migrated reference table entries in PATSLIST, put into
5 ; ^XTMP. Then return the next PATSNO entries into global PATSBY,
6 ; from the table referrenced by PATSFLAG.
7 ; PATSBY = the name of the output global
8 ; PATSNO = the number of records to return
9 ; PATSLIST = If defined, contains a list of ^ delimited strings
10 ; 0 node set to a flag indicating which file these came from.
11 ; The other entries contain two pieces:
12 ; 1)ien or primary key of the entry on the M VistA side
13 ; 2)primary key of the entry in the Oracle table (usually id).
14 ; PATSFLAG="H" (hospital location), "U" (user), "P" (patient),
15 ; "C" (congressional contact), "E" (employee involved),
16 ; "F" (facility service or section)
17 ; PATSFRST = 1 on the first call to this routine, 0 on subsequent calls.
18 ;
19 ; Process incoming list
20 N FLAG,TYPE,UNAME,DONENAME
21 S PATSNO=+$G(PATSNO),PATSFRST=+$G(PATSFRST)
22 ; For the incoming list, find the file type on the first array entry.
23 S FLAG=$P($G(PATSLIST(0)),"^"),TYPE=""
24 I FLAG]"" S TYPE=$S(FLAG="H":"HL",FLAG="U":"USER",FLAG="P":"PT",FLAG="C":"CC",FLAG="E":"EMPINV",FLAG="F":"FSOS",1:"")
25 ; Move list of migrated entries to ^XTMP("QACMIGR",file_type,"D").
26 ; at the same time, delete them from the list of entries still to be
27 ; migrated, ^XTMP("QACMIGR",file_type,"U").
28 I TYPE]"" D
29 . S UNAME=$NA(^XTMP("QACMIGR",TYPE,"U"))
30 . S DONENAME=$NA(^XTMP("QACMIGR",TYPE,"D"))
31 . D LISTIN Q
32 ; Now get the next set of entries to be migrated, for the table
33 ; referenced by the PATSFLAG input parameter.
34 S FLAG=$G(PATSFLAG)
35 S TYPE=$S(FLAG="H":"HL",FLAG="U":"USER",FLAG="P":"PT",FLAG="C":"CC",FLAG="E":"EMPINV",FLAG="F":"FSOS",1:"")
36 Q:TYPE=""
37 S UNAME=$NA(^XTMP("QACMIGR",TYPE,"U"))
38 S PATSBY=$NA(^TMP(TYPE,$J))
39 ; Build the next list of entries to be migrated.
40 D LISTOUT
41 Q
42 ;
43LISTIN ; Move Ids of migrated data entries into ^XTMP
44 N I,X,CNT S CNT=0
45 F I=0:0 S I=$O(PATSLIST(I)) Q:'I S X=PATSLIST(I) D
46 . S Y=$P(X,"^"),X=$P(X,"^",2)
47 . ; If entry not added to Oracle table, quit
48 . Q:X=""
49 . ; Else, kill 'unmigrated' entry, set 'migrated' entry
50 . K @UNAME@(Y)
51 . S @DONENAME@(Y)=X
52 . S CNT=CNT+1 Q
53 ; If no data left in table of entries to be migrated, kill it.
54 I '$O(@UNAME@(0)) K @UNAME
55 I CNT>0 D
56 . ; Increment count of migrated entries
57 . S @DONENAME=$G(@DONENAME)+CNT
58 . Q:'$O(@UNAME@(0))
59 . ; Decrement count of entries to be migrated.
60 . S @UNAME=$G(@UNAME)-CNT
61 . Q
62 Q
63 ;
64LISTOUT ; Build next set of data to be migrated into ^TMP global
65 K @PATSBY
66 N CNT,I,X,XOUT
67 ; On the first time calling this routine, check.
68 S XOUT=0 I PATSFRST=1 D Q:XOUT
69 . ; If no data in staging area, return 0 in 0th node
70 . S CNT=0 F I="ROC","HL","USER","PT","CC","EMPINV","FSOS" D
71 .. S CNT=CNT+$G(^XTMP("QACMIGR",I,"U")) Q
72 . I CNT=0 S @PATSBY@(0)=0,XOUT=1
73 . Q
74 ; If no data to migrate in the current table, return nothing
75 ; in the output array.
76 Q:'$O(@UNAME@(0))
77 S CNT=0
78 ; For Facility Service or Section, set VISN name into first entry of output array.
79 ; For Users or Employees Involved, put station number for server into first entry of output array.
80 I "F^U^E"[FLAG,$O(@UNAME@(0)) D
81 . S CNT=1,PATSNO=PATSNO+1
82 . S @PATSBY@(1)=$G(^XTMP("QACMIGR",TYPE,"U",0))
83 . Q
84 ; Move data to be migrated into output global.
85 F I=0:0 S I=$O(@UNAME@(I)) Q:'I Q:PATSNO&(CNT=PATSNO) S X=^(I) D
86 . S CNT=CNT+1
87 . S @PATSBY@(CNT)=X
88 . Q:FLAG'="P"
89 . ; Load continuation patient data
90 . S CNT=CNT+1
91 . S @PATSBY@(CNT)=@UNAME@(I,"cont")
92 . Q
93 Q
94 ;
95 ;
Note: See TracBrowser for help on using the repository browser.