Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUXRC4

TIUXRC4.m

Go to the documentation of this file.
TIUXRC4 ; COMPILED XREF FOR FILE #8925 ; 05/09/23
 ; 
 I X'="" S DH=8925,DV=1504,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(15)),U,6)
 I X'="" S DH=8925,DV=1506,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(15)),U,7)
 I X'="" D KACLEC^TIUDD01(1507,X)
 S X=$P($G(DIKZ(15)),U,7)
 I X'="" D SACLPT^TIUDD0(1507,X)
 S X=$P($G(DIKZ(15)),U,7)
 I X'="" S DH=8925,DV=1507,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(15)),U,8)
 I X'="" S DH=8925,DV=1508,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(15)),U,9)
 I X'="" S DH=8925,DV=1509,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(15)),U,10)
 I X'="" S DH=8925,DV=1510,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(15)),U,12)
 I X'="" S DH=8925,DV=1512,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(15)),U,13)
 I X'="" S DH=8925,DV=1513,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S DIKZ(16)=$G(^TIU(8925,DA,16))
 S X=$P($G(DIKZ(16)),U,1)
 I X'="" S DH=8925,DV=1601,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(16)),U,2)
 I X'="" S DH=8925,DV=1602,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(16)),U,3)
 I X'="" S DH=8925,DV=1603,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(16)),U,4)
 I X'="" S DH=8925,DV=1604,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(16)),U,5)
 I X'="" S DH=8925,DV=1605,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(16)),U,10)
 I X'="" S DH=8925,DV=1610,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S X=$P($G(DIKZ(16)),U,11)
 I X'="" S DH=8925,DV=1611,DU=1 S DIIX=3 D:$G(DIK(0))'["A" AUDIT^DIK1
 S DIKZ(17)=$G(^TIU(8925,DA,17))
 S X=$P($G(DIKZ(17)),U,1)
 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)
 S DIKZ(21)=$G(^TIU(8925,DA,21))
 S X=$P($G(DIKZ(21)),U,1)
 I X'="" S ^TIU(8925,"GDAD",$E(X,1,30),DA)=""
 S DIKZ(150)=$G(^TIU(8925,DA,150))
 S X=$P($G(DIKZ(150)),U,1)
 I X'="" S ^TIU(8925,"VID",$E(X,1,30),DA)=""
CR1 S DIXR=247
 K X
 S X(1)=$P(DIKZ(12),U,12)
 S DIKZ(0)=$G(^TIU(8925,DA,0))
 S X(2)=$P(DIKZ(0),U,1)
 S X(3)=$P(DIKZ(0),U,5)
 S X=$P(DIKZ(13),U,1)
 I $G(X)]"" S X=9999999-X
 S:$D(X)#2 X(4)=X
 S X=$G(X(1))
 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
 . K X1,X2 M X1=X,X2=X
 . S ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)=""
CR2 S DIXR=557
 K X
 S DIKZ(12)=$G(^TIU(8925,DA,12))
 S X(1)=$P(DIKZ(12),U,1)
 S DIKZ(18)=$G(^TIU(8925,DA,18))
 S X(2)=$P(DIKZ(18),U,1)
 S X=$G(X(1))
 I $G(X(1))]"",$G(X(2))]"" D
 . K X1,X2 M X1=X,X2=X
 . S ^TIU(8925,"VBC",$E(X(1),1,14),$E(X(2),1,6),DA)=""
CR3 S DIXR=1329
 K X
 S DIKZ(0)=$G(^TIU(8925,DA,0))
 S X(1)=$P(DIKZ(0),U,1)
 S X(2)=$P(DIKZ(0),U,5)
 S X(3)=$P(DIKZ(0),U,6)
 S X(4)=$P(DIKZ(0),U,7)
 S X(5)=$P(DIKZ(0),U,8)
 S DIKZ(12)=$G(^TIU(8925,DA,12))
 S X(6)=$P(DIKZ(12),U,2)
 S X(7)=$P(DIKZ(12),U,5)
 S DIKZ(13)=$G(^TIU(8925,DA,13))
 S X(8)=$P(DIKZ(13),U,1)
 S DIKZ(14)=$G(^TIU(8925,DA,14))
 S X(9)=$P(DIKZ(14),U,5)
 S DIKZ(17)=$G(^TIU(8925,DA,17))
 S X(10)=$P(DIKZ(17),U,1)
 S DIKZ(21)=$G(^TIU(8925,DA,21))
 S X(11)=$P(DIKZ(21),U,1)
 S X(12)=$P(DIKZ(0),U,2)
 S X=$G(X(1))
 D
 . K X1,X2 M X1=X,X2=X
 . N DIKXARR M DIKXARR=X S DIKCOND=1
 . S X=(X2(12)'="")
 . S DIKCOND=$G(X) K X M X=DIKXARR
 . Q:'DIKCOND
 . D DOC^TIUDDX
CR4 S DIXR=1571
 K X
 S DIKZ(12)=$G(^TIU(8925,DA,12))
 S X(1)=$P(DIKZ(12),U,2)
 S DIKZ(13)=$G(^TIU(8925,DA,13))
 S X(2)=$P(DIKZ(13),U,2)
 S X(3)=$P(DIKZ(13),U,1)
 S X=$G(X(1))
 D
 . K X1,X2 M X1=X,X2=X
 . D SAADT^TIUDD0(.X)
CR5 S DIXR=1696
 K X
 S DIKZ(12)=$G(^TIU(8925,DA,12))
 S X(1)=$P(DIKZ(12),U,7)
 S X=$G(X(1))
 I $G(X(1))]"" D
 . K X1,X2 M X1=X,X2=X
 . S ^TIU(8925,"VS",X,DA)=""
CR6 K X
END Q