| 1 | BPSOSUD ;BHAM ISC/FCS/DRS/FLS - utils, some options ;06/01/2004 | 
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45 | 
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | ; Some utilities. | 
|---|
| 6 | ; Some options- goal is to move them out to other routines | 
|---|
| 7 | ; | 
|---|
| 8 | Q | 
|---|
| 9 | ; | 
|---|
| 10 | INCSTAT(N1,P1,N2,P2,N3,P3) ;EP - BPSBUTL,BPSOSQL | 
|---|
| 11 | ; increment the given N nodes at the P pieces | 
|---|
| 12 | D ADD1STAT(N1,P1,1) | 
|---|
| 13 | Q:'$D(N2)  D ADD1STAT(N2,P2,1) | 
|---|
| 14 | Q:'$D(N3)  D ADD1STAT(N3,P3,1) | 
|---|
| 15 | Q | 
|---|
| 16 | ADDSTAT(N1,P1,Q1,N2,P2,Q2,N3,P3,Q3) ; | 
|---|
| 17 | ; add Quantities to given Nodes,Pieces | 
|---|
| 18 | D ADD1STAT(N1,P1,Q1) | 
|---|
| 19 | Q:'$D(N2)  D ADD1STAT(N2,P2,Q2) | 
|---|
| 20 | Q:'$D(N3)  D ADD1STAT(N3,P3,Q3) | 
|---|
| 21 | Q | 
|---|
| 22 | ADD1STAT(N,P,Q) ; | 
|---|
| 23 | L +^BPSECX("S",1,N):5 | 
|---|
| 24 | I '$D(^BPSECX("S",1,N)) S ^BPSECX("S",1,N)="" | 
|---|
| 25 | S $P(^BPSECX("S",1,N),U,P)=$P(^BPSECX("S",1,N),U,P)+Q | 
|---|
| 26 | L -^BPSECX("S",1,N) | 
|---|
| 27 | Q | 
|---|
| 28 | ; | 
|---|
| 29 | DATETIME(Y) ;EP - convert fileman date.time to printable | 
|---|
| 30 | X ^DD("DD") Q Y | 
|---|
| 31 | TIMEAGO(THEN) ; external form for TIMEAGOI | 
|---|
| 32 | N %,%H,%I,X D NOW^%DTC Q $$TIMEDIF(THEN,%) | 
|---|
| 33 | TIMEAGOI(THEN) ; how many seconds ago was it? returns positive value | 
|---|
| 34 | N %,%H,%I,X D NOW^%DTC ; giving % | 
|---|
| 35 | Q $$TIMEDIFI(THEN,%) | 
|---|
| 36 | TIMEDIFI(X1,X2) ;EP - Computed field of BPS Log of Transactions and BPS Transactions | 
|---|
| 37 | ; time difference in seconds, negative if X1>X2 | 
|---|
| 38 | I X1>X2 Q -$$TIMEDIFI(X2,X1) | 
|---|
| 39 | N %,X,%H,%T,%Y,D1,T1,D2,T2 | 
|---|
| 40 | S X=X1 D H^%DTC S D1=%H,T1=%T | 
|---|
| 41 | S X=X2 D H^%DTC S D2=%H,T2=%T | 
|---|
| 42 | S X=D2-D1*86400+T2-T1 | 
|---|
| 43 | Q X | 
|---|
| 44 | TIMEDIF(X1,X2) ;EP - Computed field of BPS Log of Transactions and BPS Transactions | 
|---|
| 45 | N X S X=$$TIMEDIFI(X1,X2) | 
|---|
| 46 | N SGN S SGN=$S(X<0:-1,1:1),X=X*SGN | 
|---|
| 47 | Q $S(SGN<0:"-",1:"")_$$SECSDHMS(X) | 
|---|
| 48 | SECSDHMS(X) ;EP - seconds ->  # da # hr # min # sec | 
|---|
| 49 | N % S %="" | 
|---|
| 50 | I X'<86400 S %=X\86400_" da",X=X#86400 | 
|---|
| 51 | I X'<3600!(%]"") S:%]"" %=%_" " S %=%_(X\3600)_" hr",X=X#3600 | 
|---|
| 52 | I X'<60!(%]"") S:%]"" %=%_" " S %=%_(X\60)_" min",X=X#60 | 
|---|
| 53 | S:%]"" %=%_" " S %=%_X_" sec" | 
|---|
| 54 | Q % | 
|---|
| 55 | PRESSANY D PRESSANY^BPSOSU5() Q | 
|---|
| 56 | CONTINUE(DEF) ;EP - | 
|---|
| 57 | ; returns a single character | 
|---|
| 58 | ; or returns DEF, the default | 
|---|
| 59 | CONT1 ; | 
|---|
| 60 | S X=$$FREETEXT^BPSOSU2("Type C to continue or Q to quit: ",,1,1,1,15) | 
|---|
| 61 | Q X | 
|---|
| 62 | ; | 
|---|
| 63 | 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 | 
|---|
| 64 | SHOULDNT W "this should never happen" Q | 
|---|
| 65 | TDIFNOW(T) ;EP - ; compute time difference between T and NOW | 
|---|
| 66 | ; returns # of seconds, positive if T precedes now (how long ago) | 
|---|
| 67 | ;   negative if T follows NOW (countdown "T minus...") | 
|---|
| 68 | N %,%H,%I,X D NOW^%DTC ; giving % | 
|---|
| 69 | Q $$TDIF(%,T) | 
|---|
| 70 | TDIF(T1,T2) ; compute time difference T1-T2 = how many seconds | 
|---|
| 71 | ;T1,T2 both Fileman date.times | 
|---|
| 72 | S T1=$TR($J(T1,16,8)," ","0"),T2=$TR($J(T2,16,8)," ","0") | 
|---|
| 73 | N R S R=$P(T1,".")-$P(T2,".")*86400 ; days' difference | 
|---|
| 74 | S T1=$P(T1,".",2),T2=$P(T2,".",2) ; hhmmsstt | 
|---|
| 75 | S T1=$E(T1,1,2)*60+$E(T1,3,4)*60+$E(T1,5,6) | 
|---|
| 76 | S T2=$E(T2,1,2)*60+$E(T2,3,4)*60+$E(T2,5,6) | 
|---|
| 77 | I $E(T1,7,8) S T1=$E(T1,7,8)/100+T1 | 
|---|
| 78 | I $E(T2,7,8) S T2=$E(T2,7,8)/100+T2 | 
|---|
| 79 | S R=R+T1-T2 | 
|---|
| 80 | Q R | 
|---|
| 81 | TADDSECS(T1,SECS) ; add SECS seconds to T1 | 
|---|
| 82 | N T2 S T2=$$SECS2T2(SECS) | 
|---|
| 83 | Q $$TADD(T1,T2) | 
|---|
| 84 | BADPARAM(VARNAME,ATLABEL) D IMPOSS^BPSOSUE("P,DB","TI","Bad parameter "_VARNAME_"="_$G(@VARNAME),,ATLABEL,$T(+0)) Q | 
|---|
| 85 | TADDNOWS(SECS) ;EP - add SECS seconds to NOW | 
|---|
| 86 | I SECS'?1N.N D BADPARAM("SECS","TADDNOWS") Q "" | 
|---|
| 87 | N T2 S T2=$$SECS2T2(SECS) | 
|---|
| 88 | Q $$TADDNOW(T2) | 
|---|
| 89 | SECS2T2(SECS) ; convert integer seconds into a fileman time format | 
|---|
| 90 | N T2,NEG S NEG=(SECS<0) I NEG S SECS=-SECS | 
|---|
| 91 | I SECS>86400 S T2=SECS\86400,SECS=SECS#86400_"." | 
|---|
| 92 | E  S T2="." | 
|---|
| 93 | N % S %=SECS\3600,SECS=SECS#3600 S:$L(%)=1 %="0"_% S T2=T2_% | 
|---|
| 94 | S %=SECS\60,SECS=SECS#60 S:$L(%)=1 %="0"_% S T2=T2_% | 
|---|
| 95 | S:$L(SECS)=1 SECS="0"_SECS S T2=T2_SECS | 
|---|
| 96 | Q $S(NEG:"-",1:"")_T2 | 
|---|
| 97 | TADDNOW(T2) ;EP - ; add T2 time differential to NOW | 
|---|
| 98 | N %,%H,%I,X D NOW^%DTC ; giving % | 
|---|
| 99 | Q $$TADD(%,T2) | 
|---|
| 100 | TADD(T1,T2) ;EP -  ; add T2 time differential to T1 | 
|---|
| 101 | I T1<0 D BADPARAM("T1","TADD") Q  ; but T2 can be negative | 
|---|
| 102 | N SGN S SGN=$S(T2<0:-1,1:1),T2=T2*SGN | 
|---|
| 103 | I SGN<0,T2>T1 D BADPARAM("T2","TADD") Q  ; can't handle this case (yet) | 
|---|
| 104 | S T1=$TR($J(T1,16,8)," ","0"),T2=$TR($J(T2,16,8)," ","0") | 
|---|
| 105 | N R ;S R=$P(T1,".",1)+($P(T2,".",1)*SGN) ; add days portion | 
|---|
| 106 | S R=$$CDTC($P(T1,"."),$P(T2,".")*SGN) | 
|---|
| 107 | S T2=$P(T2,".",2) ; note: without the sign | 
|---|
| 108 | S T1=$P(T1,".",2) | 
|---|
| 109 | S T1=$E(T1,1,2)*60+$E(T1,3,4)*60+$E(T1,5,6) ; seconds | 
|---|
| 110 | S T2=$E(T2,1,2)*60+$E(T2,3,4)*60+$E(T2,5,6) ; seconds | 
|---|
| 111 | I $E(T1,7,8) S T1=$E(T1,7,8)/100+T1 ; hundredths | 
|---|
| 112 | I $E(T2,7,8) S T2=$E(T2,7,8)/100+T2 ; hundredths | 
|---|
| 113 | S T2=T2*SGN ; restore sign to T2's hundredths | 
|---|
| 114 | N S S S=T1+T2 | 
|---|
| 115 | I S>86400 S S=S-86400,R=$$CDTC(R,1) ; R+1 ; carry | 
|---|
| 116 | E  I S<0 S S=S+86400,R=$$CDTC(R,-1) ; R-1 ; borrow | 
|---|
| 117 | S T2=S\3600,S=S#3600 | 
|---|
| 118 | S R=R_"."_$TR($J(T2,2)," ","0") ; hours | 
|---|
| 119 | S T2=S\60,S=S#60 | 
|---|
| 120 | S R=R_$TR($J(T2,2)," ","0") ; minutes | 
|---|
| 121 | S T2=S\1,S=S#1 | 
|---|
| 122 | S R=R_$TR($J(T2,2)," ","0") ; seconds | 
|---|
| 123 | S T2=S*100\1,R=R_$TR($J(T2,2)," ","0") ; hundredths of seconds | 
|---|
| 124 | S R=+R ; removes trailing zeroes | 
|---|
| 125 | Q R | 
|---|
| 126 | CDTC(X1,X2) N X,%H D C^%DTC Q X | 
|---|