source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCHLX1.m@ 1484

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1SCMCHLX1 ;BP/DJB - PCMM HL7 EVENT File Xref Code ; 13 Dec 2002 1:25 PM
2 ;;5.3;Scheduling;**177,264,272,515**;May 01, 1999;Build 14
3 ;
4TXREF(IFN) ;Logic for AEVENT* xrefs on TEAM file (404.51). Create entry in
5 ; PCMM HL7 EVENT file.
6 ;
7 ; Input: IFN - Pointer to entry in file
8 ;Output: None
9 ;
10 ;Check input
11 Q:'$G(IFN)
12 ;
13 ;Declare variables
14 NEW DFN,DFNPTR,ND,VARPTR
15 ;
16 ;Store event variable pointer
17 S VARPTR=IFN_";SCTM(404.51,"
18 ;
19 ;Quit if an event entry already exists for this record
20 Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
21 ;
22 ;Create an entry in PCMM HL7 EVENT file (#404.48)
23 D ADD^SCMCHLE("NOW",VARPTR)
24 Q
25 ;
26PTXREF(IFN,OLDTYPE) ;Logic for AEVENT* xrefs on PATIENT TEAM ASSIGN file
27 ; (404.42). Create entry in PCMM HL7 EVENT file.
28 ;
29 ; Input: IFN - Pointer to entry in file
30 ; OLDTYPE - If OLDTYPE=1 then send a deletion since it's no
31 ; longer a primary care team.
32 ;Output: None
33 ;
34 ;Check input
35 Q:'$G(IFN)
36 ;
37 ;Declare variables
38 NEW DFN,ND,VARPTR
39 ;
40 ;Get data
41 S ND=$G(^SCPT(404.42,IFN,0)) ;.........Zero node of 404.42
42 Q:ND']""
43 I $P(ND,U,8)'=1,$G(OLDTYPE)'=1 Q ;....Not Primary Care related
44 S DFN=$P(ND,U,1) ;.....................Get pointer to 404.42
45 Q:'DFN
46 ;
47 ;Store event variable pointer.
48 S VARPTR=IFN_";SCPT(404.42,"
49 ;
50 ;Quit if an event entry for this record is already set to transmit.
51 Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
52 ;
53 ;If event entry exists, turn on transmission flag.
54 ;I $D(^SCPT(404.48,"AC",VARPTR)) D TRANSMIT^SCMCHLE(VARPTR,1) Q
55 ;
56 ;Create an entry in PCMM HL7 EVENT file (#404.48).
57 D ADD^SCMCHLE("NOW",VARPTR,DFN)
58 Q
59 ;
60PTPXREF(IFN,OLDROLE) ;Logic for AEVENT* xrefs on PATIENT TEAM POSITION ASSIGN
61 ; file (404.43). Create entry in PCMM HL7 EVENT file.
62 ;
63 ; Input: IFN - Pointer to entry in file
64 ; OLDROLE - If OLDROLE=1 then send a deletion since it's no
65 ; longer a primary care position.
66 ;Output: None
67 ;
68 ;Check input
69 Q:'$G(IFN)
70 ;
71 ;Declare variables
72 NEW DFN,DFNPTR,ND,TP,VARPTR
73 ;
74 ;Get data
75 S ND=$G(^SCPT(404.43,IFN,0)) ;............Zero node of 404.43
76 Q:ND']""
77 ;I $P(ND,U,5)'=1,$G(OLDROLE)'=1 Q ;.......Not Primary Care related
78 S SCTPA=$$TPACHK^SCMCHLB("",IFN) ; 20070518 PATCH 515
79 I ($P(ND,U,5)'=1)&($G(OLDROLE)'=1)&(SCTPA=0) Q ;.......Not Primary Care AND NOT TPA
80 S DFNPTR=$P(ND,U,1) ;.....................Get pointer to 404.42
81 Q:'DFNPTR
82 S DFN=$P($G(^SCPT(404.42,DFNPTR,0)),U,1) ;Pointer to PATIENT file
83 Q:'DFN
84 S TP=$P(ND,U,2) ;.........................Team Position
85 ;
86 ;Store event variable pointer
87 S VARPTR=IFN_";SCPT(404.43,"
88 ;
89 ;Quit if an event entry already exists for this record
90 Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
91 ;
92 ;Create an entry in PCMM HL7 EVENT file (#404.48)
93 D ADD^SCMCHLE("NOW",VARPTR,DFN,TP)
94 Q
95 ;
96POSHXREF(IFN) ;Logic for AEVENT* xrefs on POSITION ASSIGNMENT HISTORY file
97 ; (404.52). Create entry in PCMM HL7 EVENT file.
98 ;
99 ; Input: IFN - Pointer to entry in file
100 ;Output: None
101 ;
102 ;Check input
103 Q:'$G(IFN)
104 ;
105 ;Declare variables
106 NEW ND,TP,VARPTR
107 ;
108 ;Get data
109 S ND=$G(^SCTM(404.52,IFN,0)) ;..Zero node of 404.52
110 S TP=$P(ND,U,1) ;...............Team Position
111 ;
112 ;Store event variable pointer
113 S VARPTR=IFN_";SCTM(404.52,"
114 ;
115 ;Quit if an event entry already exists for this record
116 Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
117 ;
118 ;Create an entry in PCMM HL7 EVENT file (#404.48)
119 D ADD^SCMCHLE("NOW",VARPTR,,TP)
120 Q
121 ;
122PREHXREF(IFN) ;Logic for AEVENT* xrefs on PRECEPTOR ASSIGNMENT HISTORY file
123 ; (404.53). Create entry in PCMM HL7 EVENT file.
124 ;
125 ; Input: IFN - Pointer to entry in file
126 ;Output: None
127 ;
128 ;Check input
129 Q:'$G(IFN)
130 ;
131 ;Declare variables
132 NEW ND,TP,VARPTR
133 ;
134 ;Store event variable pointer
135 S VARPTR=IFN_";SCTM(404.53,"
136 ;
137 ;Get data
138 S ND=$G(^SCTM(404.53,IFN,0)) ;....Zero node of 404.53
139 S TP=$P(ND,U,1)_"-"_$P(ND,U,6) ;..Team Position: Preceptee-Preceptor
140 ;
141 ;Quit if an event entry already exists for this record
142 Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
143 ;
144 ;Create an entry in PCMM HL7 EVENT file (#404.48)
145 D ADD^SCMCHLE("NOW",VARPTR,,TP)
146 Q
147POSBXREF(IFN,FILE) ;
148 ; (404.52). Create entry in PCMM HL7 EVENT file.
149 ;
150 ; Input: IFN - Pointer to entry in file
151 ;Output: None
152 S:'$G(FILE) FILE=404.52
153 I FILE=404.52 Q:'$P($G(^SCTM(404.57,+$G(^SCTM(404.52,+$G(IFN),0)),0)),U,4) ;quit if not pc
154 ;
155 ; ;Check input
156 Q:'$G(IFN)
157 ;
158 ;Declare variables
159 NEW ND,TP,VARPTR
160 ;
161 ;Get data
162 S ND=$G(^SCTM(404.52,IFN,0)) ;..Zero node of 404.52
163 S TP=$P(ND,U,1) I FILE=404.57 S TP=IFN ;...............Team Position
164 ;
165 ;Store event variable pointer
166 S VARPTR=IFN_";SCTM("_FILE_","
167 ;
168 ;Quit if an event entry already exists for this record
169 N QUIT,I S QUIT=0
170 F I=0:0 S I=$O(^SCPT(404.48,"AACXMIT",VARPTR,I)) Q:'I I $P($G(^SCPT(404.48,I,0)),U,8) S QUIT=1 Q
171 Q:QUIT
172 ;
173 ;Create an entry in PCMM HL7 EVENT file (#404.48)
174 D ADD^SCMCHLE("NOW",VARPTR,,TP,1)
175 Q
176 ;
Note: See TracBrowser for help on using the repository browser.