INHOU8 ;DJL,DP; 9 Apr 96 08:28;Interface Message Requeue Utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
REQ ;Requeue an Entry for processing
; MODULE NAME: REQ ( Requeue INH message/s )
; DESCRIPTION: Prompts the user for a message to requeue. The user may
; enter any valid indexed message component for a single
; message requeue or '/' to search and requeue multiple
; messages. In either case a List will be displayed which
; allows requeueing THREE different ways. 1)use existing
; information, 2)use one set of info. for all message to
; be requeued, or 3) use unique info. for each message.
; RETURN = none
; PARAMETERS = none
; CODE BEGINS
N X,Y,INQUIT,INDA,INREQLST,INPARM2,DIC
; construct the structure defining the requeue operations, etc
S INPARM2("TITLE")="W ?IOM-$L(""Interface Message Requeue"")/2,""Interface Message Requeue"",!,$$INMSGSTR^INHMS2("""",1,"""")"
; Create the list processor help text
S INPARM2("INHELP")="N INHELP D BLDHELP^INHOU2(.INHELP),SRCHHELP^INHMS3(.INHELP)"
; create the HOT KEY structure
S INPARM2("HOT",1)="EXISTING^H1"
S INPARM2("HOT",1,"ACTION")="D GOHOT1^INHOU1(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
S INPARM2("HOT",2)="SINGLE^H2"
S INPARM2("HOT",2,"ACTION")="D GOHOT2^INHOU1(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
S INPARM2("HOT",3)="UNIQUE^H3"
S INPARM2("HOT",3,"ACTION")="D GOHOT3^INHOU1(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
S INQUIT=0 F D Q:INQUIT K X,Y
. I '$O(^INTHU(0)) W !!,"There are no entries to requeue." S INQUIT=1 Q
. ; handle initial user input
. K X D CLEAR^DW W !! D ^UTSRD("Enter a Message to Requeue: ;;;;;","Terminate:^ or <RETURN>, Search Queue:/, or a Valid Message Component")
. ; handle the different error/exit conditions
. I X="/" S INQUIT=$$BGNSRCH^INHMS("INREQLST",1,.INDA,.INPARM2) S INQUIT=0 Q
. I X="^"!(X="") S INQUIT=1 Q
. ; let DIC handle all other input checks for single message requeue
. S DIC="^INTHU(",DIC(0)="NMEQ"
. D ^DIC Q:Y<0
. I +Y S INREQLST(1)=+Y,INREQLST(1,0)="" D REQONE^INHOU2(.INREQLST,.INPARM2) S INQUIT=0 Q
D:$D(INDA) INKINDA^INHMS(INDA)
Q
;
REMQUED(INLIST1,INLIST2) ; remove items in list1 from list1,list2
N INNODE
S INNODE="" F S INNODE=$O(INLIST1(INNODE)) Q:'INNODE K INLIST1(INNODE),@INLIST2@(INNODE)
Q
;
GETPT(INHOTOPT,INREQIEN,INPRIO,INTTPROC) ; get prior. and time-to-proc.
; MODULE NAME: GETPT ( acquire the priority and time-to-process msg)
; DESCRIPTION: Depending on the INHOTOPT parameter, the message prio-
; ity and time-to-process is returned for the message
; in ^INTHU(INREQIEN.
; RETURN = PASS/FAIL (0/1)
; PARAMETERS:
; INHOTOPTP = Option selector.
; INREQIEN = The IEN of the message of interest.
; INPRIO = (Ref.) The priority is returned here.
; INTTPROC = (Ref.) The Time-to-Process is returned here.
; CODE BEGINS
N X,Y,%DT,INQUIT,INABORT
S INABORT=0
S INHOTOPT=$G(INHOTOPT),INREQIEN=$G(INREQIEN),INPRIO=$G(INPRIO),INTTPROC=$G(INTTPROC)
I INHOTOPT=1 D Q INABORT
. ; get the priority and time to process from the original message
. S INPRIO=+$P(^INTHU(INREQIEN,0),U,16),INTTPROC=$P(^INTHU(INREQIEN,0),U,19)
. S:'$L(INTTPROC) INTTPROC=$H
; for option 3 kill the prio and ttproc and use option 2 to get
; new input for each message
I INHOTOPT=3 K INPRIO,INTTPROC S (INPRIO,INTTPROC)=""
; for option 2 prompt for input only if prio and ttproc are not defined
I INHOTOPT=2!(INHOTOPT=3) D Q INABORT
. D CLEAR^DW
. ; get the priority and time to process from the user on the first
. ; pass and then use the passed value from then on.
. I '$G(INPRIO)!('$G(INTTPROC)) D
.. S INQUIT=0 F D Q:INQUIT K X,Y
... W:$G(INREQIEN) "Message:",!,$$INMSGSTR^INHMS2(INREQIEN)
... ; handle initial user input for time-to-process
... K X W ! D ^UTSRD("Time to process: ;;;;NOW;","Enter the Time-to-process the message.")
... I X["^"!(X="") S (INQUIT,INABORT)=1 Q
... S X=$$CASECONV^UTIL(X,"U")
... ; handle the different error/exit conditions
... I X="STAT" S INTTPROC="00000,00000",INQUIT=1 Q
... ; let DT handle all other input checks for time to process
... S %DT="ET" D ^%DT S INTTPROC=$$CDATF2H^UTDT(Y) I Y>-1 S INQUIT=1 Q
.. Q:INABORT
.. S INPRIO=0 W ! D ^UTSRD("PRIORITY: ;;;;0;0,10","Enter the New Priority.") S INPRIO=+X
.. I X["^"!(X="") S (INQUIT,INABORT)=1 Q
. Q:INABORT
. ; default the Priority and Time to Process if STILL not defined
. S:'INPRIO INPRIO=0 S:'$L(INTTPROC) INTTPROC=$H
Q INABORT
;
GOHOT1(INSELECT,INLSTNAM) ; Hot Key #1 execution code
; MODULE NAME: GOHOT1 ( HotKey #1 execution code )
; DESCRIPTION: Requeue using existing priorities and time to process for each message
; RETURN = none
; PARAMETERS:
; INSELECT = Array of selected items from List Processor (DWLMK or DWLMK1)
; INLSTNAM = Array of IEN's into ^INTHU to be Queued for processing
; CODE BEGINS
N INNODE,INREQIEN,INPRIO,INTTPROC
S INNODE="" F S INNODE=$O(INSELECT(INNODE)) Q:'INNODE S INREQIEN=$G(@INLSTNAM@(INNODE,0)) Q:$$GETPT^INHOU5(1,INREQIEN,.INPRIO,.INTTPROC) D DOREQ^INHOU1(INREQIEN,INPRIO,INTTPROC)
Q
;
GOHOT2(INSELECT,INLSTNAM) ; Hot Key #2 execution code
; MODULE NAME: GOHOT2 ( HotKey #2 execution code )
; DESCRIPTION: Requeue using one priority and time to process for all messages
; See GOHOT1^INHOU1 for Parameter information
; CODE BEGINS
N INNODE,INREQIEN,INPRIO,INTTPROC
Q:$$GETPT(2,"",.INPRIO,.INTTPROC) S INNODE="" F S INNODE=$O(INSELECT(INNODE)) Q:'INNODE S INREQIEN=$G(@INLSTNAM@(INNODE,0)) D DOREQ^INHOU1(INREQIEN,INPRIO,INTTPROC)
Q
;
GOHOT3(INSELECT,INLSTNAM) ; Hot Key #3 execution code
; MODULE NAME: GOHOT3 ( HotKey #3 execution code )
; DESCRIPTION: Requeue using unique priorities and time to process for each message
; See GOHOT1^INHOU1 for Parameter information
; CODE BEGINS
N INNODE,INREQIEN,INPRIO,INTTPROC
S INNODE="" F S INNODE=$O(INSELECT(INNODE)) Q:'INNODE S INREQIEN=$G(@INLSTNAM@(INNODE,0)) Q:$$GETPT^INHOU5(3,INREQIEN,.INPRIO,.INTTPROC) D DOREQ^INHOU1(INREQIEN,INPRIO,INTTPROC)
Q
;
DOREQ(INREQIEN,INPRIO,INTTPROC) ; requeue the transaction
; MODULE NAME: DOREQ ( Requeue the transaction )
; DESCRIPTION: Requeues the transaction INREQIEN with the priority and
; time-to-process passed in INPRIO and INTTPROC
; RETURN = none
; PARAMETERS:
; INREQIEN = The message IEN
; INPRIO = The priority of the message
; INTTPROC = The time to process the message
; CODE BEGINS
N INIEN,INTTP,INQUEUED,INCURP,INCURT,INDEST,INDET,INQUE,INMID
; check to see if the message is already queued at the current
; priority and time-to-process
S INDET=^INTHU(INREQIEN,0)
S INDEST=$P(INDET,U,2),INMID=$P(INDET,U,5),INCURP=+$P(INDET,U,16)
S INCURT=$P(INDET,U,19)
S:'$L(INCURT) INCURT=+INCURT
;Get the current queue
S INQUE=$P($G(^INRHD(INDEST,0)),U,12)
; check if already queued.
D @INQUE
I INQUEUED W !,$$INMSGSTR^INHMS2(INREQIEN)
I INQUEUED D CLEAR^DW D
.W !,"Message "_INMID_" is already queued on "_$S(INQUE=0:"^INLHSCH",1:"^INLHDEST")_" for "_$$CDATH2F^UTDT(INCURT)_" with a priority of "_INCURP_"."
.F W ! D ^UTSRD("Do you still want to queue this message? ;;;;Y;","Enter Y or N") S X=$$CASECONV^UTIL(X,"U") Q:X="Y"!(X="N") I X="" S X="N" Q
Q:INQUEUED&(X="N")
;Priority for requeue is set to 0 ?????
S INPRIO=0
D SET^INHD(INTTPROC,$P(^INTHU(INREQIEN,0),U,2),INREQIEN,"",INPRIO)
Q
;
0 ;
S INQUEUED=$S($D(^INLHSCH(INCURP,INCURT,INREQIEN)):1,1:0)
Q
1 ;
S INQUEUED=$S($D(^INLHDEST(INDEST,INCURP,INCURT,INREQIEN)):1,1:0)
Q
INHOU8 ;DJL,DP; 9 Apr 96 08:28;Interface Message Requeue Utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
REQ ;Requeue an Entry for processing
+1 ; MODULE NAME: REQ ( Requeue INH message/s )
+2 ; DESCRIPTION: Prompts the user for a message to requeue. The user may
+3 ; enter any valid indexed message component for a single
+4 ; message requeue or '/' to search and requeue multiple
+5 ; messages. In either case a List will be displayed which
+6 ; allows requeueing THREE different ways. 1)use existing
+7 ; information, 2)use one set of info. for all message to
+8 ; be requeued, or 3) use unique info. for each message.
+9 ; RETURN = none
+10 ; PARAMETERS = none
+11 ; CODE BEGINS
+12 NEW X,Y,INQUIT,INDA,INREQLST,INPARM2,DIC
+13 ; construct the structure defining the requeue operations, etc
+14 SET INPARM2("TITLE")="W ?IOM-$L(""Interface Message Requeue"")/2,""Interface Message Requeue"",!,$$INMSGSTR^INHMS2("""",1,"""")"
+15 ; Create the list processor help text
+16 SET INPARM2("INHELP")="N INHELP D BLDHELP^INHOU2(.INHELP),SRCHHELP^INHMS3(.INHELP)"
+17 ; create the HOT KEY structure
+18 SET INPARM2("HOT",1)="EXISTING^H1"
+19 SET INPARM2("HOT",1,"ACTION")="D GOHOT1^INHOU1(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
+20 SET INPARM2("HOT",2)="SINGLE^H2"
+21 SET INPARM2("HOT",2,"ACTION")="D GOHOT2^INHOU1(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
+22 SET INPARM2("HOT",3)="UNIQUE^H3"
+23 SET INPARM2("HOT",3,"ACTION")="D GOHOT3^INHOU1(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
+24 SET INQUIT=0
FOR
Begin DoDot:1
+25 IF '$ORDER(^INTHU(0))
WRITE !!,"There are no entries to requeue."
SET INQUIT=1
QUIT
+26 ; handle initial user input
+27 KILL X
DO CLEAR^DW
WRITE !!
DO ^UTSRD("Enter a Message to Requeue: ;;;;;","Terminate:^ or <RETURN>, Search Queue:/, or a Valid Message Component")
+28 ; handle the different error/exit conditions
+29 IF X="/"
SET INQUIT=$$BGNSRCH^INHMS("INREQLST",1,.INDA,.INPARM2)
SET INQUIT=0
QUIT
+30 IF X="^"!(X="")
SET INQUIT=1
QUIT
+31 ; let DIC handle all other input checks for single message requeue
+32 SET DIC="^INTHU("
SET DIC(0)="NMEQ"
+33 DO ^DIC
IF Y<0
QUIT
+34 IF +Y
SET INREQLST(1)=+Y
SET INREQLST(1,0)=""
DO REQONE^INHOU2(.INREQLST,.INPARM2)
SET INQUIT=0
QUIT
End DoDot:1
IF INQUIT
QUIT
KILL X,Y
+35 IF $DATA(INDA)
DO INKINDA^INHMS(INDA)
+36 QUIT
+37 ;
REMQUED(INLIST1,INLIST2) ; remove items in list1 from list1,list2
+1 NEW INNODE
+2 SET INNODE=""
FOR
SET INNODE=$ORDER(INLIST1(INNODE))
IF 'INNODE
QUIT
KILL INLIST1(INNODE),@INLIST2@(INNODE)
+3 QUIT
+4 ;
GETPT(INHOTOPT,INREQIEN,INPRIO,INTTPROC) ; get prior. and time-to-proc.
+1 ; MODULE NAME: GETPT ( acquire the priority and time-to-process msg)
+2 ; DESCRIPTION: Depending on the INHOTOPT parameter, the message prio-
+3 ; ity and time-to-process is returned for the message
+4 ; in ^INTHU(INREQIEN.
+5 ; RETURN = PASS/FAIL (0/1)
+6 ; PARAMETERS:
+7 ; INHOTOPTP = Option selector.
+8 ; INREQIEN = The IEN of the message of interest.
+9 ; INPRIO = (Ref.) The priority is returned here.
+10 ; INTTPROC = (Ref.) The Time-to-Process is returned here.
+11 ; CODE BEGINS
+12 NEW X,Y,%DT,INQUIT,INABORT
+13 SET INABORT=0
+14 SET INHOTOPT=$GET(INHOTOPT)
SET INREQIEN=$GET(INREQIEN)
SET INPRIO=$GET(INPRIO)
SET INTTPROC=$GET(INTTPROC)
+15 IF INHOTOPT=1
Begin DoDot:1
+16 ; get the priority and time to process from the original message
+17 SET INPRIO=+$PIECE(^INTHU(INREQIEN,0),U,16)
SET INTTPROC=$PIECE(^INTHU(INREQIEN,0),U,19)
+18 IF '$LENGTH(INTTPROC)
SET INTTPROC=$HOROLOG
End DoDot:1
QUIT INABORT
+19 ; for option 3 kill the prio and ttproc and use option 2 to get
+20 ; new input for each message
+21 IF INHOTOPT=3
KILL INPRIO,INTTPROC
SET (INPRIO,INTTPROC)=""
+22 ; for option 2 prompt for input only if prio and ttproc are not defined
+23 IF INHOTOPT=2!(INHOTOPT=3)
Begin DoDot:1
+24 DO CLEAR^DW
+25 ; get the priority and time to process from the user on the first
+26 ; pass and then use the passed value from then on.
+27 IF '$GET(INPRIO)!('$GET(INTTPROC))
Begin DoDot:2
+28 SET INQUIT=0
FOR
Begin DoDot:3
+29 IF $GET(INREQIEN)
WRITE "Message:",!,$$INMSGSTR^INHMS2(INREQIEN)
+30 ; handle initial user input for time-to-process
+31 KILL X
WRITE !
DO ^UTSRD("Time to process: ;;;;NOW;","Enter the Time-to-process the message.")
+32 IF X["^"!(X="")
SET (INQUIT,INABORT)=1
QUIT
+33 SET X=$$CASECONV^UTIL(X,"U")
+34 ; handle the different error/exit conditions
+35 IF X="STAT"
SET INTTPROC="00000,00000"
SET INQUIT=1
QUIT
+36 ; let DT handle all other input checks for time to process
+37 SET %DT="ET"
DO ^%DT
SET INTTPROC=$$CDATF2H^UTDT(Y)
IF Y>-1
SET INQUIT=1
QUIT
End DoDot:3
IF INQUIT
QUIT
KILL X,Y
+38 IF INABORT
QUIT
+39 SET INPRIO=0
WRITE !
DO ^UTSRD("PRIORITY: ;;;;0;0,10","Enter the New Priority.")
SET INPRIO=+X
+40 IF X["^"!(X="")
SET (INQUIT,INABORT)=1
QUIT
End DoDot:2
+41 IF INABORT
QUIT
+42 ; default the Priority and Time to Process if STILL not defined
+43 IF 'INPRIO
SET INPRIO=0
IF '$LENGTH(INTTPROC)
SET INTTPROC=$HOROLOG
End DoDot:1
QUIT INABORT
+44 QUIT INABORT
+45 ;
GOHOT1(INSELECT,INLSTNAM) ; Hot Key #1 execution code
+1 ; MODULE NAME: GOHOT1 ( HotKey #1 execution code )
+2 ; DESCRIPTION: Requeue using existing priorities and time to process for each message
+3 ; RETURN = none
+4 ; PARAMETERS:
+5 ; INSELECT = Array of selected items from List Processor (DWLMK or DWLMK1)
+6 ; INLSTNAM = Array of IEN's into ^INTHU to be Queued for processing
+7 ; CODE BEGINS
+8 NEW INNODE,INREQIEN,INPRIO,INTTPROC
+9 SET INNODE=""
FOR
SET INNODE=$ORDER(INSELECT(INNODE))
IF 'INNODE
QUIT
SET INREQIEN=$GET(@INLSTNAM@(INNODE,0))
IF $$GETPT^INHOU5(1,INREQIEN,.INPRIO,.INTTPROC)
QUIT
DO DOREQ^INHOU1(INREQIEN,INPRIO,INTTPROC)
+10 QUIT
+11 ;
GOHOT2(INSELECT,INLSTNAM) ; Hot Key #2 execution code
+1 ; MODULE NAME: GOHOT2 ( HotKey #2 execution code )
+2 ; DESCRIPTION: Requeue using one priority and time to process for all messages
+3 ; See GOHOT1^INHOU1 for Parameter information
+4 ; CODE BEGINS
+5 NEW INNODE,INREQIEN,INPRIO,INTTPROC
+6 IF $$GETPT(2,"",.INPRIO,.INTTPROC)
QUIT
SET INNODE=""
FOR
SET INNODE=$ORDER(INSELECT(INNODE))
IF 'INNODE
QUIT
SET INREQIEN=$GET(@INLSTNAM@(INNODE,0))
DO DOREQ^INHOU1(INREQIEN,INPRIO,INTTPROC)
+7 QUIT
+8 ;
GOHOT3(INSELECT,INLSTNAM) ; Hot Key #3 execution code
+1 ; MODULE NAME: GOHOT3 ( HotKey #3 execution code )
+2 ; DESCRIPTION: Requeue using unique priorities and time to process for each message
+3 ; See GOHOT1^INHOU1 for Parameter information
+4 ; CODE BEGINS
+5 NEW INNODE,INREQIEN,INPRIO,INTTPROC
+6 SET INNODE=""
FOR
SET INNODE=$ORDER(INSELECT(INNODE))
IF 'INNODE
QUIT
SET INREQIEN=$GET(@INLSTNAM@(INNODE,0))
IF $$GETPT^INHOU5(3,INREQIEN,.INPRIO,.INTTPROC)
QUIT
DO DOREQ^INHOU1(INREQIEN,INPRIO,INTTPROC)
+7 QUIT
+8 ;
DOREQ(INREQIEN,INPRIO,INTTPROC) ; requeue the transaction
+1 ; MODULE NAME: DOREQ ( Requeue the transaction )
+2 ; DESCRIPTION: Requeues the transaction INREQIEN with the priority and
+3 ; time-to-process passed in INPRIO and INTTPROC
+4 ; RETURN = none
+5 ; PARAMETERS:
+6 ; INREQIEN = The message IEN
+7 ; INPRIO = The priority of the message
+8 ; INTTPROC = The time to process the message
+9 ; CODE BEGINS
+10 NEW INIEN,INTTP,INQUEUED,INCURP,INCURT,INDEST,INDET,INQUE,INMID
+11 ; check to see if the message is already queued at the current
+12 ; priority and time-to-process
+13 SET INDET=^INTHU(INREQIEN,0)
+14 SET INDEST=$PIECE(INDET,U,2)
SET INMID=$PIECE(INDET,U,5)
SET INCURP=+$PIECE(INDET,U,16)
+15 SET INCURT=$PIECE(INDET,U,19)
+16 IF '$LENGTH(INCURT)
SET INCURT=+INCURT
+17 ;Get the current queue
+18 SET INQUE=$PIECE($GET(^INRHD(INDEST,0)),U,12)
+19 ; check if already queued.
+20 DO @INQUE
+21 IF INQUEUED
WRITE !,$$INMSGSTR^INHMS2(INREQIEN)
+22 IF INQUEUED
DO CLEAR^DW
Begin DoDot:1
+23 WRITE !,"Message "_INMID_" is already queued on "_$SELECT(INQUE=0:"^INLHSCH",1:"^INLHDEST")_" for "_$$CDATH2F^UTDT(INCURT)_" with a priority of "_INCURP_"."
+24 FOR
WRITE !
DO ^UTSRD("Do you still want to queue this message? ;;;;Y;","Enter Y or N")
SET X=$$CASECONV^UTIL(X,"U")
IF X="Y"!(X="N")
QUIT
IF X=""
SET X="N"
QUIT
End DoDot:1
+25 IF INQUEUED&(X="N")
QUIT
+26 ;Priority for requeue is set to 0 ?????
+27 SET INPRIO=0
+28 DO SET^INHD(INTTPROC,$PIECE(^INTHU(INREQIEN,0),U,2),INREQIEN,"",INPRIO)
+29 QUIT
+30 ;
0 ;
+1 SET INQUEUED=$SELECT($DATA(^INLHSCH(INCURP,INCURT,INREQIEN)):1,1:0)
+2 QUIT
1 ;
+1 SET INQUEUED=$SELECT($DATA(^INLHDEST(INDEST,INCURP,INCURT,INREQIEN)):1,1:0)
+2 QUIT
