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

TIUDD01.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. KACLPT(FLD,X) ; KILL Logic for ACLPT
  1. N TIUD0,TIUD13
  1. S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13))
  1. I $S(FLD=.05:1,FLD=1501:1,FLD=1507:1,1:0) D ;P65 add ACLPT to fld .05
  1. . 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)
  1. I FLD=.01 D
  1. . 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)
  1. I FLD=.02 D
  1. . I +$P(TIUD0,U),+$P(TIUD13,U) K ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+X,$$INVDATE($P(TIUD13,U)),DA)
  1. I FLD=1301 D
  1. . 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)
  1. Q
  1. ;
  1. KACLAU(FLD,X) ; KILL Logic for ACLAU
  1. N TIUD0,TIUD13,TIUD12
  1. S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD12=$G(^(12))
  1. I FLD=.05 D
  1. . 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)
  1. I FLD=1501 D
  1. . 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)
  1. I FLD=.01 D
  1. . 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)
  1. I FLD=1202 D
  1. . ; DO NOT KILL VALID X-REF FOR 1302 FIELD *299
  1. . I +$P(TIUD13,U,2)=+X Q
  1. . 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)
  1. I FLD=.02 D
  1. . 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)
  1. I FLD=1301 D
  1. . 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)
  1. Q
  1. ;
  1. KACLAU1(FLD,X) ; KILL Logic for ACLAU - TRANSCRIPTIONIST (ENTERED BY)
  1. N TIUD0,TIUD13,TIUD12
  1. S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13))
  1. I FLD=.05 D
  1. . 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)
  1. I FLD=1501 D
  1. . 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)
  1. I FLD=.01 D
  1. . 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)
  1. I FLD=1302 D
  1. . 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)
  1. I FLD=.02 D
  1. . 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)
  1. I FLD=1301 D
  1. . 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)
  1. Q
  1. ;
  1. KACLEC(FLD,X) ; KILL Logic For ACLEC
  1. N TIUD0,TIUD13,TIUD12
  1. S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD12=$G(^(12))
  1. I $S(FLD=.05:1,FLD=1501:1,FLD=1507:1,1:0) D
  1. . 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)
  1. I FLD=.01 D
  1. . 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)
  1. I FLD=1208 D
  1. . 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)
  1. I FLD=.02 D
  1. . 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)
  1. I FLD=1301 D
  1. . 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)
  1. Q
  1. ;
  1. KACLSB(FLD,X) ; KILL Logic for ACLSB
  1. N TIUD0,TIUD13,TIUD15
  1. S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD15=$G(^(15))
  1. I FLD=.01 D
  1. . 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)
  1. I FLD=1502 D
  1. . 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)
  1. I FLD=.02 D
  1. . 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)
  1. I FLD=1301 D
  1. . 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)
  1. Q
  1. ;
  1. KAPTLD(FLD,X) ; KILL Logic for "APTLD"
  1. ; APTLD on fields .02,.01,"1211;.07;.13",.03
  1. N TIUD0,TIUD12
  1. S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^(12))
  1. I FLD=.02 D
  1. . I +TIUD0,+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
  1. . . N TIUVS
  1. . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
  1. . . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
  1. . . K ^TIU(8925,"APTLD",+X,+TIUD0,TIUVS,DA)
  1. . . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+X,TIUVS,+$P(TIUD0,U,3),DA)
  1. I FLD=.01 D
  1. . I +$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
  1. . . N TIUVS
  1. . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
  1. . . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
  1. . . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+X,TIUVS,DA)
  1. I FLD=1211 D
  1. . I +TIUD0,+$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)) D
  1. . . N TIUVS
  1. . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
  1. . . S TIUVS=+X_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
  1. . . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
  1. . . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
  1. I FLD=.07 D
  1. . I +TIUD0,+$P(TIUD0,U,2),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
  1. . . N TIUVS
  1. . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
  1. . . S TIUVS=$P(TIUD12,U,11)_";"_+X_";"_$P(TIUD0,U,13)
  1. . . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
  1. . . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
  1. I FLD=.13 D
  1. . I +TIUD0,+$P(TIUD0,U,2),+$P(TIUD0,U,7),+$P(TIUD12,U,11) D
  1. . . N TIUVS
  1. . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
  1. . . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_X
  1. . . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
  1. . . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
  1. ; SET V-String/Visit Map if Visit record exists
  1. I FLD=.03 D
  1. . I +$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
  1. . . N TIUVS
  1. . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
  1. . . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
  1. . . K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+X,DA)
  1. Q
  1. ;
  1. KAADT(X) ; KILL Logic for AADT
  1. ;N TIUD0,TIUD13,TIUD12,TIUPROV
  1. I +X(3)>0 D
  1. . I +X(1)>0 K ^TIU(8925,"AADT",+X(1),+X(3),DA)
  1. . I +X(2)>0 K ^TIU(8925,"AADT",+X(2),+X(3),DA)
  1. ;I ((+X(1))!(+X(2))) D
  1. ;. S TIUPROV=$S(+X(1)>0:+X(1),1:+X(2))
  1. ;. I +X(3) D
  1. ;.. K ^TIU(8925,"AADT",TIUPROV,+X(3),DA)
  1. ;I FLD=2,+X(2)'=+X(1) D
  1. ;. I +X(3) K ^TIU(8925,"AADT",+X(2),+X(3),DA)
  1. ;I FLD=1301 D
  1. ;. I ((+$P(TIUD12,U,2))!(+$P(TIUD13,U,2))) D
  1. ;.. S TIUPROV=$S(+$P(TIUD12,U,2)'=0:+$P(TIUD12,U,2),1:+$P(TIUD13,U,2))
  1. ;.. I TIUPROV=0 Q
  1. ;.. K ^TIU(8925,"AADT",TIUPROV,+X,DA)
  1. Q
  1. ;
  1. INVDATE(DATE) ; Inverts date
  1. Q 9999999-DATE