source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUDD01.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1TIUDD01 ; SLC/JER,AJB - KILL LOGIC for Cross-references on 8925
2 ;;1.0;TEXT INTEGRATION UTILITIES;**65,153**;Jun 20, 1997
3KACLPT(FLD,X) ; KILL Logic for ACLPT
4 N TIUD0,TIUD13
5 S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13))
6 I $S(FLD=.05:1,FLD=1501:1,FLD=1507:1,1:0) D ;P65 add ACLPT to fld .05
7 . 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)
8 I FLD=.01 D
9 . 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)
10 I FLD=.02 D
11 . I +$P(TIUD0,U),+$P(TIUD13,U) K ^TIU(8925,"ACLPT",+$$CLINDOC^TIULC1(+$P(TIUD0,U),+DA),+X,$$INVDATE($P(TIUD13,U)),DA)
12 I FLD=1301 D
13 . 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)
14 Q
15 ;
16KACLAU(FLD,X) ; KILL Logic for ACLAU
17 N TIUD0,TIUD13,TIUD12
18 S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD12=$G(^(12))
19 I FLD=.05 D
20 . 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)
21 I FLD=1501 D
22 . 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)
23 I FLD=.01 D
24 . 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)
25 I FLD=1202 D
26 . 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)
27 I FLD=.02 D
28 . 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)
29 I FLD=1301 D
30 . 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)
31 Q
32 ;
33KACLAU1(FLD,X) ; KILL Logic for ACLAU - TRANSCRIPTIONIST (ENTERED BY)
34 N TIUD0,TIUD13,TIUD12
35 S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13))
36 I FLD=.05 D
37 . 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)
38 I FLD=1501 D
39 . 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)
40 I FLD=.01 D
41 . 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)
42 I FLD=1302 D
43 . 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)
44 I FLD=.02 D
45 . 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)
46 I FLD=1301 D
47 . 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)
48 Q
49 ;
50KACLEC(FLD,X) ; KILL Logic For ACLEC
51 N TIUD0,TIUD13,TIUD12
52 S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD12=$G(^(12))
53 I $S(FLD=.05:1,FLD=1501:1,FLD=1507:1,1:0) D
54 . 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)
55 I FLD=.01 D
56 . 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)
57 I FLD=1208 D
58 . 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)
59 I FLD=.02 D
60 . 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)
61 I FLD=1301 D
62 . 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)
63 Q
64 ;
65KACLSB(FLD,X) ; KILL Logic for ACLSB
66 N TIUD0,TIUD13,TIUD15
67 S TIUD0=$G(^TIU(8925,+DA,0)),TIUD13=$G(^(13)),TIUD15=$G(^(15))
68 I FLD=.01 D
69 . 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)
70 I FLD=1502 D
71 . 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)
72 I FLD=.02 D
73 . 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)
74 I FLD=1301 D
75 . 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)
76 Q
77 ;
78KAPTLD(FLD,X) ; KILL Logic for "APTLD"
79 ; APTLD on fields .02,.01,"1211;.07;.13",.03
80 N TIUD0,TIUD12
81 S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^(12))
82 I FLD=.02 D
83 . I +TIUD0,+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
84 . . N TIUVS
85 . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
86 . . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
87 . . K ^TIU(8925,"APTLD",+X,+TIUD0,TIUVS,DA)
88 . . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+X,TIUVS,+$P(TIUD0,U,3),DA)
89 I FLD=.01 D
90 . I +$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
91 . . N TIUVS
92 . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
93 . . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
94 . . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+X,TIUVS,DA)
95 I FLD=1211 D
96 . I +TIUD0,+$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)) D
97 . . N TIUVS
98 . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
99 . . S TIUVS=+X_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
100 . . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
101 . . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
102 I FLD=.07 D
103 . I +TIUD0,+$P(TIUD0,U,2),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
104 . . N TIUVS
105 . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
106 . . S TIUVS=$P(TIUD12,U,11)_";"_+X_";"_$P(TIUD0,U,13)
107 . . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
108 . . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
109 I FLD=.13 D
110 . I +TIUD0,+$P(TIUD0,U,2),+$P(TIUD0,U,7),+$P(TIUD12,U,11) D
111 . . N TIUVS
112 . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
113 . . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_X
114 . . K ^TIU(8925,"APTLD",+$P(TIUD0,U,2),+TIUD0,TIUVS,DA)
115 . . I +$P(TIUD0,U,3) K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+$P(TIUD0,U,3),DA)
116 ; SET V-String/Visit Map if Visit record exists
117 I FLD=.03 D
118 . I +$P(TIUD0,U,2),+$P(TIUD0,U,7),$L($P(TIUD0,U,13)),+$P(TIUD12,U,11) D
119 . . N TIUVS
120 . . ; TIUVS="Hosp Loc;Visit/Adm Date/time;Visit Type"
121 . . S TIUVS=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
122 . . K ^TIU(8925,"AVSTRV",+$P(TIUD0,U,2),TIUVS,+X,DA)
123 Q
124 ;
125INVDATE(DATE) ; Inverts date
126 Q 9999999-DATE
Note: See TracBrowser for help on using the repository browser.