source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTXB1.m@ 949

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1RTXB1 ; COMPILED XREF FOR FILE #195.9 ; 01/30/05
2 ;
3 S DIKZK=2
4 S DIKZ(0)=$G(^RTV(195.9,DA,0))
5 S X=$P(DIKZ(0),U,2)
6 I X'="" D
7 .N DIK,DIV,DIU,DIN
8 .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 S X="" X ^DD(195.9,2,1,2,2.4)
9 S DIKZ(0)=$G(^RTV(195.9,DA,0))
10 S X=$P(DIKZ(0),U,3)
11 I X'="" K ^RTV(195.9,"ABOR",$P(^RTV(195.9,DA,0),U),X,DA)
12 S X=$P(DIKZ(0),U,4)
13 I X'="" K ^RTV(195.9,"AC",$E(X,1,30),DA)
14 S X=$P(DIKZ(0),U,8)
15 I X'="" D
16 .N DIK,DIV,DIU,DIN
17 .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,2.1) X ^DD(195.9,8,1,1,2.4)
18 S DIKZ(0)=$G(^RTV(195.9,DA,0))
19 S X=$P(DIKZ(0),U,9)
20 I X'="" D
21 .N DIK,DIV,DIU,DIN
22 .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,2.1) X ^DD(195.9,9,1,1,2.4)
23 S DIKZ(1)=$G(^RTV(195.9,DA,1))
24 S X=$P(DIKZ(1),U,1)
25 I X'="" K ^RTV(195.9,"AE",$E(X,1,30),DA)
26 S DIKZ("ADM")=$G(^RTV(195.9,DA,"ADM"))
27 S X=$P(DIKZ("ADM"),U,1)
28 I X'="" K ^RTV(195.9,"AD",$E(X,1,30),DA)
29 S DIKZ(0)=$G(^RTV(195.9,DA,0))
30 S X=$P(DIKZ(0),U,1)
31 I X'="" K ^RTV(195.9,"B",$E(X,1,30),DA)
32 S X=$P(DIKZ(0),U,1)
33 I X'="" D
34 .N DIK,DIV,DIU,DIN
35 .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,2),X=X S DIU=X K Y S X="" X ^DD(195.9,.01,1,2,2.4)
36END G ^RTXB2
Note: See TracBrowser for help on using the repository browser.