[613] | 1 | TIUXRC4 ; COMPILED XREF FOR FILE #8925 ; 11/08/09
|
---|
| 2 | ;
|
---|
| 3 | END G ^TIUXRC4
|
---|
| 4 | S X=$P(DIKZ(0),U,5)
|
---|
| 5 | I X'="" I +$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,4) S ^TIU(8925,"ADCPT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U,4),+X,(9999999-$P(^TIU(8925,+DA,13),U)),DA)=""
|
---|
| 6 | S X=$P(DIKZ(0),U,5)
|
---|
| 7 | I X'="" D SACLPT^TIUDD0(.05,X)
|
---|
| 8 | S X=$P(DIKZ(0),U,5)
|
---|
| 9 | I X'="" D SACLEC^TIUDD0(.05,X)
|
---|
| 10 | S X=$P(DIKZ(0),U,5)
|
---|
| 11 | I X'="" D SACLAU^TIUDD0(.05,X),SACLAU1^TIUDD0(.05,X)
|
---|
| 12 | S X=$P(DIKZ(0),U,6)
|
---|
| 13 | I X'="" S ^TIU(8925,"DAD",$E(X,1,30),DA)=""
|
---|
| 14 | S X=$P(DIKZ(0),U,7)
|
---|
| 15 | I X'="" D SAPTLD^TIUDD0(.07,X)
|
---|
| 16 | S X=$P(DIKZ(0),U,12)
|
---|
| 17 | I X'="" S ^TIU(8925,"FIX",$E(X,1,30),DA)=""
|
---|
| 18 | S X=$P(DIKZ(0),U,13)
|
---|
| 19 | I X'="" D SAPTLD^TIUDD0(.13,X)
|
---|
| 20 | S DIKZ(12)=$G(^TIU(8925,DA,12))
|
---|
| 21 | S X=$P(DIKZ(12),U,1)
|
---|
| 22 | I X'="" S ^TIU(8925,"F",$E(X,1,30),DA)=""
|
---|
| 23 | S X=$P(DIKZ(12),U,2)
|
---|
| 24 | I X'="" S ^TIU(8925,"CA",$E(X,1,30),DA)=""
|
---|
| 25 | S X=$P(DIKZ(12),U,2)
|
---|
| 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,"AAU",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),+DA)=""
|
---|
| 27 | S X=$P(DIKZ(12),U,2)
|
---|
| 28 | I X'="" I +$$AAUP^TIULX(+DA),+$P($G(^TIU(8925,+DA,15)),U) S ^TIU(8925,"AAUP",+X,+$P($G(^TIU(8925,+DA,15)),U),+DA)=""
|
---|
| 29 | S X=$P(DIKZ(12),U,2)
|
---|
| 30 | I X'="" D SACLAU^TIUDD0(1202,X)
|
---|
| 31 | S X=$P(DIKZ(12),U,2)
|
---|
| 32 | I X'="" D
|
---|
| 33 | .N DIK,DIV,DIU,DIN
|
---|
| 34 | .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I '+$$ISDS^TIULX(+$G(^TIU(8925,+DA,0))) I X S X=DIV S Y(1)=$S($D(^TIU(8925,D0,14)):^(14),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(8925,1202,1,5,1.1) X ^DD(8925,1202,1,5,1.4)
|
---|
| 35 | S DIKZ(12)=$G(^TIU(8925,DA,12))
|
---|
| 36 | S X=$P(DIKZ(12),U,5)
|
---|
| 37 | 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,"ALOC",+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)=""
|
---|
| 38 | S X=$P(DIKZ(12),U,5)
|
---|
| 39 | I X'="" I +$$ALOCP^TIULX(+DA),+$P($G(^TIU(8925,+DA,15)),U) S ^TIU(8925,"ALOCP",+X,+$P($G(^TIU(8925,+DA,15)),U),+DA)=""
|
---|
| 40 | S X=$P(DIKZ(12),U,7)
|
---|
| 41 | I X'="" D:$D(^AUPNVSIT(+X)) ADD^AUPNVSIT
|
---|
| 42 | S X=$P(DIKZ(12),U,8)
|
---|
| 43 | I X'="" S ^TIU(8925,"CS",$E(X,1,30),DA)=""
|
---|
| 44 | S X=$P(DIKZ(12),U,8)
|
---|
| 45 | 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,"ASUP",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)=""
|
---|
| 46 | S X=$P(DIKZ(12),U,8)
|
---|
| 47 | I X'="" D SACLEC^TIUDD0(1208,X)
|
---|
| 48 | S X=$P(DIKZ(12),U,11)
|
---|
| 49 | I X'="" D SAPTLD^TIUDD0(1211,X)
|
---|
| 50 | S DIKZ(13)=$G(^TIU(8925,DA,13))
|
---|
| 51 | S X=$P(DIKZ(13),U,1)
|
---|
| 52 | 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) S ^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)=""
|
---|
| 53 | S X=$P(DIKZ(13),U,1)
|
---|
| 54 | 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) S ^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)=""
|
---|
| 55 | S X=$P(DIKZ(13),U,1)
|
---|
| 56 | 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) S ^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)=""
|
---|
| 57 | S X=$P(DIKZ(13),U,1)
|
---|
| 58 | 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) S ^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)=""
|
---|
| 59 | S X=$P(DIKZ(13),U,1)
|
---|
| 60 | 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) S ^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)=""
|
---|
| 61 | S X=$P(DIKZ(13),U,1)
|
---|
| 62 | I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ALL","ANY",+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)=""
|
---|
| 63 | S X=$P(DIKZ(13),U,1)
|
---|
| 64 | 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 ASUBS^TIUDD($P($G(^TIU(8925,+DA,17)),U),+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)
|
---|
| 65 | S X=$P(DIKZ(13),U,1)
|
---|
| 66 | 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) S ^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)=""
|
---|
| 67 | S X=$P(DIKZ(13),U,1)
|
---|
| 68 | 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 APRBS^TIUDD(+$G(^TIU(8925,+DA,0)),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)
|
---|
| 69 | S X=$P(DIKZ(13),U,1)
|
---|
| 70 | 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) S ^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)=""
|
---|
| 71 | S X=$P(DIKZ(13),U,1)
|
---|
| 72 | I X'="" I +$P($G(^TIU(8925,+DA,0)),U,4),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ADCPT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U,4),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA)=""
|
---|
| 73 | S X=$P(DIKZ(13),U,1)
|
---|
| 74 | I X'="" S ^TIU(8925,"D",$E(X,1,30),DA)=""
|
---|
| 75 | S X=$P(DIKZ(13),U,1)
|
---|
| 76 | 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)=""
|
---|
| 77 | S X=$P(DIKZ(13),U,1)
|
---|
| 78 | 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)=""
|
---|
| 79 | S X=$P(DIKZ(13),U,1)
|
---|
| 80 | 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)=""
|
---|
| 81 | S X=$P(DIKZ(13),U,1)
|
---|
| 82 | I X'="" D SACLPT^TIUDD0(1301,X)
|
---|
| 83 | S X=$P(DIKZ(13),U,1)
|
---|
| 84 | I X'="" D SACLAU^TIUDD0(1301,X),SACLAU1^TIUDD0(1301,X)
|
---|
| 85 | S X=$P(DIKZ(13),U,1)
|
---|
| 86 | I X'="" D SACLEC^TIUDD0(1301,X)
|
---|
| 87 | S X=$P(DIKZ(13),U,1)
|
---|
| 88 | I X'="" D SACLSB^TIUDD0(1301,X)
|
---|
| 89 | S X=$P(DIKZ(13),U,2)
|
---|
| 90 | I X'="" S ^TIU(8925,"TC",$E(X,1,30),DA)=""
|
---|
| 91 | S X=$P(DIKZ(13),U,2)
|
---|
| 92 | 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)=""
|
---|
| 93 | S X=$P(DIKZ(13),U,2)
|
---|
| 94 | I X'="" D SACLAU1^TIUDD0(1302,X)
|
---|
| 95 | S X=$P(DIKZ(13),U,4)
|
---|
| 96 | I X'="" S ^TIU(8925,"E",$E(X,1,30),DA)=""
|
---|
| 97 | S DIKZ(14)=$G(^TIU(8925,DA,14))
|
---|
| 98 | S X=$P(DIKZ(14),U,2)
|
---|
| 99 | I X'="" S ^TIU(8925,"TS",$E(X,1,30),DA)=""
|
---|
| 100 | S X=$P(DIKZ(14),U,2)
|
---|
| 101 | 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)=""
|
---|
| 102 | S X=$P(DIKZ(14),U,4)
|
---|
| 103 | 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)=""
|
---|
| 104 | S X=$P(DIKZ(14),U,4)
|
---|
| 105 | I X'="" S ^TIU(8925,"SVC",$E(X,1,30),DA)=""
|
---|
| 106 | S X=$P(DIKZ(14),U,5)
|
---|
| 107 | I X'="" S ^TIU(8925,"G",$E(X,1,30),DA)=""
|
---|
| 108 | S DIKZ(15)=$G(^TIU(8925,DA,15))
|
---|
| 109 | S X=$P(DIKZ(15),U,1)
|
---|
| 110 | 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)=""
|
---|
| 111 | S X=$P(DIKZ(15),U,1)
|
---|
| 112 | 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)=""
|
---|
| 113 | S X=$P(DIKZ(15),U,1)
|
---|
| 114 | 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)=""
|
---|
| 115 | S X=$P(DIKZ(15),U,1)
|
---|
| 116 | I X'="" D SACLPT^TIUDD0(1501,X)
|
---|
| 117 | S X=$P(DIKZ(15),U,1)
|
---|
| 118 | I X'="" D SACLEC^TIUDD0(1501,X)
|
---|
| 119 | S X=$P(DIKZ(15),U,1)
|
---|
| 120 | I X'="" D KACLAU^TIUDD01(1501,X),KACLAU1^TIUDD01(1501,X)
|
---|
| 121 | S X=$P(DIKZ(15),U,2)
|
---|
| 122 | I X'="" D SACLSB^TIUDD0(1502,X)
|
---|
| 123 | S X=$P(DIKZ(15),U,7)
|
---|
| 124 | I X'="" D KACLEC^TIUDD01(1507,X)
|
---|
| 125 | S X=$P(DIKZ(15),U,7)
|
---|
| 126 | I X'="" D SACLPT^TIUDD0(1507,X)
|
---|
| 127 | S DIKZ(17)=$G(^TIU(8925,DA,17))
|
---|
| 128 | S X=$P(DIKZ(17),U,1)
|
---|
| 129 | 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)
|
---|
| 130 | S DIKZ(21)=$G(^TIU(8925,DA,21))
|
---|
| 131 | S X=$P(DIKZ(21),U,1)
|
---|
| 132 | I X'="" S ^TIU(8925,"GDAD",$E(X,1,30),DA)=""
|
---|
| 133 | S DIKZ(150)=$G(^TIU(8925,DA,150))
|
---|
| 134 | S X=$P(DIKZ(150),U,1)
|
---|
| 135 | I X'="" S ^TIU(8925,"VID",$E(X,1,30),DA)=""
|
---|
| 136 | CR1 S DIXR=247
|
---|
| 137 | K X
|
---|
| 138 | S X(1)=$P(DIKZ(12),U,12)
|
---|
| 139 | S DIKZ(0)=$G(^TIU(8925,DA,0))
|
---|
| 140 | S X(2)=$P(DIKZ(0),U,1)
|
---|
| 141 | S X(3)=$P(DIKZ(0),U,5)
|
---|
| 142 | S X=$P(DIKZ(13),U,1)
|
---|
| 143 | I $G(X)]"" S X=9999999-X
|
---|
| 144 | S:$D(X)#2 X(4)=X
|
---|
| 145 | S X=$G(X(1))
|
---|
| 146 | I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
|
---|
| 147 | . K X1,X2 M X1=X,X2=X
|
---|
| 148 | . S ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)=""
|
---|
| 149 | CR2 S DIXR=413
|
---|
| 150 | K X
|
---|
| 151 | S DIKZ(12)=$G(^TIU(8925,DA,12))
|
---|
| 152 | S X(1)=$P(DIKZ(12),U,7)
|
---|
| 153 | S X=$G(X(1))
|
---|
| 154 | I $G(X(1))]"" D
|
---|
| 155 | . K X1,X2 M X1=X,X2=X
|
---|
| 156 | . S ^TIU(8925,"VS",X,DA)=""
|
---|
| 157 | CR3 K X
|
---|
| 158 | END Q
|
---|