ABSPOSUD ; IHS/FCS/DRS - utils, some options ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
;
; Some utilities.
; Some options- goal is to move them out to other routines
;
Q
;
INCSTAT(N1,P1,N2,P2,N3,P3) ;EP - ABSPOSAM,ABSPOSQA,ABSPOSQC,ABSPOSQL,others to come
; 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) ;EP - ABSPOSAM,ABSPOSQ3,others to come
; 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 +^ABSPECX("S",1,N):5
I '$D(^ABSPECX("S",1,N)) S ^ABSPECX("S",1,N)=""
S $P(^ABSPECX("S",1,N),U,P)=$P(^ABSPECX("S",1,N),U,P)+Q
L -^ABSPECX("S",1,N)
Q
;
; General LOCK routine to exclusive ownership of 9002313.59
; Interactive by default
;
LOCKPOS(OK2WAIT,SILENT) ;EP - ABSPOS2D,ABSPOS6L - Lock 9002313.59
I '$D(OK2WAIT) S OK2WAIT=1
N RESULT S RESULT=""
F D Q:RESULT]"" Q:'OK2WAIT
. L +^ABSPT:1 I $T S RESULT=1 Q
. W "Waiting 5 minutes for interLOCK...",!
. L +^ABSPT:299 I $T S RESULT=1 Q
. D Q
. . W "Failed to obtain interLOCK",!
. . S RESULT=0 Q
. H 5 ; want to ask here - and set RESULT=0 if they say no, don't wait
Q RESULT
ULOCKPOS ;EP
L -^ABSPT Q
;
DATETIME(Y) ;EP - ABSPOS6M - convert fileman date.time to printable
X ^DD("DD") Q Y
TIMEAGO(THEN) ;EP - ABSPOSU7 ; external form for TIMEAGOI
N %,%H,%I,X D NOW^%DTC Q $$TIMEDIF(THEN,%)
TIMEAGOI(THEN) ;EP - ABSPOSU7 ;
; how many seconds ago was it? returns positive value
N %,%H,%I,X D NOW^%DTC ; giving %
Q $$TIMEDIFI(THEN,%)
TIMEDIFI(X1,X2) ;EP - ABSPOSB,ABSPOSIV,ABSPOSIZ ;
; 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 - ABSPOS6M,ABSPOSIV
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^ABSPOSU5() Q
CONTINUE(DEF) ;EP - ABSPOS2E
; returns a single character
; or returns DEF, the default
;N X,%,%H,%I,X,Y,TT D NOW^%DTC S Y=% S TT=$$TT X TT
CONT1 ;W "----- ",Y," Press C to continue, Q to quit, or ^: "
;R X#1:15 S:'$T X=DEF W !
S X=$$FREETEXT^ABSPOSU2("Type C to continue or Q to quit: ",,1,1,1,15)
Q X
;
; SORT() has moved to ABSPOSUA
; DEFDEST^ABSPOSUA() gives default root of where its results are
; DISP and DISP1 have been superseded by ^ABSPOS functionality
; the code has been deleted and all that's left is the paper copy
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 - ABSPOSQS ; 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) ;EP - ABSPOSR1 - add SECS seconds to T1
N T2 S T2=$$SECS2T2(SECS)
Q $$TADD(T1,T2)
BADPARAM(VARNAME,ATLABEL) D IMPOSS^ABSPOSUE("P,DB","TI","Bad parameter "_VARNAME_"="_$G(@VARNAME),,ATLABEL,$T(+0)) Q
TADDNOWS(SECS) ;EP - ABSPOSQ4,ABSPOSQJ - 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 - ABSPOSQS ; add T2 time differential to NOW
N %,%H,%I,X D NOW^%DTC ; giving %
Q $$TADD(%,T2)
TADD(T1,T2) ;EP - ABSPOS6D,ABSPOS6I ; 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
ABSPOSUD ; IHS/FCS/DRS - utils, some options ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
+2 ;
+3 ; Some utilities.
+4 ; Some options- goal is to move them out to other routines
+5 ;
+6 QUIT
+7 ;
INCSTAT(N1,P1,N2,P2,N3,P3) ;EP - ABSPOSAM,ABSPOSQA,ABSPOSQC,ABSPOSQL,others to come
+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) ;EP - ABSPOSAM,ABSPOSQ3,others to come
+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 +^ABSPECX("S",1,N):5
+2 IF '$DATA(^ABSPECX("S",1,N))
SET ^ABSPECX("S",1,N)=""
+3 SET $PIECE(^ABSPECX("S",1,N),U,P)=$PIECE(^ABSPECX("S",1,N),U,P)+Q
+4 LOCK -^ABSPECX("S",1,N)
+5 QUIT
+6 ;
+7 ; General LOCK routine to exclusive ownership of 9002313.59
+8 ; Interactive by default
+9 ;
LOCKPOS(OK2WAIT,SILENT) ;EP - ABSPOS2D,ABSPOS6L - Lock 9002313.59
+1 IF '$DATA(OK2WAIT)
SET OK2WAIT=1
+2 NEW RESULT
SET RESULT=""
+3 FOR
Begin DoDot:1
+4 LOCK +^ABSPT:1
IF $TEST
SET RESULT=1
QUIT
+5 WRITE "Waiting 5 minutes for interLOCK...",!
+6 LOCK +^ABSPT:299
IF $TEST
SET RESULT=1
QUIT
+7 Begin DoDot:2
+8 WRITE "Failed to obtain interLOCK",!
+9 SET RESULT=0
QUIT
End DoDot:2
QUIT
+10 ; want to ask here - and set RESULT=0 if they say no, don't wait
HANG 5
End DoDot:1
IF RESULT]""
QUIT
IF 'OK2WAIT
QUIT
+11 QUIT RESULT
ULOCKPOS ;EP
+1 LOCK -^ABSPT
QUIT
+2 ;
DATETIME(Y) ;EP - ABSPOS6M - convert fileman date.time to printable
+1 XECUTE ^DD("DD")
QUIT Y
TIMEAGO(THEN) ;EP - ABSPOSU7 ; external form for TIMEAGOI
+1 NEW %,%H,%I,X
DO NOW^%DTC
QUIT $$TIMEDIF(THEN,%)
TIMEAGOI(THEN) ;EP - ABSPOSU7 ;
+1 ; how many seconds ago was it? returns positive value
+2 ; giving %
NEW %,%H,%I,X
DO NOW^%DTC
+3 QUIT $$TIMEDIFI(THEN,%)
TIMEDIFI(X1,X2) ;EP - ABSPOSB,ABSPOSIV,ABSPOSIZ ;
+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 - ABSPOS6M,ABSPOSIV
+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^ABSPOSU5()
QUIT
CONTINUE(DEF) ;EP - ABSPOS2E
+1 ; returns a single character
+2 ; or returns DEF, the default
+3 ;N X,%,%H,%I,X,Y,TT D NOW^%DTC S Y=% S TT=$$TT X TT
CONT1 ;W "----- ",Y," Press C to continue, Q to quit, or ^: "
+1 ;R X#1:15 S:'$T X=DEF W !
+2 SET X=$$FREETEXT^ABSPOSU2("Type C to continue or Q to quit: ",,1,1,1,15)
+3 QUIT X
+4 ;
+5 ; SORT() has moved to ABSPOSUA
+6 ; DEFDEST^ABSPOSUA() gives default root of where its results are
+7 ; DISP and DISP1 have been superseded by ^ABSPOS functionality
+8 ; the code has been deleted and all that's left is the paper copy
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 - ABSPOSQS ; 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) ;EP - ABSPOSR1 - add SECS seconds to T1
+1 NEW T2
SET T2=$$SECS2T2(SECS)
+2 QUIT $$TADD(T1,T2)
BADPARAM(VARNAME,ATLABEL) DO IMPOSS^ABSPOSUE("P,DB","TI","Bad parameter "_VARNAME_"="_$GET(@VARNAME),,ATLABEL,$TEXT(+0))
QUIT
TADDNOWS(SECS) ;EP - ABSPOSQ4,ABSPOSQJ - 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 - ABSPOSQS ; add T2 time differential to NOW
+1 ; giving %
NEW %,%H,%I,X
DO NOW^%DTC
+2 QUIT $$TADD(%,T2)
TADD(T1,T2) ;EP - ABSPOS6D,ABSPOS6I ; 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
