INHRTZ ;DP; 5 Jan 96 08:54;27 Dec 95 10:39;Throughput analyzer report
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
EN ;Main entry point
N DES,N,I,X,INLOAD,DET,INBEG,INEND,INENDX
W @IOF Q:'$$PARM
;Device handling & Tasking logic
K IOP S %ZIS("A")="QUEUE ON DEVICE: ",%ZIS("B")="",%ZIS="NQ"
D ^%ZIS G:POP QUIT
S IOP=ION_";"_IOST_";"_IOM_";"_IOSL
I IO=IO(0) S %ZIS="" D ^%ZIS I POP W *7,!,"Sorry, unable to find device..." G QUIT
I IO'=IO(0) D G QUIT
.S ZTDESC="Throughput analyzer report",ZTIO=IOP,ZTRTN="ENQUE^INHRTZ"
.S ZTSAVE("INLOAD")=INLOAD
.D ^%ZTLOAD
ENQUE ;Taskman entry point
K ^UTILITY($J)
S ST=$P(INLOAD,U),DET=$P(INLOAD,U,2),DES=$P(INLOAD,U,3)
S INBEG=$P(INLOAD,U,4),INEND=$P(INLOAD,U,5)
; INDES flag for destination list
; 1 List
; 0 All destinations
S INDES=0 I $L(DES)>1 S INDES=1 D
.F I=1:1:$L(DES,",")-1 S X=$P(DES,",",I),DES(X)=$P(^INRHD(X,0),U)
S PAG=1,X1=0,DV=1
D COMP,DEV,OUTPUT
F I=$Y:1:(IOSL-1) W !
S X="*** End of Report ***" W ?IOM-$L(X)\2,X
K ^UTILITY($J)
;
QUIT ;Exit point
D ^%ZISC
Q
;
COMP ;Compile statistics
;
; C = holder of creation totals
; T = holder of transmission totals
;
S LOOP=$O(^INTHU("B",INBEG,"")),C="CC",T="TT"
; get the last internal number for the ending date
S INENDX=$O(^INTHU("B",INEND,""))-1
F CNT=1:1 S LOOP=$O(^INTHU(LOOP)) Q:'LOOP!(LOOP>INENDX) D
. I IO=$P W:'(CNT#1000) "."
. S ZE=$G(^INTHU(LOOP,0))
. ; quit if date is out of range
. Q:+ZE>INEND
. ; message creation date
. S MSGDTTM=+$E($P(ZE,U),1,10)
. ; get destination
. S DES=$P(ZE,U,2) Q:DES=""
. ;quit if destination is not on the selected array.
. I INDES Q:'$D(DES(DES))
. ;for message that was created befor the begining date make
. ;sure to quit if no work was done later.
. I +ZE<INBEG Q:$P(ZE,U,14)<INBEG D MULT Q
. ;
. ;Quit if status is not part of the selection string
. Q:$F(ST,$P(ZE,U,3))<2
. S STAT=$P(ZE,U,3)
. S ^UTILITY($J,MSGDTTM,C)=$G(^UTILITY($J,MSGDTTM,C))+1 S:^(C)>DV DV=^(C)
. ;stor details only if detail flag DET is on.
. I DET S ^UTILITY($J,MSGDTTM,DES,STAT,C)=$G(^UTILITY($J,MSGDTTM,DES,STAT,C))+1 S:^(C)>DV DV=^(C)
. D MULT
Q
MULT ; Look for activity on the multiple level
S ACT=0
F ACTLOOP=0:1 S ACT=$O(^INTHU(LOOP,1,ACT)) Q:'ACT&ACTLOOP D
.S ACTZE=""
.S:ACT ACTZE=$G(^INTHU(LOOP,1,ACT,0))
.; Get status
.Q:$F(ST,$P(ACTZE,U,2))<2 S STAT=$P(ACTZE,U,2)
.; Quit if messages has no date/time.
.Q:+ACTZE=0 S DTTM=$P(ACTZE,U)
.Q:DTTM>INEND
.S DTTM=+$E(DTTM,1,10)
.S ^UTILITY($J,DTTM,T)=$G(^UTILITY($J,DTTM,T))+1 S:^(T)>DV DV=^(T)
. ;stor details only if detail flag DET is on.
.Q:'DET
.S ^UTILITY($J,DTTM,DES,STAT,T)=$G(^UTILITY($J,DTTM,DES,STAT,T))+1 S:^(T)>DV DV=^(T)
Q
;
OUTPUT ;Output data
S (DT1,DTTM)=0,ASTRX="",$P(ASTRX,"*",80)=""
F S DTTM=$O(^UTILITY($J,DTTM)) Q:DTTM="" D
.D DT S FLG=1 F I=C,T D @I
.; quit here if this is not a detailed report
.Q:'DET W !
.S FLG=0,DES=""
.F S DES=$O(^UTILITY($J,DTTM,DES)) Q:DES="" D W:$X>20 !
..; display destination
..Q:DES'?.N I $Y>(IOSL-2) D HDR,DT
..W:$X>50 ! W ?15,$E($P(^INRHD(DES,0),U),1,30)
..; display status
..S ST="" F S ST=$O(^UTILITY($J,DTTM,DES,ST)) Q:ST="" D
...Q:ST'?1A W:$X>50 !
...I $Y>(IOSL-2) S DT1="" D HDR,DT
...W ?46,ST
...F I=C,T S X=$G(^UTILITY($J,DTTM,DES,ST,I)) D @I
.I $Y>IOSL D HDR,DT
Q
;
CC ;Dsplay details for creation rate
I $Y>IOSL S DT1="" D HDR,DT
I FLG S X=$G(^UTILITY($J,DTTM,I))
Q:X="" S P=54 S:'DET P=22 W ?(P-$L(X)),X
; display the astrics line
S X=$E(ASTRX,1,$J(X/DV,0,0)) S:'$L(X) X="*"
S:$L(X)>SE X=$E(X,1,(SE-2))_">>" W ?(P+2),X
Q
TT ;Display details for transmission rate
N X0 I FLG S X=$G(^UTILITY($J,DTTM,I))
Q:X="" S X0=X,X=$E(ASTRX,1,$J(X/DV,0,0))
S:'$L(X) X="*" S:$L(X)>SE X="<<"_$E(X,1,(SE-2))
S X=X_$J(X0,7) W ?(IOM-1)-$L(X),X
Q
DT ;Print date time
I $Y>(IOSL-3) S DT1="" D HDR
S DT2=$$CDATASC^%ZTFDT(DTTM,2,1)
I DT1'=$P(DTTM,".") S DT1=$P(DTTM,".") W !,$P(DT2,"@")
W:'DET!($X>55) ! W ?9,$P(DT2,"@",2)
Q
;
DEV ;Calculate the devisor
S SE=16 I 'DET S DV=DV/2,SE=31
S DV=$S(DV>9000:1000,DV>4500:500,DV>1900:250,DV>900:100,1:25)
;
; Set header
S X=$$CDATASC^%ZTFDT($H,1,1),X(0)=X_" Page "
S X(1)="Throughput analyzer report" I DET S X(1)=X(1)_" - Detailed"
S X="From: "_$$CDATASC^%ZTFDT($E(INBEG,1,10),3,1)
S X(2)=X_" To: "_$$CDATASC^%ZTFDT($E(INEND,1,10),3,1)
D ST1 S X(3)="Status: "_X3
S X(5)="Divisor: "_DV
;get the site name
S X(6)=$S($D(^DIC(4,^DD("SITE",1),0)):^(0),1:^DD("SITE"))
S X(6)=$S($P(X(6),U,4)]"":$P(X(6),U,4),1:$P(X(6),U,1))
S LN="",$P(LN,"-",IOM)=""
;
HDR ;Print header
W @IOF,!,X(6)
S X=X(0)_PAG,PAG=PAG+1,DT1=""
W ?IOM-$L(X)-2,X,!!
F I=1:1:4 I $G(X(I))'="" W !?IOM-$L(X(I))\2,X(I)
W !,"Destination:" D
.I 'INDES W " All",! Q
.S II="" F S II=$O(DES(II)) Q:II="" W !?14,DES(II)
W !!,X(5),!!,LN
W !," Date Time" W:DET ?15,"Destination"
W:DET ?42,"Status"
S P=15 S:DET P=40 W !?P,"Creation Rates "
S X="Transmission Rates" W ?IOM-$L(X)-2,X
W !,LN
Q
;
PARM() ;Get parameters
;
S DIC=4005,DIC(0)="AEMNQZ"
D DES Q:'Y
S (INBEG,INEND)=0
Q:'$$GETRNG(.INBEG,.INEND) 0
S POP=0 D STU Q:POP 0
I ST="" S ST=X1 W "ALL"
D DET Q:POP 0
Q 1
;
DES ;Get multiple destinations
K X,X1,X2 S X2="" F I=1:1 D W:Y=-1&(X2="") "ALL" Q:Y=-1
.D ^DIC Q:+Y<1
.S X(+Y)=$P(^INRHD(+Y,0),U)
.S X1(X(+Y))="",X2=X2_(+Y)_","
Q
GETRNG(START,STOP) ;get start & stop dates
;
S START=1,STOP=999999999
W ! Q:'$$IEN(.START,"Starting Date: ") 0
; search starts on the previous day at midnight.
S INBEG=$O(^INTHU("B",($P(Y,".")-2)_".999999"))
W ! Q:'$$IEN(.STOP," Ending Date: ") 0
;Ending date
S INEND=$O(^INTHU("B",($P(IEN2,".")_".999999")),-1)
S:INEND<INBEG INEND=INBEG
Q 1
;
IEN(IEN,ASK) ;read date
;
S %DT="TAEX",%DT("A")=$G(ASK) D ^%DT Q:Y<1 0
S IEN=$Q(^INTHU("B",Y,0))
I $QS(IEN,1)'="B" S IEN="^INTHU(""B"",3000101,9999999999999)"
S (IEN,IEN2)=$QS(IEN,2)
Q 1
;
Q
DET ;Detail yes/no
W ! S X=$$YN^UTSRD("Detailed: ;N")
I X[U S POP=1 Q
W @IOF,!,"Destination: " I $L(X2)=0 W "All "
E F I=1:1:$L(X2,",")-1 W ?13,$P(^INRHD($P(X2,",",I),0),U),!
W !,"Status(s): " F I=1:1:$L(ST) W ?13,$P($P(X3,";",I),":",2),!
W !,"From: ",$$CDATASC^%ZTFDT($E(INBEG,1,10),3,1)
W !," To: ",$$CDATASC^%ZTFDT($E(INEND,1,10),3,1),!
W !,"Detail: ",$S(X=1:"Yes",1:"No"),!!
S Z=$$YN^UTSRD("O.K To continue? ")
I Z[U!(Z=0) S POP=1 Q
; taskman variables
; ST = status string
; X = detail 1 yes 0 no
; X2 = destination list (IEN,...)
; INBEG = beginning date@time
; INEND = ending date@time
;
S INLOAD=ST_U_X_U_X2_U_INBEG_U_INEND
W ! Q
;
STU ;Build status string
N I,C S (X1,ST)=""
S X3=$P(^DD(4001,.03,0),U,3,99)
F I=1:1:$L(X3,":")-1 S X1=X1_$P($P(X3,";",I),":")
W ! F I=1:1 D ST Q:C=""!(POP)
Q
ST ;Display status list
W ! D ^UTSRD("Status: ") Q:POP
S C=X Q:C=""
I C=U S POP=1 Q
I C="ALL" S ST=X1,C="" Q
; enter a "-" to remove an item
I C["-",$L(ST)>0 S C=$E(C,2) D Q
.S ST=$E(ST,1,($F(ST,C)-2))_$E(ST,($F(ST,C)),99)
I X1[(C) W " ",$P($P(X3,";",($F(X1,C)-1)),":",2) S ST=ST_C Q
N I W !,"Please select from:"
F I=1:1:$L(X1) W !," ",$P($P(X3,";",I),":")," ",$P($P(X3,";",I),":",2)
W !," ALL"
S:$$CR^UTSRD POP=1
Q
ST1 ;get the status string to be printed as part of the header.
N I
S X=$P(^DD(4001,.03,0),U,3,99),(X3,X4)=""
F I=1:1:$L(ST) S X3=X3_$P($P(X,";",I),":",2) S:I<$L(ST) X3=X3_", "
I $L(X3)>(IOM-8) S X4=X3 D
.F I=$L(X4,","):-1 S X3=$P(X4,",",1,I) I $L(X3)<(IOM-8) S X4=$P(X4,",",(I+1),99) Q
S X(3)=X3,X(4)=X4
Q
INHRTZ ;DP; 5 Jan 96 08:54;27 Dec 95 10:39;Throughput analyzer report
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
EN ;Main entry point
+1 NEW DES,N,I,X,INLOAD,DET,INBEG,INEND,INENDX
+2 WRITE @IOF
IF '$$PARM
QUIT
+3 ;Device handling & Tasking logic
+4 KILL IOP
SET %ZIS("A")="QUEUE ON DEVICE: "
SET %ZIS("B")=""
SET %ZIS="NQ"
+5 DO ^%ZIS
IF POP
GOTO QUIT
+6 SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
+7 IF IO=IO(0)
SET %ZIS=""
DO ^%ZIS
IF POP
WRITE *7,!,"Sorry, unable to find device..."
GOTO QUIT
+8 IF IO'=IO(0)
Begin DoDot:1
+9 SET ZTDESC="Throughput analyzer report"
SET ZTIO=IOP
SET ZTRTN="ENQUE^INHRTZ"
+10 SET ZTSAVE("INLOAD")=INLOAD
+11 DO ^%ZTLOAD
End DoDot:1
GOTO QUIT
ENQUE ;Taskman entry point
+1 KILL ^UTILITY($JOB)
+2 SET ST=$PIECE(INLOAD,U)
SET DET=$PIECE(INLOAD,U,2)
SET DES=$PIECE(INLOAD,U,3)
+3 SET INBEG=$PIECE(INLOAD,U,4)
SET INEND=$PIECE(INLOAD,U,5)
+4 ; INDES flag for destination list
+5 ; 1 List
+6 ; 0 All destinations
+7 SET INDES=0
IF $LENGTH(DES)>1
SET INDES=1
Begin DoDot:1
+8 FOR I=1:1:$LENGTH(DES,",")-1
SET X=$PIECE(DES,",",I)
SET DES(X)=$PIECE(^INRHD(X,0),U)
End DoDot:1
+9 SET PAG=1
SET X1=0
SET DV=1
+10 DO COMP
DO DEV
DO OUTPUT
+11 FOR I=$Y:1:(IOSL-1)
WRITE !
+12 SET X="*** End of Report ***"
WRITE ?IOM-$LENGTH(X)\2,X
+13 KILL ^UTILITY($JOB)
+14 ;
QUIT ;Exit point
+1 DO ^%ZISC
+2 QUIT
+3 ;
COMP ;Compile statistics
+1 ;
+2 ; C = holder of creation totals
+3 ; T = holder of transmission totals
+4 ;
+5 SET LOOP=$ORDER(^INTHU("B",INBEG,""))
SET C="CC"
SET T="TT"
+6 ; get the last internal number for the ending date
+7 SET INENDX=$ORDER(^INTHU("B",INEND,""))-1
+8 FOR CNT=1:1
SET LOOP=$ORDER(^INTHU(LOOP))
IF 'LOOP!(LOOP>INENDX)
QUIT
Begin DoDot:1
+9 IF IO=$PRINCIPAL
IF '(CNT#1000)
WRITE "."
+10 SET ZE=$GET(^INTHU(LOOP,0))
+11 ; quit if date is out of range
+12 IF +ZE>INEND
QUIT
+13 ; message creation date
+14 SET MSGDTTM=+$EXTRACT($PIECE(ZE,U),1,10)
+15 ; get destination
+16 SET DES=$PIECE(ZE,U,2)
IF DES=""
QUIT
+17 ;quit if destination is not on the selected array.
+18 IF INDES
IF '$DATA(DES(DES))
QUIT
+19 ;for message that was created befor the begining date make
+20 ;sure to quit if no work was done later.
+21 IF +ZE<INBEG
IF $PIECE(ZE,U,14)<INBEG
QUIT
DO MULT
QUIT
+22 ;
+23 ;Quit if status is not part of the selection string
+24 IF $FIND(ST,$PIECE(ZE,U,3))<2
QUIT
+25 SET STAT=$PIECE(ZE,U,3)
+26 SET ^UTILITY($JOB,MSGDTTM,C)=$GET(^UTILITY($JOB,MSGDTTM,C))+1
IF ^(C)>DV
SET DV=^(C)
+27 ;stor details only if detail flag DET is on.
+28 IF DET
SET ^UTILITY($JOB,MSGDTTM,DES,STAT,C)=$GET(^UTILITY($JOB,MSGDTTM,DES,STAT,C))+1
IF ^(C)>DV
SET DV=^(C)
+29 DO MULT
End DoDot:1
+30 QUIT
MULT ; Look for activity on the multiple level
+1 SET ACT=0
+2 FOR ACTLOOP=0:1
SET ACT=$ORDER(^INTHU(LOOP,1,ACT))
IF 'ACT&ACTLOOP
QUIT
Begin DoDot:1
+3 SET ACTZE=""
+4 IF ACT
SET ACTZE=$GET(^INTHU(LOOP,1,ACT,0))
+5 ; Get status
+6 IF $FIND(ST,$PIECE(ACTZE,U,2))<2
QUIT
SET STAT=$PIECE(ACTZE,U,2)
+7 ; Quit if messages has no date/time.
+8 IF +ACTZE=0
QUIT
SET DTTM=$PIECE(ACTZE,U)
+9 IF DTTM>INEND
QUIT
+10 SET DTTM=+$EXTRACT(DTTM,1,10)
+11 SET ^UTILITY($JOB,DTTM,T)=$GET(^UTILITY($JOB,DTTM,T))+1
IF ^(T)>DV
SET DV=^(T)
+12 ;stor details only if detail flag DET is on.
+13 IF 'DET
QUIT
+14 SET ^UTILITY($JOB,DTTM,DES,STAT,T)=$GET(^UTILITY($JOB,DTTM,DES,STAT,T))+1
IF ^(T)>DV
SET DV=^(T)
End DoDot:1
+15 QUIT
+16 ;
OUTPUT ;Output data
+1 SET (DT1,DTTM)=0
SET ASTRX=""
SET $PIECE(ASTRX,"*",80)=""
+2 FOR
SET DTTM=$ORDER(^UTILITY($JOB,DTTM))
IF DTTM=""
QUIT
Begin DoDot:1
+3 DO DT
SET FLG=1
FOR I=C,T
DO @I
+4 ; quit here if this is not a detailed report
+5 IF 'DET
QUIT
WRITE !
+6 SET FLG=0
SET DES=""
+7 FOR
SET DES=$ORDER(^UTILITY($JOB,DTTM,DES))
IF DES=""
QUIT
Begin DoDot:2
+8 ; display destination
+9 IF DES'?.N
QUIT
IF $Y>(IOSL-2)
DO HDR
DO DT
+10 IF $X>50
WRITE !
WRITE ?15,$EXTRACT($PIECE(^INRHD(DES,0),U),1,30)
+11 ; display status
+12 SET ST=""
FOR
SET ST=$ORDER(^UTILITY($JOB,DTTM,DES,ST))
IF ST=""
QUIT
Begin DoDot:3
+13 IF ST'?1A
QUIT
IF $X>50
WRITE !
+14 IF $Y>(IOSL-2)
SET DT1=""
DO HDR
DO DT
+15 WRITE ?46,ST
+16 FOR I=C,T
SET X=$GET(^UTILITY($JOB,DTTM,DES,ST,I))
DO @I
End DoDot:3
End DoDot:2
IF $X>20
WRITE !
+17 IF $Y>IOSL
DO HDR
DO DT
End DoDot:1
+18 QUIT
+19 ;
CC ;Dsplay details for creation rate
+1 IF $Y>IOSL
SET DT1=""
DO HDR
DO DT
+2 IF FLG
SET X=$GET(^UTILITY($JOB,DTTM,I))
+3 IF X=""
QUIT
SET P=54
IF 'DET
SET P=22
WRITE ?(P-$LENGTH(X)),X
+4 ; display the astrics line
+5 SET X=$EXTRACT(ASTRX,1,$JUSTIFY(X/DV,0,0))
IF '$LENGTH(X)
SET X="*"
+6 IF $LENGTH(X)>SE
SET X=$EXTRACT(X,1,(SE-2))_">>"
WRITE ?(P+2),X
+7 QUIT
TT ;Display details for transmission rate
+1 NEW X0
IF FLG
SET X=$GET(^UTILITY($JOB,DTTM,I))
+2 IF X=""
QUIT
SET X0=X
SET X=$EXTRACT(ASTRX,1,$JUSTIFY(X/DV,0,0))
+3 IF '$LENGTH(X)
SET X="*"
IF $LENGTH(X)>SE
SET X="<<"_$EXTRACT(X,1,(SE-2))
+4 SET X=X_$JUSTIFY(X0,7)
WRITE ?(IOM-1)-$LENGTH(X),X
+5 QUIT
DT ;Print date time
+1 IF $Y>(IOSL-3)
SET DT1=""
DO HDR
+2 SET DT2=$$CDATASC^%ZTFDT(DTTM,2,1)
+3 IF DT1'=$PIECE(DTTM,".")
SET DT1=$PIECE(DTTM,".")
WRITE !,$PIECE(DT2,"@")
+4 IF 'DET!($X>55)
WRITE !
WRITE ?9,$PIECE(DT2,"@",2)
+5 QUIT
+6 ;
DEV ;Calculate the devisor
+1 SET SE=16
IF 'DET
SET DV=DV/2
SET SE=31
+2 SET DV=$SELECT(DV>9000:1000,DV>4500:500,DV>1900:250,DV>900:100,1:25)
+3 ;
+4 ; Set header
+5 SET X=$$CDATASC^%ZTFDT($HOROLOG,1,1)
SET X(0)=X_" Page "
+6 SET X(1)="Throughput analyzer report"
IF DET
SET X(1)=X(1)_" - Detailed"
+7 SET X="From: "_$$CDATASC^%ZTFDT($EXTRACT(INBEG,1,10),3,1)
+8 SET X(2)=X_" To: "_$$CDATASC^%ZTFDT($EXTRACT(INEND,1,10),3,1)
+9 DO ST1
SET X(3)="Status: "_X3
+10 SET X(5)="Divisor: "_DV
+11 ;get the site name
+12 SET X(6)=$SELECT($DATA(^DIC(4,^DD("SITE",1),0)):^(0),1:^DD("SITE"))
+13 SET X(6)=$SELECT($PIECE(X(6),U,4)]"":$PIECE(X(6),U,4),1:$PIECE(X(6),U,1))
+14 SET LN=""
SET $PIECE(LN,"-",IOM)=""
+15 ;
HDR ;Print header
+1 WRITE @IOF,!,X(6)
+2 SET X=X(0)_PAG
SET PAG=PAG+1
SET DT1=""
+3 WRITE ?IOM-$LENGTH(X)-2,X,!!
+4 FOR I=1:1:4
IF $GET(X(I))'=""
WRITE !?IOM-$LENGTH(X(I))\2,X(I)
+5 WRITE !,"Destination:"
Begin DoDot:1
+6 IF 'INDES
WRITE " All",!
QUIT
+7 SET II=""
FOR
SET II=$ORDER(DES(II))
IF II=""
QUIT
WRITE !?14,DES(II)
End DoDot:1
+8 WRITE !!,X(5),!!,LN
+9 WRITE !," Date Time"
IF DET
WRITE ?15,"Destination"
+10 IF DET
WRITE ?42,"Status"
+11 SET P=15
IF DET
SET P=40
WRITE !?P,"Creation Rates "
+12 SET X="Transmission Rates"
WRITE ?IOM-$LENGTH(X)-2,X
+13 WRITE !,LN
+14 QUIT
+15 ;
PARM() ;Get parameters
+1 ;
+2 SET DIC=4005
SET DIC(0)="AEMNQZ"
+3 DO DES
IF 'Y
QUIT
+4 SET (INBEG,INEND)=0
+5 IF '$$GETRNG(.INBEG,.INEND)
QUIT 0
+6 SET POP=0
DO STU
IF POP
QUIT 0
+7 IF ST=""
SET ST=X1
WRITE "ALL"
+8 DO DET
IF POP
QUIT 0
+9 QUIT 1
+10 ;
DES ;Get multiple destinations
+1 KILL X,X1,X2
SET X2=""
FOR I=1:1
Begin DoDot:1
+2 DO ^DIC
IF +Y<1
QUIT
+3 SET X(+Y)=$PIECE(^INRHD(+Y,0),U)
+4 SET X1(X(+Y))=""
SET X2=X2_(+Y)_","
End DoDot:1
IF Y=-1&(X2="")
WRITE "ALL"
IF Y=-1
QUIT
+5 QUIT
GETRNG(START,STOP) ;get start & stop dates
+1 ;
+2 SET START=1
SET STOP=999999999
+3 WRITE !
IF '$$IEN(.START,"Starting Date
QUIT 0
+4 ; search starts on the previous day at midnight.
+5 SET INBEG=$ORDER(^INTHU("B",($PIECE(Y,".")-2)_".999999"))
+6 WRITE !
IF '$$IEN(.STOP," Ending Date
QUIT 0
+7 ;Ending date
+8 SET INEND=$ORDER(^INTHU("B",($PIECE(IEN2,".")_".999999")),-1)
+9 IF INEND<INBEG
SET INEND=INBEG
+10 QUIT 1
+11 ;
IEN(IEN,ASK) ;read date
+1 ;
+2 SET %DT="TAEX"
SET %DT("A")=$GET(ASK)
DO ^%DT
IF Y<1
QUIT 0
+3 SET IEN=$QUERY(^INTHU("B",Y,0))
+4 IF $QSUBSCRIPT(IEN,1)'="B"
SET IEN="^INTHU(""B"",3000101,9999999999999)"
+5 SET (IEN,IEN2)=$QSUBSCRIPT(IEN,2)
+6 QUIT 1
+7 ;
+8 QUIT
DET ;Detail yes/no
+1 WRITE !
SET X=$$YN^UTSRD("Detailed: ;N")
+2 IF X[U
SET POP=1
QUIT
+3 WRITE @IOF,!,"Destination: "
IF $LENGTH(X2)=0
WRITE "All "
+4 IF '$TEST
FOR I=1:1:$LENGTH(X2,",")-1
WRITE ?13,$PIECE(^INRHD($PIECE(X2,",",I),0),U),!
+5 WRITE !,"Status(s): "
FOR I=1:1:$LENGTH(ST)
WRITE ?13,$PIECE($PIECE(X3,";",I),":",2),!
+6 WRITE !,"From: ",$$CDATASC^%ZTFDT($EXTRACT(INBEG,1,10),3,1)
+7 WRITE !," To: ",$$CDATASC^%ZTFDT($EXTRACT(INEND,1,10),3,1),!
+8 WRITE !,"Detail: ",$SELECT(X=1:"Yes",1:"No"),!!
+9 SET Z=$$YN^UTSRD("O.K To continue? ")
+10 IF Z[U!(Z=0)
SET POP=1
QUIT
+11 ; taskman variables
+12 ; ST = status string
+13 ; X = detail 1 yes 0 no
+14 ; X2 = destination list (IEN,...)
+15 ; INBEG = beginning date@time
+16 ; INEND = ending date@time
+17 ;
+18 SET INLOAD=ST_U_X_U_X2_U_INBEG_U_INEND
+19 WRITE !
QUIT
+20 ;
STU ;Build status string
+1 NEW I,C
SET (X1,ST)=""
+2 SET X3=$PIECE(^DD(4001,.03,0),U,3,99)
+3 FOR I=1:1:$LENGTH(X3,":")-1
SET X1=X1_$PIECE($PIECE(X3,";",I),":")
+4 WRITE !
FOR I=1:1
DO ST
IF C=""!(POP)
QUIT
+5 QUIT
ST ;Display status list
+1 WRITE !
DO ^UTSRD("Status: ")
IF POP
QUIT
+2 SET C=X
IF C=""
QUIT
+3 IF C=U
SET POP=1
QUIT
+4 IF C="ALL"
SET ST=X1
SET C=""
QUIT
+5 ; enter a "-" to remove an item
+6 IF C["-"
IF $LENGTH(ST)>0
SET C=$EXTRACT(C,2)
Begin DoDot:1
+7 SET ST=$EXTRACT(ST,1,($FIND(ST,C)-2))_$EXTRACT(ST,($FIND(ST,C)),99)
End DoDot:1
QUIT
+8 IF X1[(C)
WRITE " ",$PIECE($PIECE(X3,";",($FIND(X1,C)-1)),":",2)
SET ST=ST_C
QUIT
+9 NEW I
WRITE !,"Please select from:"
+10 FOR I=1:1:$LENGTH(X1)
WRITE !," ",$PIECE($PIECE(X3,";",I),":")," ",$PIECE($PIECE(X3,";",I),":",2)
+11 WRITE !," ALL"
+12 IF $$CR^UTSRD
SET POP=1
+13 QUIT
ST1 ;get the status string to be printed as part of the header.
+1 NEW I
+2 SET X=$PIECE(^DD(4001,.03,0),U,3,99)
SET (X3,X4)=""
+3 FOR I=1:1:$LENGTH(ST)
SET X3=X3_$PIECE($PIECE(X,";",I),":",2)
IF I<$LENGTH(ST)
SET X3=X3_", "
+4 IF $LENGTH(X3)>(IOM-8)
SET X4=X3
Begin DoDot:1
+5 FOR I=$LENGTH(X4,","):-1
SET X3=$PIECE(X4,",",1,I)
IF $LENGTH(X3)<(IOM-8)
SET X4=$PIECE(X4,",",(I+1),99)
QUIT
End DoDot:1
+6 SET X(3)=X3
SET X(4)=X4
+7 QUIT
