VDEFREQ ;INTEGIC/AM & BPOIFO/JG - VDEF Request Processor ;15 Nov 2005 3:00 PM
;;1.0;VDEF;**3,14**;Dec 28, 2004;Build 3
;Per VA Directive 6402, this routine should not be modified.
;
; IA: 10063 - $$S^%ZTLOAD
; 10063 - $$ASKSTOP^%ZTLOAD
;
Q ; No bozos
;
EN ; Main entry point for the Request Queue processor from TaskMan
;
; Input parameter:
; QIEN - Request Queue IEN passed in by TaskMan
;
; Output parameters:
; ZTSTOP - flag indicating whether to stop processing: 0 by default
; 1 if an outside request to stop the Processor or internal error
; 2 if VistA HL7 API errored out
; ZTREQ - Tells the Submanager to delete this task's record if "@"
;
N DSTDATA,DSTIEN,ERR,FDA,NVPIEN,QUEUE,SCHED,IEN,VDEFWAIT,VDEFTSK
S VDEFTSK=ZTSK
;
; Lock this Request Queue from other processors. If it's already locked,
; another process has it.
L +^VDEFHL7(579.3,"QUEUE",QIEN):1 G EXIT:'$T
;
EN1 ; Re-entry point after the wait period has expired
;
; Quit if there has been a request to stop processing
S ZTSTOP=$$S^%ZTLOAD() G EXIT:ZTSTOP
;
; Get the queue data
S QUEUE=$G(^VDEFHL7(579.3,QIEN,0))
;
; Quit if this Request Queue is suspended
G EXIT:$P(QUEUE,U,9)="S"
;
; Set the wait period to the REQUEST QUEUE WAKEUP
S VDEFWAIT=+$P(QUEUE,U,2)
;
; See if current time is in a scheduling rule
S SCHED=$$SCHEDULE^VDEFQM(QIEN,$H) G EN2:'SCHED
;
; If current time is in a suspend rule, set wait period to
; the next start time or the basic wakeup period whichever is longer.
I $P(SCHED,U)="S",$P(SCHED,U,2)>VDEFWAIT S VDEFWAIT=$P(SCHED,U,2) G WAITLOOP
;
EN2 ; Update the Request Queue definition with the current task #
K FDA S FDA(1,579.3,QIEN_",",.11)=VDEFTSK D FILE^DIE("","FDA(1)","ERR(1)")
;
; Store VDEF Destination data in a local array
S DSTIEN=0 F S DSTIEN=$O(^VDEFHL7(579.2,DSTIEN)) Q:'DSTIEN D
. S DSTDATA(DSTIEN)=$G(^VDEFHL7(579.2,DSTIEN,0))
;
; Loop through the Queued Up requests for this queue
S (ZTSTOP,IEN)=0
F S IEN=$O(^VDEFHL7(579.3,"C","Q",QIEN,IEN)) Q:IEN="" D Q:ZTSTOP
. ;
. ; Quit if there has been a request to stop processing
. S ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
. I $P($G(^VDEFHL7(579.3,QIEN,0)),U,9)="S" S ZTSTOP=1 Q
. N DSTPROT,DSTTYP,DYNAMIC,ERR,SITEPARM,VDEFN
. N FDA,VDEFHL,HLA,HLCS,IEN577,IENS,II,HL
. N NAMEVAL,PAIR,REQUEST,SUBT,VAL,VDEFERR
. S IENS=IEN_","_QIEN_"," ; Request Queue IEN string
. L +^VDEFHL7(579.3,QIEN,IEN):5 Q:'$T
. M VAL=^VDEFHL7(579.3,QIEN,1,IEN) S REQUEST=$G(VAL(0))
. M NAMEVAL=VAL(.05) ; Name Value pairs
. M DYNAMIC=VAL(.19) ; Dynamic Addressing information
. K VAL
. ;
. ; Check for an incomplete record
. ;VDEF*14 - should not rely on global structure
. ;I '$D(NAMEVAL(1)) L -^VDEFHL7(579.3,QIEN,IEN) Q
. ;
. ; Change request status from "Q"ueued Up to "C"hecked Out
. S FDA(1,579.31,IENS,.02)="C" D FILE^DIE("","FDA(1)") K FDA
. ;
. ; VDEF*14 loop through the NAMEVAL array - regardless of ien
. S (SUBT,NVPIEN)="",VDEFN=0
. F S VDEFN=$O(NAMEVAL(VDEFN)) Q:VDEFN="" D
.. S PAIR=$P($G(NAMEVAL(VDEFN,0)),U,2)
.. I PAIR["SUBTYPE" S SUBT=$P(PAIR,"=",2)
.. I PAIR["IEN" S NVPIEN=$P(PAIR,"=",2)
.. Q
. ;VDEF*14 quit if unable to determine subtype or ien
. I SUBT="" D ERR("Subtype missing from Name/Value Pair") L -^VDEFHL7(579.3,QIEN,IEN) Q
. I NVPIEN="" D ERR("IEN missing from Name/Value Pair") L -^VDEFHL7(579.3,QIEN,IEN) Q
. ;
. ; Retrieve the Destination information for this request
. S DSTIEN=$P(REQUEST,U,7),DSTTYP=$P($G(DSTDATA(+DSTIEN)),U,2)
. ;
. ; Get the VDEF Event IEN
. S IEN577=$P(REQUEST,U,18)
. ;
. ; Get the VISTA HL7 Protocol
. S DSTPROT=$P($G(^VDEFHL7(577,IEN577,0)),U,7)
. I DSTPROT="" D ERR("Protocol not defined in VDEF event file") S ZTSTOP=1 L -^VDEFHL7(579.3,QIEN,IEN) Q
. ;
. ; Create delimiter structure to use when building segments
. D INIT^HLFNC2(DSTPROT,.VDEFHL)
. I '$D(VDEFHL) D ERR("No HL7 parameters for this Protocol") S ZTSTOP=1 L -^VDEFHL7(579.3,QIEN,IEN) Q
. S HLCS=$E(VDEFHL("ECH")) M HL=VDEFHL ; Some called routines use 'HL' array
. ;
. ; Get the site parameters
. S SITEPARM=$$PARAM^HLCS2
. ;
. ; If no IEN don't generate an HL7 message
. I $G(NVPIEN)="" D STATUS^VDEFREQ1(IENS,"P"),ERR("Invalid IEN") S ZTSTOP=1 L -^VDEFHL7(579.3,QIEN,IEN) Q
. D NOW^%DTC S FDA(1,579.31,IENS,.09)=%
. ;
. ; Update this Request record with the current date & time
. D FILE^DIE("","FDA(1)","ERR(1)") K FDA
. ;
. ; Generate HL7 message for this request
. D GENERATE^VDEFREQ1(NVPIEN,.HLA,HLCS,IEN577,SUBT,DSTPROT,DSTTYP,.ZTSTOP,.VDEFHL,.DYNAMIC)
. ;
. ; Update request status from Checked Out to Processed or Errored Out
. ; Leave Request Checked Out if VistA HL7 errored out (ZTSTOP=2)
. I ZTSTOP'=2 D STATUS^VDEFREQ1(IENS,$S(ZTSTOP=1:"E",1:"P")) S ZTSTOP=0
. I ZTSTOP=2 S ZTSTOP=0 ; If VistA HL7 errored out, continue processing
. ;
. ; Unlock the record
. L -^VDEFHL7(579.3,QIEN,IEN)
;
; Quit if necessary.
G EXIT:ZTSTOP
; Wait for the next time to run.
; The wait process is in a loop so it can check if there
; has been a request to stop processing before the wait expires.
WAITLOOP N I S ZTSTOP=0 F I=1:1:VDEFWAIT D Q:ZTSTOP
. S ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
. I $P(^VDEFHL7(579.3,QIEN,0),U,9)="S" S ZTSTOP=1 Q
. H 1
;
; Quit or resume processing
I 'ZTSTOP K I G EN1
;
; Quit
; Unlock the record in case it left the loop with an error
EXIT L -^VDEFHL7(579.3,"QUEUE",QIEN),-^VDEFHL7(579.3,QIEN,IEN)
D ALERT^VDEFUTIL("VDEF REQUEST QUEUE PROCESSOR FOR "_$P(QUEUE,U)_" HAS EXITED.")
;
; Stop the task and delete this task's record
N X,I S ZTSK=VDEFTSK,X=$$ASKSTOP^%ZTLOAD(ZTSK),ZTREQ="@"
F I=1:1:5 D STAT^%ZTLOAD Q:ZTSK(1)=0!(ZTSK(1)>2) H 1
K X,I
Q
;
ERR(TEXT) ; Error processing
N FDA,ERR
S VDEFERR=$TR(TEXT,"^"),FDA(1,579.31,IENS,.17)=VDEFERR
D FILE^DIE("","FDA(1)","ERR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVDEFREQ 5967 printed Dec 13, 2024@02:43:57 Page 2
VDEFREQ ;INTEGIC/AM & BPOIFO/JG - VDEF Request Processor ;15 Nov 2005 3:00 PM
+1 ;;1.0;VDEF;**3,14**;Dec 28, 2004;Build 3
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IA: 10063 - $$S^%ZTLOAD
+5 ; 10063 - $$ASKSTOP^%ZTLOAD
+6 ;
+7 ; No bozos
QUIT
+8 ;
EN ; Main entry point for the Request Queue processor from TaskMan
+1 ;
+2 ; Input parameter:
+3 ; QIEN - Request Queue IEN passed in by TaskMan
+4 ;
+5 ; Output parameters:
+6 ; ZTSTOP - flag indicating whether to stop processing: 0 by default
+7 ; 1 if an outside request to stop the Processor or internal error
+8 ; 2 if VistA HL7 API errored out
+9 ; ZTREQ - Tells the Submanager to delete this task's record if "@"
+10 ;
+11 NEW DSTDATA,DSTIEN,ERR,FDA,NVPIEN,QUEUE,SCHED,IEN,VDEFWAIT,VDEFTSK
+12 SET VDEFTSK=ZTSK
+13 ;
+14 ; Lock this Request Queue from other processors. If it's already locked,
+15 ; another process has it.
+16 LOCK +^VDEFHL7(579.3,"QUEUE",QIEN):1
if '$TEST
GOTO EXIT
+17 ;
EN1 ; Re-entry point after the wait period has expired
+1 ;
+2 ; Quit if there has been a request to stop processing
+3 SET ZTSTOP=$$S^%ZTLOAD()
if ZTSTOP
GOTO EXIT
+4 ;
+5 ; Get the queue data
+6 SET QUEUE=$GET(^VDEFHL7(579.3,QIEN,0))
+7 ;
+8 ; Quit if this Request Queue is suspended
+9 if $PIECE(QUEUE,U,9)="S"
GOTO EXIT
+10 ;
+11 ; Set the wait period to the REQUEST QUEUE WAKEUP
+12 SET VDEFWAIT=+$PIECE(QUEUE,U,2)
+13 ;
+14 ; See if current time is in a scheduling rule
+15 SET SCHED=$$SCHEDULE^VDEFQM(QIEN,$HOROLOG)
if 'SCHED
GOTO EN2
+16 ;
+17 ; If current time is in a suspend rule, set wait period to
+18 ; the next start time or the basic wakeup period whichever is longer.
+19 IF $PIECE(SCHED,U)="S"
IF $PIECE(SCHED,U,2)>VDEFWAIT
SET VDEFWAIT=$PIECE(SCHED,U,2)
GOTO WAITLOOP
+20 ;
EN2 ; Update the Request Queue definition with the current task #
+1 KILL FDA
SET FDA(1,579.3,QIEN_",",.11)=VDEFTSK
DO FILE^DIE("","FDA(1)","ERR(1)")
+2 ;
+3 ; Store VDEF Destination data in a local array
+4 SET DSTIEN=0
FOR
SET DSTIEN=$ORDER(^VDEFHL7(579.2,DSTIEN))
if 'DSTIEN
QUIT
Begin DoDot:1
+5 SET DSTDATA(DSTIEN)=$GET(^VDEFHL7(579.2,DSTIEN,0))
End DoDot:1
+6 ;
+7 ; Loop through the Queued Up requests for this queue
+8 SET (ZTSTOP,IEN)=0
+9 FOR
SET IEN=$ORDER(^VDEFHL7(579.3,"C","Q",QIEN,IEN))
if IEN=""
QUIT
Begin DoDot:1
+10 ;
+11 ; Quit if there has been a request to stop processing
+12 SET ZTSTOP=$$S^%ZTLOAD()
if ZTSTOP
QUIT
+13 IF $PIECE($GET(^VDEFHL7(579.3,QIEN,0)),U,9)="S"
SET ZTSTOP=1
QUIT
+14 NEW DSTPROT,DSTTYP,DYNAMIC,ERR,SITEPARM,VDEFN
+15 NEW FDA,VDEFHL,HLA,HLCS,IEN577,IENS,II,HL
+16 NEW NAMEVAL,PAIR,REQUEST,SUBT,VAL,VDEFERR
+17 ; Request Queue IEN string
SET IENS=IEN_","_QIEN_","
+18 LOCK +^VDEFHL7(579.3,QIEN,IEN):5
if '$TEST
QUIT
+19 MERGE VAL=^VDEFHL7(579.3,QIEN,1,IEN)
SET REQUEST=$GET(VAL(0))
+20 ; Name Value pairs
MERGE NAMEVAL=VAL(.05)
+21 ; Dynamic Addressing information
MERGE DYNAMIC=VAL(.19)
+22 KILL VAL
+23 ;
+24 ; Check for an incomplete record
+25 ;VDEF*14 - should not rely on global structure
+26 ;I '$D(NAMEVAL(1)) L -^VDEFHL7(579.3,QIEN,IEN) Q
+27 ;
+28 ; Change request status from "Q"ueued Up to "C"hecked Out
+29 SET FDA(1,579.31,IENS,.02)="C"
DO FILE^DIE("","FDA(1)")
KILL FDA
+30 ;
+31 ; VDEF*14 loop through the NAMEVAL array - regardless of ien
+32 SET (SUBT,NVPIEN)=""
SET VDEFN=0
+33 FOR
SET VDEFN=$ORDER(NAMEVAL(VDEFN))
if VDEFN=""
QUIT
Begin DoDot:2
+34 SET PAIR=$PIECE($GET(NAMEVAL(VDEFN,0)),U,2)
+35 IF PAIR["SUBTYPE"
SET SUBT=$PIECE(PAIR,"=",2)
+36 IF PAIR["IEN"
SET NVPIEN=$PIECE(PAIR,"=",2)
+37 QUIT
End DoDot:2
+38 ;VDEF*14 quit if unable to determine subtype or ien
+39 IF SUBT=""
DO ERR("Subtype missing from Name/Value Pair")
LOCK -^VDEFHL7(579.3,QIEN,IEN)
QUIT
+40 IF NVPIEN=""
DO ERR("IEN missing from Name/Value Pair")
LOCK -^VDEFHL7(579.3,QIEN,IEN)
QUIT
+41 ;
+42 ; Retrieve the Destination information for this request
+43 SET DSTIEN=$PIECE(REQUEST,U,7)
SET DSTTYP=$PIECE($GET(DSTDATA(+DSTIEN)),U,2)
+44 ;
+45 ; Get the VDEF Event IEN
+46 SET IEN577=$PIECE(REQUEST,U,18)
+47 ;
+48 ; Get the VISTA HL7 Protocol
+49 SET DSTPROT=$PIECE($GET(^VDEFHL7(577,IEN577,0)),U,7)
+50 IF DSTPROT=""
DO ERR("Protocol not defined in VDEF event file")
SET ZTSTOP=1
LOCK -^VDEFHL7(579.3,QIEN,IEN)
QUIT
+51 ;
+52 ; Create delimiter structure to use when building segments
+53 DO INIT^HLFNC2(DSTPROT,.VDEFHL)
+54 IF '$DATA(VDEFHL)
DO ERR("No HL7 parameters for this Protocol")
SET ZTSTOP=1
LOCK -^VDEFHL7(579.3,QIEN,IEN)
QUIT
+55 ; Some called routines use 'HL' array
SET HLCS=$EXTRACT(VDEFHL("ECH"))
MERGE HL=VDEFHL
+56 ;
+57 ; Get the site parameters
+58 SET SITEPARM=$$PARAM^HLCS2
+59 ;
+60 ; If no IEN don't generate an HL7 message
+61 IF $GET(NVPIEN)=""
DO STATUS^VDEFREQ1(IENS,"P")
DO ERR("Invalid IEN")
SET ZTSTOP=1
LOCK -^VDEFHL7(579.3,QIEN,IEN)
QUIT
+62 DO NOW^%DTC
SET FDA(1,579.31,IENS,.09)=%
+63 ;
+64 ; Update this Request record with the current date & time
+65 DO FILE^DIE("","FDA(1)","ERR(1)")
KILL FDA
+66 ;
+67 ; Generate HL7 message for this request
+68 DO GENERATE^VDEFREQ1(NVPIEN,.HLA,HLCS,IEN577,SUBT,DSTPROT,DSTTYP,.ZTSTOP,.VDEFHL,.DYNAMIC)
+69 ;
+70 ; Update request status from Checked Out to Processed or Errored Out
+71 ; Leave Request Checked Out if VistA HL7 errored out (ZTSTOP=2)
+72 IF ZTSTOP'=2
DO STATUS^VDEFREQ1(IENS,$SELECT(ZTSTOP=1:"E",1:"P"))
SET ZTSTOP=0
+73 ; If VistA HL7 errored out, continue processing
IF ZTSTOP=2
SET ZTSTOP=0
+74 ;
+75 ; Unlock the record
+76 LOCK -^VDEFHL7(579.3,QIEN,IEN)
End DoDot:1
if ZTSTOP
QUIT
+77 ;
+78 ; Quit if necessary.
+79 if ZTSTOP
GOTO EXIT
+80 ; Wait for the next time to run.
+81 ; The wait process is in a loop so it can check if there
+82 ; has been a request to stop processing before the wait expires.
WAITLOOP NEW I
SET ZTSTOP=0
FOR I=1:1:VDEFWAIT
Begin DoDot:1
+1 SET ZTSTOP=$$S^%ZTLOAD()
if ZTSTOP
QUIT
+2 IF $PIECE(^VDEFHL7(579.3,QIEN,0),U,9)="S"
SET ZTSTOP=1
QUIT
+3 HANG 1
End DoDot:1
if ZTSTOP
QUIT
+4 ;
+5 ; Quit or resume processing
+6 IF 'ZTSTOP
KILL I
GOTO EN1
+7 ;
+8 ; Quit
+9 ; Unlock the record in case it left the loop with an error
EXIT LOCK -^VDEFHL7(579.3,"QUEUE",QIEN),-^VDEFHL7(579.3,QIEN,IEN)
+1 DO ALERT^VDEFUTIL("VDEF REQUEST QUEUE PROCESSOR FOR "_$PIECE(QUEUE,U)_" HAS EXITED.")
+2 ;
+3 ; Stop the task and delete this task's record
+4 NEW X,I
SET ZTSK=VDEFTSK
SET X=$$ASKSTOP^%ZTLOAD(ZTSK)
SET ZTREQ="@"
+5 FOR I=1:1:5
DO STAT^%ZTLOAD
if ZTSK(1)=0!(ZTSK(1)>2)
QUIT
HANG 1
+6 KILL X,I
+7 QUIT
+8 ;
ERR(TEXT) ; Error processing
+1 NEW FDA,ERR
+2 SET VDEFERR=$TRANSLATE(TEXT,"^")
SET FDA(1,579.31,IENS,.17)=VDEFERR
+3 DO FILE^DIE("","FDA(1)","ERR")
+4 QUIT
