source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSNPIXI.m@ 1437

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

initial load of WorldVistAEHR
File size: 5.5 KB
Line 
1XUSNPIXI ;OAK_BP/BEE - NPI EXTRACT REPORT INTERFACE ROUTINE ;01-OCT-06
2 ;;8.0;KERNEL;**481**;Jul 10, 1995;Build 21
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; Process incoming HL7 NPI Crosswalk Extract Schedule/Cancel Message
6 ;
7 ; Incoming Variables (Defined in HL7 Message Handler)
8 ;
9 ; HLNEXT -> Executable code to step through message
10 ; HLMTIENS -> IEN of entry in Message Text file for subscriber application
11 ; HLNODE -> Array containing current segment information
12 ; HLQUIT -> Variable signifying last segment has been reached
13 ;
14EN ; Entry Point - Place message into a TMP global.
15 ;
16 N ACK,CNT,%DT,EVENT,FS,FSHLI,IDT,ORDCTL,PROCID,SEGCNT,SEGMSH,SEGORC,STS,X,XDT,Y
17 ;
18 ; Load message into ^TMP global
19 ;
20 K ^TMP($J,"XUSNPIXI")
21 F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
22 . S CNT=0,^TMP($J,"XUSNPIXI",SEGCNT,CNT)=HLNODE
23 . F S CNT=$O(HLNODE(CNT)) Q:'CNT D
24 .. S ^TMP($J,"XUSNPIXI",SEGCNT,CNT)=HLNODE(CNT)
25 ;
26 ; Check MSH Segment
27 ;
28 S SEGMSH=$G(^TMP($J,"XUSNPIXI",1,0))
29 S (FS,FSHLI)=$E(SEGMSH,4)
30 ;
31 ;Make sure first message is MSH and check Process ID
32 S PROCID=$P(SEGMSH,FSHLI,11)
33 I ($E(SEGMSH,1,3)'="MSH")!(",T,P,"'[(","_PROCID_",")) D G ACK
34 . S STS="AE^Invalid Message Header - First segment found is not MSH or PROCESS ID is not 'T' or 'P'"
35 ;
36 ;Verify Correct Message Type
37 S EVENT=$P(SEGMSH,FSHLI,9)
38 I EVENT'="ORM^O01^ORM_O01" D G ACK
39 . S STS="AE^Invalid Message Type ("_EVENT_") - Expecting ORM^O01^ORM_O01"
40 ;
41 ;Save needed parameter
42 S HL("HLMTIENS")=$G(HLMTIENS)
43 ;
44 ; Process ORC Segment
45 ;
46 ;Pull next segment (should be an ORC)
47 S SEGORC=$G(^TMP($J,"XUSNPIXI",2,0))
48 ;
49 ;Check for ORC segment
50 I $E(SEGORC,1,3)'="ORC" D G ACK
51 . S STS="AE^Invalid Segment ("_$E(SEGORC,1,3)_") - Second segment should be an ORC segment"
52 ;
53 ;Pull Order Control Field
54 S ORDCTL=$P(SEGORC,FSHLI,2)
55 I ORDCTL'="NW",ORDCTL'="CA" D G ACK
56 . S STS="AE^Invalid Order Control Field Value ("_ORDCTL_") - Expected 'NW' or 'CA'"
57 ;
58 ;Check Date and Time
59 S X=$E($P(SEGORC,FSHLI,10),1,12)
60 S:X?8N X=X_"2100" ;Default to 9:00PM if no time
61 S:X?10N X=X_"00" ;Default minutes if not sent
62 S:X'?12N X=-1 ;Invalid date
63 S:X'=-1 X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)_"@"_$E(X,9,12)
64 S %DT="R" D ^%DT I Y=-1 D G ACK
65 . S STS="AE^Invalid Run Date/Time - ("_$P(SEGORC,FSHLI,10)_")"
66 S IDT=Y,XDT=X
67 ;
68 ;Call Schedule (NW) or Cancel (CA) Tags
69 I ORDCTL="NW" D
70 . S STS=$$NW(IDT,XDT)
71 I ORDCTL="CA" D
72 . S STS=$$CA(IDT,XDT)
73 ;
74 ; Kick Off Application Acknowledgment
75 ;
76ACK S ACK("MSA",1)=$P(STS,U)
77 S ACK("MSA",2)=$G(HL("MID")) ;Message ID
78 S ACK("MSA",3)=$P(STS,U,2) ;Message Text
79 D APPACK(.HL,.ACK)
80 ;
81 ; Exit the process
82 ;
83EXIT K ACK,CNT,%DT,EVENT,FS,FSHLI,IDT,PROCID,SEGCNT,SEGMSH,SEGORC,STS,X,XDT,Y
84 K ^TMP($J,"XUSNPIXI"),HL,HLNEXT,HLNODE,HLQUIT
85 Q
86 ;
87 ; Schedule a New Run
88 ;
89NW(IDT,XDT) N TSK
90 ;
91 ;Check if task already scheduled for date/time
92 S TSK=$$GETTASK(IDT)
93 I TSK Q "AE^Task (#"_TSK_") already scheduled to run on "_XDT
94 ;
95 ;Schedule the task
96 S TSK=$$SCHED(IDT)
97 ;
98 ;Check for scheduling problem
99 I 'TSK Q "AE^Task Could Not Be Scheduled"
100 ;
101 ;Send successful schedule message
102 D MSG("CROSSWALK EXTRACT REPORT Scheduled "_XDT)
103 Q "AA^"
104 ;
105 ; Cancel a Scheduled Run
106 ;
107CA(IDT,XDT) N ZTSK
108 ;
109 ;Check if task has been scheduled for date/time
110 S ZTSK=$$GETTASK(IDT)
111 I 'ZTSK Q "AE^Task was not scheduled to run on "_XDT_"."
112 ;
113 ;Delete Task
114 D KILL^%ZTLOAD
115 ;
116 ;Check for problem with cancel request
117 I '$G(ZTSK(0)) Q "AE^Task (#"_ZTSK_") could not be killed."
118 ;
119 ;Send successful run cancel message
120 D MSG("CROSSWALK EXTRACT REPORT Cancelled "_XDT)
121 ;
122 Q "AA^"
123 ;
124 ;Check To See If Task Is Scheduled for Date and Time/Locate Task
125 ;
126GETTASK(IDT) N TASK,TASKNO,TDT,XUSUCI,Y,ZTSK0
127 ;
128 ;Retrieve UCI
129 X ^%ZOSF("UCI") S XUSUCI=Y
130 ;
131 S TASK=0,TASKNO=""
132 F S TASK=$O(^%ZTSK(TASK)) Q:'TASK D Q:TASKNO
133 .I $G(^%ZTSK(TASK,.03))["XUS NPI EXTRACT" D
134 ..S ZTSK0=$G(^%ZTSK(TASK,0))
135 ..;
136 ..;Exclude tasks scheduled by TaskMan
137 ..Q:ZTSK0["ZTSK^XQ1"
138 ..;
139 ..;Exclude tasks in other ucis
140 ..Q:(($P(ZTSK0,U,11)_","_$P(ZTSK0,U,12))'=XUSUCI)
141 ..;
142 ..;Check for correct date and time
143 ..S TDT=$$HTFM^XLFDT($P(ZTSK0,"^",6))
144 ..I TDT=IDT S TASKNO=TASK
145 Q TASKNO
146 ;
147 ;Schedule Task
148 ;
149SCHED(ZTDTH) N ZTRTN,ZTDESC,ZTIO,ZTSK
150 S ZTRTN="TASKMAN^XUSNPIX1"
151 S ZTDESC="XUS NPI EXTRACT"
152 S ZTIO=""
153 D ^%ZTLOAD
154 Q ZTSK
155 ;
156 ;Send Application Acknowledgment
157 ;
158APPACK(HL,XUSACK) ;
159 N FS,HLA,XUSGENR
160 S FS=$G(HL("FS")) I FS="" S FS="|"
161 ;
162 ;Set up HL7
163 D INIT^HLFNC2("XUS NPI EXTRACT INPUT",.HL)
164 ;
165 ;MSA Segment
166 S HLA("HLA",1)="MSA"_FS_$G(XUSACK("MSA",1))_FS_$G(XUSACK("MSA",2))_FS_$G(XUSACK("MSA",3))
167 ;
168 ;Kick off Application Acknowledgment
169 D GENACK^HLMA1($G(HL("EID")),$G(HL("HLMTIENS")),$G(HL("EIDS")),"LM",1,.XUSGENR)
170 ;
171 Q
172 ;
173 ;Send MailMan Status Message
174 ;
175MSG(XUSSUB) N XMSUB,XMTEXT,XMY,XUDT,XUSNPIMM,XMDUZ,XMZ,XMMG,DIFROM
176 ;
177 ;Set subject and text
178 S XMTEXT="XUSNPIMM("
179 S XUDT=$P($P(XUSSUB,"@")," ",$L(XUSSUB," "))
180 S XUSSUB=$P(XUSSUB," ",1,$L(XUSSUB," ")-1)_" "
181 S XUSSUB=XUSSUB_$E(XUDT,7,10)_$E(XUDT,1,2)_$E(XUDT,4,5)
182 S XMSUB=$$SUBJ()_XUSSUB
183 S XMDUZ="XUS NPI CROSSWALK EXTRACT SCHEDULER"
184 ;
185 ;Put subject in body as well so message will transmit
186 S XUSNPIMM(.0001)=XMSUB
187 ;
188 ;Set recipient
189 S XMY("G.NPI EXTRACT VERIFICATION")=""
190 ;
191 ;Send
192 D ^XMD
193 ;
194 Q
195 ;
196 ; Define First Part of Message Subject
197 ;
198SUBJ() N PROD,SINFO,SITE,SUBJ
199 ;
200 ;Pull site info
201 S SINFO=$$SITE^VASITE
202 ;
203 ; Station Number
204 S SITE=$P(SINFO,U,3)
205 ;
206 ;Determine whether production or test
207 S PROD=$S($$PROD^XUPROD(1):"PROD",1:"TEST")
208 ;
209 Q "Station "_SITE_"("_PROD_") NPI "
Note: See TracBrowser for help on using the repository browser.