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