INHOU3 ;DP; 27 Jan 98 15:10;List Queued Tansactions.
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
QTSK ;Display currently queued entries
K ^UTILITY($J)
N DA,DIC,DIE,DIK
N DDSFILE,DR,DDSPAGE,DDSPARM,DDSSAVE
I $O(^INLHSCH(""))'?1.N,$O(^INLHDEST(""))'?1.N D Q
.W !!,"There are no entries queued for processing." Q
S X=$J_"_"_DUZ_"_"_$P($H,",",2),DIC=4001.1,DIC(0)="L",DLAYGO=4001.1
D ^DIC S INDA=+Y
I +Y<0 D ERR^INHMS2("Unable to create file ") Q
S DA=INDA,DWN="INH QUEUE LIST",DIE=4001.1
;Check for IHS
I $$SC^INHUTIL1 D Q:'$D(DWFILE)
.S DWASK="" D ^DWC
I '$$SC^INHUTIL1 D Q:'$G(DDSSAVE)
.N INDIC S INDIC=DIC N DIC S DIC=INDIC
.S DDSFILE=DIE,DR="["_DWN_"]",DDSPAGE=1,DDSPARM="SC"
.D ^DDS
K IOP S %ZIS="N" D ^%ZIS Q:POP
S IOP=ION_";"_IOST_";"_IOM_";"_IOSL
N DIZ M DIZ(4001.1,INDA)=^DIZ(4001.1,INDA)
S ZTIO=IOP I IO'=IO(0) D Q
.S ZTRTN="QZTSK^INHOU3"
.S ZTDESC="List of Queued Interface Transactions"
.;N DIZ M DIZ(4001.1,INDA)=^DIZ(4001.1,INDA) S ZTSAVE("DIZ(")=""
.S ZTSAVE("DIZ(")=""
.S ZTSAVE("INDA")=INDA D ^%ZTLOAD
S DA=INDA,DIK=DIC D ^DIK
S %ZIS="" D ^%ZIS
I POP W *7,!,"Unable to find device" D ^%ZISC Q
;
QZTSK ;TaskMan entry point
N DIOUT,DUOUT,INH,INLOOP,D0,INDX,X,Y,%
N INDET,QUE,PRIO,PRI,DIRC,DEST,INBEG,INEND,INSEL,INQUE,DA,DES,DETL,PAG,PC,INBEG1,INE,INEND1,INH1,INLN,QUE1,COUNT
;Initialize variables
;Details
S INDET=+$P($G(DIZ(4001.1,INDA,20)),U,3)
;Queue
S QUE=$G(DIZ(4001.1,INDA,8))
;Priority
S PRIO=$P($G(DIZ(4001.1,INDA,20)),U,11)
;Direction
S DIRC=$G(DIZ(4001.1,INDA,6))
;Destination
S DEST=$G(DIZ(4001.1,INDA,2))
;Start date
S INBEG=$G(DIZ(4001.1,INDA,1))
S:INBEG="" INBEG=$O(^INTHU("B",""))
S:INBEG'["." INBEG=INBEG_".0"
;End date
S INEND=$G(DIZ(4001.1,INDA,1.1))
S:'$L(INEND) INEND=DT S:INEND'["." INEND=INEND_".24"
S POP=0 D SHDR
;Cnvert date to $h format
S INBEG1=$$CDATF2H^%ZTFDT(INBEG)
S INEND1=$$CDATF2H^%ZTFDT(INEND)
I QUE'?1N D D CLOSE Q
.F INQUE=0,1 D @INQUE,DIPA
I QUE=0!QUE=1 D @QUE,DIPA
CLOSE ;Close device
I POP D ^%ZISC Q
F I=1:1:IOSL-$Y-3 W !
S X="End of Report" W ?IOM-$L(X)\2,X
D ^%ZISC
Q
0 ;^INLHSCH QUEUE
S PRI="",(POP,CNT,QUE1)=0 D HDR
F S PRI=$O(^INLHSCH(PRI)) Q:PRI=""!POP D
.I PRIO'="" Q:PRI>PRIO
.S INH=INBEG1_","_($P(INBEG1,",",2)-1),D0=0
.F S INH=$O(^INLHSCH(PRI,INH)) Q:'$L(INH)!POP!($$DTCHK(INBEG1,INEND1,INH)=2) D
..Q:INH<INBEG1
..F S D0=$O(^INLHSCH(PRI,INH,D0)) Q:'D0!POP D
...S DETL=$G(^INTHU(D0,0)) Q:DETL=""
...I DIRC'="" Q:$P(DETL,U,10)'=DIRC
...I DEST'="" Q:$P(DETL,U,2)'=DEST
...S CNT=CNT+1 D DIPA
I 'CNT S X="No entries in queue INLHSCH" W ?IOM-$L(X)\2,X,!
I CNT S X="End of queue INLHSCH" W ?IOM-$L(X)\2,X,!
D CR
Q
1 ;^INLHDEST QUEUE
Q:POP Q:DIRC="I"
S DES="",(POP,CNT)=0,QUE1=1 D HDR
F S DES=$O(^INLHDEST(DES)) Q:DES=""!POP D
.D:$Y>(IOSL-3) HDR Q:POP
.I DEST'="" Q:DEST'=DES
.W !,"DESTINATION: ",$P($G(^INRHD(DES,0)),U),!
.S PRI="" F S PRI=$O(^INLHDEST(DES,PRI)) Q:PRI=""!POP D
..I PRIO'="" Q:PRI>PRIO
..S INH=INBEG1_","_($P(INBEG1,",",2)-1),D0=0
..F S INH=$O(^INLHDEST(DES,PRI,INH)) Q:'$L(INH)!POP!($$DTCHK(INBEG1,INEND1,INH)=2) D
...Q:INH<INBEG1
...F S D0=$O(^INLHDEST(DES,PRI,INH,D0)) Q:'D0!POP S CNT=CNT+1 D DIPA
I 'CNT S X="No entries in queue INLDEST" W ?IOM-$L(X)\2,X,!
I CNT S X="End of queue INLHDEST" W ?IOM-$L(X)\2,X,!
D CR ;added by DGH for IHS port
Q
DIPA ;
Q:'$G(D0) S INE=D0
Q:'$D(^INTHU(INE,0))
S DETL=^INTHU(INE,0)
I 'INDET D Q
.S INH1=$P(DETL,U)
.W $$DATEFMT^UTDT(INH1,"MM/DD@HH:II")
.W ?14,$E($P(DETL,U,16),1,4)
.W ?19,$P(DETL,U,5)
.S PC=$P(DETL,U,2),PC=$S(PC="":PC,$D(^INRHD(PC,0))#2:$P(^(0),U),1:" "_PC)
.W ?40,$E(PC,1,35),!
.D:$Y>(IOSL-3) HDR
W $$DATEFMT^UTDT($P(DETL,U),"MM/DD@HH:II") K DIP
;PRIORITY
W ?14,$E($P(DETL,U,16),1,4)
;Status
N PC S PC=$P(DETL,U,3)
W ?19,$S(PC="":PC,$D(INDX(PC)):INDX(PC),1:PC)
;ID
W ?24,$E($P(DETL,U,5),1,18)
;Destination
S PC=$P(DETL,U,2)
S PC=$S(PC="":PC,$D(^INRHD(PC,0))#2:$P(^(0),U),1:" "_PC)
W ?35,$E(PC,1,35)
;Source
W !?35,$P(^INRHT($P(DETL,U,11),0),U)
I $Y>(IOSL-3) D HDR Q
W !
Q
;
SHDR ;set header
K INLN S X=$$CDATASC^%ZTFDT($H,1,1),INLN(0)=X_" Page ",PAG=1
S INLN(1)="List Queued Transaction Report"
S X="From: "_$$CDATASC^%ZTFDT($E(INBEG,1,10),3,1)
I INEND'="" D
.S X=X_" To: "_$$CDATASC^%ZTFDT($E(INEND,1,10),3,1)
S INLN(2)=X
;get the site name
S INLN(6)=$S($D(^DIC(4,^DD("SITE",1),0)):^(0),1:^DD("SITE"))
S INLN(6)=$S($P(INLN(6),U,4)]"":$P(INLN(6),U,4),1:$P(INLN(6),U,1))
S INLN="",$P(INLN,"-",IOM+1)=""
S INLN(7)=" Date/Time Prio Status ID Destination / Tran. Type"
I 'INDET S INLN(7)=" Date/Time Prio ID Destination"
D TEXT Q
;
HDR ;Print header
;S POP=0 I $P=IO I $Y>(IOSL-4) D CR
S POP=0 I $P(IOST,"-")["C",IO=IO(0),$Y>(IOSL-4) D CR Q:POP
I PAG>1!($P(IOST,"-")["C") W @IOF
W !,INLN(6)
S X=INLN(0)_PAG,PAG=PAG+1
W ?IOM-$L(X)-1,X,!
F I=1,2 W !?IOM-$L(INLN(I))\2,INLN(I)
;S X="Queue: "_$S(QUE=0:"INLHSCH",QUE=1:"INLHDEST",1:"ALL QUEUES")
;S X="Queue: "_$S($G(INQUE)=0:"INLHSCH",1:"INLHDEST")
S X="Queue: "_$S(QUE1=0:"INLHSCH",1:"INLHDEST")
W !?IOM-$L(X)\2,X D:'$D(INSEL) SEL
W !,INLN(7),!,INLN,!
Q
CR ;
I IO'=IO(0)!($E(IOST)="P") Q
W !,"Press <RETURN> to continue. " R X:DTIME S:X[U POP=1
Q
SEL ;Display selection criteria
W !,"Selection Criteria: "
W !,"Queue: ",$S(QUE=0:"INLHSCH",QUE=1:"INLHDEST",1:"All")
W !,"Cut Off Priority: ",$S(PRIO?1.N:PRIO,1:"All")
W !,"Direction: ",$S(DIRC="I":"In",DIRC="O":"Out",1:"All")
W !,"Destination: ",$S(DEST="":"All",$D(^INRHD(DEST,0))#2:$P(^(0),U),1:" "_DEST)
W !,"Detailed: ",$S(INDET=0:"No",1:"Yes"),!
S INSEL=1
Q
TEXT ;Set up status array
S INDX("A")="ACCEPT A"
S INDX("C")="COMPLETE"
S INDX("E")="ERROR"
S INDX("K")="NEGATIVE"
S INDX("N")="NEW"
S INDX("P")="PENDING"
S INDX("S")="SENT (Aw"
Q
QUE ;Select que
I X[U!(X="^") S POP=1 Q
N QUE1,INX S INX=X
S X=$$UPCASE^%ZTF(X)
S X=$S('$L(X):"",X=1:1,X=0:0,X["INLHSCH":0,X["INLHDEST":1,X="ALL":"ALL",1:2)
I X=2 K X Q
S QUE1=$S('$L(X):"ALL",X=0:"^INLHSCH",X=1:"^INLHDEST",1:"ALL")
I $L(INX)=1,QUE1'=INX W " ",QUE1
I $O(@QUE1@(""))'?.N D MESS^DWD(4) W ?10,QUE1_" is empty",!,?10,"Press <RETURN> to continue. " R X:DTIME K X
Q
HELP ;
W !,"Select Queue: 0=INLHSCH"
W !," 1=INLHDEST"
W !!,"Press 'Enter' to select all queues"
Q
HELP1 ;Help text for IHS
N INMSG
S INMSG="Select Queue: 0=INLHSCH or 1=INLHDEST"
D HLP^DDSUTL(.INMSG)
Q
;
DTCHK(INBEG1,INEND1,INH) ;check queue entry to see if it's in time range
;INBEG1=Selected start time
;INEND1=Selected end date/time
;INH=Date/time of entry in queue
;RETURNS -- 0 if TIME is between START and STOP
; -- 1 if TIME is before START
; -- 2 if TIME is after STOP
Q:INH<INBEG1 1 Q:INH>INEND1 2
Q:$P(INH,",",2)<$P(INBEG1,",",2) 1
Q:$P(INH,",",2)>$P(INEND1,",",2) 2
Q 0
;
INHOU3 ;DP; 27 Jan 98 15:10;List Queued Tansactions.
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
QTSK ;Display currently queued entries
+1 KILL ^UTILITY($JOB)
+2 NEW DA,DIC,DIE,DIK
+3 NEW DDSFILE,DR,DDSPAGE,DDSPARM,DDSSAVE
+4 IF $ORDER(^INLHSCH(""))'?1.N
IF $ORDER(^INLHDEST(""))'?1.N
Begin DoDot:1
+5 WRITE !!,"There are no entries queued for processing."
QUIT
End DoDot:1
QUIT
+6 SET X=$JOB_"_"_DUZ_"_"_$PIECE($HOROLOG,",",2)
SET DIC=4001.1
SET DIC(0)="L"
SET DLAYGO=4001.1
+7 DO ^DIC
SET INDA=+Y
+8 IF +Y<0
DO ERR^INHMS2("Unable to create file ")
QUIT
+9 SET DA=INDA
SET DWN="INH QUEUE LIST"
SET DIE=4001.1
+10 ;Check for IHS
+11 IF $$SC^INHUTIL1
Begin DoDot:1
+12 SET DWASK=""
DO ^DWC
End DoDot:1
IF '$DATA(DWFILE)
QUIT
+13 IF '$$SC^INHUTIL1
Begin DoDot:1
+14 NEW INDIC
SET INDIC=DIC
NEW DIC
SET DIC=INDIC
+15 SET DDSFILE=DIE
SET DR="["_DWN_"]"
SET DDSPAGE=1
SET DDSPARM="SC"
+16 DO ^DDS
End DoDot:1
IF '$GET(DDSSAVE)
QUIT
+17 KILL IOP
SET %ZIS="N"
DO ^%ZIS
IF POP
QUIT
+18 SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
+19 NEW DIZ
MERGE DIZ(4001.1,INDA)=^DIZ(4001.1,INDA)
+20 SET ZTIO=IOP
IF IO'=IO(0)
Begin DoDot:1
+21 SET ZTRTN="QZTSK^INHOU3"
+22 SET ZTDESC="List of Queued Interface Transactions"
+23 ;N DIZ M DIZ(4001.1,INDA)=^DIZ(4001.1,INDA) S ZTSAVE("DIZ(")=""
+24 SET ZTSAVE("DIZ(")=""
+25 SET ZTSAVE("INDA")=INDA
DO ^%ZTLOAD
End DoDot:1
QUIT
+26 SET DA=INDA
SET DIK=DIC
DO ^DIK
+27 SET %ZIS=""
DO ^%ZIS
+28 IF POP
WRITE *7,!,"Unable to find device"
DO ^%ZISC
QUIT
+29 ;
QZTSK ;TaskMan entry point
+1 NEW DIOUT,DUOUT,INH,INLOOP,D0,INDX,X,Y,%
+2 NEW INDET,QUE,PRIO,PRI,DIRC,DEST,INBEG,INEND,INSEL,INQUE,DA,DES,DETL,PAG,PC,INBEG1,INE,INEND1,INH1,INLN,QUE1,COUNT
+3 ;Initialize variables
+4 ;Details
+5 SET INDET=+$PIECE($GET(DIZ(4001.1,INDA,20)),U,3)
+6 ;Queue
+7 SET QUE=$GET(DIZ(4001.1,INDA,8))
+8 ;Priority
+9 SET PRIO=$PIECE($GET(DIZ(4001.1,INDA,20)),U,11)
+10 ;Direction
+11 SET DIRC=$GET(DIZ(4001.1,INDA,6))
+12 ;Destination
+13 SET DEST=$GET(DIZ(4001.1,INDA,2))
+14 ;Start date
+15 SET INBEG=$GET(DIZ(4001.1,INDA,1))
+16 IF INBEG=""
SET INBEG=$ORDER(^INTHU("B",""))
+17 IF INBEG'["."
SET INBEG=INBEG_".0"
+18 ;End date
+19 SET INEND=$GET(DIZ(4001.1,INDA,1.1))
+20 IF '$LENGTH(INEND)
SET INEND=DT
IF INEND'["."
SET INEND=INEND_".24"
+21 SET POP=0
DO SHDR
+22 ;Cnvert date to $h format
+23 SET INBEG1=$$CDATF2H^%ZTFDT(INBEG)
+24 SET INEND1=$$CDATF2H^%ZTFDT(INEND)
+25 IF QUE'?1N
Begin DoDot:1
+26 FOR INQUE=0,1
DO @INQUE
DO DIPA
End DoDot:1
DO CLOSE
QUIT
+27 IF QUE=0!QUE=1
DO @QUE
DO DIPA
CLOSE ;Close device
+1 IF POP
DO ^%ZISC
QUIT
+2 FOR I=1:1:IOSL-$Y-3
WRITE !
+3 SET X="End of Report"
WRITE ?IOM-$LENGTH(X)\2,X
+4 DO ^%ZISC
+5 QUIT
0 ;^INLHSCH QUEUE
+1 SET PRI=""
SET (POP,CNT,QUE1)=0
DO HDR
+2 FOR
SET PRI=$ORDER(^INLHSCH(PRI))
IF PRI=""!POP
QUIT
Begin DoDot:1
+3 IF PRIO'=""
IF PRI>PRIO
QUIT
+4 SET INH=INBEG1_","_($PIECE(INBEG1,",",2)-1)
SET D0=0
+5 FOR
SET INH=$ORDER(^INLHSCH(PRI,INH))
IF '$LENGTH(INH)!POP!($$DTCHK(INBEG1,INEND1,INH)=2)
QUIT
Begin DoDot:2
+6 IF INH<INBEG1
QUIT
+7 FOR
SET D0=$ORDER(^INLHSCH(PRI,INH,D0))
IF 'D0!POP
QUIT
Begin DoDot:3
+8 SET DETL=$GET(^INTHU(D0,0))
IF DETL=""
QUIT
+9 IF DIRC'=""
IF $PIECE(DETL,U,10)'=DIRC
QUIT
+10 IF DEST'=""
IF $PIECE(DETL,U,2)'=DEST
QUIT
+11 SET CNT=CNT+1
DO DIPA
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF 'CNT
SET X="No entries in queue INLHSCH"
WRITE ?IOM-$LENGTH(X)\2,X,!
+13 IF CNT
SET X="End of queue INLHSCH"
WRITE ?IOM-$LENGTH(X)\2,X,!
+14 DO CR
+15 QUIT
1 ;^INLHDEST QUEUE
+1 IF POP
QUIT
IF DIRC="I"
QUIT
+2 SET DES=""
SET (POP,CNT)=0
SET QUE1=1
DO HDR
+3 FOR
SET DES=$ORDER(^INLHDEST(DES))
IF DES=""!POP
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-3)
DO HDR
IF POP
QUIT
+5 IF DEST'=""
IF DEST'=DES
QUIT
+6 WRITE !,"DESTINATION: ",$PIECE($GET(^INRHD(DES,0)),U),!
+7 SET PRI=""
FOR
SET PRI=$ORDER(^INLHDEST(DES,PRI))
IF PRI=""!POP
QUIT
Begin DoDot:2
+8 IF PRIO'=""
IF PRI>PRIO
QUIT
+9 SET INH=INBEG1_","_($PIECE(INBEG1,",",2)-1)
SET D0=0
+10 FOR
SET INH=$ORDER(^INLHDEST(DES,PRI,INH))
IF '$LENGTH(INH)!POP!($$DTCHK(INBEG1,INEND1,INH)=2)
QUIT
Begin DoDot:3
+11 IF INH<INBEG1
QUIT
+12 FOR
SET D0=$ORDER(^INLHDEST(DES,PRI,INH,D0))
IF 'D0!POP
QUIT
SET CNT=CNT+1
DO DIPA
End DoDot:3
End DoDot:2
End DoDot:1
+13 IF 'CNT
SET X="No entries in queue INLDEST"
WRITE ?IOM-$LENGTH(X)\2,X,!
+14 IF CNT
SET X="End of queue INLHDEST"
WRITE ?IOM-$LENGTH(X)\2,X,!
+15 ;added by DGH for IHS port
DO CR
+16 QUIT
DIPA ;
+1 IF '$GET(D0)
QUIT
SET INE=D0
+2 IF '$DATA(^INTHU(INE,0))
QUIT
+3 SET DETL=^INTHU(INE,0)
+4 IF 'INDET
Begin DoDot:1
+5 SET INH1=$PIECE(DETL,U)
+6 WRITE $$DATEFMT^UTDT(INH1,"MM/DD@HH:II")
+7 WRITE ?14,$EXTRACT($PIECE(DETL,U,16),1,4)
+8 WRITE ?19,$PIECE(DETL,U,5)
+9 SET PC=$PIECE(DETL,U,2)
SET PC=$SELECT(PC="":PC,$DATA(^INRHD(PC,0))#2:$PIECE(^(0),U),1:" "_PC)
+10 WRITE ?40,$EXTRACT(PC,1,35),!
+11 IF $Y>(IOSL-3)
DO HDR
End DoDot:1
QUIT
+12 WRITE $$DATEFMT^UTDT($PIECE(DETL,U),"MM/DD@HH:II")
KILL DIP
+13 ;PRIORITY
+14 WRITE ?14,$EXTRACT($PIECE(DETL,U,16),1,4)
+15 ;Status
+16 NEW PC
SET PC=$PIECE(DETL,U,3)
+17 WRITE ?19,$SELECT(PC="":PC,$DATA(INDX(PC)):INDX(PC),1:PC)
+18 ;ID
+19 WRITE ?24,$EXTRACT($PIECE(DETL,U,5),1,18)
+20 ;Destination
+21 SET PC=$PIECE(DETL,U,2)
+22 SET PC=$SELECT(PC="":PC,$DATA(^INRHD(PC,0))#2:$PIECE(^(0),U),1:" "_PC)
+23 WRITE ?35,$EXTRACT(PC,1,35)
+24 ;Source
+25 WRITE !?35,$PIECE(^INRHT($PIECE(DETL,U,11),0),U)
+26 IF $Y>(IOSL-3)
DO HDR
QUIT
+27 WRITE !
+28 QUIT
+29 ;
SHDR ;set header
+1 KILL INLN
SET X=$$CDATASC^%ZTFDT($HOROLOG,1,1)
SET INLN(0)=X_" Page "
SET PAG=1
+2 SET INLN(1)="List Queued Transaction Report"
+3 SET X="From: "_$$CDATASC^%ZTFDT($EXTRACT(INBEG,1,10),3,1)
+4 IF INEND'=""
Begin DoDot:1
+5 SET X=X_" To: "_$$CDATASC^%ZTFDT($EXTRACT(INEND,1,10),3,1)
End DoDot:1
+6 SET INLN(2)=X
+7 ;get the site name
+8 SET INLN(6)=$SELECT($DATA(^DIC(4,^DD("SITE",1),0)):^(0),1:^DD("SITE"))
+9 SET INLN(6)=$SELECT($PIECE(INLN(6),U,4)]"":$PIECE(INLN(6),U,4),1:$PIECE(INLN(6),U,1))
+10 SET INLN=""
SET $PIECE(INLN,"-",IOM+1)=""
+11 SET INLN(7)=" Date/Time Prio Status ID Destination / Tran. Type"
+12 IF 'INDET
SET INLN(7)=" Date/Time Prio ID Destination"
+13 DO TEXT
QUIT
+14 ;
HDR ;Print header
+1 ;S POP=0 I $P=IO I $Y>(IOSL-4) D CR
+2 SET POP=0
IF $PIECE(IOST,"-")["C"
IF IO=IO(0)
IF $Y>(IOSL-4)
DO CR
IF POP
QUIT
+3 IF PAG>1!($PIECE(IOST,"-")["C")
WRITE @IOF
+4 WRITE !,INLN(6)
+5 SET X=INLN(0)_PAG
SET PAG=PAG+1
+6 WRITE ?IOM-$LENGTH(X)-1,X,!
+7 FOR I=1,2
WRITE !?IOM-$LENGTH(INLN(I))\2,INLN(I)
+8 ;S X="Queue: "_$S(QUE=0:"INLHSCH",QUE=1:"INLHDEST",1:"ALL QUEUES")
+9 ;S X="Queue: "_$S($G(INQUE)=0:"INLHSCH",1:"INLHDEST")
+10 SET X="Queue: "_$SELECT(QUE1=0:"INLHSCH",1:"INLHDEST")
+11 WRITE !?IOM-$LENGTH(X)\2,X
IF '$DATA(INSEL)
DO SEL
+12 WRITE !,INLN(7),!,INLN,!
+13 QUIT
CR ;
+1 IF IO'=IO(0)!($EXTRACT(IOST)="P")
QUIT
+2 WRITE !,"Press <RETURN> to continue. "
READ X:DTIME
IF X[U
SET POP=1
+3 QUIT
SEL ;Display selection criteria
+1 WRITE !,"Selection Criteria: "
+2 WRITE !,"Queue: ",$SELECT(QUE=0:"INLHSCH",QUE=1:"INLHDEST",1:"All")
+3 WRITE !,"Cut Off Priority: ",$SELECT(PRIO?1.N:PRIO,1:"All")
+4 WRITE !,"Direction: ",$SELECT(DIRC="I":"In",DIRC="O":"Out",1:"All")
+5 WRITE !,"Destination: ",$SELECT(DEST="":"All",$DATA(^INRHD(DEST,0))#2:$PIECE(^(0),U),1:" "_DEST)
+6 WRITE !,"Detailed: ",$SELECT(INDET=0:"No",1:"Yes"),!
+7 SET INSEL=1
+8 QUIT
TEXT ;Set up status array
+1 SET INDX("A")="ACCEPT A"
+2 SET INDX("C")="COMPLETE"
+3 SET INDX("E")="ERROR"
+4 SET INDX("K")="NEGATIVE"
+5 SET INDX("N")="NEW"
+6 SET INDX("P")="PENDING"
+7 SET INDX("S")="SENT (Aw"
+8 QUIT
QUE ;Select que
+1 IF X[U!(X="^")
SET POP=1
QUIT
+2 NEW QUE1,INX
SET INX=X
+3 SET X=$$UPCASE^%ZTF(X)
+4 SET X=$SELECT('$LENGTH(X):"",X=1:1,X=0:0,X["INLHSCH":0,X["INLHDEST":1,X="ALL":"ALL",1:2)
+5 IF X=2
KILL X
QUIT
+6 SET QUE1=$SELECT('$LENGTH(X):"ALL",X=0:"^INLHSCH",X=1:"^INLHDEST",1:"ALL")
+7 IF $LENGTH(INX)=1
IF QUE1'=INX
WRITE " ",QUE1
+8 IF $ORDER(@QUE1@(""))'?.N
DO MESS^DWD(4)
WRITE ?10,QUE1_" is empty",!,?10,"Press <RETURN> to continue. "
READ X:DTIME
KILL X
+9 QUIT
HELP ;
+1 WRITE !,"Select Queue: 0=INLHSCH"
+2 WRITE !," 1=INLHDEST"
+3 WRITE !!,"Press 'Enter' to select all queues"
+4 QUIT
HELP1 ;Help text for IHS
+1 NEW INMSG
+2 SET INMSG="Select Queue: 0=INLHSCH or 1=INLHDEST"
+3 DO HLP^DDSUTL(.INMSG)
+4 QUIT
+5 ;
DTCHK(INBEG1,INEND1,INH) ;check queue entry to see if it's in time range
+1 ;INBEG1=Selected start time
+2 ;INEND1=Selected end date/time
+3 ;INH=Date/time of entry in queue
+4 ;RETURNS -- 0 if TIME is between START and STOP
+5 ; -- 1 if TIME is before START
+6 ; -- 2 if TIME is after STOP
+7 IF INH<INBEG1
QUIT 1
IF INH>INEND1
QUIT 2
+8 IF $PIECE(INH,",",2)<$PIECE(INBEG1,",",2)
QUIT 1
+9 IF $PIECE(INH,",",2)>$PIECE(INEND1,",",2)
QUIT 2
+10 QUIT 0
+11 ;
