| 1 | QACI4 ; OAKOIFO/TKW - DATA MIGRATION - VISTALINK RPC CODE ;9/28/04 11:54
|
|---|
| 2 | ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
|
|---|
| 3 | EN(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 | ;
|
|---|
| 21 | LISTIN ;
|
|---|
| 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 | ;
|
|---|
| 35 | LISTOUT ;
|
|---|
| 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 | ;
|
|---|
