- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUXRC2.m
r613 r623 1 TIUXRC2 ; COMPILED XREF FOR FILE #8925 ; 1 1/08/091 TIUXRC2 ; COMPILED XREF FOR FILE #8925 ; 12/25/06 2 2 ; 3 END G ^TIUXRC2 3 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AAU",+$P(^TIU(8925,+DA,12),U,2),+$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'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,8),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASUP",+$P(^TIU(8925,+DA,12),U,8),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 6 S X=$P(DIKZ(13),U,1) 7 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"APT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 8 S X=$P(DIKZ(13),U,1) 9 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATS",+$P(^TIU(8925,+DA,14),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 10 S X=$P(DIKZ(13),U,1) 11 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+$P(^TIU(8925,+DA,13),U,2),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 12 S X=$P(DIKZ(13),U,1) 13 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALL","ANY",+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 14 S X=$P(DIKZ(13),U,1) 15 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),$L($P($G(^TIU(8925,+DA,17)),U)) D ASUBK^TIUDD($P($G(^TIU(8925,+DA,17)),U),+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA) 16 S X=$P(DIKZ(13),U,1) 17 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,4),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASVC",+$P(^TIU(8925,+DA,14),U,4),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA) 18 S X=$P(DIKZ(13),U,1) 19 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$O(^TIU(8925.9,"B",+DA,0)) D APRBK^TIUDD(+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA) 20 S X=$P(DIKZ(13),U,1) 4 21 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,3),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA) 5 22 S X=$P(DIKZ(13),U,1) … … 89 106 I X'="" I $L($P($G(^TIU(8925,+DA,17)),U)),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) D ASUBK^TIUDD($P($G(^TIU(8925,+DA,17)),U),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA) 90 107 S X=$P(DIKZ(0),U,1) 91 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) 92 S X=$P(DIKZ(0),U,1) 93 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) 94 S X=$P(DIKZ(0),U,1) 95 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) 96 S X=$P(DIKZ(0),U,1) 97 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) 98 S X=$P(DIKZ(0),U,1) 99 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) 100 S X=$P(DIKZ(0),U,1) 101 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) 102 S X=$P(DIKZ(0),U,1) 103 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) 104 S X=$P(DIKZ(0),U,1) 105 I X'="" D KACLPT^TIUDD01(.01,X) 106 S X=$P(DIKZ(0),U,1) 107 I X'="" D KACLAU^TIUDD01(.01,X),KACLAU1^TIUDD01(.01,X) 108 S X=$P(DIKZ(0),U,1) 109 I X'="" D KACLEC^TIUDD01(.01,X) 110 S X=$P(DIKZ(0),U,1) 111 I X'="" D KACLSB^TIUDD01(.01,X) 112 S X=$P(DIKZ(0),U,1) 113 I X'="" D KAPTLD^TIUDD01(.01,X) 114 CR1 S DIXR=247 115 K X 116 S X(1)=$P(DIKZ(12),U,12) 117 S X(2)=$P(DIKZ(0),U,1) 118 S X(3)=$P(DIKZ(0),U,5) 119 S X=$P(DIKZ(13),U,1) 120 I $G(X)]"" S X=9999999-X 121 S:$D(X)#2 X(4)=X 122 S X=$G(X(1)) 123 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D 124 . K X1,X2 M X1=X,X2=X 125 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4))="" 126 . K ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA) 127 CR2 S DIXR=413 128 K X 129 S DIKZ(12)=$G(^TIU(8925,DA,12)) 130 S X(1)=$P(DIKZ(12),U,7) 131 S X=$G(X(1)) 132 I $G(X(1))]"" D 133 . K X1,X2 M X1=X,X2=X 134 . S:$D(DIKIL) (X2,X2(1))="" 135 . K ^TIU(8925,"VS",X,DA) 136 CR3 K X 137 END Q 108 END G ^TIUXRC3
Note:
See TracChangeset
for help on using the changeset viewer.