source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUXRC8.m@ 1078

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1TIUXRC8 ; COMPILED XREF FOR FILE #8925 ; 02/27/98
2 ;
3 S X=$P(DIKZ(13),U,1)
4 I X'="" S ^TIU(8925,"D",$E(X,1,30),DA)=""
5 S X=$P(DIKZ(13),U,1)
6 I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) S ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)=""
7 S X=$P(DIKZ(13),U,1)
8 I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) S ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)=""
9 S X=$P(DIKZ(13),U,1)
10 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)=""
11 S X=$P(DIKZ(13),U,1)
12 I X'="" D SACLPT^TIUDD0(1301,X)
13 S X=$P(DIKZ(13),U,1)
14 I X'="" D SACLAU^TIUDD0(1301,X),SACLAU1^TIUDD0(1301,X)
15 S X=$P(DIKZ(13),U,1)
16 I X'="" D SACLEC^TIUDD0(1301,X)
17 S X=$P(DIKZ(13),U,1)
18 I X'="" D SACLSB^TIUDD0(1301,X)
19 S X=$P(DIKZ(13),U,2)
20 I X'="" S ^TIU(8925,"TC",$E(X,1,30),DA)=""
21 S X=$P(DIKZ(13),U,2)
22 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)=""
23 S X=$P(DIKZ(13),U,2)
24 I X'="" D SACLAU1^TIUDD0(1302,X)
25 S X=$P(DIKZ(13),U,4)
26 I X'="" S ^TIU(8925,"E",$E(X,1,30),DA)=""
27 S DIKZ(14)=$G(^TIU(8925,DA,14))
28 S X=$P(DIKZ(14),U,2)
29 I X'="" S ^TIU(8925,"TS",$E(X,1,30),DA)=""
30 S X=$P(DIKZ(14),U,2)
31 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)=""
32 S X=$P(DIKZ(14),U,4)
33 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)=""
34 S X=$P(DIKZ(14),U,4)
35 I X'="" S ^TIU(8925,"SVC",$E(X,1,30),DA)=""
36 S X=$P(DIKZ(14),U,5)
37 I X'="" S ^TIU(8925,"G",$E(X,1,30),DA)=""
38 S DIKZ(15)=$G(^TIU(8925,DA,15))
39 S X=$P(DIKZ(15),U,1)
40 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)=""
41 S X=$P(DIKZ(15),U,1)
42 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)=""
43 S X=$P(DIKZ(15),U,1)
44 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)=""
45 S X=$P(DIKZ(15),U,1)
46 I X'="" D SACLPT^TIUDD0(1501,X)
47 S X=$P(DIKZ(15),U,1)
48 I X'="" D SACLEC^TIUDD0(1501,X)
49 S X=$P(DIKZ(15),U,1)
50 I X'="" D KACLAU^TIUDD01(1501,X),KACLAU1^TIUDD01(1501,X)
51 S X=$P(DIKZ(15),U,2)
52 I X'="" D SACLSB^TIUDD0(1502,X)
53 S X=$P(DIKZ(15),U,7)
54 I X'="" D KACLEC^TIUDD01(1507,X)
55 S X=$P(DIKZ(15),U,7)
56 I X'="" D SACLPT^TIUDD0(1507,X)
57 S DIKZ(17)=$G(^TIU(8925,DA,17))
58 S X=$P(DIKZ(17),U,1)
59 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)
60 S DIKZ(150)=$G(^TIU(8925,DA,150))
61 S X=$P(DIKZ(150),U,1)
62 I X'="" S ^TIU(8925,"VID",$E(X,1,30),DA)=""
63END Q
Note: See TracBrowser for help on using the repository browser.