source: FOIAVistA/tag/r/LIBRARY-LBR-LBRS/LBRVCONX.m@ 736

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1LBRVCONX ;SSI/ALA/JSR-Convert data for conso Part 2 ;[ 05/02/2000 5:28 PM ]
2 ;;2.5;Library;**8**;Mar 11, 2000
3 ;
4 ; Convert pointers of other pointed to files that are
5 ; not being moved and convert them to text with a '*'
6 ; includes Service and Vendor pointers.
7TF S TDA=0 F I="B","C","D","E","F","H" K ^A7RLBRY(LBRWSTA,680.5,I)
8 ;
9EN S LDA=0 D MES^LBRPUTL("Converting pointers in File 680.4")
10NME S LDA=$O(^A7RLBRY(LBRWSTA,680.4,LDA)) G VN:LDA'>0
11 S SRV=$P(^A7RLBRY(LBRWSTA,680.4,LDA,0),U,2)
12 I SRV'="",SRV>0 D
13 . S DIC(0)="N",DIC="^DIC(49,",X=SRV D ^DIC
14 . I +Y>0 S SERV=$P(Y,U,2),$P(^A7RLBRY(LBRWSTA,680.4,LDA,0),U,2)=SERV_"*"
15 G NME
16 ;
17VN ;
18 ;
19NX S LDA=0 D MES^LBRPUTL("Converting pointers in File 681")
20NVN S LDA=$O(^A7RLBRY(LBRWSTA,681,LDA)) G US:LDA'>0
21 S USR=$P($G(^A7RLBRY(LBRWSTA,681,LDA,1)),U,3)
22 I USR'="",USR>0,$G(^VA(200,USR,0))'="" S USER=$P(^VA(200,USR,0),U),$P(^A7RLBRY(LBRWSTA,681,LDA,1),U,3)=USER_"*"
23 G NVN
24 ;
25US S LDA=0 D MES^LBRPUTL("Converting pointers in File 682")
26USR S LDA=$O(^A7RLBRY(LBRWSTA,682,LDA)) G QUIT:LDA'>0
27 S USR=$P($G(^A7RLBRY(LBRWSTA,682,LDA,1)),U,6)
28 I USR'="",USR>0,$G(^VA(200,USR,0))'="" S USER=$P(^VA(200,USR,0),U)_"*",$P(^A7RLBRY(LBRWSTA,682,LDA,1),U,6)=USER
29 ;
30 S ODA=0 F S ODA=$O(^A7RLBRY(LBRWSTA,682,LDA,4,ODA)) Q:ODA'>0 D
31 . S USR=$P($G(^A7RLBRY(LBRWSTA,682,LDA,4,ODA,0)),U,4)
32 . I USR'="",USR>0,$G(^VA(200,USR,0))'="" S $P(^A7RLBRY(LBRWSTA,682,LDA,4,ODA,0),U,4)=$$GET1^DIQ(200,USR,.01,"E")_"*"
33 . S USR=$P($G(^A7RLBRY(LBRWSTA,682,LDA,4,ODA,0)),U,8)
34 . I USR'="",USR>0,$G(^VA(200,USR,0))'="" S USER=$P(^VA(200,USR,0),U)_"*",$P(^A7RLBRY(LBRWSTA,682,LDA,4,ODA,0),U,8)=USER
35 I USR'="",USR>0,$G(^VA(200,USR,0))'="" S USER=$P(^VA(200,USR,0),U),$P(^A7RLBRY(LBRWSTA,682,LDA,1),U,6)=USER
36 G USR
37QUIT ;
38 M ^A7RLBRY(LBRWSTA,"LBRV",0)=^XTMP("LBRV",0)
39 Q
40 ;
Note: See TracBrowser for help on using the repository browser.