BPSOSUD ;BHAM ISC/FCS/DRS/FLS - utils, some options ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Some utilities.
; Some options- goal is to move them out to other routines
;
Q
;
INCSTAT(N1,P1,N2,P2,N3,P3) ;EP - BPSBUTL,BPSOSQL
; increment the given N nodes at the P pieces
D ADD1STAT(N1,P1,1)
Q:'$D(N2) D ADD1STAT(N2,P2,1)
Q:'$D(N3) D ADD1STAT(N3,P3,1)
Q
ADDSTAT(N1,P1,Q1,N2,P2,Q2,N3,P3,Q3) ;
; add Quantities to given Nodes,Pieces
D ADD1STAT(N1,P1,Q1)
Q:'$D(N2) D ADD1STAT(N2,P2,Q2)
Q:'$D(N3) D ADD1STAT(N3,P3,Q3)
Q
ADD1STAT(N,P,Q) ;
L +^BPSECX("S",1,N):5
I '$D(^BPSECX("S",1,N)) S ^BPSECX("S",1,N)=""
S $P(^BPSECX("S",1,N),U,P)=$P(^BPSECX("S",1,N),U,P)+Q
L -^BPSECX("S",1,N)
Q
;
DATETIME(Y) ;EP - convert fileman date.time to printable
X ^DD("DD") Q Y
TIMEAGO(THEN) ; external form for TIMEAGOI
N %,%H,%I,X D NOW^%DTC Q $$TIMEDIF(THEN,%)
TIMEAGOI(THEN) ; how many seconds ago was it? returns positive value
N %,%H,%I,X D NOW^%DTC ; giving %
Q $$TIMEDIFI(THEN,%)
TIMEDIFI(X1,X2) ;EP - Computed field of BPS Log of Transactions and BPS Transactions
; time difference in seconds, negative if X1>X2
I X1>X2 Q -$$TIMEDIFI(X2,X1)
N %,X,%H,%T,%Y,D1,T1,D2,T2
S X=X1 D H^%DTC S D1=%H,T1=%T
S X=X2 D H^%DTC S D2=%H,T2=%T
S X=D2-D1*86400+T2-T1
Q X
TIMEDIF(X1,X2) ;EP - Computed field of BPS Log of Transactions and BPS Transactions
N X S X=$$TIMEDIFI(X1,X2)
N SGN S SGN=$S(X<0:-1,1:1),X=X*SGN
Q $S(SGN<0:"-",1:"")_$$SECSDHMS(X)
SECSDHMS(X) ;EP - seconds -> # da # hr # min # sec
N % S %=""
I X'<86400 S %=X\86400_" da",X=X#86400
I X'<3600!(%]"") S:%]"" %=%_" " S %=%_(X\3600)_" hr",X=X#3600
I X'<60!(%]"") S:%]"" %=%_" " S %=%_(X\60)_" min",X=X#60
S:%]"" %=%_" " S %=%_X_" sec"
Q %
PRESSANY D PRESSANY^BPSOSU5() Q
CONTINUE(DEF) ;EP -
; returns a single character
; or returns DEF, the default
CONT1 ;
S X=$$FREETEXT^BPSOSU2("Type C to continue or Q to quit: ",,1,1,1,15)
Q X
;
TT() Q "S:Y[""."" Y=$P(Y,""."",2) S Y=Y_""000000"" S Y=""@""_$E(Y,1,2)_"":""_$E(Y,3,4)_"":""_$E(Y,5,6)" ; TT is kind of like ^DD("DD") but just for our times
SHOULDNT W "this should never happen" Q
TDIFNOW(T) ;EP - ; compute time difference between T and NOW
; returns # of seconds, positive if T precedes now (how long ago)
; negative if T follows NOW (countdown "T minus...")
N %,%H,%I,X D NOW^%DTC ; giving %
Q $$TDIF(%,T)
TDIF(T1,T2) ; compute time difference T1-T2 = how many seconds
;T1,T2 both Fileman date.times
S T1=$TR($J(T1,16,8)," ","0"),T2=$TR($J(T2,16,8)," ","0")
N R S R=$P(T1,".")-$P(T2,".")*86400 ; days' difference
S T1=$P(T1,".",2),T2=$P(T2,".",2) ; hhmmsstt
S T1=$E(T1,1,2)*60+$E(T1,3,4)*60+$E(T1,5,6)
S T2=$E(T2,1,2)*60+$E(T2,3,4)*60+$E(T2,5,6)
I $E(T1,7,8) S T1=$E(T1,7,8)/100+T1
I $E(T2,7,8) S T2=$E(T2,7,8)/100+T2
S R=R+T1-T2
Q R
TADDSECS(T1,SECS) ; add SECS seconds to T1
N T2 S T2=$$SECS2T2(SECS)
Q $$TADD(T1,T2)
BADPARAM(VARNAME,ATLABEL) D IMPOSS^BPSOSUE("P,DB","TI","Bad parameter "_VARNAME_"="_$G(@VARNAME),,ATLABEL,$T(+0)) Q
TADDNOWS(SECS) ;EP - add SECS seconds to NOW
I SECS'?1N.N D BADPARAM("SECS","TADDNOWS") Q ""
N T2 S T2=$$SECS2T2(SECS)
Q $$TADDNOW(T2)
SECS2T2(SECS) ; convert integer seconds into a fileman time format
N T2,NEG S NEG=(SECS<0) I NEG S SECS=-SECS
I SECS>86400 S T2=SECS\86400,SECS=SECS#86400_"."
E S T2="."
N % S %=SECS\3600,SECS=SECS#3600 S:$L(%)=1 %="0"_% S T2=T2_%
S %=SECS\60,SECS=SECS#60 S:$L(%)=1 %="0"_% S T2=T2_%
S:$L(SECS)=1 SECS="0"_SECS S T2=T2_SECS
Q $S(NEG:"-",1:"")_T2
TADDNOW(T2) ;EP - ; add T2 time differential to NOW
N %,%H,%I,X D NOW^%DTC ; giving %
Q $$TADD(%,T2)
TADD(T1,T2) ;EP - ; add T2 time differential to T1
I T1<0 D BADPARAM("T1","TADD") Q ; but T2 can be negative
N SGN S SGN=$S(T2<0:-1,1:1),T2=T2*SGN
I SGN<0,T2>T1 D BADPARAM("T2","TADD") Q ; can't handle this case (yet)
S T1=$TR($J(T1,16,8)," ","0"),T2=$TR($J(T2,16,8)," ","0")
N R ;S R=$P(T1,".",1)+($P(T2,".",1)*SGN) ; add days portion
S R=$$CDTC($P(T1,"."),$P(T2,".")*SGN)
S T2=$P(T2,".",2) ; note: without the sign
S T1=$P(T1,".",2)
S T1=$E(T1,1,2)*60+$E(T1,3,4)*60+$E(T1,5,6) ; seconds
S T2=$E(T2,1,2)*60+$E(T2,3,4)*60+$E(T2,5,6) ; seconds
I $E(T1,7,8) S T1=$E(T1,7,8)/100+T1 ; hundredths
I $E(T2,7,8) S T2=$E(T2,7,8)/100+T2 ; hundredths
S T2=T2*SGN ; restore sign to T2's hundredths
N S S S=T1+T2
I S>86400 S S=S-86400,R=$$CDTC(R,1) ; R+1 ; carry
E I S<0 S S=S+86400,R=$$CDTC(R,-1) ; R-1 ; borrow
S T2=S\3600,S=S#3600
S R=R_"."_$TR($J(T2,2)," ","0") ; hours
S T2=S\60,S=S#60
S R=R_$TR($J(T2,2)," ","0") ; minutes
S T2=S\1,S=S#1
S R=R_$TR($J(T2,2)," ","0") ; seconds
S T2=S*100\1,R=R_$TR($J(T2,2)," ","0") ; hundredths of seconds
S R=+R ; removes trailing zeroes
Q R
CDTC(X1,X2) N X,%H D C^%DTC Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSUD 4938 printed Oct 16, 2024@17:53:06 Page 2
BPSOSUD ;BHAM ISC/FCS/DRS/FLS - utils, some options ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Some utilities.
+5 ; Some options- goal is to move them out to other routines
+6 ;
+7 QUIT
+8 ;
INCSTAT(N1,P1,N2,P2,N3,P3) ;EP - BPSBUTL,BPSOSQL
+1 ; increment the given N nodes at the P pieces
+2 DO ADD1STAT(N1,P1,1)
+3 if '$DATA(N2)
QUIT
DO ADD1STAT(N2,P2,1)
+4 if '$DATA(N3)
QUIT
DO ADD1STAT(N3,P3,1)
+5 QUIT
ADDSTAT(N1,P1,Q1,N2,P2,Q2,N3,P3,Q3) ;
+1 ; add Quantities to given Nodes,Pieces
+2 DO ADD1STAT(N1,P1,Q1)
+3 if '$DATA(N2)
QUIT
DO ADD1STAT(N2,P2,Q2)
+4 if '$DATA(N3)
QUIT
DO ADD1STAT(N3,P3,Q3)
+5 QUIT
ADD1STAT(N,P,Q) ;
+1 LOCK +^BPSECX("S",1,N):5
+2 IF '$DATA(^BPSECX("S",1,N))
SET ^BPSECX("S",1,N)=""
+3 SET $PIECE(^BPSECX("S",1,N),U,P)=$PIECE(^BPSECX("S",1,N),U,P)+Q
+4 LOCK -^BPSECX("S",1,N)
+5 QUIT
+6 ;
DATETIME(Y) ;EP - convert fileman date.time to printable
+1 XECUTE ^DD("DD")
QUIT Y
TIMEAGO(THEN) ; external form for TIMEAGOI
+1 NEW %,%H,%I,X
DO NOW^%DTC
QUIT $$TIMEDIF(THEN,%)
TIMEAGOI(THEN) ; how many seconds ago was it? returns positive value
+1 ; giving %
NEW %,%H,%I,X
DO NOW^%DTC
+2 QUIT $$TIMEDIFI(THEN,%)
TIMEDIFI(X1,X2) ;EP - Computed field of BPS Log of Transactions and BPS Transactions
+1 ; time difference in seconds, negative if X1>X2
+2 IF X1>X2
QUIT -$$TIMEDIFI(X2,X1)
+3 NEW %,X,%H,%T,%Y,D1,T1,D2,T2
+4 SET X=X1
DO H^%DTC
SET D1=%H
SET T1=%T
+5 SET X=X2
DO H^%DTC
SET D2=%H
SET T2=%T
+6 SET X=D2-D1*86400+T2-T1
+7 QUIT X
TIMEDIF(X1,X2) ;EP - Computed field of BPS Log of Transactions and BPS Transactions
+1 NEW X
SET X=$$TIMEDIFI(X1,X2)
+2 NEW SGN
SET SGN=$SELECT(X<0:-1,1:1)
SET X=X*SGN
+3 QUIT $SELECT(SGN<0:"-",1:"")_$$SECSDHMS(X)
SECSDHMS(X) ;EP - seconds -> # da # hr # min # sec
+1 NEW %
SET %=""
+2 IF X'<86400
SET %=X\86400_" da"
SET X=X#86400
+3 IF X'<3600!(%]"")
if %]""
SET %=%_" "
SET %=%_(X\3600)_" hr"
SET X=X#3600
+4 IF X'<60!(%]"")
if %]""
SET %=%_" "
SET %=%_(X\60)_" min"
SET X=X#60
+5 if %]""
SET %=%_" "
SET %=%_X_" sec"
+6 QUIT %
PRESSANY DO PRESSANY^BPSOSU5()
QUIT
CONTINUE(DEF) ;EP -
+1 ; returns a single character
+2 ; or returns DEF, the default
CONT1 ;
+1 SET X=$$FREETEXT^BPSOSU2("Type C to continue or Q to quit: ",,1,1,1,15)
+2 QUIT X
+3 ;
TT() ; TT is kind of like ^DD("DD") but just for our times
QUIT "S:Y[""."" Y=$P(Y,""."",2) S Y=Y_""000000"" S Y=""@""_$E(Y,1,2)_"":""_$E(Y,3,4)_"":""_$E(Y,5,6)"
SHOULDNT WRITE "this should never happen"
QUIT
TDIFNOW(T) ;EP - ; compute time difference between T and NOW
+1 ; returns # of seconds, positive if T precedes now (how long ago)
+2 ; negative if T follows NOW (countdown "T minus...")
+3 ; giving %
NEW %,%H,%I,X
DO NOW^%DTC
+4 QUIT $$TDIF(%,T)
TDIF(T1,T2) ; compute time difference T1-T2 = how many seconds
+1 ;T1,T2 both Fileman date.times
+2 SET T1=$TRANSLATE($JUSTIFY(T1,16,8)," ","0")
SET T2=$TRANSLATE($JUSTIFY(T2,16,8)," ","0")
+3 ; days' difference
NEW R
SET R=$PIECE(T1,".")-$PIECE(T2,".")*86400
+4 ; hhmmsstt
SET T1=$PIECE(T1,".",2)
SET T2=$PIECE(T2,".",2)
+5 SET T1=$EXTRACT(T1,1,2)*60+$EXTRACT(T1,3,4)*60+$EXTRACT(T1,5,6)
+6 SET T2=$EXTRACT(T2,1,2)*60+$EXTRACT(T2,3,4)*60+$EXTRACT(T2,5,6)
+7 IF $EXTRACT(T1,7,8)
SET T1=$EXTRACT(T1,7,8)/100+T1
+8 IF $EXTRACT(T2,7,8)
SET T2=$EXTRACT(T2,7,8)/100+T2
+9 SET R=R+T1-T2
+10 QUIT R
TADDSECS(T1,SECS) ; add SECS seconds to T1
+1 NEW T2
SET T2=$$SECS2T2(SECS)
+2 QUIT $$TADD(T1,T2)
BADPARAM(VARNAME,ATLABEL) DO IMPOSS^BPSOSUE("P,DB","TI","Bad parameter "_VARNAME_"="_$GET(@VARNAME),,ATLABEL,$TEXT(+0))
QUIT
TADDNOWS(SECS) ;EP - add SECS seconds to NOW
+1 IF SECS'?1N.N
DO BADPARAM("SECS","TADDNOWS")
QUIT ""
+2 NEW T2
SET T2=$$SECS2T2(SECS)
+3 QUIT $$TADDNOW(T2)
SECS2T2(SECS) ; convert integer seconds into a fileman time format
+1 NEW T2,NEG
SET NEG=(SECS<0)
IF NEG
SET SECS=-SECS
+2 IF SECS>86400
SET T2=SECS\86400
SET SECS=SECS#86400_"."
+3 IF '$TEST
SET T2="."
+4 NEW %
SET %=SECS\3600
SET SECS=SECS#3600
if $LENGTH(%)=1
SET %="0"_%
SET T2=T2_%
+5 SET %=SECS\60
SET SECS=SECS#60
if $LENGTH(%)=1
SET %="0"_%
SET T2=T2_%
+6 if $LENGTH(SECS)=1
SET SECS="0"_SECS
SET T2=T2_SECS
+7 QUIT $SELECT(NEG:"-",1:"")_T2
TADDNOW(T2) ;EP - ; add T2 time differential to NOW
+1 ; giving %
NEW %,%H,%I,X
DO NOW^%DTC
+2 QUIT $$TADD(%,T2)
TADD(T1,T2) ;EP - ; add T2 time differential to T1
+1 ; but T2 can be negative
IF T1<0
DO BADPARAM("T1","TADD")
QUIT
+2 NEW SGN
SET SGN=$SELECT(T2<0:-1,1:1)
SET T2=T2*SGN
+3 ; can't handle this case (yet)
IF SGN<0
IF T2>T1
DO BADPARAM("T2","TADD")
QUIT
+4 SET T1=$TRANSLATE($JUSTIFY(T1,16,8)," ","0")
SET T2=$TRANSLATE($JUSTIFY(T2,16,8)," ","0")
+5 ;S R=$P(T1,".",1)+($P(T2,".",1)*SGN) ; add days portion
NEW R
+6 SET R=$$CDTC($PIECE(T1,"."),$PIECE(T2,".")*SGN)
+7 ; note: without the sign
SET T2=$PIECE(T2,".",2)
+8 SET T1=$PIECE(T1,".",2)
+9 ; seconds
SET T1=$EXTRACT(T1,1,2)*60+$EXTRACT(T1,3,4)*60+$EXTRACT(T1,5,6)
+10 ; seconds
SET T2=$EXTRACT(T2,1,2)*60+$EXTRACT(T2,3,4)*60+$EXTRACT(T2,5,6)
+11 ; hundredths
IF $EXTRACT(T1,7,8)
SET T1=$EXTRACT(T1,7,8)/100+T1
+12 ; hundredths
IF $EXTRACT(T2,7,8)
SET T2=$EXTRACT(T2,7,8)/100+T2
+13 ; restore sign to T2's hundredths
SET T2=T2*SGN
+14 NEW S
SET S=T1+T2
+15 ; R+1 ; carry
IF S>86400
SET S=S-86400
SET R=$$CDTC(R,1)
+16 ; R-1 ; borrow
IF '$TEST
IF S<0
SET S=S+86400
SET R=$$CDTC(R,-1)
+17 SET T2=S\3600
SET S=S#3600
+18 ; hours
SET R=R_"."_$TRANSLATE($JUSTIFY(T2,2)," ","0")
+19 SET T2=S\60
SET S=S#60
+20 ; minutes
SET R=R_$TRANSLATE($JUSTIFY(T2,2)," ","0")
+21 SET T2=S\1
SET S=S#1
+22 ; seconds
SET R=R_$TRANSLATE($JUSTIFY(T2,2)," ","0")
+23 ; hundredths of seconds
SET T2=S*100\1
SET R=R_$TRANSLATE($JUSTIFY(T2,2)," ","0")
+24 ; removes trailing zeroes
SET R=+R
+25 QUIT R
CDTC(X1,X2) NEW X,%H
DO C^%DTC
QUIT X
