TIUDD01 ; SLC/JER,AJB - KILL LOGIC for Cross-references on 8925 ;Apr 16, 2018@06:58
;;1.0;TEXT INTEGRATION UTILITIES;**65,153,299,290**;Jun 20, 1997;Build 548
;Per VA Directive 6402, this routine should not be modified.
KACLPT(FLD,X) ; KILL Logic for ACLPT
N TIUD0,TIUD13
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13))
I $S(FLD=.05:1,FLD=1501:1,FLD=1507:1,1:0) D ;P65 add ACLPT to fld .05
. I +$P(TIUD0,U),+$P(TIUD13,U),+$P(TIUD0,U,2) K ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.01 D
. I +$P(TIUD13,U),+$P(TIUD0,U,2) K ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+X,+DA),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.02 D
. I +$P(TIUD0,U),+$P(TIUD13,U) K ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+X,$$INVDATE($P(TIUD13,U)),DA)
I FLD=1301 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2) K ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD0,U,2),$$INVDATE(+X),DA)
Q
;
KACLAU(FLD,X) ; KILL Logic for ACLAU
N TIUD0,TIUD13,TIUD12
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD12=$G(^(12))
I FLD=.05 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD12,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD12,U,2),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=1501 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD12,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD12,U,2),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.01 D
. I +$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD12,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+X,+DA),+$P(TIUD12,U,2),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=1202 D
. ; DO NOT KILL VALID X-REF FOR 1302 FIELD *299
. I +$P(TIUD13,U,2)=+X Q
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+X,+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.02 D
. I +$P(TIUD0,U),+$P(TIUD13,U),+$P(TIUD12,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD12,U,2),+X,$$INVDATE($P(TIUD13,U)),DA)
I FLD=1301 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD12,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD12,U,2),+$P(TIUD0,U,2),$$INVDATE(+X),DA)
Q
;
KACLAU1(FLD,X) ; KILL Logic for ACLAU - TRANSCRIPTIONIST (ENTERED BY)
N TIUD0,TIUD13,TIUD12
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13))
I FLD=.05 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD13,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD13,U,2),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=1501 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD13,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD13,U,2),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.01 D
. I +$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD13,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+X,+DA),+$P(TIUD13,U,2),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=1302 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+X,+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.02 D
. I +$P(TIUD0,U),+$P(TIUD13,U),+$P(TIUD13,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD13,U,2),+X,$$INVDATE($P(TIUD13,U)),DA)
I FLD=1301 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U,2) K ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD13,U,2),+$P(TIUD0,U,2),$$INVDATE(+X),DA)
Q
;
KACLEC(FLD,X) ; KILL Logic For ACLEC
N TIUD0,TIUD13,TIUD12
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD12=$G(^(12))
I $S(FLD=.05:1,FLD=1501:1,FLD=1507:1,1:0) D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD12,U,8) K ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD12,U,8),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.01 D
. I +$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD12,U,8) K ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+X,+DA),+$P(TIUD12,U,8),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=1208 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U) K ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+X,+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.02 D
. I +$P(TIUD0,U),+$P(TIUD13,U),+$P(TIUD12,U,8) K ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD12,U,8),+X,$$INVDATE($P(TIUD13,U)),DA)
I FLD=1301 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD12,U,8) K ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD12,U,8),+$P(TIUD0,U,2),$$INVDATE(+X),DA)
Q
;
KACLSB(FLD,X) ; KILL Logic for ACLSB
N TIUD0,TIUD13,TIUD15
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD15=$G(^(15))
I FLD=.01 D
. I +$P(TIUD0,U,2),+$P(TIUD13,U),+$P(TIUD15,U,2) K ^TIU(8925,"ACLSB",+$$CLINDOC^TIULC1(+X,+DA),+$P(TIUD15,U,2),+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=1502 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD13,U) K ^TIU(8925,"ACLSB",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+X,+$P(TIUD0,U,2),$$INVDATE($P(TIUD13,U)),DA)
I FLD=.02 D
. I +$P(TIUD0,U),+$P(TIUD13,U),+$P(TIUD15,U,2) K ^TIU(8925,"ACLSB",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD15,U,2),+X,$$INVDATE($P(TIUD13,U)),DA)
I FLD=1301 D
. I +$P(TIUD0,U),+$P(TIUD0,U,2),+$P(TIUD15,U,2) K ^TIU(8925,"ACLSB",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+$P(TIUD15,U,2),+$P(TIUD0,U,2),$$INVDATE(+X),DA)
Q
;
KAPTLD(FLD,X) ; KILL Logic for "APTLD"
; APTLD on fields .02,.01,"1211;.07;.13",.03
N TIUD0,TIUD12
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^(12))
I FLD=.02 D
. I +TIUD0,+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
. . N TIUVS
. . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
. . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
. . K ^TIU(8925,"APTLD",+X,+TIUD0,TIUVS,DA)
. . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+X,TIUVS,+$P(TIUD0,U,3),DA)
I FLD=.01 D
. I +$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
. . N TIUVS
. . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
. . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
. . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+X,TIUVS,DA)
I FLD=1211 D
. I +TIUD0,+$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)) D
. . N TIUVS
. . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
. . S TIUVS=+X_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
. . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
. . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
I FLD=.07 D
. I +TIUD0,+$P(TIUD0,U,2),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
. . N TIUVS
. . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
. . S TIUVS=$P(TIUD12,U,11)_";"_+X_";"_$P(TIUD0,U,13)
. . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
. . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
I FLD=.13 D
. I +TIUD0,+$P(TIUD0,U,2),+$P(TIUD0,U,7),+$P(TIUD12,U,11) D
. . N TIUVS
. . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
. . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_X
. . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
. . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
; SET V-String/Visit Map if Visit record exists
I FLD=.03 D
. I +$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
. . N TIUVS
. . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
. . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
. . K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+X,DA)
Q
;
KAADT(X) ; KILL Logic for AADT
;N TIUD0,TIUD13,TIUD12,TIUPROV
I +X(3)>0 D
. I +X(1)>0 K ^TIU(8925,"AADT",+X(1),+X(3),DA)
. I +X(2)>0 K ^TIU(8925,"AADT",+X(2),+X(3),DA)
;I ((+X(1))!(+X(2))) D
;. S TIUPROV=$S(+X(1)>0:+X(1),1:+X(2))
;. I +X(3) D
;.. K ^TIU(8925,"AADT",TIUPROV,+X(3),DA)
;I FLD=2,+X(2)'=+X(1) D
;. I +X(3) K ^TIU(8925,"AADT",+X(2),+X(3),DA)
;I FLD=1301 D
;. I ((+$P(TIUD12,U,2))!(+$P(TIUD13,U,2))) D
;.. S TIUPROV=$S(+$P(TIUD12,U,2)'=0:+$P(TIUD12,U,2),1:+$P(TIUD13,U,2))
;.. I TIUPROV=0 Q
;.. K ^TIU(8925,"AADT",TIUPROV,+X,DA)
Q
;
INVDATE(DATE) ; Inverts date
Q 9999999-DATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUDD01 8047 printed Dec 13, 2024@02:39:39 Page 2
TIUDD01 ; SLC/JER,AJB - KILL LOGIC for Cross-references on 8925 ;Apr 16, 2018@06:58
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**65,153,299,290**;Jun 20, 1997;Build 548
+2 ;Per VA Directive 6402, this routine should not be modified.
KACLPT(FLD,X) ; KILL Logic for ACLPT
+1 NEW TIUD0,TIUD13
+2 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD13=$GET(^(13))
+3 ;P65 add ACLPT to fld .05
IF $SELECT(FLD=.05:1,FLD=1501:1,FLD=1507:1,1:0)
Begin DoDot:1
+4 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD0,U,2)
KILL ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+5 IF FLD=.01
Begin DoDot:1
+6 IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD0,U,2)
KILL ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+X,+DA),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+7 IF FLD=.02
Begin DoDot:1
+8 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD13,U)
KILL ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+X,$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+9 IF FLD=1301
Begin DoDot:1
+10 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
KILL ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD0,U,2),$$INVDATE(+X),DA)
End DoDot:1
+11 QUIT
+12 ;
KACLAU(FLD,X) ; KILL Logic for ACLAU
+1 NEW TIUD0,TIUD13,TIUD12
+2 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD13=$GET(^(13))
SET TIUD12=$GET(^(12))
+3 IF FLD=.05
Begin DoDot:1
+4 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD12,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD12,U,2),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+5 IF FLD=1501
Begin DoDot:1
+6 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD12,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD12,U,2),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+7 IF FLD=.01
Begin DoDot:1
+8 IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD12,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+X,+DA),+$PIECE(TIUD12,U,2),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+9 IF FLD=1202
Begin DoDot:1
+10 ; DO NOT KILL VALID X-REF FOR 1302 FIELD *299
+11 IF +$PIECE(TIUD13,U,2)=+X
QUIT
+12 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+X,+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+13 IF FLD=.02
Begin DoDot:1
+14 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD12,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD12,U,2),+X,$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+15 IF FLD=1301
Begin DoDot:1
+16 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD12,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD12,U,2),+$PIECE(TIUD0,U,2),$$INVDATE(+X),DA)
End DoDot:1
+17 QUIT
+18 ;
KACLAU1(FLD,X) ; KILL Logic for ACLAU - TRANSCRIPTIONIST (ENTERED BY)
+1 NEW TIUD0,TIUD13,TIUD12
+2 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD13=$GET(^(13))
+3 IF FLD=.05
Begin DoDot:1
+4 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD13,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD13,U,2),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+5 IF FLD=1501
Begin DoDot:1
+6 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD13,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD13,U,2),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+7 IF FLD=.01
Begin DoDot:1
+8 IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD13,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+X,+DA),+$PIECE(TIUD13,U,2),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+9 IF FLD=1302
Begin DoDot:1
+10 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+X,+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+11 IF FLD=.02
Begin DoDot:1
+12 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD13,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD13,U,2),+X,$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+13 IF FLD=1301
Begin DoDot:1
+14 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U,2)
KILL ^TIU(8925,"ACLAU",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD13,U,2),+$PIECE(TIUD0,U,2),$$INVDATE(+X),DA)
End DoDot:1
+15 QUIT
+16 ;
KACLEC(FLD,X) ; KILL Logic For ACLEC
+1 NEW TIUD0,TIUD13,TIUD12
+2 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD13=$GET(^(13))
SET TIUD12=$GET(^(12))
+3 IF $SELECT(FLD=.05:1,FLD=1501:1,FLD=1507:1,1:0)
Begin DoDot:1
+4 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD12,U,8)
KILL ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD12,U,8),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+5 IF FLD=.01
Begin DoDot:1
+6 IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD12,U,8)
KILL ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+X,+DA),+$PIECE(TIUD12,U,8),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+7 IF FLD=1208
Begin DoDot:1
+8 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
KILL ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+X,+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+9 IF FLD=.02
Begin DoDot:1
+10 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD12,U,8)
KILL ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD12,U,8),+X,$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+11 IF FLD=1301
Begin DoDot:1
+12 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD12,U,8)
KILL ^TIU(8925,"ACLEC",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD12,U,8),+$PIECE(TIUD0,U,2),$$INVDATE(+X),DA)
End DoDot:1
+13 QUIT
+14 ;
KACLSB(FLD,X) ; KILL Logic for ACLSB
+1 NEW TIUD0,TIUD13,TIUD15
+2 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD13=$GET(^(13))
SET TIUD15=$GET(^(15))
+3 IF FLD=.01
Begin DoDot:1
+4 IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD15,U,2)
KILL ^TIU(8925,"ACLSB",+$$CLINDOC^TIULC1(+X,+DA),+$PIECE(TIUD15,U,2),+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+5 IF FLD=1502
Begin DoDot:1
+6 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD13,U)
KILL ^TIU(8925,"ACLSB",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+X,+$PIECE(TIUD0,U,2),$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+7 IF FLD=.02
Begin DoDot:1
+8 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD13,U)
IF +$PIECE(TIUD15,U,2)
KILL ^TIU(8925,"ACLSB",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD15,U,2),+X,$$INVDATE($PIECE(TIUD13,U)),DA)
End DoDot:1
+9 IF FLD=1301
Begin DoDot:1
+10 IF +$PIECE(TIUD0,U)
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD15,U,2)
KILL ^TIU(8925,"ACLSB",+$$CLINDOC^TIULC1(+$PIECE(TIUD0,U),+DA),+$PIECE(TIUD15,U,2),+$PIECE(TIUD0,U,2),$$INVDATE(+X),DA)
End DoDot:1
+11 QUIT
+12 ;
KAPTLD(FLD,X) ; KILL Logic for "APTLD"
+1 ; APTLD on fields .02,.01,"1211;.07;.13",.03
+2 NEW TIUD0,TIUD12
+3 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD12=$GET(^(12))
+4 IF FLD=.02
Begin DoDot:1
+5 IF +TIUD0
IF +$PIECE(TIUD0,U,7)
IF $LENGTH($PIECE(TIUD0,U,13))
IF +$PIECE(TIUD12,U,11)
Begin DoDot:2
+6 NEW TIUVS
+7 ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
+8 SET TIUVS=$PIECE(TIUD12,U,11)_";"_$PIECE(TIUD0,U,7)_";"_$PIECE(TIUD0,U,13)
+9 KILL ^TIU(8925,"APTLD",+X,+TIUD0,TIUVS,DA)
+10 IF +$PIECE(TIUD0,U,3)
KILL ^TIU(8925,"AVSTRV",+X,TIUVS,+$PIECE(TIUD0,U,3),DA)
End DoDot:2
End DoDot:1
+11 IF FLD=.01
Begin DoDot:1
+12 IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD0,U,7)
IF $LENGTH($PIECE(TIUD0,U,13))
IF +$PIECE(TIUD12,U,11)
Begin DoDot:2
+13 NEW TIUVS
+14 ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
+15 SET TIUVS=$PIECE(TIUD12,U,11)_";"_$PIECE(TIUD0,U,7)_";"_$PIECE(TIUD0,U,13)
+16 KILL ^TIU(8925,"APTLD",+$PIECE(TIUD0,U,2),+X,TIUVS,DA)
End DoDot:2
End DoDot:1
+17 IF FLD=1211
Begin DoDot:1
+18 IF +TIUD0
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD0,U,7)
IF $LENGTH($PIECE(TIUD0,U,13))
Begin DoDot:2
+19 NEW TIUVS
+20 ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
+21 SET TIUVS=+X_";"_$PIECE(TIUD0,U,7)_";"_$PIECE(TIUD0,U,13)
+22 KILL ^TIU(8925,"APTLD",+$PIECE(TIUD0,U,2),+TIUD0,TIUVS,DA)
+23 IF +$PIECE(TIUD0,U,3)
KILL ^TIU(8925,"AVSTRV",+$PIECE(TIUD0,U,2),TIUVS,+$PIECE(TIUD0,U,3),DA)
End DoDot:2
End DoDot:1
+24 IF FLD=.07
Begin DoDot:1
+25 IF +TIUD0
IF +$PIECE(TIUD0,U,2)
IF $LENGTH($PIECE(TIUD0,U,13))
IF +$PIECE(TIUD12,U,11)
Begin DoDot:2
+26 NEW TIUVS
+27 ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
+28 SET TIUVS=$PIECE(TIUD12,U,11)_";"_+X_";"_$PIECE(TIUD0,U,13)
+29 KILL ^TIU(8925,"APTLD",+$PIECE(TIUD0,U,2),+TIUD0,TIUVS,DA)
+30 IF +$PIECE(TIUD0,U,3)
KILL ^TIU(8925,"AVSTRV",+$PIECE(TIUD0,U,2),TIUVS,+$PIECE(TIUD0,U,3),DA)
End DoDot:2
End DoDot:1
+31 IF FLD=.13
Begin DoDot:1
+32 IF +TIUD0
IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD0,U,7)
IF +$PIECE(TIUD12,U,11)
Begin DoDot:2
+33 NEW TIUVS
+34 ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
+35 SET TIUVS=$PIECE(TIUD12,U,11)_";"_$PIECE(TIUD0,U,7)_";"_X
+36 KILL ^TIU(8925,"APTLD",+$PIECE(TIUD0,U,2),+TIUD0,TIUVS,DA)
+37 IF +$PIECE(TIUD0,U,3)
KILL ^TIU(8925,"AVSTRV",+$PIECE(TIUD0,U,2),TIUVS,+$PIECE(TIUD0,U,3),DA)
End DoDot:2
End DoDot:1
+38 ; SET V-String/Visit Map if Visit record exists
+39 IF FLD=.03
Begin DoDot:1
+40 IF +$PIECE(TIUD0,U,2)
IF +$PIECE(TIUD0,U,7)
IF $LENGTH($PIECE(TIUD0,U,13))
IF +$PIECE(TIUD12,U,11)
Begin DoDot:2
+41 NEW TIUVS
+42 ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
+43 SET TIUVS=$PIECE(TIUD12,U,11)_";"_$PIECE(TIUD0,U,7)_";"_$PIECE(TIUD0,U,13)
+44 KILL ^TIU(8925,"AVSTRV",+$PIECE(TIUD0,U,2),TIUVS,+X,DA)
End DoDot:2
End DoDot:1
+45 QUIT
+46 ;
KAADT(X) ; KILL Logic for AADT
+1 ;N TIUD0,TIUD13,TIUD12,TIUPROV
+2 IF +X(3)>0
Begin DoDot:1
+3 IF +X(1)>0
KILL ^TIU(8925,"AADT",+X(1),+X(3),DA)
+4 IF +X(2)>0
KILL ^TIU(8925,"AADT",+X(2),+X(3),DA)
End DoDot:1
+5 ;I ((+X(1))!(+X(2))) D
+6 ;. S TIUPROV=$S(+X(1)>0:+X(1),1:+X(2))
+7 ;. I +X(3) D
+8 ;.. K ^TIU(8925,"AADT",TIUPROV,+X(3),DA)
+9 ;I FLD=2,+X(2)'=+X(1) D
+10 ;. I +X(3) K ^TIU(8925,"AADT",+X(2),+X(3),DA)
+11 ;I FLD=1301 D
+12 ;. I ((+$P(TIUD12,U,2))!(+$P(TIUD13,U,2))) D
+13 ;.. S TIUPROV=$S(+$P(TIUD12,U,2)'=0:+$P(TIUD12,U,2),1:+$P(TIUD13,U,2))
+14 ;.. I TIUPROV=0 Q
+15 ;.. K ^TIU(8925,"AADT",TIUPROV,+X,DA)
+16 QUIT
+17 ;
INVDATE(DATE) ; Inverts date
+1 QUIT 9999999-DATE
