- TIUDD01 ; SLC/JER,AJB - KILL LOGIC for Cross-references on 8925
- ;;1.0;TEXT INTEGRATION UTILITIES;**65,153**;Jun 20, 1997
- 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
- . 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
- ;
- INVDATE(DATE) ; Inverts date
- Q 9999999-DATE
- TIUDD01 ; SLC/JER,AJB - KILL LOGIC for Cross-references on 8925
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**65,153**;Jun 20, 1997
- 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 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(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
- +13 IF FLD=1301
- Begin DoDot:1
- +14 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
- +15 QUIT
- +16 ;
- 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 ;
- INVDATE(DATE) ; Inverts date
- +1 QUIT 9999999-DATE
