- 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 Feb 19, 2025@00:10:24 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