INHRTH1 ;DP; 2 Apr 98 16:16;27 Dec 95 10:39;Throughput analyzer report II
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
PARM() ;Get parameters
;
S DIC=4005,DIC(0)="AEMNQZ"
S POP=0 D DES Q:'Y Q:POP 0
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,X2,IN1 S X2=""
F I=1:1 D Q:POP W:Y=-1&(X2="") "ALL" Q:Y=-1
.D ^DIC S:X[U POP=1 Q:POP Q:+Y<1
.S X(+Y)=$P(^INRHD(+Y,0),U)
.S IN1(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.
; The asking start date
S INABEG=Y
W ! Q:'$$IEN(.STOP," Ending Date: ") 0
; The asking stop date
S INAEND=Y
; Set up the date/time
D GETDATE(.INABEG,.INAEND,.START,.STOP)
Q 1
;
IEN(IEN,ASK) ;read date
;
S %DT="TAEX",%DT("A")=$G(ASK) D ^%DT Q:Y<1 0
Q 1
;
Q
DET ;Detail yes/no
W ! S DET=$$YN^UTSRD("Detailed: ;N")
I DET[U S POP=1 Q
INT ;Read time interval
W !! D ^UTSRD("Time interval: ;1.4AN;;;60 ;;;;;INTM","Enter 1 to 60 Minutes Or 1H to 24H for Hours. ") I 'INTM S POP=1 Q
D PAGES
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 !,"Status(s): " F I=1:1:$L(ST) W ?13,$P($P(X3,$E(ST,I)_":",2),";"),!
W !,"From: ",$$CDATASC^%ZTFDT($E(INABEG,1,12),3,1)
W !," To: ",$$CDATASC^%ZTFDT($E(INAEND,1,12),3,1),!
W !,"Detail: ",$S(DET=1:"Yes",1:"No"),!
W !,"Time intervals: ",INTM W $S(INTM["H":"r",1:"Minutes") W !!
W "This report is about ",PAGES," page" W:PAGES>1 "s" W " long",!!
S Z=$$CR^UTSRD
I Z 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
; INTM = time interval
;
S INLOAD=ST_U_DET_U_X2_U_INBEG_U_INEND_U_INTM_U_INABEG_U_INAEND
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: ","^D ST0^INHRTH1") 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
ST0 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.
; INLN(3) = line 1
; INLN(4) = line 2
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_", "
F I=1:1:$L(ST) S X3=X3_$P($P(X,$E(ST,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)\2) S X4=$P(X4,",",(I+1),99) Q
S INLN(3)=X3,INLN(4)=X4
Q
PAGES ;Calculate number of pages for the report
; time periods * destenations * number of statuses * number of days \ 55
S X=INTM S:INTM["H" X=INTM*60
S X=1440\X*($S(DET:$L(ST),1:1))
S X=X*($S(X2[",":$L(X2,",")-1,1:$P(^INRHD(0),U,4)))
S X=X*($$CDATF2H^%ZTFDT(INEND)-$$CDATF2H^%ZTFDT(INBEG))
S PAGES=X\55 S:PAGES<1 PAGES=1
Q
;
GETDATE(INASTART,INAEND,INSTART,INEND) ; setup the date/time
; Description: Set the start and end times appropriately
; Return: None
; Parameters:
; INASTART = The asking start date from user
; INAEND = The asking end date from user
; ( must be passed in by reference because they will
; be adjusted, i.e. INAEND=T will become INAEND=T@2400 )
; INSTART = The reference start date to be searched in ^INTHU
; INEND = The reference end date to be searched in ^INTHU
;
; Code Begins:
N INTEMP
S INEND=$G(INAEND),INSTART=$G(INASTART)
S:'INEND!(INEND=DT) INEND=DT_".24"
; Take care a special case (start date T-1@0800 and end date t-1)
S:(INEND\1=INEND)&(INSTART\1=INEND) INEND=INEND+.24
I (INEND-INSTART)<0 D
. ; a RECENT to PAST search criteria
. S INTEMP=INSTART,(INASTART,INSTART)=INEND
. S:((INSTART\1)=INSTART) INSTART=INSTART-.0000001
. I (INTEMP\1)=INTEMP S INEND=INTEMP+.999999,INAEND=INTEMP+.24
. I (INTEMP\1)'=INTEMP S (INAEND,INEND)=INTEMP
E D
. ; a PAST to RECENT search criteria
. I ((INEND\1)=INEND) S INAEND=INEND+.24,INEND=INEND+.999999
. E S INAEND=INEND,INEND=INEND+.000099 ; Because second resolution can not be entered
. S INASTART=INSTART,INSTART=INSTART-.0000001
; At this point, INSTART AND INEND are defined, however we need
; to look it up in ^INTHU for the existing date value
S INSTART=INSTART-3
S INSTART=$O(^INTHU("B",INSTART))
S INEND=$O(^INTHU("B",INEND),-1)
; if start date is not found, set it to end date. This only
; happened if start date is greater than the latest date in ^INTHU
I '$G(INSTART) S INSTART=INEND
; if end date is not found, set it to start date. This only happened
; when end date is smaller than the earliest date in ^INTHU
I '$G(INEND) S INEND=INSTART
Q
INHRTH1 ;DP; 2 Apr 98 16:16;27 Dec 95 10:39;Throughput analyzer report II
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
PARM() ;Get parameters
+1 ;
+2 SET DIC=4005
SET DIC(0)="AEMNQZ"
+3 SET POP=0
DO DES
IF 'Y
QUIT
IF POP
QUIT 0
+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,X2,IN1
SET X2=""
+2 FOR I=1:1
Begin DoDot:1
+3 DO ^DIC
IF X[U
SET POP=1
IF POP
QUIT
IF +Y<1
QUIT
+4 SET X(+Y)=$PIECE(^INRHD(+Y,0),U)
+5 SET IN1(X(+Y))=""
SET X2=X2_(+Y)_","
End DoDot:1
IF POP
QUIT
IF Y=-1&(X2="")
WRITE "ALL"
IF Y=-1
QUIT
+6 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 ; The asking start date
+6 SET INABEG=Y
+7 WRITE !
IF '$$IEN(.STOP," Ending Date
QUIT 0
+8 ; The asking stop date
+9 SET INAEND=Y
+10 ; Set up the date/time
+11 DO GETDATE(.INABEG,.INAEND,.START,.STOP)
+12 QUIT 1
+13 ;
IEN(IEN,ASK) ;read date
+1 ;
+2 SET %DT="TAEX"
SET %DT("A")=$GET(ASK)
DO ^%DT
IF Y<1
QUIT 0
+3 QUIT 1
+4 ;
+5 QUIT
DET ;Detail yes/no
+1 WRITE !
SET DET=$$YN^UTSRD("Detailed: ;N")
+2 IF DET[U
SET POP=1
QUIT
INT ;Read time interval
+1 WRITE !!
DO ^UTSRD("Time interval: ;1.4AN;;;60 ;;;;;INTM","Enter 1 to 60 Minutes Or 1H to 24H for Hours. ")
IF 'INTM
SET POP=1
QUIT
+2 DO PAGES
+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 ;W !,"Status(s): " F I=1:1:$L(ST) W ?13,$P($P(X3,";",I),":",2),!
+6 WRITE !,"Status(s): "
FOR I=1:1:$LENGTH(ST)
WRITE ?13,$PIECE($PIECE(X3,$EXTRACT(ST,I)_":",2),";"),!
+7 WRITE !,"From: ",$$CDATASC^%ZTFDT($EXTRACT(INABEG,1,12),3,1)
+8 WRITE !," To: ",$$CDATASC^%ZTFDT($EXTRACT(INAEND,1,12),3,1),!
+9 WRITE !,"Detail: ",$SELECT(DET=1:"Yes",1:"No"),!
+10 WRITE !,"Time intervals: ",INTM
WRITE $SELECT(INTM["H":"r",1:"Minutes")
WRITE !!
+11 WRITE "This report is about ",PAGES," page"
IF PAGES>1
WRITE "s"
WRITE " long",!!
+12 SET Z=$$CR^UTSRD
+13 IF Z
SET POP=1
QUIT
+14 ; taskman variables
+15 ; ST = status string
+16 ; X = detail 1 yes 0 no
+17 ; X2 = destination list (IEN,...)
+18 ; INBEG = beginning date@time
+19 ; INEND = ending date@time
+20 ; INTM = time interval
+21 ;
+22 SET INLOAD=ST_U_DET_U_X2_U_INBEG_U_INEND_U_INTM_U_INABEG_U_INAEND
+23 WRITE !
QUIT
+24 ;
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: ","^D ST0^INHRTH1")
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
ST0 NEW I
WRITE !,"Please select from:"
+1 FOR I=1:1:$LENGTH(X1)
WRITE !," ",$PIECE($PIECE(X3,";",I),":")," ",$PIECE($PIECE(X3,";",I),":",2)
+2 WRITE !," ALL"
+3 IF $$CR^UTSRD
SET POP=1
+4 QUIT
ST1 ;get the status string to be printed as part of the header.
+1 ; INLN(3) = line 1
+2 ; INLN(4) = line 2
+3 NEW I
+4 SET X=$PIECE(^DD(4001,.03,0),U,3,99)
SET (X3,X4)=""
+5 ;F I=1:1:$L(ST) S X3=X3_$P($P(X,";",I),":",2) S:I<$L(ST) X3=X3_", "
+6 FOR I=1:1:$LENGTH(ST)
SET X3=X3_$PIECE($PIECE(X,$EXTRACT(ST,I)_":",2),";")
IF I<$LENGTH(ST)
SET X3=X3_", "
+7 IF $LENGTH(X3)>(IOM-8)
SET X4=X3
Begin DoDot:1
+8 FOR I=$LENGTH(X4,","):-1
SET X3=$PIECE(X4,",",1,I)
IF $LENGTH(X3)<((IOM+8)\2)
SET X4=$PIECE(X4,",",(I+1),99)
QUIT
End DoDot:1
+9 SET INLN(3)=X3
SET INLN(4)=X4
+10 QUIT
PAGES ;Calculate number of pages for the report
+1 ; time periods * destenations * number of statuses * number of days \ 55
+2 SET X=INTM
IF INTM["H"
SET X=INTM*60
+3 SET X=1440\X*($SELECT(DET:$LENGTH(ST),1:1))
+4 SET X=X*($SELECT(X2[",":$LENGTH(X2,",")-1,1:$PIECE(^INRHD(0),U,4)))
+5 SET X=X*($$CDATF2H^%ZTFDT(INEND)-$$CDATF2H^%ZTFDT(INBEG))
+6 SET PAGES=X\55
IF PAGES<1
SET PAGES=1
+7 QUIT
+8 ;
GETDATE(INASTART,INAEND,INSTART,INEND) ; setup the date/time
+1 ; Description: Set the start and end times appropriately
+2 ; Return: None
+3 ; Parameters:
+4 ; INASTART = The asking start date from user
+5 ; INAEND = The asking end date from user
+6 ; ( must be passed in by reference because they will
+7 ; be adjusted, i.e. INAEND=T will become INAEND=T@2400 )
+8 ; INSTART = The reference start date to be searched in ^INTHU
+9 ; INEND = The reference end date to be searched in ^INTHU
+10 ;
+11 ; Code Begins:
+12 NEW INTEMP
+13 SET INEND=$GET(INAEND)
SET INSTART=$GET(INASTART)
+14 IF 'INEND!(INEND=DT)
SET INEND=DT_".24"
+15 ; Take care a special case (start date T-1@0800 and end date t-1)
+16 IF (INEND\1=INEND)&(INSTART\1=INEND)
SET INEND=INEND+.24
+17 IF (INEND-INSTART)<0
Begin DoDot:1
+18 ; a RECENT to PAST search criteria
+19 SET INTEMP=INSTART
SET (INASTART,INSTART)=INEND
+20 IF ((INSTART\1)=INSTART)
SET INSTART=INSTART-.0000001
+21 IF (INTEMP\1)=INTEMP
SET INEND=INTEMP+.999999
SET INAEND=INTEMP+.24
+22 IF (INTEMP\1)'=INTEMP
SET (INAEND,INEND)=INTEMP
End DoDot:1
+23 IF '$TEST
Begin DoDot:1
+24 ; a PAST to RECENT search criteria
+25 IF ((INEND\1)=INEND)
SET INAEND=INEND+.24
SET INEND=INEND+.999999
+26 ; Because second resolution can not be entered
IF '$TEST
SET INAEND=INEND
SET INEND=INEND+.000099
+27 SET INASTART=INSTART
SET INSTART=INSTART-.0000001
End DoDot:1
+28 ; At this point, INSTART AND INEND are defined, however we need
+29 ; to look it up in ^INTHU for the existing date value
+30 SET INSTART=INSTART-3
+31 SET INSTART=$ORDER(^INTHU("B",INSTART))
+32 SET INEND=$ORDER(^INTHU("B",INEND),-1)
+33 ; if start date is not found, set it to end date. This only
+34 ; happened if start date is greater than the latest date in ^INTHU
+35 IF '$GET(INSTART)
SET INSTART=INEND
+36 ; if end date is not found, set it to start date. This only happened
+37 ; when end date is smaller than the earliest date in ^INTHU
+38 IF '$GET(INEND)
SET INEND=INSTART
+39 QUIT
