source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUXRC3.m@ 1697

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

revised back to 6/30/08 version

File size: 2.3 KB
RevLine 
[623]1TIUXRC3 ; COMPILED XREF FOR FILE #8925 ; 12/25/06
[613]2 ;
[623]3 I X'="" I +$P($G(^TIU(8925,+DA,14)),U,4),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASVC",+$P($G(^TIU(8925,+DA,14)),U,4),+X,+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
[613]4 S X=$P(DIKZ(0),U,1)
[623]5 I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) K ^TIU(8925,"AE",+$P($G(^TIU(8925,+DA,0)),U,2),(9999999-$P(+^AUPNVSIT(+$P(^TIU(8925,+DA,0),U,3),0),".")),+X,+DA)
[613]6 S X=$P(DIKZ(0),U,1)
[623]7 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,5),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALOC",+$P($G(^TIU(8925,+DA,12)),U,5),+X,+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
[613]8 S X=$P(DIKZ(0),U,1)
[623]9 I X'="" I +$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$O(^TIU(8925.9,"B",+DA,0)) D APRBK^TIUDD(+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA)
[613]10 S X=$P(DIKZ(0),U,1)
[623]11 I X'="" I +$P(^TIU(8925,+DA,0),U,3),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
[613]12 S X=$P(DIKZ(0),U,1)
[623]13 I X'="" I +$P(^TIU(8925,+DA,0),U,2),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+X,+DA),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
[613]14 S X=$P(DIKZ(0),U,1)
[623]15 I X'="" I +$P(^TIU(8925,+DA,0),U,2),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-$P(^TIU(8925,+DA,13),U)),DA)
[613]16 S X=$P(DIKZ(0),U,1)
[623]17 I X'="" D KACLPT^TIUDD01(.01,X)
[613]18 S X=$P(DIKZ(0),U,1)
[623]19 I X'="" D KACLAU^TIUDD01(.01,X),KACLAU1^TIUDD01(.01,X)
[613]20 S X=$P(DIKZ(0),U,1)
[623]21 I X'="" D KACLEC^TIUDD01(.01,X)
[613]22 S X=$P(DIKZ(0),U,1)
[623]23 I X'="" D KACLSB^TIUDD01(.01,X)
[613]24 S X=$P(DIKZ(0),U,1)
[623]25 I X'="" D KAPTLD^TIUDD01(.01,X)
26CR1 S DIXR=247
27 K X
28 S X(1)=$P(DIKZ(12),U,12)
29 S X(2)=$P(DIKZ(0),U,1)
30 S X(3)=$P(DIKZ(0),U,5)
31 S X=$P(DIKZ(13),U,1)
32 I $G(X)]"" S X=9999999-X
33 S:$D(X)#2 X(4)=X
34 S X=$G(X(1))
35 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
36 . K X1,X2 M X1=X,X2=X
37 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4))=""
38 . K ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)
39CR2 S DIXR=413
40 K X
41 S DIKZ(12)=$G(^TIU(8925,DA,12))
42 S X(1)=$P(DIKZ(12),U,7)
43 S X=$G(X(1))
44 I $G(X(1))]"" D
45 . K X1,X2 M X1=X,X2=X
46 . S:$D(DIKIL) (X2,X2(1))=""
47 . K ^TIU(8925,"VS",X,DA)
48CR3 K X
49END Q
Note: See TracBrowser for help on using the repository browser.