- 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 Jan 18, 2025@02:53:30 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