TIUXRC1 ; COMPILED XREF FOR FILE #8925 ; 05/09/23
;
S DIKZK=2
S DIKZ(0)=$G(^TIU(8925,DA,0))
S X=$P($G(DIKZ(0)),U,2)
I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) K ^TIU(8925,"AA",+X,+^TIU(8925,+DA,0),(9999999-$P(+^AUPNVSIT($P(^TIU(8925,+DA,0),U,3),0),".")),+DA)
S X=$P($G(DIKZ(0)),U,2)
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) K ^TIU(8925,"APT",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) K ^TIU(8925,"AE",+X,(9999999-$P(+^AUPNVSIT($P(^TIU(8925,+DA,0),U,3),0),".")),+^TIU(8925,+DA,0),+DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" K ^TIU(8925,"C",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^(0)),U,3) K ^TIU(8925,"AV",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,3),+DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" I +$P($G(^TIU(8925,+DA,15)),U) K ^TIU(8925,"APTP",+X,+$P($G(^TIU(8925,+DA,15)),U),+DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U,4),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ADCPT",+X,+$P(^TIU(8925,+DA,0),U,4),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"APTCL",+X,+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"APTCL",+X,38,(9999999-$P(^TIU(8925,+DA,13),U)),DA)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D KACLPT^TIUDD01(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D KACLAU^TIUDD01(.02,X),KACLAU1^TIUDD01(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D KACLEC^TIUDD01(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D KACLSB^TIUDD01(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" D KAPTLD^TIUDD01(.02,X)
S X=$P($G(DIKZ(0)),U,2)
I X'="" S DH=8925,DV=.02,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(0)),U,3)
I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,2)>0) K ^TIU(8925,"AA",$P(^(0),U,2),+$P(^(0),U),(9999999-$P(+$G(^AUPNVSIT(X,0)),".")),DA)
S X=$P($G(DIKZ(0)),U,3)
I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,2)>0) K ^TIU(8925,"AE",+$P(^TIU(8925,+DA,0),U,2),(9999999-$P(+$G(^AUPNVSIT(+X,0)),".")),+^TIU(8925,+DA,0),+DA)
S X=$P($G(DIKZ(0)),U,3)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^(0)),U,2) K ^TIU(8925,"AV",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U),+X,+DA)
S X=$P($G(DIKZ(0)),U,3)
I X'="" D:$D(^AUPNVSIT(+X)) SUB^AUPNVSIT
S X=$P($G(DIKZ(0)),U,3)
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) K ^TIU(8925,"AVSIT",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
S X=$P($G(DIKZ(0)),U,3)
I X'="" K ^TIU(8925,"V",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^TIU(8925,D0,150)):^(150),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(8925,.03,1,7,2.4)
S X=$P($G(DIKZ(0)),U,3)
I X'="" D KAPTLD^TIUDD01(.03,X)
S DIKZ(0)=$G(^TIU(8925,DA,0))
S X=$P($G(DIKZ(0)),U,4)
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,5) K ^TIU(8925,"ADCPT",+$P(^TIU(8925,+DA,0),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
S X=$P($G(DIKZ(0)),U,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),+X,(9999999-+$P(^TIU(8925,+DA,13),U)),+DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,2),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"AAU",+$P(^TIU(8925,+DA,12),U,2),+$P(^TIU(8925,+DA,0),U),+X,(9999999-$P(^TIU(8925,+DA,13),U)),+DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"APT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U),+X,(9999999-$P(^TIU(8925,+DA,13),U)),+DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U,2),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"ATC",+$P($G(^TIU(8925,+DA,13)),U,2),+$P(^TIU(8925,+DA,0),U),+X,(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,2),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"ATS",+$P($G(^TIU(8925,+DA,14)),U,2),+$P(^TIU(8925,+DA,0),U),+X,(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"ALL","ANY",+$P(^TIU(8925,+DA,0),U),+X,(9999999-$P(^TIU(8925,+DA,13),U)),+DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),$L($P($G(^TIU(8925,+DA,17)),U)),+$P($G(^TIU(8925,+DA,13)),U) D ASUBK^TIUDD($P($G(^TIU(8925,+DA,17)),U),+$G(^TIU(8925,+DA,0)),+X,(9999999-+$G(^TIU(8925,+DA,13))),DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,14)),U,4),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"ASVC",+$P($G(^TIU(8925,+DA,14)),U,4),+$P(^TIU(8925,+DA,0),U),+X,(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,5)
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) K ^TIU(8925,"ALOC",+$P($G(^TIU(8925,+DA,12)),U,5),+$P($G(^TIU(8925,+DA,0)),U),+X,(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$O(^TIU(8925.9,"B",+DA,0)) D APRBK^TIUDD(+$G(^TIU(8925,+DA,0)),+X,(9999999-+$G(^TIU(8925,+DA,13))),DA)
S X=$P($G(DIKZ(0)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,3),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+$P(^TIU(8925,+DA,0),U),+X,(9999999-$P(^TIU(8925,+DA,13),U)),+DA)
S X=$P($G(DIKZ(0)),U,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) K ^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)
S X=$P($G(DIKZ(0)),U,5)
I X'="" D KACLPT^TIUDD01(.05,X)
S X=$P($G(DIKZ(0)),U,5)
I X'="" D KACLEC^TIUDD01(.05,X)
S X=$P($G(DIKZ(0)),U,5)
I X'="" D KACLAU^TIUDD01(.05,X),KACLAU1^TIUDD01(.05,X)
S X=$P($G(DIKZ(0)),U,5)
I X'="" S DH=8925,DV=.05,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(0)),U,6)
I X'="" K ^TIU(8925,"DAD",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,7)
I X'="" D KAPTLD^TIUDD01(.07,X)
S X=$P($G(DIKZ(0)),U,12)
I X'="" K ^TIU(8925,"FIX",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,13)
I X'="" D KAPTLD^TIUDD01(.13,X)
S DIKZ(12)=$G(^TIU(8925,DA,12))
S X=$P($G(DIKZ(12)),U,1)
I X'="" K ^TIU(8925,"F",$E(X,1,30),DA)
S X=$P($G(DIKZ(12)),U,1)
I X'="" S DH=8925,DV=1201,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(12)),U,2)
I X'="" K ^TIU(8925,"CA",$E(X,1,30),DA)
S X=$P($G(DIKZ(12)),U,2)
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) K ^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)
S X=$P($G(DIKZ(12)),U,2)
I X'="" I +$P($G(^TIU(8925,+DA,15)),U) K ^TIU(8925,"AAUP",+X,+$P($G(^TIU(8925,+DA,15)),U),+DA)
S X=$P($G(DIKZ(12)),U,2)
I X'="" D KACLAU^TIUDD01(1202,X)
S X=$P($G(DIKZ(12)),U,2)
I X'="" S DH=8925,DV=1202,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(12)),U,4)
I X'="" S DH=8925,DV=1204,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(12)),U,5)
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) K ^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)
S X=$P($G(DIKZ(12)),U,5)
I X'="" I +$P($G(^TIU(8925,+DA,15)),U) K ^TIU(8925,"ALOCP",+X,+$P($G(^TIU(8925,+DA,15)),U),+DA)
S X=$P($G(DIKZ(12)),U,7)
I X'="" D:$D(^AUPNVSIT(+X)) SUB^AUPNVSIT
S X=$P($G(DIKZ(12)),U,7)
I X'="" K ^TIU(8925,"VS",$E(X,1,30),DA)
S X=$P($G(DIKZ(12)),U,8)
I X'="" K ^TIU(8925,"CS",$E(X,1,30),DA)
S X=$P($G(DIKZ(12)),U,8)
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) K ^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)
S X=$P($G(DIKZ(12)),U,8)
I X'="" D KACLEC^TIUDD01(1208,X)
S X=$P($G(DIKZ(12)),U,8)
I X'="" S DH=8925,DV=1208,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(12)),U,9)
I X'="" S DH=8925,DV=1209,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(12)),U,11)
I X'="" D KAPTLD^TIUDD01(1211,X)
S DIKZ(13)=$G(^TIU(8925,DA,13))
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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)
S X=$P($G(DIKZ(13)),U,1)
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) K ^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)
S X=$P($G(DIKZ(13)),U,1)
I X'="" K ^TIU(8925,"D",$E(X,1,30),DA)
S X=$P($G(DIKZ(13)),U,1)
I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)
S X=$P($G(DIKZ(13)),U,1)
I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)
S X=$P($G(DIKZ(13)),U,1)
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) K ^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)
S X=$P($G(DIKZ(13)),U,1)
I X'="" D KACLPT^TIUDD01(1301,X)
S X=$P($G(DIKZ(13)),U,1)
I X'="" D KACLAU^TIUDD01(1301,X),KACLAU1^TIUDD01(1301,X)
S X=$P($G(DIKZ(13)),U,1)
I X'="" D KACLEC^TIUDD01(1301,X)
S X=$P($G(DIKZ(13)),U,1)
I X'="" D KACLSB^TIUDD01(1301,X)
S X=$P($G(DIKZ(13)),U,1)
I X'="" K ^TIU(8925,"H",$E(X,1,30),DA)
S X=$P($G(DIKZ(13)),U,1)
I X'="" S DH=8925,DV=1301,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(13)),U,2)
I X'="" K ^TIU(8925,"TC",$E(X,1,30),DA)
S X=$P($G(DIKZ(13)),U,2)
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) K ^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)
S X=$P($G(DIKZ(13)),U,2)
I X'="" D KACLAU1^TIUDD01(1302,X)
S X=$P($G(DIKZ(13)),U,2)
I X'="" S DH=8925,DV=1302,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(13)),U,4)
I X'="" K ^TIU(8925,"E",$E(X,1,30),DA)
S DIKZ(14)=$G(^TIU(8925,DA,14))
S X=$P($G(DIKZ(14)),U,2)
I X'="" K ^TIU(8925,"TS",$E(X,1,30),DA)
S X=$P($G(DIKZ(14)),U,2)
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) K ^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)
S X=$P($G(DIKZ(14)),U,4)
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) K ^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)
S X=$P($G(DIKZ(14)),U,4)
I X'="" K ^TIU(8925,"SVC",$E(X,1,30),DA)
S X=$P($G(DIKZ(14)),U,5)
I X'="" K ^TIU(8925,"G",$E(X,1,30),DA)
S X=$P($G(DIKZ(14)),U,6)
I X'="" S DH=8925,DV=1406,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S DIKZ(15)=$G(^TIU(8925,DA,15))
S X=$P($G(DIKZ(15)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,12)),U,5) K ^TIU(8925,"ALOCP",+$P($G(^TIU(8925,+DA,12)),U,5),+X,+DA)
S X=$P($G(DIKZ(15)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTP",+$P($G(^TIU(8925,+DA,0)),U,2),+X,+DA)
S X=$P($G(DIKZ(15)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,12)),U,2) K ^TIU(8925,"AAUP",+$P($G(^TIU(8925,+DA,12)),U,2),+X,+DA)
S X=$P($G(DIKZ(15)),U,1)
I X'="" D KACLPT^TIUDD01(1501,X)
S X=$P($G(DIKZ(15)),U,1)
I X'="" D KACLEC^TIUDD01(1501,X)
S X=$P($G(DIKZ(15)),U,1)
I X'="" D SACLAU^TIUDD0(1501,X),SACLAU1^TIUDD0(1501,X)
S X=$P($G(DIKZ(15)),U,1)
I X'="" S DH=8925,DV=1501,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(15)),U,2)
I X'="" D KACLSB^TIUDD01(1502,X)
S X=$P($G(DIKZ(15)),U,2)
I X'="" S DH=8925,DV=1502,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(15)),U,3)
I X'="" S DH=8925,DV=1503,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(15)),U,4)
I X'="" S DH=8925,DV=1504,DU=1 S DIIX=2 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=2 D:$G(DIK(0))'["A" AUDIT^DIK1
S X=$P($G(DIKZ(15)),U,7)
I X'="" D SACLEC^TIUDD0(1507,X)
S X=$P($G(DIKZ(15)),U,7)
I X'="" D KACLPT^TIUDD01(1507,X)
S X=$P($G(DIKZ(15)),U,7)
I X'="" S DH=8925,DV=1507,DU=1 S DIIX=2 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=2 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=2 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=2 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=2 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=2 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=2 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=2 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=2 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=2 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=2 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=2 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=2 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 ASUBK^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'="" K ^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'="" K ^TIU(8925,"VID",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" K ^TIU(8925,"B",$E(X,1,30),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P(^TIU(8925,+DA,0),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"APT",+$P(^TIU(8925,+DA,0),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,12)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AAU",+$P($G(^TIU(8925,+DA,12)),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,12)),U,8),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASUP",+$P($G(^TIU(8925,+DA,12)),U,8),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^(0)),U,3) K ^TIU(8925,"AV",+$P(^TIU(8925,+DA,0),U,2),+X,+$P(^TIU(8925,+DA,0),U,3),+DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,14)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATS",+$P($G(^TIU(8925,+DA,14)),U,2),+X,+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,13)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+$P($G(^TIU(8925,+DA,13)),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I +$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALL","ANY",+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
S X=$P($G(DIKZ(0)),U,1)
I X'="" I $L($P(^TIU(8925,+DA,0),U,2)),(+$P(^(0),U,3)>0) K ^TIU(8925,"AA",+$P(^(0),U,2),+X,(9999999-$P(+^AUPNVSIT(+$P(^TIU(8925,+DA,0),U,3),0),".")),DA)
S X=$P($G(DIKZ(0)),U,1)
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)
S X=$P($G(DIKZ(0)),U,1)
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)
S X=$P($G(DIKZ(0)),U,1)
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)
S X=$P($G(DIKZ(0)),U,1)
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)
S X=$P($G(DIKZ(0)),U,1)
END G ^TIUXRC2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUXRC1 19834 printed Apr 09, 2024@21:46:11 Page 2
TIUXRC1 ; COMPILED XREF FOR FILE #8925 ; 05/09/23
+1 ;
+2 SET DIKZK=2
+3 SET DIKZ(0)=$GET(^TIU(8925,DA,0))
+4 SET X=$PIECE($GET(DIKZ(0)),U,2)
+5 IF X'=""
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,3)>0)
KILL ^TIU(8925,"AA",+X,+^TIU(8925,+DA,0),(9999999-$PIECE(+^AUPNVSIT($PIECE(^TIU(8925,+DA,0),U,3),0),".")),+DA)
+6 SET X=$PIECE($GET(DIKZ(0)),U,2)
+7 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"APT",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+8 SET X=$PIECE($GET(DIKZ(0)),U,2)
+9 IF X'=""
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,3)>0)
KILL ^TIU(8925,"AE",+X,(9999999-$PIECE(+^AUPNVSIT($PIECE(^TIU(8925,+DA,0),U,3),0),".")),+^TIU(8925,+DA,0),+DA)
+10 SET X=$PIECE($GET(DIKZ(0)),U,2)
+11 IF X'=""
KILL ^TIU(8925,"C",$EXTRACT(X,1,30),DA)
+12 SET X=$PIECE($GET(DIKZ(0)),U,2)
+13 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^(0)),U,3)
KILL ^TIU(8925,"AV",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,3),+DA)
+14 SET X=$PIECE($GET(DIKZ(0)),U,2)
+15 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,15)),U)
KILL ^TIU(8925,"APTP",+X,+$PIECE($GET(^TIU(8925,+DA,15)),U),+DA)
+16 SET X=$PIECE($GET(DIKZ(0)),U,2)
+17 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,4)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ADCPT",+X,+$PIECE(^TIU(8925,+DA,0),U,4),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+18 SET X=$PIECE($GET(DIKZ(0)),U,2)
+19 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"APTCL",+X,+$$CLINDOC^TIULC1(+$PIECE(^TIU(8925,+DA,0),U),+DA),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+20 SET X=$PIECE($GET(DIKZ(0)),U,2)
+21 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"APTCL",+X,38,(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+22 SET X=$PIECE($GET(DIKZ(0)),U,2)
+23 IF X'=""
DO KACLPT^TIUDD01(.02,X)
+24 SET X=$PIECE($GET(DIKZ(0)),U,2)
+25 IF X'=""
DO KACLAU^TIUDD01(.02,X)
DO KACLAU1^TIUDD01(.02,X)
+26 SET X=$PIECE($GET(DIKZ(0)),U,2)
+27 IF X'=""
DO KACLEC^TIUDD01(.02,X)
+28 SET X=$PIECE($GET(DIKZ(0)),U,2)
+29 IF X'=""
DO KACLSB^TIUDD01(.02,X)
+30 SET X=$PIECE($GET(DIKZ(0)),U,2)
+31 IF X'=""
DO KAPTLD^TIUDD01(.02,X)
+32 SET X=$PIECE($GET(DIKZ(0)),U,2)
+33 IF X'=""
SET DH=8925
SET DV=.02
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+34 SET X=$PIECE($GET(DIKZ(0)),U,3)
+35 IF X'=""
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,2)>0)
KILL ^TIU(8925,"AA",$PIECE(^(0),U,2),+$PIECE(^(0),U),(9999999-$PIECE(+$GET(^AUPNVSIT(X,0)),".")),DA)
+36 SET X=$PIECE($GET(DIKZ(0)),U,3)
+37 IF X'=""
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,2)>0)
KILL ^TIU(8925,"AE",+$PIECE(^TIU(8925,+DA,0),U,2),(9999999-$PIECE(+$GET(^AUPNVSIT(+X,0)),".")),+^TIU(8925,+DA,0),+DA)
+38 SET X=$PIECE($GET(DIKZ(0)),U,3)
+39 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^(0)),U,2)
KILL ^TIU(8925,"AV",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U),+X,+DA)
+40 SET X=$PIECE($GET(DIKZ(0)),U,3)
+41 IF X'=""
if $DATA(^AUPNVSIT(+X))
DO SUB^AUPNVSIT
+42 SET X=$PIECE($GET(DIKZ(0)),U,3)
+43 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"AVSIT",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+44 SET X=$PIECE($GET(DIKZ(0)),U,3)
+45 IF X'=""
KILL ^TIU(8925,"V",$EXTRACT(X,1,30),DA)
+46 SET X=$PIECE($GET(DIKZ(0)),U,3)
+47 IF X'=""
Begin DoDot:1
+48 NEW DIK,DIV,DIU,DIN
+49 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^TIU(8925,D0,150)):^(150),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=""
XECUTE ^DD(8925,.03,1,7,2.4)
End DoDot:1
+50 SET X=$PIECE($GET(DIKZ(0)),U,3)
+51 IF X'=""
DO KAPTLD^TIUDD01(.03,X)
+52 SET DIKZ(0)=$GET(^TIU(8925,DA,0))
+53 SET X=$PIECE($GET(DIKZ(0)),U,4)
+54 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ADCPT",+$PIECE(^TIU(8925,+DA,0),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+55 SET X=$PIECE($GET(DIKZ(0)),U,5)
+56 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,8)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ASUP",+$PIECE(^TIU(8925,+DA,12),U,8),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-+$PIECE(^TIU(8925,+DA,13),U)),+DA)
+57 SET X=$PIECE($GET(DIKZ(0)),U,5)
+58 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"AAU",+$PIECE(^TIU(8925,+DA,12),U,2),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE(^TIU(8925,+DA,13),U)),+DA)
+59 SET X=$PIECE($GET(DIKZ(0)),U,5)
+60 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"APT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE(^TIU(8925,+DA,13),U)),+DA)
+61 SET X=$PIECE($GET(DIKZ(0)),U,5)
+62 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"ATC",+$PIECE($GET(^TIU(8925,+DA,13)),U,2),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+63 SET X=$PIECE($GET(DIKZ(0)),U,5)
+64 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"ATS",+$PIECE($GET(^TIU(8925,+DA,14)),U,2),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+65 SET X=$PIECE($GET(DIKZ(0)),U,5)
+66 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"ALL","ANY",+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE(^TIU(8925,+DA,13),U)),+DA)
+67 SET X=$PIECE($GET(DIKZ(0)),U,5)
+68 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF $LENGTH($PIECE($GET(^TIU(8925,+DA,17)),U))
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
DO ASUBK^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+$GET(^TIU(8925,+DA,0)),+X,(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+69 SET X=$PIECE($GET(DIKZ(0)),U,5)
+70 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,4)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"ASVC",+$PIECE($GET(^TIU(8925,+DA,14)),U,4),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+71 SET X=$PIECE($GET(DIKZ(0)),U,5)
+72 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,5)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
KILL ^TIU(8925,"ALOC",+$PIECE($GET(^TIU(8925,+DA,12)),U,5),+$PIECE($GET(^TIU(8925,+DA,0)),U),+X,(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+73 SET X=$PIECE($GET(DIKZ(0)),U,5)
+74 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$ORDER(^TIU(8925.9,"B",+DA,0))
DO APRBK^TIUDD(+$GET(^TIU(8925,+DA,0)),+X,(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+75 SET X=$PIECE($GET(DIKZ(0)),U,5)
+76 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,3)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
KILL ^TIU(8925,"AVSIT",+$PIECE(^TIU(8925,+DA,0),U,3),+$PIECE(^TIU(8925,+DA,0),U),+X,(9999999-$PIECE(^TIU(8925,+DA,13),U)),+DA)
+77 SET X=$PIECE($GET(DIKZ(0)),U,5)
+78 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,4)
KILL ^TIU(8925,"ADCPT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U,4),+X,(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+79 SET X=$PIECE($GET(DIKZ(0)),U,5)
+80 IF X'=""
DO KACLPT^TIUDD01(.05,X)
+81 SET X=$PIECE($GET(DIKZ(0)),U,5)
+82 IF X'=""
DO KACLEC^TIUDD01(.05,X)
+83 SET X=$PIECE($GET(DIKZ(0)),U,5)
+84 IF X'=""
DO KACLAU^TIUDD01(.05,X)
DO KACLAU1^TIUDD01(.05,X)
+85 SET X=$PIECE($GET(DIKZ(0)),U,5)
+86 IF X'=""
SET DH=8925
SET DV=.05
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+87 SET X=$PIECE($GET(DIKZ(0)),U,6)
+88 IF X'=""
KILL ^TIU(8925,"DAD",$EXTRACT(X,1,30),DA)
+89 SET X=$PIECE($GET(DIKZ(0)),U,7)
+90 IF X'=""
DO KAPTLD^TIUDD01(.07,X)
+91 SET X=$PIECE($GET(DIKZ(0)),U,12)
+92 IF X'=""
KILL ^TIU(8925,"FIX",$EXTRACT(X,1,30),DA)
+93 SET X=$PIECE($GET(DIKZ(0)),U,13)
+94 IF X'=""
DO KAPTLD^TIUDD01(.13,X)
+95 SET DIKZ(12)=$GET(^TIU(8925,DA,12))
+96 SET X=$PIECE($GET(DIKZ(12)),U,1)
+97 IF X'=""
KILL ^TIU(8925,"F",$EXTRACT(X,1,30),DA)
+98 SET X=$PIECE($GET(DIKZ(12)),U,1)
+99 IF X'=""
SET DH=8925
SET DV=1201
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+100 SET X=$PIECE($GET(DIKZ(12)),U,2)
+101 IF X'=""
KILL ^TIU(8925,"CA",$EXTRACT(X,1,30),DA)
+102 SET X=$PIECE($GET(DIKZ(12)),U,2)
+103 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"AAU",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),+DA)
+104 SET X=$PIECE($GET(DIKZ(12)),U,2)
+105 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,15)),U)
KILL ^TIU(8925,"AAUP",+X,+$PIECE($GET(^TIU(8925,+DA,15)),U),+DA)
+106 SET X=$PIECE($GET(DIKZ(12)),U,2)
+107 IF X'=""
DO KACLAU^TIUDD01(1202,X)
+108 SET X=$PIECE($GET(DIKZ(12)),U,2)
+109 IF X'=""
SET DH=8925
SET DV=1202
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+110 SET X=$PIECE($GET(DIKZ(12)),U,4)
+111 IF X'=""
SET DH=8925
SET DV=1204
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+112 SET X=$PIECE($GET(DIKZ(12)),U,5)
+113 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ALOC",+X,+$PIECE($GET(^TIU(8925,+DA,0)),U),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+114 SET X=$PIECE($GET(DIKZ(12)),U,5)
+115 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,15)),U)
KILL ^TIU(8925,"ALOCP",+X,+$PIECE($GET(^TIU(8925,+DA,15)),U),+DA)
+116 SET X=$PIECE($GET(DIKZ(12)),U,7)
+117 IF X'=""
if $DATA(^AUPNVSIT(+X))
DO SUB^AUPNVSIT
+118 SET X=$PIECE($GET(DIKZ(12)),U,7)
+119 IF X'=""
KILL ^TIU(8925,"VS",$EXTRACT(X,1,30),DA)
+120 SET X=$PIECE($GET(DIKZ(12)),U,8)
+121 IF X'=""
KILL ^TIU(8925,"CS",$EXTRACT(X,1,30),DA)
+122 SET X=$PIECE($GET(DIKZ(12)),U,8)
+123 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ASUP",+X,+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+124 SET X=$PIECE($GET(DIKZ(12)),U,8)
+125 IF X'=""
DO KACLEC^TIUDD01(1208,X)
+126 SET X=$PIECE($GET(DIKZ(12)),U,8)
+127 IF X'=""
SET DH=8925
SET DV=1208
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+128 SET X=$PIECE($GET(DIKZ(12)),U,9)
+129 IF X'=""
SET DH=8925
SET DV=1209
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+130 SET X=$PIECE($GET(DIKZ(12)),U,11)
+131 IF X'=""
DO KAPTLD^TIUDD01(1211,X)
+132 SET DIKZ(13)=$GET(^TIU(8925,DA,13))
+133 SET X=$PIECE($GET(DIKZ(13)),U,1)
+134 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"AAU",+$PIECE(^TIU(8925,+DA,12),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
+135 SET X=$PIECE($GET(DIKZ(13)),U,1)
+136 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,8)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ASUP",+$PIECE(^TIU(8925,+DA,12),U,8),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
+137 SET X=$PIECE($GET(DIKZ(13)),U,1)
+138 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"APT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
+139 SET X=$PIECE($GET(DIKZ(13)),U,1)
+140 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ATS",+$PIECE(^TIU(8925,+DA,14),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
+141 SET X=$PIECE($GET(DIKZ(13)),U,1)
+142 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ATC",+$PIECE(^TIU(8925,+DA,13),U,2),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
+143 SET X=$PIECE($GET(DIKZ(13)),U,1)
+144 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ALL","ANY",+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
+145 SET X=$PIECE($GET(DIKZ(13)),U,1)
+146 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
IF $LENGTH($PIECE($GET(^TIU(8925,+DA,17)),U))
DO ASUBK^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)
+147 SET X=$PIECE($GET(DIKZ(13)),U,1)
+148 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,4)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ASVC",+$PIECE(^TIU(8925,+DA,14),U,4),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
+149 SET X=$PIECE($GET(DIKZ(13)),U,1)
+150 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
IF +$ORDER(^TIU(8925.9,"B",+DA,0))
DO APRBK^TIUDD(+$GET(^TIU(8925,+DA,0)),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-+X),DA)
+151 SET X=$PIECE($GET(DIKZ(13)),U,1)
+152 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,3)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"AVSIT",+$PIECE(^TIU(8925,+DA,0),U,3),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),DA)
+153 SET X=$PIECE($GET(DIKZ(13)),U,1)
+154 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,4)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ADCPT",+$PIECE(^TIU(8925,+DA,0),U,2),+$PIECE(^TIU(8925,+DA,0),U,4),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),DA)
+155 SET X=$PIECE($GET(DIKZ(13)),U,1)
+156 IF X'=""
KILL ^TIU(8925,"D",$EXTRACT(X,1,30),DA)
+157 SET X=$PIECE($GET(DIKZ(13)),U,1)
+158 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
KILL ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$PIECE(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)
+159 SET X=$PIECE($GET(DIKZ(13)),U,1)
+160 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
KILL ^TIU(8925,"APTCL",+$PIECE(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)
+161 SET X=$PIECE($GET(DIKZ(13)),U,1)
+162 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,5)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ALOC",+$PIECE(^TIU(8925,+DA,12),U,5),+$PIECE(^TIU(8925,+DA,0),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
+163 SET X=$PIECE($GET(DIKZ(13)),U,1)
+164 IF X'=""
DO KACLPT^TIUDD01(1301,X)
+165 SET X=$PIECE($GET(DIKZ(13)),U,1)
+166 IF X'=""
DO KACLAU^TIUDD01(1301,X)
DO KACLAU1^TIUDD01(1301,X)
+167 SET X=$PIECE($GET(DIKZ(13)),U,1)
+168 IF X'=""
DO KACLEC^TIUDD01(1301,X)
+169 SET X=$PIECE($GET(DIKZ(13)),U,1)
+170 IF X'=""
DO KACLSB^TIUDD01(1301,X)
+171 SET X=$PIECE($GET(DIKZ(13)),U,1)
+172 IF X'=""
KILL ^TIU(8925,"H",$EXTRACT(X,1,30),DA)
+173 SET X=$PIECE($GET(DIKZ(13)),U,1)
+174 IF X'=""
SET DH=8925
SET DV=1301
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+175 SET X=$PIECE($GET(DIKZ(13)),U,2)
+176 IF X'=""
KILL ^TIU(8925,"TC",$EXTRACT(X,1,30),DA)
+177 SET X=$PIECE($GET(DIKZ(13)),U,2)
+178 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ATC",+X,+$PIECE($GET(^TIU(8925,+DA,0)),U),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+179 SET X=$PIECE($GET(DIKZ(13)),U,2)
+180 IF X'=""
DO KACLAU1^TIUDD01(1302,X)
+181 SET X=$PIECE($GET(DIKZ(13)),U,2)
+182 IF X'=""
SET DH=8925
SET DV=1302
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+183 SET X=$PIECE($GET(DIKZ(13)),U,4)
+184 IF X'=""
KILL ^TIU(8925,"E",$EXTRACT(X,1,30),DA)
+185 SET DIKZ(14)=$GET(^TIU(8925,DA,14))
+186 SET X=$PIECE($GET(DIKZ(14)),U,2)
+187 IF X'=""
KILL ^TIU(8925,"TS",$EXTRACT(X,1,30),DA)
+188 SET X=$PIECE($GET(DIKZ(14)),U,2)
+189 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ATS",+X,+$PIECE($GET(^TIU(8925,+DA,0)),U),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+190 SET X=$PIECE($GET(DIKZ(14)),U,4)
+191 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ASVC",+X,+$PIECE($GET(^TIU(8925,+DA,0)),U),+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+192 SET X=$PIECE($GET(DIKZ(14)),U,4)
+193 IF X'=""
KILL ^TIU(8925,"SVC",$EXTRACT(X,1,30),DA)
+194 SET X=$PIECE($GET(DIKZ(14)),U,5)
+195 IF X'=""
KILL ^TIU(8925,"G",$EXTRACT(X,1,30),DA)
+196 SET X=$PIECE($GET(DIKZ(14)),U,6)
+197 IF X'=""
SET DH=8925
SET DV=1406
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+198 SET DIKZ(15)=$GET(^TIU(8925,DA,15))
+199 SET X=$PIECE($GET(DIKZ(15)),U,1)
+200 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,5)
KILL ^TIU(8925,"ALOCP",+$PIECE($GET(^TIU(8925,+DA,12)),U,5),+X,+DA)
+201 SET X=$PIECE($GET(DIKZ(15)),U,1)
+202 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
KILL ^TIU(8925,"APTP",+$PIECE($GET(^TIU(8925,+DA,0)),U,2),+X,+DA)
+203 SET X=$PIECE($GET(DIKZ(15)),U,1)
+204 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,2)
KILL ^TIU(8925,"AAUP",+$PIECE($GET(^TIU(8925,+DA,12)),U,2),+X,+DA)
+205 SET X=$PIECE($GET(DIKZ(15)),U,1)
+206 IF X'=""
DO KACLPT^TIUDD01(1501,X)
+207 SET X=$PIECE($GET(DIKZ(15)),U,1)
+208 IF X'=""
DO KACLEC^TIUDD01(1501,X)
+209 SET X=$PIECE($GET(DIKZ(15)),U,1)
+210 IF X'=""
DO SACLAU^TIUDD0(1501,X)
DO SACLAU1^TIUDD0(1501,X)
+211 SET X=$PIECE($GET(DIKZ(15)),U,1)
+212 IF X'=""
SET DH=8925
SET DV=1501
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+213 SET X=$PIECE($GET(DIKZ(15)),U,2)
+214 IF X'=""
DO KACLSB^TIUDD01(1502,X)
+215 SET X=$PIECE($GET(DIKZ(15)),U,2)
+216 IF X'=""
SET DH=8925
SET DV=1502
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+217 SET X=$PIECE($GET(DIKZ(15)),U,3)
+218 IF X'=""
SET DH=8925
SET DV=1503
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+219 SET X=$PIECE($GET(DIKZ(15)),U,4)
+220 IF X'=""
SET DH=8925
SET DV=1504
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+221 SET X=$PIECE($GET(DIKZ(15)),U,6)
+222 IF X'=""
SET DH=8925
SET DV=1506
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+223 SET X=$PIECE($GET(DIKZ(15)),U,7)
+224 IF X'=""
DO SACLEC^TIUDD0(1507,X)
+225 SET X=$PIECE($GET(DIKZ(15)),U,7)
+226 IF X'=""
DO KACLPT^TIUDD01(1507,X)
+227 SET X=$PIECE($GET(DIKZ(15)),U,7)
+228 IF X'=""
SET DH=8925
SET DV=1507
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+229 SET X=$PIECE($GET(DIKZ(15)),U,8)
+230 IF X'=""
SET DH=8925
SET DV=1508
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+231 SET X=$PIECE($GET(DIKZ(15)),U,9)
+232 IF X'=""
SET DH=8925
SET DV=1509
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+233 SET X=$PIECE($GET(DIKZ(15)),U,10)
+234 IF X'=""
SET DH=8925
SET DV=1510
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+235 SET X=$PIECE($GET(DIKZ(15)),U,12)
+236 IF X'=""
SET DH=8925
SET DV=1512
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+237 SET X=$PIECE($GET(DIKZ(15)),U,13)
+238 IF X'=""
SET DH=8925
SET DV=1513
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+239 SET DIKZ(16)=$GET(^TIU(8925,DA,16))
+240 SET X=$PIECE($GET(DIKZ(16)),U,1)
+241 IF X'=""
SET DH=8925
SET DV=1601
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+242 SET X=$PIECE($GET(DIKZ(16)),U,2)
+243 IF X'=""
SET DH=8925
SET DV=1602
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+244 SET X=$PIECE($GET(DIKZ(16)),U,3)
+245 IF X'=""
SET DH=8925
SET DV=1603
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+246 SET X=$PIECE($GET(DIKZ(16)),U,4)
+247 IF X'=""
SET DH=8925
SET DV=1604
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+248 SET X=$PIECE($GET(DIKZ(16)),U,5)
+249 IF X'=""
SET DH=8925
SET DV=1605
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+250 SET X=$PIECE($GET(DIKZ(16)),U,10)
+251 IF X'=""
SET DH=8925
SET DV=1610
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+252 SET X=$PIECE($GET(DIKZ(16)),U,11)
+253 IF X'=""
SET DH=8925
SET DV=1611
SET DU=1
SET DIIX=2
if $GET(DIK(0))'["A"
DO AUDIT^DIK1
+254 SET DIKZ(17)=$GET(^TIU(8925,DA,17))
+255 SET X=$PIECE($GET(DIKZ(17)),U,1)
+256 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
DO ASUBK^TIUDD($GET(X),+$GET(^TIU(8925,+DA,0)),+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+257 SET DIKZ(21)=$GET(^TIU(8925,DA,21))
+258 SET X=$PIECE($GET(DIKZ(21)),U,1)
+259 IF X'=""
KILL ^TIU(8925,"GDAD",$EXTRACT(X,1,30),DA)
+260 SET DIKZ(150)=$GET(^TIU(8925,DA,150))
+261 SET X=$PIECE($GET(DIKZ(150)),U,1)
+262 IF X'=""
KILL ^TIU(8925,"VID",$EXTRACT(X,1,30),DA)
+263 SET X=$PIECE($GET(DIKZ(0)),U,1)
+264 IF X'=""
KILL ^TIU(8925,"B",$EXTRACT(X,1,30),DA)
+265 SET X=$PIECE($GET(DIKZ(0)),U,1)
+266 IF X'=""
IF +$PIECE(^TIU(8925,+DA,0),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"APT",+$PIECE(^TIU(8925,+DA,0),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE(^TIU(8925,+DA,13),U)),DA)
+267 SET X=$PIECE($GET(DIKZ(0)),U,1)
+268 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"AAU",+$PIECE($GET(^TIU(8925,+DA,12)),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+269 SET X=$PIECE($GET(DIKZ(0)),U,1)
+270 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,8)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ASUP",+$PIECE($GET(^TIU(8925,+DA,12)),U,8),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+271 SET X=$PIECE($GET(DIKZ(0)),U,1)
+272 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,2)
IF +$PIECE($GET(^(0)),U,3)
KILL ^TIU(8925,"AV",+$PIECE(^TIU(8925,+DA,0),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,3),+DA)
+273 SET X=$PIECE($GET(DIKZ(0)),U,1)
+274 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ATS",+$PIECE($GET(^TIU(8925,+DA,14)),U,2),+X,+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+275 SET X=$PIECE($GET(DIKZ(0)),U,1)
+276 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,13)),U,2)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ATC",+$PIECE($GET(^TIU(8925,+DA,13)),U,2),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+277 SET X=$PIECE($GET(DIKZ(0)),U,1)
+278 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ALL","ANY",+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+279 SET X=$PIECE($GET(DIKZ(0)),U,1)
+280 IF X'=""
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U,2))
IF (+$PIECE(^(0),U,3)>0)
KILL ^TIU(8925,"AA",+$PIECE(^(0),U,2),+X,(9999999-$PIECE(+^AUPNVSIT(+$PIECE(^TIU(8925,+DA,0),U,3),0),".")),DA)
+281 SET X=$PIECE($GET(DIKZ(0)),U,1)
+282 IF X'=""
IF $LENGTH($PIECE($GET(^TIU(8925,+DA,17)),U))
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
DO ASUBK^TIUDD($PIECE($GET(^TIU(8925,+DA,17)),U),+X,+$PIECE(^TIU(8925,+DA,0),U,5),(9999999-+$GET(^TIU(8925,+DA,13))),DA)
+283 SET X=$PIECE($GET(DIKZ(0)),U,1)
+284 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,14)),U,4)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ASVC",+$PIECE($GET(^TIU(8925,+DA,14)),U,4),+X,+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+285 SET X=$PIECE($GET(DIKZ(0)),U,1)
+286 IF X'=""
IF $LENGTH($PIECE(^TIU(8925,+DA,0),U))
IF (+$PIECE(^(0),U,3)>0)
KILL ^TIU(8925,"AE",+$PIECE($GET(^TIU(8925,+DA,0)),U,2),(9999999-$PIECE(+^AUPNVSIT(+$PIECE(^TIU(8925,+DA,0),U,3),0),".")),+X,+DA)
+287 SET X=$PIECE($GET(DIKZ(0)),U,1)
+288 IF X'=""
IF +$PIECE($GET(^TIU(8925,+DA,12)),U,5)
IF +$PIECE($GET(^TIU(8925,+DA,13)),U)
IF +$PIECE($GET(^TIU(8925,+DA,0)),U,5)
KILL ^TIU(8925,"ALOC",+$PIECE($GET(^TIU(8925,+DA,12)),U,5),+X,+$PIECE($GET(^TIU(8925,+DA,0)),U,5),(9999999-$PIECE($GET(^TIU(8925,+DA,13)),U)),DA)
+289 SET X=$PIECE($GET(DIKZ(0)),U,1)
END GOTO ^TIUXRC2
