source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUXRC6.m@ 701

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

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1TIUXRC6 ; COMPILED XREF FOR FILE #8925 ; 12/25/06
2 ;
3 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,5),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ALOC",+$P(^TIU(8925,+DA,12),U,5),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""
4 S X=$P(DIKZ(13),U,1)
5 I X'="" D SACLPT^TIUDD0(1301,X)
6 S X=$P(DIKZ(13),U,1)
7 I X'="" D SACLAU^TIUDD0(1301,X),SACLAU1^TIUDD0(1301,X)
8 S X=$P(DIKZ(13),U,1)
9 I X'="" D SACLEC^TIUDD0(1301,X)
10 S X=$P(DIKZ(13),U,1)
11 I X'="" D SACLSB^TIUDD0(1301,X)
12 S X=$P(DIKZ(13),U,2)
13 I X'="" S ^TIU(8925,"TC",$E(X,1,30),DA)=""
14 S X=$P(DIKZ(13),U,2)
15 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ATC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)=""
16 S X=$P(DIKZ(13),U,2)
17 I X'="" D SACLAU1^TIUDD0(1302,X)
18 S X=$P(DIKZ(13),U,4)
19 I X'="" S ^TIU(8925,"E",$E(X,1,30),DA)=""
20 S DIKZ(14)=$G(^TIU(8925,DA,14))
21 S X=$P(DIKZ(14),U,2)
22 I X'="" S ^TIU(8925,"TS",$E(X,1,30),DA)=""
23 S X=$P(DIKZ(14),U,2)
24 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ATS",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)=""
25 S X=$P(DIKZ(14),U,4)
26 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ASVC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)=""
27 S X=$P(DIKZ(14),U,4)
28 I X'="" S ^TIU(8925,"SVC",$E(X,1,30),DA)=""
29 S X=$P(DIKZ(14),U,5)
30 I X'="" S ^TIU(8925,"G",$E(X,1,30),DA)=""
31 S DIKZ(15)=$G(^TIU(8925,DA,15))
32 S X=$P(DIKZ(15),U,1)
33 I X'="" I +$$ALOCP^TIULX(+DA),+$P($G(^TIU(8925,+DA,12)),U,5) S ^TIU(8925,"ALOCP",+$P($G(^TIU(8925,+DA,12)),U,5),+X,+DA)=""
34 S X=$P(DIKZ(15),U,1)
35 I X'="" I +$$APTP^TIULX(+DA),+$P($G(^TIU(8925,+DA,0)),U,2) S ^TIU(8925,"APTP",+$P($G(^TIU(8925,+DA,0)),U,2),+X,+DA)=""
36 S X=$P(DIKZ(15),U,1)
37 I X'="" I +$$AAUP^TIULX(+DA),+$P($G(^TIU(8925,+DA,12)),U,2) S ^TIU(8925,"AAUP",+$P($G(^TIU(8925,+DA,12)),U,2),+X,+DA)=""
38 S X=$P(DIKZ(15),U,1)
39 I X'="" D SACLPT^TIUDD0(1501,X)
40 S X=$P(DIKZ(15),U,1)
41 I X'="" D SACLEC^TIUDD0(1501,X)
42 S X=$P(DIKZ(15),U,1)
43 I X'="" D KACLAU^TIUDD01(1501,X),KACLAU1^TIUDD01(1501,X)
44 S X=$P(DIKZ(15),U,2)
45 I X'="" D SACLSB^TIUDD0(1502,X)
46 S X=$P(DIKZ(15),U,7)
47 I X'="" D KACLEC^TIUDD01(1507,X)
48 S X=$P(DIKZ(15),U,7)
49 I X'="" D SACLPT^TIUDD0(1507,X)
50 S DIKZ(17)=$G(^TIU(8925,DA,17))
51 S X=$P(DIKZ(17),U,1)
52 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$P($G(^TIU(8925,+DA,13)),U) D ASUBS^TIUDD($G(X),+$G(^TIU(8925,+DA,0)),+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA)
53 S DIKZ(21)=$G(^TIU(8925,DA,21))
54 S X=$P(DIKZ(21),U,1)
55 I X'="" S ^TIU(8925,"GDAD",$E(X,1,30),DA)=""
56 S DIKZ(150)=$G(^TIU(8925,DA,150))
57 S X=$P(DIKZ(150),U,1)
58 I X'="" S ^TIU(8925,"VID",$E(X,1,30),DA)=""
59CR1 S DIXR=247
60 K X
61 S X(1)=$P(DIKZ(12),U,12)
62 S DIKZ(0)=$G(^TIU(8925,DA,0))
63 S X(2)=$P(DIKZ(0),U,1)
64 S X(3)=$P(DIKZ(0),U,5)
65 S X=$P(DIKZ(13),U,1)
66 I $G(X)]"" S X=9999999-X
67 S:$D(X)#2 X(4)=X
68 S X=$G(X(1))
69 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
70 . K X1,X2 M X1=X,X2=X
71 . S ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)=""
72CR2 S DIXR=413
73 K X
74 S DIKZ(12)=$G(^TIU(8925,DA,12))
75 S X(1)=$P(DIKZ(12),U,7)
76 S X=$G(X(1))
77 I $G(X(1))]"" D
78 . K X1,X2 M X1=X,X2=X
79 . S ^TIU(8925,"VS",X,DA)=""
80CR3 K X
81END Q
Note: See TracBrowser for help on using the repository browser.