source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACI4.m@ 750

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1QACI4 ; OAKOIFO/TKW - DATA MIGRATION - VISTALINK RPC CODE ;9/28/04 11:54
2 ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
3EN(PATSBY,PATSLIST) ;
4 ; Read list of migrated ROCs in PATSLIST, put into ^XTMP. Then
5 ; return the next list of ROCs to be migrated into global ^TMP.
6 ; NOTE: This routine is always called after QACI3, so there is
7 ; no need to check the 'ready to migrate' flag.
8 ; PATSBY = the name of the output global
9 ; PATSLIST = If defined, contains a list of ROC numbers
10 ; for ROCs that have been successfully migrated to PATS.
11 ;
12 ; Process incoming list. Move list of migrated ROCs into
13 ; ^XTMP("QACMIGR","ROC","D"), remove them from the list of ROCs
14 ; to be migrated ^XTMP("QACMIGR","ROC","U").
15 D LISTIN
16 ; Now return the next set of ROCs to be migrated.
17 S PATSBY=$NA(^TMP("ROC",$J))
18 D LISTOUT
19 Q
20 ;
21LISTIN ;
22 N I,ROCNO,CNT S I="",CNT=0
23 F S I=$O(PATSLIST(I)) Q:I="" S ROCNO=PATSLIST(I) I ROCNO]"" D
24 . K ^XTMP("QACMIGR","ROC","U",ROCNO_" ")
25 . S ^XTMP("QACMIGR","ROC","D",ROCNO)=""
26 . S CNT=CNT+1
27 . Q
28 I CNT>0 D
29 . S ^XTMP("QACMIGR","ROC","D")=$G(^XTMP("QACMIGR","ROC","D"))+CNT
30 . I $O(^XTMP("QACMIGR","ROC","U",0))="" K ^XTMP("QACMIGR","ROC","U") Q
31 . S ^XTMP("QACMIGR","ROC","U")=$G(^XTMP("QACMIGR","ROC","U"))-CNT
32 . Q
33 Q
34 ;
35LISTOUT ;
36 K ^TMP("ROC",$J)
37 ; The output array will be empty if there is no data to migrate
38 Q:$O(^XTMP("QACMIGR","ROC","U",0))=""
39 ; The 0 node should contain VISN name and Station Numbers
40 ; if not, return the output array empty.
41 N X S X=$G(^XTMP("QACMIGR","ROC","U",0))
42 Q:X=""
43 S ^TMP("ROC",$J,1)=X
44 N ROCNO,I,CNT S CNT=1,ROCNO=0
45 F S ROCNO=$O(^XTMP("QACMIGR","ROC","U",ROCNO)) Q:ROCNO=""!(CNT>1500) D
46 . S I=$O(^XTMP("QACMIGR","ROC","U",ROCNO,"A"),-1)
47 . I (I+CNT)>1500 S CNT=9999 Q
48 . F I=0:0 S I=$O(^XTMP("QACMIGR","ROC","U",ROCNO,I)) Q:'I S X=^(I) D
49 .. S CNT=CNT+1
50 .. S ^TMP("ROC",$J,CNT)=X Q
51 . Q
52 Q
53 ;
Note: See TracBrowser for help on using the repository browser.