VDEFQM ;INTEGIC/AM & BPOIFO/JG - VDEF API ; 21 Dec 2005 11:38 AM
;;1.0;VDEF;**3**;Dec 28, 2004
;Per VHA Directive 2004-038, this routine should not be modified.
;
; IA's: #4271 - Lookup to file #771.2
; #4321 - Lookup to file #779.001
;
Q ; No bozos
;
; Validates and places a request in the VDEF queue
QUEUE(EVENT,PAIR,MSTEXT,REQIEN,DYNAMIC) ;
; EVENT = HL7 event in the form Event Type^Message Type (e.g. ADT^A28)
; PAIR = Name/value pairs uniquely identifying the IEN
; (e.g. SUBTYPE="CHEM"^IEN=1234)
; MSTEXT = Returned text message, passed by reference
; REQIEN = Requestor IEN in file 579.1, only valued for solicited
; requests
; DYNAMIC = Dynamic Addressing array in nodes DYNAMIC("LINKS",1-n)
;
N CNT,CUSTIEN,DATA,DESTIEN,ERR,EVENTIEN,EVTY,EVTYIEN,FDA,VDI,IENROOT
N MESIEN,MSTY,OUTPUT,QUEIEN,RQIEN,SUBTYPE,SUBIEN,NVPIEN
N D0,DA,DH,DI,DIC,DIE,DIK,DIKRFIL,DIN,DIROOT,DR,X,Y
S MSTEXT="",REQIEN=$G(REQIEN) S:$G(U)="" U="^"
;
; Check for the existence of the HL7 event
I $G(EVENT)="" S MSTEXT="HL7 event is required" G EXBAD
;
; Check for the existence of the name/value pair
I $G(PAIR)="" S MSTEXT="Name/value pair(s) is required" G EXBAD
;
; Retrieve the HL7 Message Type and the HL7 Event Type
S MSTY=$P($G(EVENT),U,1),EVTY=$P($G(EVENT),U,2)
;
; Validate the HL7 Message type
I MSTY="" S MSTEXT="HL7 Message Type is required" G EXBAD
;
; Validate the HL7 Event type
I EVTY="" S MSTEXT="HL7 Event Type is required" G EXBAD
;
; Get the default Requestor IEN or '1' if not set up
S REQIEN=$O(^VDEFHL7(579.1,"C","Y",0)) S:REQIEN="" REQIEN=1
;
; Retrieve Requestor data and see if Requestor is enabled
S DATA=$G(^VDEFHL7(579.1,REQIEN,0)) I $P(DATA,U,5)="I" D G EXBAD
. S MSTEXT="VDEF HL7 messaging disabled for this Requestor"
;
; Get the Request Queue IEN for this Requestor
S QUEIEN=$P(DATA,U,4) I 'QUEIEN S MSTEXT="Could not get a valid Request Queue" G EXBAD
;
; Get the Destination IEN for this Requestor
S DESTIEN=$P(DATA,U,3) I 'DESTIEN S MSTEXT="No Destination for this Requestor" G EXBAD
;
; Validate Name/Value Pair
I $P($P(PAIR,U),"=",1)'="SUBTYPE"!($P($P(PAIR,U,2),"=",1)'="IEN") D G EXBAD
. S MSTEXT="Invalid Name/Value Pair"
S SUBTYPE=$P($P(PAIR,U),"=",2),NVPIEN=$P($P(PAIR,U,2),"=",2)
;
; Validate the Subtype
S SUBIEN=$$FIND1^DIC(577.4,"","BX",SUBTYPE)
I 'SUBIEN S MSTEXT="Invalid VDEF Subtype" G EXBAD
;
; Validate the HL7 Message and Event Types
S MESIEN=$$FIND1^DIC(771.2,"","BX",MSTY)
I 'MESIEN S MSTEXT="Invalid HL7 Message Type" G EXBAD
S EVTYIEN=$$FIND1^DIC(779.001,,"BX",EVTY)
I 'EVTYIEN S MSTEXT="Invalid HL7 Event Type" G EXBAD
;
; Validate the VDEF Event
S EVENTIEN=$O(^VDEFHL7(577,"BB",MESIEN,EVTYIEN,SUBIEN,""))
I 'EVENTIEN S MSTEXT="Invalid 'Message Type-Event Type-Subtype'" G EXBAD
;
; Check if this Request is for a disabled custodial package
S X=$G(^VDEFHL7(577,EVENTIEN,0)),CUSTIEN=$P(X,U,9)
I $P($G(^VDEFHL7(579.6,+CUSTIEN,0)),U,2)="I" D G EXBAD
. S MSTEXT="Custodial package disabled for this event"
;
; Check if this VDEF API is disabled
I $P(X,U,11)'="A" D G EXBAD
. S MSTEXT="VDEF API "_$P(X,U,1)_" is turned off"
;
; Start filing request into ^VDEFHL7(579.3
; Lock the queue to prevent other requests from being added to it
; doesn't affect the processing of existing requests
L +^VDEFHL7(579.3,QUEIEN,"ADD"):10
E S MSTEXT="VDEF queuing is currently unavailable" G EXBAD
;
; Populate the Request data (579.31) for this queue
S FDA(1,579.31,"+1,"_QUEIEN_",",.01)=9999 ; DINUM placeholder
S FDA(1,579.31,"+1,"_QUEIEN_",",.02)="Q" ; Request status - "Q"ueued
S FDA(1,579.31,"+1,"_QUEIEN_",",.03)=MSTY ; Message Type
S FDA(1,579.31,"+1,"_QUEIEN_",",.04)=EVTY ; Event Type
S FDA(1,579.31,"+1,"_QUEIEN_",",.06)=REQIEN ; Requestor
S FDA(1,579.31,"+1,"_QUEIEN_",",.07)=DESTIEN ; Destination
D NOW^%DTC S FDA(1,579.31,"+1,"_QUEIEN_",",.08)=% ; DTS when request was added
S FDA(1,579.31,"+1,"_QUEIEN_",",.18)=EVENTIEN ; VDEF Event IEN
D UPDATE^DIE("","FDA(1)","IENROOT","ERR")
S RQIEN=$G(IENROOT(1)) ; Get the assigned Request entry IEN
;
; Lock this queue entry to prevent the Request Processor from
; retrieving an incomplete Request
L +^VDEFHL7(579.3,QUEIEN,RQIEN)
L -^VDEFHL7(579.3,QUEIEN,"ADD") ; Release the queue "ADD" lock
;
; Update the DINUM field with the IEN value for this Request
S FDA(1,579.31,RQIEN_","_QUEIEN_",",.01)=RQIEN D FILE^DIE("","FDA(1)","ERR(2)")
;
; Set up the name value pairs multiple (579.311)
F VDI=1,2 D
. S FDA(1,579.311,"+"_VDI_","_RQIEN_","_QUEIEN_",",.01)=VDI
. S FDA(1,579.311,"+"_VDI_","_RQIEN_","_QUEIEN_",",.02)=$P(PAIR,U,VDI)
D UPDATE^DIE("","FDA(1)","","ERR")
;
; Set up the Dynamic Adressing multiple, if passed in
S (VDI,DATA)="",CNT=0 F S VDI=$O(DYNAMIC("LINKS",VDI)) Q:'VDI D
. ; CNT and VDI may be different since the "LINKS" array may be sparse
. S DATA=$G(DYNAMIC("LINKS",VDI)),CNT=CNT+1
. S FDA(1,579.313,"+"_CNT_","_RQIEN_","_QUEIEN_",",.01)=VDI
. S FDA(1,579.313,"+"_CNT_","_RQIEN_","_QUEIEN_",",.02)=DATA
;
; File Dynamic Addressing information
I $D(FDA) D UPDATE^DIE("","FDA(1)","","ERR")
L -^VDEFHL7(579.3,QUEIEN,RQIEN) ; Release the lock on this Request
S MSTEXT="Message "_MSTY_", Event "_EVTY_", Subtype "_SUBTYPE_" queued for processing"
EXIT Q 1 ; Good exit
EXBAD Q 0 ; Bad, bad exit
;
; Function to set up a Request Processor Scheduling Rule
SCHEDULE(Q,H) ;
N HT,SIEN,NZ,DOW,STM,ETM
I $G(Q)="" Q ""
I $G(H)="" S H=$H
S DOW=H-2#7,SIEN=0,HT=0
F S SIEN=$O(^VDEFHL7(579.3,Q,2,SIEN)) Q:'SIEN D Q:HT'=0
. S NZ=^VDEFHL7(579.3,Q,2,SIEN,0)
. Q:$P(NZ,U,2)'=DOW
. S STM=$P(NZ,U,4),ETM=$P(NZ,U,5)
. S STM=$TR(STM,":- "),STM=$E(STM,1,2)*60+$E(STM,3,4)*60+$E(STM,5,6)
. S ETM=$TR(ETM,":- "),ETM=$E(ETM,1,2)*60+$E(ETM,3,4)*60+$E(ETM,5,6)
. I $P(H,",",2)'<STM,$P(H,",",2)'>ETM S HT=$P(NZ,U,3)
I HT'=0 Q HT_U_(ETM-$P(H,",",2))
Q ""
;
TIMECK(T) N H,M,S I T?4.6N S H=+$E(T,1,2),M=+$E(T,3,4),S=+$E(T,5,6)
E I T[":" S H=+$P(T,":"),M=+$P(T,":",2),S=+$P(T,":",3)
E I T["-" S H=+$P(T,"-"),M=+$P(T,"-",2),S=+$P(T,"-",3)
E I T[" " S H=+$P(T," "),M=+$P(T," ",2),S=+$P(T," ",3)
E Q 0
I H<24,M<60,S<60 Q 1
Q 0
;
REQUEUE(Q,X) ; Requeue Checked Out requests.
; Change the status of all "C" entries in a Request Queue to "Q".
; If ZTQUEUED not set, run this interactively.
; Input - Request Queue IEN
; Output - 0 = no requests requeued
; 1 = requests weere requeued
S X=0
I $G(Q)="" W:'$D(ZTQUEUED) !,"Invalid queue IEN" Q
;
; Quit if no requests are Checked Out
I $O(^VDEFHL7(579.3,"C","C",0))="" W:'$D(ZTQUEUED) !,"No Requests in Checked Out status" Q
;
; Get Queue
N QUE S QUE=$P($G(^VDEFHL7(579.3,Q,0)),U)
I QUE="" W:'$D(ZTQUEUED) !,"Invalid queue" Q
G REQUEUE1:$D(ZTQUEUED)
K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="No"
W !,"This action will reset all entries in the '"_QUE_"' queue to 'Q'ueued."
D ^DIR I Y=0 W !,"Entries not reset." Q
REQUEUE1 N FDA,IEN,MSG S IEN=""
F S IEN=$O(^VDEFHL7(579.3,"C","C",Q,IEN)) Q:'IEN D
. ;
. ; If request has not had an alert yet or can't be locked,
. ; don't requeue it.
. Q:$$GET1^DIQ(579.31,IEN_","_Q_",",.15,"I")=""
. L +^VDEFHL7(579.3,Q,IEN):1 Q:'$T
. ;
. ; Change status to "Q" (queued up) and delete
. ; the old check out date/time and alert date/time
. ; and error message
. K FDA,MSG S FDA(579.31,IEN_","_Q_",",.02)="Q"
. S FDA(579.31,IEN_","_Q_",",.15)="@"
. S FDA(579.31,IEN_","_Q_",",.09)="@"
. D FILE^DIE(,"FDA","MSG")
. K ^VDEFHL7(579.3,Q,1,IEN,"ERRMSG")
. L -^VDEFHL7(579.3,Q,IEN)
. S X=1
W:'$D(ZTQUEUED) !,"Entries reset to 'Q'ueued status for "_QUE_"."
Q
;
; Requeue Errored Out requests.
; Change the status of all "E" entries in a Request Queue to "Q".
; If ZTQUEUED not set, run this interactively.
RQERR(Q,X) ;
S X=0
I $G(Q)="" W:'$D(ZTQUEUED) !,"Invalid queue IEN" Q
;
; Quit if no requests are Errored Out
I $O(^VDEFHL7(579.3,"C","E",0))="" W:'$D(ZTQUEUED) !,"No Requests in Errored Out status" Q
;
; Get Queue
N QUE S QUE=$P($G(^VDEFHL7(579.3,Q,0)),U)
I QUE="" W:'$D(ZTQUEUED) !,"Invalid queue" Q
G RQERR1:$D(ZTQUEUED)
K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="No"
W !,"This action resets all Errored Out entries in the '"_QUE_"' queue to 'Q'ueued."
D ^DIR I Y=0 W !,"Entries not reset." Q
RQERR1 N FDA,IEN,MSG S IEN=""
F S IEN=$O(^VDEFHL7(579.3,"C","E",Q,IEN)) Q:'IEN D
. L +^VDEFHL7(579.3,Q,IEN):1 Q:'$T
. ;
. ; Fix the actual status in the record if it's not "E".
. I $$GET1^DIQ(579.31,IEN_","_Q_",",.02,"I")'="E" D
.. K FDA,MSG S FDA(579.31,IEN_","_Q_",",.02)="E"
.. D FILE^DIE(,"FDA","MSG")
. ;
. ; Change status to "Q" (queued up) and delete
. ; the old check out date/time and alert date/time
. ; and error message
. K FDA,MSG S FDA(579.31,IEN_","_Q_",",.02)="Q"
. S FDA(579.31,IEN_","_Q_",",.15)="@"
. S FDA(579.31,IEN_","_Q_",",.09)="@"
. D FILE^DIE(,"FDA","MSG")
. K ^VDEFHL7(579.3,Q,1,IEN,"ERRMSG")
. L -^VDEFHL7(579.3,Q,IEN)
. S X=1
W:'$D(ZTQUEUED) !,"Entries reset to 'Q'ueued status for "_QUE_"."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVDEFQM 9310 printed Oct 16, 2024@18:44:31 Page 2
VDEFQM ;INTEGIC/AM & BPOIFO/JG - VDEF API ; 21 Dec 2005 11:38 AM
+1 ;;1.0;VDEF;**3**;Dec 28, 2004
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; IA's: #4271 - Lookup to file #771.2
+5 ; #4321 - Lookup to file #779.001
+6 ;
+7 ; No bozos
QUIT
+8 ;
+9 ; Validates and places a request in the VDEF queue
QUEUE(EVENT,PAIR,MSTEXT,REQIEN,DYNAMIC) ;
+1 ; EVENT = HL7 event in the form Event Type^Message Type (e.g. ADT^A28)
+2 ; PAIR = Name/value pairs uniquely identifying the IEN
+3 ; (e.g. SUBTYPE="CHEM"^IEN=1234)
+4 ; MSTEXT = Returned text message, passed by reference
+5 ; REQIEN = Requestor IEN in file 579.1, only valued for solicited
+6 ; requests
+7 ; DYNAMIC = Dynamic Addressing array in nodes DYNAMIC("LINKS",1-n)
+8 ;
+9 NEW CNT,CUSTIEN,DATA,DESTIEN,ERR,EVENTIEN,EVTY,EVTYIEN,FDA,VDI,IENROOT
+10 NEW MESIEN,MSTY,OUTPUT,QUEIEN,RQIEN,SUBTYPE,SUBIEN,NVPIEN
+11 NEW D0,DA,DH,DI,DIC,DIE,DIK,DIKRFIL,DIN,DIROOT,DR,X,Y
+12 SET MSTEXT=""
SET REQIEN=$GET(REQIEN)
if $GET(U)=""
SET U="^"
+13 ;
+14 ; Check for the existence of the HL7 event
+15 IF $GET(EVENT)=""
SET MSTEXT="HL7 event is required"
GOTO EXBAD
+16 ;
+17 ; Check for the existence of the name/value pair
+18 IF $GET(PAIR)=""
SET MSTEXT="Name/value pair(s) is required"
GOTO EXBAD
+19 ;
+20 ; Retrieve the HL7 Message Type and the HL7 Event Type
+21 SET MSTY=$PIECE($GET(EVENT),U,1)
SET EVTY=$PIECE($GET(EVENT),U,2)
+22 ;
+23 ; Validate the HL7 Message type
+24 IF MSTY=""
SET MSTEXT="HL7 Message Type is required"
GOTO EXBAD
+25 ;
+26 ; Validate the HL7 Event type
+27 IF EVTY=""
SET MSTEXT="HL7 Event Type is required"
GOTO EXBAD
+28 ;
+29 ; Get the default Requestor IEN or '1' if not set up
+30 SET REQIEN=$ORDER(^VDEFHL7(579.1,"C","Y",0))
if REQIEN=""
SET REQIEN=1
+31 ;
+32 ; Retrieve Requestor data and see if Requestor is enabled
+33 SET DATA=$GET(^VDEFHL7(579.1,REQIEN,0))
IF $PIECE(DATA,U,5)="I"
Begin DoDot:1
+34 SET MSTEXT="VDEF HL7 messaging disabled for this Requestor"
End DoDot:1
GOTO EXBAD
+35 ;
+36 ; Get the Request Queue IEN for this Requestor
+37 SET QUEIEN=$PIECE(DATA,U,4)
IF 'QUEIEN
SET MSTEXT="Could not get a valid Request Queue"
GOTO EXBAD
+38 ;
+39 ; Get the Destination IEN for this Requestor
+40 SET DESTIEN=$PIECE(DATA,U,3)
IF 'DESTIEN
SET MSTEXT="No Destination for this Requestor"
GOTO EXBAD
+41 ;
+42 ; Validate Name/Value Pair
+43 IF $PIECE($PIECE(PAIR,U),"=",1)'="SUBTYPE"!($PIECE($PIECE(PAIR,U,2),"=",1)'="IEN")
Begin DoDot:1
+44 SET MSTEXT="Invalid Name/Value Pair"
End DoDot:1
GOTO EXBAD
+45 SET SUBTYPE=$PIECE($PIECE(PAIR,U),"=",2)
SET NVPIEN=$PIECE($PIECE(PAIR,U,2),"=",2)
+46 ;
+47 ; Validate the Subtype
+48 SET SUBIEN=$$FIND1^DIC(577.4,"","BX",SUBTYPE)
+49 IF 'SUBIEN
SET MSTEXT="Invalid VDEF Subtype"
GOTO EXBAD
+50 ;
+51 ; Validate the HL7 Message and Event Types
+52 SET MESIEN=$$FIND1^DIC(771.2,"","BX",MSTY)
+53 IF 'MESIEN
SET MSTEXT="Invalid HL7 Message Type"
GOTO EXBAD
+54 SET EVTYIEN=$$FIND1^DIC(779.001,,"BX",EVTY)
+55 IF 'EVTYIEN
SET MSTEXT="Invalid HL7 Event Type"
GOTO EXBAD
+56 ;
+57 ; Validate the VDEF Event
+58 SET EVENTIEN=$ORDER(^VDEFHL7(577,"BB",MESIEN,EVTYIEN,SUBIEN,""))
+59 IF 'EVENTIEN
SET MSTEXT="Invalid 'Message Type-Event Type-Subtype'"
GOTO EXBAD
+60 ;
+61 ; Check if this Request is for a disabled custodial package
+62 SET X=$GET(^VDEFHL7(577,EVENTIEN,0))
SET CUSTIEN=$PIECE(X,U,9)
+63 IF $PIECE($GET(^VDEFHL7(579.6,+CUSTIEN,0)),U,2)="I"
Begin DoDot:1
+64 SET MSTEXT="Custodial package disabled for this event"
End DoDot:1
GOTO EXBAD
+65 ;
+66 ; Check if this VDEF API is disabled
+67 IF $PIECE(X,U,11)'="A"
Begin DoDot:1
+68 SET MSTEXT="VDEF API "_$PIECE(X,U,1)_" is turned off"
End DoDot:1
GOTO EXBAD
+69 ;
+70 ; Start filing request into ^VDEFHL7(579.3
+71 ; Lock the queue to prevent other requests from being added to it
+72 ; doesn't affect the processing of existing requests
+73 LOCK +^VDEFHL7(579.3,QUEIEN,"ADD"):10
+74 IF '$TEST
SET MSTEXT="VDEF queuing is currently unavailable"
GOTO EXBAD
+75 ;
+76 ; Populate the Request data (579.31) for this queue
+77 ; DINUM placeholder
SET FDA(1,579.31,"+1,"_QUEIEN_",",.01)=9999
+78 ; Request status - "Q"ueued
SET FDA(1,579.31,"+1,"_QUEIEN_",",.02)="Q"
+79 ; Message Type
SET FDA(1,579.31,"+1,"_QUEIEN_",",.03)=MSTY
+80 ; Event Type
SET FDA(1,579.31,"+1,"_QUEIEN_",",.04)=EVTY
+81 ; Requestor
SET FDA(1,579.31,"+1,"_QUEIEN_",",.06)=REQIEN
+82 ; Destination
SET FDA(1,579.31,"+1,"_QUEIEN_",",.07)=DESTIEN
+83 ; DTS when request was added
DO NOW^%DTC
SET FDA(1,579.31,"+1,"_QUEIEN_",",.08)=%
+84 ; VDEF Event IEN
SET FDA(1,579.31,"+1,"_QUEIEN_",",.18)=EVENTIEN
+85 DO UPDATE^DIE("","FDA(1)","IENROOT","ERR")
+86 ; Get the assigned Request entry IEN
SET RQIEN=$GET(IENROOT(1))
+87 ;
+88 ; Lock this queue entry to prevent the Request Processor from
+89 ; retrieving an incomplete Request
+90 LOCK +^VDEFHL7(579.3,QUEIEN,RQIEN)
+91 ; Release the queue "ADD" lock
LOCK -^VDEFHL7(579.3,QUEIEN,"ADD")
+92 ;
+93 ; Update the DINUM field with the IEN value for this Request
+94 SET FDA(1,579.31,RQIEN_","_QUEIEN_",",.01)=RQIEN
DO FILE^DIE("","FDA(1)","ERR(2)")
+95 ;
+96 ; Set up the name value pairs multiple (579.311)
+97 FOR VDI=1,2
Begin DoDot:1
+98 SET FDA(1,579.311,"+"_VDI_","_RQIEN_","_QUEIEN_",",.01)=VDI
+99 SET FDA(1,579.311,"+"_VDI_","_RQIEN_","_QUEIEN_",",.02)=$PIECE(PAIR,U,VDI)
End DoDot:1
+100 DO UPDATE^DIE("","FDA(1)","","ERR")
+101 ;
+102 ; Set up the Dynamic Adressing multiple, if passed in
+103 SET (VDI,DATA)=""
SET CNT=0
FOR
SET VDI=$ORDER(DYNAMIC("LINKS",VDI))
if 'VDI
QUIT
Begin DoDot:1
+104 ; CNT and VDI may be different since the "LINKS" array may be sparse
+105 SET DATA=$GET(DYNAMIC("LINKS",VDI))
SET CNT=CNT+1
+106 SET FDA(1,579.313,"+"_CNT_","_RQIEN_","_QUEIEN_",",.01)=VDI
+107 SET FDA(1,579.313,"+"_CNT_","_RQIEN_","_QUEIEN_",",.02)=DATA
End DoDot:1
+108 ;
+109 ; File Dynamic Addressing information
+110 IF $DATA(FDA)
DO UPDATE^DIE("","FDA(1)","","ERR")
+111 ; Release the lock on this Request
LOCK -^VDEFHL7(579.3,QUEIEN,RQIEN)
+112 SET MSTEXT="Message "_MSTY_", Event "_EVTY_", Subtype "_SUBTYPE_" queued for processing"
EXIT ; Good exit
QUIT 1
EXBAD ; Bad, bad exit
QUIT 0
+1 ;
+2 ; Function to set up a Request Processor Scheduling Rule
SCHEDULE(Q,H) ;
+1 NEW HT,SIEN,NZ,DOW,STM,ETM
+2 IF $GET(Q)=""
QUIT ""
+3 IF $GET(H)=""
SET H=$HOROLOG
+4 SET DOW=H-2#7
SET SIEN=0
SET HT=0
+5 FOR
SET SIEN=$ORDER(^VDEFHL7(579.3,Q,2,SIEN))
if 'SIEN
QUIT
Begin DoDot:1
+6 SET NZ=^VDEFHL7(579.3,Q,2,SIEN,0)
+7 if $PIECE(NZ,U,2)'=DOW
QUIT
+8 SET STM=$PIECE(NZ,U,4)
SET ETM=$PIECE(NZ,U,5)
+9 SET STM=$TRANSLATE(STM,":- ")
SET STM=$EXTRACT(STM,1,2)*60+$EXTRACT(STM,3,4)*60+$EXTRACT(STM,5,6)
+10 SET ETM=$TRANSLATE(ETM,":- ")
SET ETM=$EXTRACT(ETM,1,2)*60+$EXTRACT(ETM,3,4)*60+$EXTRACT(ETM,5,6)
+11 IF $PIECE(H,",",2)'<STM
IF $PIECE(H,",",2)'>ETM
SET HT=$PIECE(NZ,U,3)
End DoDot:1
if HT'=0
QUIT
+12 IF HT'=0
QUIT HT_U_(ETM-$PIECE(H,",",2))
+13 QUIT ""
+14 ;
TIMECK(T) NEW H,M,S
IF T?4.6N
SET H=+$EXTRACT(T,1,2)
SET M=+$EXTRACT(T,3,4)
SET S=+$EXTRACT(T,5,6)
+1 IF '$TEST
IF T[":"
SET H=+$PIECE(T,":")
SET M=+$PIECE(T,":",2)
SET S=+$PIECE(T,":",3)
+2 IF '$TEST
IF T["-"
SET H=+$PIECE(T,"-")
SET M=+$PIECE(T,"-",2)
SET S=+$PIECE(T,"-",3)
+3 IF '$TEST
IF T[" "
SET H=+$PIECE(T," ")
SET M=+$PIECE(T," ",2)
SET S=+$PIECE(T," ",3)
+4 IF '$TEST
QUIT 0
+5 IF H<24
IF M<60
IF S<60
QUIT 1
+6 QUIT 0
+7 ;
REQUEUE(Q,X) ; Requeue Checked Out requests.
+1 ; Change the status of all "C" entries in a Request Queue to "Q".
+2 ; If ZTQUEUED not set, run this interactively.
+3 ; Input - Request Queue IEN
+4 ; Output - 0 = no requests requeued
+5 ; 1 = requests weere requeued
+6 SET X=0
+7 IF $GET(Q)=""
if '$DATA(ZTQUEUED)
WRITE !,"Invalid queue IEN"
QUIT
+8 ;
+9 ; Quit if no requests are Checked Out
+10 IF $ORDER(^VDEFHL7(579.3,"C","C",0))=""
if '$DATA(ZTQUEUED)
WRITE !,"No Requests in Checked Out status"
QUIT
+11 ;
+12 ; Get Queue
+13 NEW QUE
SET QUE=$PIECE($GET(^VDEFHL7(579.3,Q,0)),U)
+14 IF QUE=""
if '$DATA(ZTQUEUED)
WRITE !,"Invalid queue"
QUIT
+15 if $DATA(ZTQUEUED)
GOTO REQUEUE1
+16 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to continue"
SET DIR("B")="No"
+17 WRITE !,"This action will reset all entries in the '"_QUE_"' queue to 'Q'ueued."
+18 DO ^DIR
IF Y=0
WRITE !,"Entries not reset."
QUIT
REQUEUE1 NEW FDA,IEN,MSG
SET IEN=""
+1 FOR
SET IEN=$ORDER(^VDEFHL7(579.3,"C","C",Q,IEN))
if 'IEN
QUIT
Begin DoDot:1
+2 ;
+3 ; If request has not had an alert yet or can't be locked,
+4 ; don't requeue it.
+5 if $$GET1^DIQ(579.31,IEN_","_Q_",",.15,"I")=""
QUIT
+6 LOCK +^VDEFHL7(579.3,Q,IEN):1
if '$TEST
QUIT
+7 ;
+8 ; Change status to "Q" (queued up) and delete
+9 ; the old check out date/time and alert date/time
+10 ; and error message
+11 KILL FDA,MSG
SET FDA(579.31,IEN_","_Q_",",.02)="Q"
+12 SET FDA(579.31,IEN_","_Q_",",.15)="@"
+13 SET FDA(579.31,IEN_","_Q_",",.09)="@"
+14 DO FILE^DIE(,"FDA","MSG")
+15 KILL ^VDEFHL7(579.3,Q,1,IEN,"ERRMSG")
+16 LOCK -^VDEFHL7(579.3,Q,IEN)
+17 SET X=1
End DoDot:1
+18 if '$DATA(ZTQUEUED)
WRITE !,"Entries reset to 'Q'ueued status for "_QUE_"."
+19 QUIT
+20 ;
+21 ; Requeue Errored Out requests.
+22 ; Change the status of all "E" entries in a Request Queue to "Q".
+23 ; If ZTQUEUED not set, run this interactively.
RQERR(Q,X) ;
+1 SET X=0
+2 IF $GET(Q)=""
if '$DATA(ZTQUEUED)
WRITE !,"Invalid queue IEN"
QUIT
+3 ;
+4 ; Quit if no requests are Errored Out
+5 IF $ORDER(^VDEFHL7(579.3,"C","E",0))=""
if '$DATA(ZTQUEUED)
WRITE !,"No Requests in Errored Out status"
QUIT
+6 ;
+7 ; Get Queue
+8 NEW QUE
SET QUE=$PIECE($GET(^VDEFHL7(579.3,Q,0)),U)
+9 IF QUE=""
if '$DATA(ZTQUEUED)
WRITE !,"Invalid queue"
QUIT
+10 if $DATA(ZTQUEUED)
GOTO RQERR1
+11 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to continue"
SET DIR("B")="No"
+12 WRITE !,"This action resets all Errored Out entries in the '"_QUE_"' queue to 'Q'ueued."
+13 DO ^DIR
IF Y=0
WRITE !,"Entries not reset."
QUIT
RQERR1 NEW FDA,IEN,MSG
SET IEN=""
+1 FOR
SET IEN=$ORDER(^VDEFHL7(579.3,"C","E",Q,IEN))
if 'IEN
QUIT
Begin DoDot:1
+2 LOCK +^VDEFHL7(579.3,Q,IEN):1
if '$TEST
QUIT
+3 ;
+4 ; Fix the actual status in the record if it's not "E".
+5 IF $$GET1^DIQ(579.31,IEN_","_Q_",",.02,"I")'="E"
Begin DoDot:2
+6 KILL FDA,MSG
SET FDA(579.31,IEN_","_Q_",",.02)="E"
+7 DO FILE^DIE(,"FDA","MSG")
End DoDot:2
+8 ;
+9 ; Change status to "Q" (queued up) and delete
+10 ; the old check out date/time and alert date/time
+11 ; and error message
+12 KILL FDA,MSG
SET FDA(579.31,IEN_","_Q_",",.02)="Q"
+13 SET FDA(579.31,IEN_","_Q_",",.15)="@"
+14 SET FDA(579.31,IEN_","_Q_",",.09)="@"
+15 DO FILE^DIE(,"FDA","MSG")
+16 KILL ^VDEFHL7(579.3,Q,1,IEN,"ERRMSG")
+17 LOCK -^VDEFHL7(579.3,Q,IEN)
+18 SET X=1
End DoDot:1
+19 if '$DATA(ZTQUEUED)
WRITE !,"Entries reset to 'Q'ueued status for "_QUE_"."
+20 QUIT
