INHOU1 ;DJL,DP; 7 Oct 97 12:50;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
;
N X,Y,INQUIT,INDA,INREQLST,INPARM2,DIC,INMSG,DIRI,DIRCP,DLAYGO,INABORT,INCLRT,INQUED,INZ,POP,INCURT,INQUEUED,%ZIS
; Set up parameter for hot key and List Processor
D SETP2^INHOU1
;
EN2 ;This is the actual working loop of the routine
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=$$TIEN^INHUTC(.INPARM2,"INREQLST") D CLEAR^DW Q
. Q:'$D(X)
. I X="^"!(X="") S INQUIT=$S(X="":1,1:2) 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
;
REQ1 ; Requeue an entry for processing
; Description: REQ1 performs similar functions as REQ in which it
; allows requeing message in three different ways.
; However, REQ1 does not prompt user for a message to
; requeue. Upon enter REQ1, variable Y contains IEN of
; message to requeue.
;
; RETURN = none
; PARAMETERS = none
;
N X,INQUIT,INDA,INREQLST,INPARM2,DIC,INMSG,DIRI,DIRCP,DLAYGO,INABORT,INCLRT,INQUED,INZ,POP,INCURT,INQUEUED,%ZIS
; Set up parameter for hot key and List Processor
D SETP2^INHOU1
;
EN3 ;This is the actual requeue operation
S INREQLST(1)=+Y,INREQLST(1,0)="" D REQONE^INHOU2(.INREQLST,.INPARM2)
D:$D(INDA) INKINDA^INHMS(INDA)
D CLEAR^DW
Q
;
SETP2 ; Set up parameter for hot key and List Processor
; construct the structure defining the requeue operations, etc
S INPARM2("LIST","TITLE")="W ?IOM-$L(""Interface Message Requeue"")/2,""Interface Message Requeue"",!,$$INMSGSTR^INHMS2("""",1,"""")"
; Create the list processor help text
S INPARM2("LIST","HELP")="N INHELP D BLDHELP^INHOU2(.INHELP),SRCHHELP^INHMS3(.INHELP)"
; create the HOT KEY structure
S INPARM2("LIST","HOT",1)="EXISTING^H1"
S INPARM2("LIST","HOT",1,"ACTION")="D GOHOT1^INHOU5(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
S INPARM2("LIST","HOT",2)="SINGLE^H2"
S INPARM2("LIST","HOT",2,"ACTION")="D GOHOT2^INHOU5(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
S INPARM2("LIST","HOT",3)="UNIQUE^H3"
S INPARM2("LIST","HOT",3,"ACTION")="D GOHOT3^INHOU5(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
Q
;
REMQUED(INLIST1,INLIST2) ; remove items in list1 from list1,list2
N INNODE
S %ZIS="" D CLEAR^DW,^%ZIS Q:POP U IO I IO=$P W @IOF
S POP=0
S INNODE="" F S INNODE=$O(INLIST1(INNODE)) Q:'INNODE!POP D
.;if second piece is null, user enter "^". Take no action
.Q:'$L($P(INLIST1(INNODE),U,2))
.I $Y>(IOSL-4) D CONT Q:POP
.W !,$P(INLIST1(INNODE),U,2)
.K INLIST1(INNODE),@INLIST2@(INNODE)
K INLIST1
D CONT
D ^%ZISC S IOP="",%ZIS="" D ^%ZIS U IO K IO("Q"),IOP,POP
Q
;
CONT I IO=IO(0),$E(IOST)'="P" W ! S X=$$CR^UTSRD I X S POP=1 Q
W @IOF
Q
;
FINDQUE(INREQIEN,INMSG) ;determines if entry is already on queue
; If entry is already on queue, prompts user if they want
; to requeue.
; INPUT:
; INREQIEN = IEN of entry being requeued
; INMSG = (PBR) message that will be displayed back to user at end
; RETURN = 0 if INREQUIEN is to be requeued
; 1 if user says "no"
; 2 if user enters "^"
;
N INDET,INDEST,INMID,INCURP,INQUE,INQUED,OUT
; 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),INCURT=$P(INDET,U,19) S:'$L(INCURT) INCURT=+INCURT
;If requeue is suppressed, quit
I $P(INDET,U,20) S INMSG=INMID_": Requeue of message is not allowed" Q 1
;Get the primary queue--0=INLHSCH, 1=INLHDEST
S INQUE=+$P($G(^INRHD(INDEST,0)),U,12),OUT=0,INQUEUED=0
; check if already queued. If on INLHSCH, look there first, but
; it may have already processed to INLHDEST
F INQUE=INQUE:1:1 I $L(INQUE),$L($T(@INQUE)) D @INQUE Q:INQUEUED
I INQUEUED D CLEAR^DW W !,$$INMSGSTR^INHMS2(INREQIEN) D
.W !!,"Message "_INMID_" is already queued on "_$S(INQUE=0:"^INLHSCH",1:"^INLHDEST")
.W " for "_$$DATEOUT^%ZTFDT(INCURT,"F"),!,"with a priority of "_INCURP_".",!
.S X=$$YN^UTSRD("Do you want to delete existing queue entry and requeue? ;N;")
.S OUT=$S(X["^":2,X=0:1,1:0)
I OUT S INMSG=INMID_": Message not requeued" Q OUT
I INQUEUED D
.;If requeue, kill exiting queue to prevent double entry
.I 'INQUE K ^INLHSCH(INCURP,INCURT,INREQIEN) Q
.K ^INLHDEST(INDEST,INCURP,INCURT,INREQIEN)
S INMSG=INMID_": "_$S(INQUEUED:"Existing queue deleted.",1:""),INMSG=INMSG_" Message requeued"
Q 0
;
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
D SET^INHD(INTTPROC,$P(^INTHU(INREQIEN,0),U,2),INREQIEN,"",INPRIO)
;Change status to "pending", update activity log
D ULOG^INHU(INREQIEN,"P","Requeued by user "_$P(^DIC(3,DUZ,0),U))
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
INHOU1 ;DJL,DP; 7 Oct 97 12:50;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 ;
+12 NEW X,Y,INQUIT,INDA,INREQLST,INPARM2,DIC,INMSG,DIRI,DIRCP,DLAYGO,INABORT,INCLRT,INQUED,INZ,POP,INCURT,INQUEUED,%ZIS
+13 ; Set up parameter for hot key and List Processor
+14 DO SETP2^INHOU1
+15 ;
EN2 ;This is the actual working loop of the routine
+1 SET INQUIT=0
FOR
Begin DoDot:1
+2 IF '$ORDER(^INTHU(0))
WRITE !!,"There are no entries to requeue."
SET INQUIT=1
QUIT
+3 ; handle initial user input
+4 KILL X
DO CLEAR^DW
WRITE !!
+5 DO ^UTSRD("Enter a Message to Requeue: ;;;;;","Terminate:^ or <RETURN>, Search Queue:/, or a Valid Message Component")
+6 ; handle the different error/exit conditions
+7 IF X="/"
SET INQUIT=$$TIEN^INHUTC(.INPARM2,"INREQLST")
DO CLEAR^DW
QUIT
+8 IF '$DATA(X)
QUIT
+9 IF X="^"!(X="")
SET INQUIT=$SELECT(X="":1,1:2)
QUIT
+10 ; let DIC handle all other input checks for single message requeue
+11 SET DIC="^INTHU("
SET DIC(0)="NMEQ"
+12 DO ^DIC
IF Y<0
QUIT
+13 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
+14 IF $DATA(INDA)
DO INKINDA^INHMS(INDA)
+15 QUIT
+16 ;
REQ1 ; Requeue an entry for processing
+1 ; Description: REQ1 performs similar functions as REQ in which it
+2 ; allows requeing message in three different ways.
+3 ; However, REQ1 does not prompt user for a message to
+4 ; requeue. Upon enter REQ1, variable Y contains IEN of
+5 ; message to requeue.
+6 ;
+7 ; RETURN = none
+8 ; PARAMETERS = none
+9 ;
+10 NEW X,INQUIT,INDA,INREQLST,INPARM2,DIC,INMSG,DIRI,DIRCP,DLAYGO,INABORT,INCLRT,INQUED,INZ,POP,INCURT,INQUEUED,%ZIS
+11 ; Set up parameter for hot key and List Processor
+12 DO SETP2^INHOU1
+13 ;
EN3 ;This is the actual requeue operation
+1 SET INREQLST(1)=+Y
SET INREQLST(1,0)=""
DO REQONE^INHOU2(.INREQLST,.INPARM2)
+2 IF $DATA(INDA)
DO INKINDA^INHMS(INDA)
+3 DO CLEAR^DW
+4 QUIT
+5 ;
SETP2 ; Set up parameter for hot key and List Processor
+1 ; construct the structure defining the requeue operations, etc
+2 SET INPARM2("LIST","TITLE")="W ?IOM-$L(""Interface Message Requeue"")/2,""Interface Message Requeue"",!,$$INMSGSTR^INHMS2("""",1,"""")"
+3 ; Create the list processor help text
+4 SET INPARM2("LIST","HELP")="N INHELP D BLDHELP^INHOU2(.INHELP),SRCHHELP^INHMS3(.INHELP)"
+5 ; create the HOT KEY structure
+6 SET INPARM2("LIST","HOT",1)="EXISTING^H1"
+7 SET INPARM2("LIST","HOT",1,"ACTION")="D GOHOT1^INHOU5(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
+8 SET INPARM2("LIST","HOT",2)="SINGLE^H2"
+9 SET INPARM2("LIST","HOT",2,"ACTION")="D GOHOT2^INHOU5(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
+10 SET INPARM2("LIST","HOT",3)="UNIQUE^H3"
+11 SET INPARM2("LIST","HOT",3,"ACTION")="D GOHOT3^INHOU5(.DWLMK,DWLRF),REMQUED^INHOU1(.DWLMK,DWLRF)"
+12 QUIT
+13 ;
REMQUED(INLIST1,INLIST2) ; remove items in list1 from list1,list2
+1 NEW INNODE
+2 SET %ZIS=""
DO CLEAR^DW
DO ^%ZIS
IF POP
QUIT
USE IO
IF IO=$PRINCIPAL
WRITE @IOF
+3 SET POP=0
+4 SET INNODE=""
FOR
SET INNODE=$ORDER(INLIST1(INNODE))
IF 'INNODE!POP
QUIT
Begin DoDot:1
+5 ;if second piece is null, user enter "^". Take no action
+6 IF '$LENGTH($PIECE(INLIST1(INNODE),U,2))
QUIT
+7 IF $Y>(IOSL-4)
DO CONT
IF POP
QUIT
+8 WRITE !,$PIECE(INLIST1(INNODE),U,2)
+9 KILL INLIST1(INNODE),@INLIST2@(INNODE)
End DoDot:1
+10 KILL INLIST1
+11 DO CONT
+12 DO ^%ZISC
SET IOP=""
SET %ZIS=""
DO ^%ZIS
USE IO
KILL IO("Q"),IOP,POP
+13 QUIT
+14 ;
CONT IF IO=IO(0)
IF $EXTRACT(IOST)'="P"
WRITE !
SET X=$$CR^UTSRD
IF X
SET POP=1
QUIT
+1 WRITE @IOF
+2 QUIT
+3 ;
FINDQUE(INREQIEN,INMSG) ;determines if entry is already on queue
+1 ; If entry is already on queue, prompts user if they want
+2 ; to requeue.
+3 ; INPUT:
+4 ; INREQIEN = IEN of entry being requeued
+5 ; INMSG = (PBR) message that will be displayed back to user at end
+6 ; RETURN = 0 if INREQUIEN is to be requeued
+7 ; 1 if user says "no"
+8 ; 2 if user enters "^"
+9 ;
+10 NEW INDET,INDEST,INMID,INCURP,INQUE,INQUED,OUT
+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)
SET INCURT=$PIECE(INDET,U,19)
IF '$LENGTH(INCURT)
SET INCURT=+INCURT
+15 ;If requeue is suppressed, quit
+16 IF $PIECE(INDET,U,20)
SET INMSG=INMID_": Requeue of message is not allowed"
QUIT 1
+17 ;Get the primary queue--0=INLHSCH, 1=INLHDEST
+18 SET INQUE=+$PIECE($GET(^INRHD(INDEST,0)),U,12)
SET OUT=0
SET INQUEUED=0
+19 ; check if already queued. If on INLHSCH, look there first, but
+20 ; it may have already processed to INLHDEST
+21 FOR INQUE=INQUE:1:1
IF $LENGTH(INQUE)
IF $LENGTH($TEXT(@INQUE))
DO @INQUE
IF INQUEUED
QUIT
+22 IF INQUEUED
DO CLEAR^DW
WRITE !,$$INMSGSTR^INHMS2(INREQIEN)
Begin DoDot:1
+23 WRITE !!,"Message "_INMID_" is already queued on "_$SELECT(INQUE=0:"^INLHSCH",1:"^INLHDEST")
+24 WRITE " for "_$$DATEOUT^%ZTFDT(INCURT,"F"),!,"with a priority of "_INCURP_".",!
+25 SET X=$$YN^UTSRD("Do you want to delete existing queue entry and requeue? ;N;")
+26 SET OUT=$SELECT(X["^":2,X=0:1,1:0)
End DoDot:1
+27 IF OUT
SET INMSG=INMID_": Message not requeued"
QUIT OUT
+28 IF INQUEUED
Begin DoDot:1
+29 ;If requeue, kill exiting queue to prevent double entry
+30 IF 'INQUE
KILL ^INLHSCH(INCURP,INCURT,INREQIEN)
QUIT
+31 KILL ^INLHDEST(INDEST,INCURP,INCURT,INREQIEN)
End DoDot:1
+32 SET INMSG=INMID_": "_$SELECT(INQUEUED:"Existing queue deleted.",1:"")
SET INMSG=INMSG_" Message requeued"
+33 QUIT 0
+34 ;
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 DO SET^INHD(INTTPROC,$PIECE(^INTHU(INREQIEN,0),U,2),INREQIEN,"",INPRIO)
+11 ;Change status to "pending", update activity log
+12 DO ULOG^INHU(INREQIEN,"P","Requeued by user "_$PIECE(^DIC(3,DUZ,0),U))
+13 QUIT
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
