source: WorldVistAEHR/trunk/r/VDEF-VDEF/VDEFREQ.m@ 623

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1VDEFREQ ;INTEGIC/AM & BPOIFO/JG - VDEF Request Processor ; 15 Nov 2005 3:00 PM
2 ;;1.0;VDEF;**3**;Dec 28, 2004
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; IA: 10063 - $$S^%ZTLOAD
6 ; 10063 - $$ASKSTOP^%ZTLOAD
7 ;
8 Q ; No bozos
9 ;
10EN ; Main entry point for the Request Queue processor from TaskMan
11 ;
12 ; Input parameter:
13 ; QIEN - Request Queue IEN passed in by TaskMan
14 ;
15 ; Output parameters:
16 ; ZTSTOP - flag indicating whether to stop processing: 0 by default
17 ; 1 if an outside request to stop the Processor or internal error
18 ; 2 if VistA HL7 API errored out
19 ; ZTREQ - Tells the Submanager to delete this task's record if "@"
20 ;
21 N DSTDATA,DSTIEN,ERR,FDA,NVPIEN,QUEUE,SCHED,IEN,VDEFWAIT,VDEFTSK
22 S VDEFTSK=ZTSK
23 ;
24 ; Lock this Request Queue from other processors. If it's already locked,
25 ; another process has it.
26 L +^VDEFHL7(579.3,"QUEUE",QIEN):1 G EXIT:'$T
27 ;
28EN1 ; Re-entry point after the wait period has expired
29 ;
30 ; Quit if there has been a request to stop processing
31 S ZTSTOP=$$S^%ZTLOAD() G EXIT:ZTSTOP
32 ;
33 ; Get the queue data
34 S QUEUE=$G(^VDEFHL7(579.3,QIEN,0))
35 ;
36 ; Quit if this Request Queue is suspended
37 G EXIT:$P(QUEUE,U,9)="S"
38 ;
39 ; Set the wait period to the REQUEST QUEUE WAKEUP
40 S VDEFWAIT=+$P(QUEUE,U,2)
41 ;
42 ; See if current time is in a scheduling rule
43 S SCHED=$$SCHEDULE^VDEFQM(QIEN,$H) G EN2:'SCHED
44 ;
45 ; If current time is in a suspend rule, set wait period to
46 ; the next start time or the basic wakeup period whichever is longer.
47 I $P(SCHED,U)="S",$P(SCHED,U,2)>VDEFWAIT S VDEFWAIT=$P(SCHED,U,2) G WAITLOOP
48 ;
49EN2 ; Update the Request Queue definition with the current task #
50 K FDA S FDA(1,579.3,QIEN_",",.11)=VDEFTSK D FILE^DIE("","FDA(1)","ERR(1)")
51 ;
52 ; Store VDEF Destination data in a local array
53 S DSTIEN=0 F S DSTIEN=$O(^VDEFHL7(579.2,DSTIEN)) Q:'DSTIEN D
54 . S DSTDATA(DSTIEN)=$G(^VDEFHL7(579.2,DSTIEN,0))
55 ;
56 ; Loop through the Queued Up requests for this queue
57 S (ZTSTOP,IEN)=0
58 F S IEN=$O(^VDEFHL7(579.3,"C","Q",QIEN,IEN)) Q:IEN="" D Q:ZTSTOP
59 . ;
60 . ; Quit if there has been a request to stop processing
61 . S ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
62 . I $P($G(^VDEFHL7(579.3,QIEN,0)),U,9)="S" S ZTSTOP=1 Q
63 . N DSTPROT,DSTTYP,DYNAMIC,ERR,SITEPARM
64 . N FDA,VDEFHL,HLA,HLCS,IEN577,IENS,II,HL
65 . N NAMEVAL,PAIR,REQUEST,SUBT,VAL,VDEFERR
66 . S IENS=IEN_","_QIEN_"," ; Request Queue IEN string
67 . L +^VDEFHL7(579.3,QIEN,IEN):5 Q:'$T
68 . M VAL=^VDEFHL7(579.3,QIEN,1,IEN) S REQUEST=$G(VAL(0))
69 . M NAMEVAL=VAL(.05) ; Name Value pairs
70 . M DYNAMIC=VAL(.19) ; Dynamic Addressing information
71 . K VAL
72 . ;
73 . ; Check for an incomplete record
74 . I '$D(NAMEVAL(1)) L -^VDEFHL7(579.3,QIEN,IEN) Q
75 . ;
76 . ; Change request status from "Q"ueued Up to "C"hecked Out
77 . S FDA(1,579.31,IENS,.02)="C" D FILE^DIE("","FDA(1)") K FDA
78 . ;
79 . ; Get the Event Subtype
80 . S SUBT="",PAIR=$P($G(NAMEVAL(1,0)),U,2)
81 . I $P(PAIR,"=",1)="SUBTYPE" S SUBT=$P(PAIR,"=",2)
82 . E D ERR("Subtype missing from Name/Value Pair") L -^VDEFHL7(579.3,QIEN,IEN) Q
83 . ;
84 . ; Get the VistA data file IEN
85 . S NVPIEN="",PAIR=$P($G(NAMEVAL(2,0)),U,2)
86 . I $P(PAIR,"=",1)="IEN" S NVPIEN=$P(PAIR,"=",2)
87 . E D ERR("IEN missing from Name/Value Pair") L -^VDEFHL7(579.3,QIEN,IEN) Q
88 . ;
89 . ; Retrieve the Destination information for this request
90 . S DSTIEN=$P(REQUEST,U,7),DSTTYP=$P($G(DSTDATA(+DSTIEN)),U,2)
91 . ;
92 . ; Get the VDEF Event IEN
93 . S IEN577=$P(REQUEST,U,18)
94 . ;
95 . ; Get the VISTA HL7 Protocol
96 . S DSTPROT=$P($G(^VDEFHL7(577,IEN577,0)),U,7)
97 . I DSTPROT="" D ERR("Protocol not defined in VDEF event file") S ZTSTOP=1 L -^VDEFHL7(579.3,QIEN,IEN) Q
98 . ;
99 . ; Create delimiter structure to use when building segments
100 . D INIT^HLFNC2(DSTPROT,.VDEFHL)
101 . I '$D(VDEFHL) D ERR("No HL7 parameters for this Protocol") S ZTSTOP=1 L -^VDEFHL7(579.3,QIEN,IEN) Q
102 . S HLCS=$E(VDEFHL("ECH")) M HL=VDEFHL ; Some called routines use 'HL' array
103 . ;
104 . ; Get the site parameters
105 . S SITEPARM=$$PARAM^HLCS2
106 . ;
107 . ; If no IEN don't generate an HL7 message
108 . I $G(NVPIEN)="" D STATUS^VDEFREQ1(IENS,"P"),ERR("Invalid IEN") S ZTSTOP=1 L -^VDEFHL7(579.3,QIEN,IEN) Q
109 . D NOW^%DTC S FDA(1,579.31,IENS,.09)=%
110 . ;
111 . ; Update this Request record with the current date & time
112 . D FILE^DIE("","FDA(1)","ERR(1)") K FDA
113 . ;
114 . ; Generate HL7 message for this request
115 . D GENERATE^VDEFREQ1(NVPIEN,.HLA,HLCS,IEN577,SUBT,DSTPROT,DSTTYP,.ZTSTOP,.VDEFHL,.DYNAMIC)
116 . ;
117 . ; Update request status from Checked Out to Processed or Errored Out
118 . ; Leave Request Checked Out if VistA HL7 errored out (ZTSTOP=2)
119 . I ZTSTOP'=2 D STATUS^VDEFREQ1(IENS,$S(ZTSTOP=1:"E",1:"P")) S ZTSTOP=0
120 . I ZTSTOP=2 S ZTSTOP=0 ; If VistA HL7 errored out, continue processing
121 . ;
122 . ; Unlock the record
123 . L -^VDEFHL7(579.3,QIEN,IEN)
124 ;
125 ; Quit if necessary.
126 G EXIT:ZTSTOP
127 ; Wait for the next time to run.
128 ; The wait process is in a loop so it can check if there
129 ; has been a request to stop processing before the wait expires.
130WAITLOOP N I S ZTSTOP=0 F I=1:1:VDEFWAIT D Q:ZTSTOP
131 . S ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
132 . I $P(^VDEFHL7(579.3,QIEN,0),U,9)="S" S ZTSTOP=1 Q
133 . H 1
134 ;
135 ; Quit or resume processing
136 I 'ZTSTOP K I G EN1
137 ;
138 ; Quit
139 ; Unlock the record in case it left the loop with an error
140EXIT L -^VDEFHL7(579.3,"QUEUE",QIEN),-^VDEFHL7(579.3,QIEN,IEN)
141 D ALERT^VDEFUTIL("VDEF REQUEST QUEUE PROCESSOR FOR "_$P(QUEUE,U)_" HAS EXITED.")
142 ;
143 ; Stop the task and delete this task's record
144 N X,I S ZTSK=VDEFTSK,X=$$ASKSTOP^%ZTLOAD(ZTSK),ZTREQ="@"
145 F I=1:1:5 D STAT^%ZTLOAD Q:ZTSK(1)=0!(ZTSK(1)>2) H 1
146 K X,I
147 Q
148 ;
149ERR(TEXT) ; Error processing
150 N FDA,ERR
151 S VDEFERR=$TR(TEXT,"^"),FDA(1,579.31,IENS,.17)=VDEFERR
152 D FILE^DIE("","FDA(1)","ERR")
153 Q
Note: See TracBrowser for help on using the repository browser.