[623] | 1 | TIUXRC3 ; 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)
|
---|
| 26 | CR1 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)
|
---|
| 39 | CR2 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)
|
---|
| 48 | CR3 K X
|
---|
| 49 | END Q
|
---|