source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSUD.m@ 1806

Last change on this file since 1806 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.7 KB
RevLine 
[613]1BPSOSUD ;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 ;
10INCSTAT(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
16ADDSTAT(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
22ADD1STAT(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 ;
29DATETIME(Y) ;EP - convert fileman date.time to printable
30 X ^DD("DD") Q Y
31TIMEAGO(THEN) ; external form for TIMEAGOI
32 N %,%H,%I,X D NOW^%DTC Q $$TIMEDIF(THEN,%)
33TIMEAGOI(THEN) ; how many seconds ago was it? returns positive value
34 N %,%H,%I,X D NOW^%DTC ; giving %
35 Q $$TIMEDIFI(THEN,%)
36TIMEDIFI(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
44TIMEDIF(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)
48SECSDHMS(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 %
55PRESSANY D PRESSANY^BPSOSU5() Q
56CONTINUE(DEF) ;EP -
57 ; returns a single character
58 ; or returns DEF, the default
59CONT1 ;
60 S X=$$FREETEXT^BPSOSU2("Type C to continue or Q to quit: ",,1,1,1,15)
61 Q X
62 ;
63TT() 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
64SHOULDNT W "this should never happen" Q
65TDIFNOW(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)
70TDIF(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
81TADDSECS(T1,SECS) ; add SECS seconds to T1
82 N T2 S T2=$$SECS2T2(SECS)
83 Q $$TADD(T1,T2)
84BADPARAM(VARNAME,ATLABEL) D IMPOSS^BPSOSUE("P,DB","TI","Bad parameter "_VARNAME_"="_$G(@VARNAME),,ATLABEL,$T(+0)) Q
85TADDNOWS(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)
89SECS2T2(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
97TADDNOW(T2) ;EP - ; add T2 time differential to NOW
98 N %,%H,%I,X D NOW^%DTC ; giving %
99 Q $$TADD(%,T2)
100TADD(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
126CDTC(X1,X2) N X,%H D C^%DTC Q X
Note: See TracBrowser for help on using the repository browser.