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