INHOU4 ;DP; 25 Jun 97 10:42;Mark transaction complete.
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
;
MC ;Mark as complete (need INH MESSAGE EDIT key to do this)
N DIC,INTT,UIF,DWFILE,Y,DES,INHERR,SUBDELIM,CU,DIOUT,DIPA,DIRCP,DIRI,DLAYGO,DIRMAX,HDR,I,INDA,INFO,INH,INQUIT,INREQLST,INZ,J,K,OK,PRIO,POP,QUE,OD,INMID,INPARM2,INL,%ZIS
D CLEAR^DW
S INPARM2("LIST","HOT",1)="PROCESS^H1"
S INPARM2("LIST","HOT",1,"ACTION")="D LOOP^INHOU4(.DWLMK,DWLRF),DISP^INHOU4(.DWLMK,DWLRF)"
EN2 S X="** Mark Transaction Complete **" W !?80-$L(X)/2,X,!! K X
D ^UTSRD("Select Transaction to Mark Complete: ;;;;;","Search Queue:/, or a Valid Message ID")
; handle the different error/exit conditions
G:X="" EXIT1
I X="/" S POP=0 D I POP D CLEAR^DW G EXIT1
.S INQUIT=$$TIEN^INHUTC(.INPARM2,"INREQLST")
.S:'$D(INREQLST) POP=1
I X="^"!(X="") Q
; let DIC handle all other input checks for single message reque
I '$D(INREQLST) D Q:'$D(INREQLST)
.S DIC="^INTHU(",DIC(0)="M" D ^DIC
.I Y<0 W *7,"No such transaction on file!." D CONT Q
.S INREQLST(1)=1,INL(1)="",INL(1,0)=+Y
D LOOP(.INREQLST,"INL")
G EN2
;
EXIT1 D:$D(INDA) INKINDA^INHMS(INDA) Q
;
LOOP(INREQLST,DWLRF) ;Loop to process transactions selected by user
N INQUIT
S CU="",HDR="*** Mark Transaction Complete ***"
S INQUIT=0 F S CU=$O(INREQLST(CU)) Q:CU=""!INQUIT D
.S UIF=$G(@DWLRF@(CU,0)) Q:'UIF
.S INFO=$G(^INTHU(UIF,0)),PRIO=+$P(INFO,U,16),INH=$P(INFO,U,19),DES=$P(INFO,U,2),INMID=$P(INFO,U,5) S:'$L(INH) INH=0
.D
..;Find what queue it is really on
..I $D(^INLHSCH(PRIO,INH,UIF)) S QUE=0 Q
..I $D(^INLHDEST(DES,PRIO,INH,UIF)) S QUE=1 Q
..;Otherwise it is not on any queue
..S QUE=""
.;If its on a queue, prompt
.I $L(QUE) D
..W @IOF,?80-$L(HDR)/2,HDR,!!
..W ?52,"Que: ",$S(QUE=1:"^INLHDEST",QUE=0:"^INLHSCH",1:"Not queued"),!
..K DIPA S D0=UIF
..S SUBDELIM="\",DIPA(D0)=INH D ^INXHR01
.I QUE="" D COMP S $P(INREQLST(CU),U,2)=INMID_": Not queued, marked complete" Q
.S OD="OK to delete from queue"
.W ! S OK=$$YN^UTSRD(OD_" ?: ;Y") S:OK["^" INQUIT=1 I 'OK D Q
..S $P(INREQLST(CU),U,2)=INMID_": Not marked complete"
.K ^INLHSCH(PRIO,INH,UIF),^INLHDEST(DES,PRIO,INH,UIF) D COMP
.S $P(INREQLST(CU),U,2)=INMID_": Removed from queue, marked complete"
Q
;
EXIT Q
;
COMP ;Successful processing
D ULOG^INHU(UIF,"C","Marked complete by user "_$P(^DIC(3,DUZ,0),U))
Q
;
DISP(INLIST1,INLIST2) ; Display results of all items selected
;Loop through selection list and display items.
; INPUT
; INLIST1 = The array of user selected items with piece 2 = action
; INLIST2 = The full array from the list processor
N INNODE
S %ZIS="" D CLEAR^DW,^%ZIS 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
INHOU4 ;DP; 25 Jun 97 10:42;Mark transaction complete.
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
+5 ;
MC ;Mark as complete (need INH MESSAGE EDIT key to do this)
+1 NEW DIC,INTT,UIF,DWFILE,Y,DES,INHERR,SUBDELIM,CU,DIOUT,DIPA,DIRCP,DIRI,DLAYGO,DIRMAX,HDR,I,INDA,INFO,INH,INQUIT,INREQLST,INZ,J,K,OK,PRIO,POP,QUE,OD,INMID,INPARM2,INL,%ZIS
+2 DO CLEAR^DW
+3 SET INPARM2("LIST","HOT",1)="PROCESS^H1"
+4 SET INPARM2("LIST","HOT",1,"ACTION")="D LOOP^INHOU4(.DWLMK,DWLRF),DISP^INHOU4(.DWLMK,DWLRF)"
EN2 SET X="** Mark Transaction Complete **"
WRITE !?80-$LENGTH(X)/2,X,!!
KILL X
+1 DO ^UTSRD("Select Transaction to Mark Complete: ;;;;;","Search Queue:/, or a Valid Message ID")
+2 ; handle the different error/exit conditions
+3 IF X=""
GOTO EXIT1
+4 IF X="/"
SET POP=0
Begin DoDot:1
+5 SET INQUIT=$$TIEN^INHUTC(.INPARM2,"INREQLST")
+6 IF '$DATA(INREQLST)
SET POP=1
End DoDot:1
IF POP
DO CLEAR^DW
GOTO EXIT1
+7 IF X="^"!(X="")
QUIT
+8 ; let DIC handle all other input checks for single message reque
+9 IF '$DATA(INREQLST)
Begin DoDot:1
+10 SET DIC="^INTHU("
SET DIC(0)="M"
DO ^DIC
+11 IF Y<0
WRITE *7,"No such transaction on file!."
DO CONT
QUIT
+12 SET INREQLST(1)=1
SET INL(1)=""
SET INL(1,0)=+Y
End DoDot:1
IF '$DATA(INREQLST)
QUIT
+13 DO LOOP(.INREQLST,"INL")
+14 GOTO EN2
+15 ;
EXIT1 IF $DATA(INDA)
DO INKINDA^INHMS(INDA)
QUIT
+1 ;
LOOP(INREQLST,DWLRF) ;Loop to process transactions selected by user
+1 NEW INQUIT
+2 SET CU=""
SET HDR="*** Mark Transaction Complete ***"
+3 SET INQUIT=0
FOR
SET CU=$ORDER(INREQLST(CU))
IF CU=""!INQUIT
QUIT
Begin DoDot:1
+4 SET UIF=$GET(@DWLRF@(CU,0))
IF 'UIF
QUIT
+5 SET INFO=$GET(^INTHU(UIF,0))
SET PRIO=+$PIECE(INFO,U,16)
SET INH=$PIECE(INFO,U,19)
SET DES=$PIECE(INFO,U,2)
SET INMID=$PIECE(INFO,U,5)
IF '$LENGTH(INH)
SET INH=0
+6 Begin DoDot:2
+7 ;Find what queue it is really on
+8 IF $DATA(^INLHSCH(PRIO,INH,UIF))
SET QUE=0
QUIT
+9 IF $DATA(^INLHDEST(DES,PRIO,INH,UIF))
SET QUE=1
QUIT
+10 ;Otherwise it is not on any queue
+11 SET QUE=""
End DoDot:2
+12 ;If its on a queue, prompt
+13 IF $LENGTH(QUE)
Begin DoDot:2
+14 WRITE @IOF,?80-$LENGTH(HDR)/2,HDR,!!
+15 WRITE ?52,"Que: ",$SELECT(QUE=1:"^INLHDEST",QUE=0:"^INLHSCH",1:"Not queued"),!
+16 KILL DIPA
SET D0=UIF
+17 SET SUBDELIM="\"
SET DIPA(D0)=INH
DO ^INXHR01
End DoDot:2
+18 IF QUE=""
DO COMP
SET $PIECE(INREQLST(CU),U,2)=INMID_": Not queued, marked complete"
QUIT
+19 SET OD="OK to delete from queue"
+20 WRITE !
SET OK=$$YN^UTSRD(OD_" ?: ;Y")
IF OK["^"
SET INQUIT=1
IF 'OK
Begin DoDot:2
+21 SET $PIECE(INREQLST(CU),U,2)=INMID_": Not marked complete"
End DoDot:2
QUIT
+22 KILL ^INLHSCH(PRIO,INH,UIF),^INLHDEST(DES,PRIO,INH,UIF)
DO COMP
+23 SET $PIECE(INREQLST(CU),U,2)=INMID_": Removed from queue, marked complete"
End DoDot:1
+24 QUIT
+25 ;
EXIT QUIT
+1 ;
COMP ;Successful processing
+1 DO ULOG^INHU(UIF,"C","Marked complete by user "_$PIECE(^DIC(3,DUZ,0),U))
+2 QUIT
+3 ;
DISP(INLIST1,INLIST2) ; Display results of all items selected
+1 ;Loop through selection list and display items.
+2 ; INPUT
+3 ; INLIST1 = The array of user selected items with piece 2 = action
+4 ; INLIST2 = The full array from the list processor
+5 NEW INNODE
+6 SET %ZIS=""
DO CLEAR^DW
DO ^%ZIS
USE IO
IF IO=$PRINCIPAL
WRITE @IOF
+7 SET POP=0
+8 SET INNODE=""
FOR
SET INNODE=$ORDER(INLIST1(INNODE))
IF 'INNODE!POP
QUIT
Begin DoDot:1
+9 ;if second piece is null, user enter "^". Take no action
+10 IF '$LENGTH($PIECE(INLIST1(INNODE),U,2))
QUIT
+11 IF $Y>(IOSL-4)
DO CONT
IF POP
QUIT
+12 WRITE !,$PIECE(INLIST1(INNODE),U,2)
+13 KILL INLIST1(INNODE),@INLIST2@(INNODE)
End DoDot:1
+14 KILL INLIST1
+15 DO CONT
+16 DO ^%ZISC
SET IOP=""
SET %ZIS=""
DO ^%ZIS
USE IO
KILL IO("Q"),IOP,POP
+17 QUIT
+18 ;
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
