source: FOIAVistA/trunk/r/RECORD_TRACKING-RT/RTXB5.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 1.9 KB
Line 
1RTXB5 ; COMPILED XREF FOR FILE #195.9 ; 10/15/04
2 ;
3 S DIKZK=1
4 S DIKZ(0)=$G(^RTV(195.9,DA,0))
5 S X=$P(DIKZ(0),U,1)
6 I X'="" S ^RTV(195.9,"B",$E(X,1,30),DA)=""
7 S X=$P(DIKZ(0),U,1)
8 I X'="" D
9 .N DIK,DIV,DIU,DIN
10 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=Y(0),X=X S X=X[";SC(" I X S X=DIV S Y(1)=$S($D(^RTV(195.9,D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=+X X ^DD(195.9,.01,1,2,1.4)
11 S DIKZ(0)=$G(^RTV(195.9,DA,0))
12 S X=$P(DIKZ(0),U,2)
13 I X'="" D
14 .N DIK,DIV,DIU,DIN
15 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^RTV(195.9,D0,0)):^(0),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y X ^DD(195.9,2,1,1,1.1) X ^DD(195.9,2,1,1,1.4)
16 S X=$P(DIKZ(0),U,2)
17 I X'="" D
18 .N DIK,DIV,DIU,DIN
19 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^RTV(195.9,D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y X ^DD(195.9,2,1,2,1.1) X ^DD(195.9,2,1,2,1.4)
20 S X=$P(DIKZ(0),U,2)
21 I X'="" D
22 .N DIK,DIV,DIU,DIN
23 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^RTV(195.9,D0,0)):^(0),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y X ^DD(195.9,2,1,3,1.1) X ^DD(195.9,2,1,3,1.4)
24 S DIKZ(0)=$G(^RTV(195.9,DA,0))
25 S X=$P(DIKZ(0),U,3)
26 I X'="" S ^RTV(195.9,"ABOR",$P(^RTV(195.9,DA,0),U),X,DA)=""
27 S X=$P(DIKZ(0),U,4)
28 I X'="" S ^RTV(195.9,"AC",$E(X,1,30),DA)=""
29 S X=$P(DIKZ(0),U,8)
30 I X'="" D
31 .N DIK,DIV,DIU,DIN
32 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^RTV(195.9,D0,0)):^(0),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(195.9,8,1,1,1.1) X ^DD(195.9,8,1,1,1.4)
33 S DIKZ(0)=$G(^RTV(195.9,DA,0))
34 S X=$P(DIKZ(0),U,9)
35 I X'="" D
36 .N DIK,DIV,DIU,DIN
37 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^RTV(195.9,D0,0)):^(0),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(195.9,9,1,1,1.1) X ^DD(195.9,9,1,1,1.4)
38 S DIKZ(1)=$G(^RTV(195.9,DA,1))
39 S X=$P(DIKZ(1),U,1)
40 I X'="" S ^RTV(195.9,"AE",$E(X,1,30),DA)=""
41 S DIKZ("ADM")=$G(^RTV(195.9,DA,"ADM"))
42 S X=$P(DIKZ("ADM"),U,1)
43 I X'="" S ^RTV(195.9,"AD",$E(X,1,30),DA)=""
44END G ^RTXB6
Note: See TracBrowser for help on using the repository browser.