ABSPOSIW ; IHS/FCS/DRS - Old-style input ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
; overflow from ABSPOSIV
BACKLOG() ;EP - from ABSPOSIV
; a rough guess on how many seconds of backlog there are
N STATS,LOCK,TALLY S LOCK=1,TALLY=0
D FETSTAT^ABSPOS2("STATS(1)")
N A S A="" F S A=$O(STATS(1,A)) Q:'A D
. S TALLY=STATS(1,A)*7 ; 7 seconds of packet preparation & overhead
D FETPKTQ^ABSPOS2("STATS(2)")
N CLAIMS S CLAIMS=$G(STATS(2,"C")) ; figure about 12 secs each
N RESPS S RESPS=$G(STATS(2,"R")) ; figure about 3 secs each
S TALLY=CLAIMS*12+(RESPS*3)+TALLY ;
S TALLY=CLAIMS*20+TALLY ; and 20 secs dialing for each one (EOT prob)
;I CLAIMS S TALLY=TALLY+20 ; normally, just 20 secs once
I 0,+$H=58107,$P($H,",",2)<(7*3600) D Q 300
. W "Computed value from $$BACKLOG=",TALLY," but change it for testing.",!
Q TALLY
GETNDC() ;EP - from ABSPOSIV
;Prompt - get NDC #
; Returns the NDC # with the "-"
; Even if pure numeric input, figure it out and put in the "-"
; "^" OR "^^" or "" if the user inputs one of those
; 0 if automatic answer input was a bad number
;
; Don't default it - they want the real, true number to always be
; scanned in from the bottle, every time.
;
N X,NDCDEF
NDC0 I DEFNDCNO S NDCDEF=$$DEFNDC^ABSPOSIV ; relies on ABSBRXI, ABSBRXR
E S NDCDEF=""
S X=$$FREETEXT^ABSPOSU2("NDC#: ",NDCDEF,1,1,15,$G(DTIME))
;
; "the Abbot Labs bar codes are really funky"
I X?1"++3"10.11N2E D
. S X=$E(X,4,$L(X)-2) ; strip off the surrounding junk
. ; fine if it's 11N
. ; if it's 10N, what? leave it to the mercy of the $$NDC10^ABSPOS9?
I "^^"[X Q X ;I X="^^" Q X ;Q:X=-1 "^" Q:X="" X
; If it's entirely numeric input, figure out where the "-" go.
I X?10N D
.N Y S Y=$$NDC10^ABSPOS9(X)
.I Y="" W !,"We couldn't figure out ",X,!
.E W " ",Y S X=Y
I X?11N D
.S X=$E(X,1,5)_"-"_$E(X,6,9)_"-"_$E(X,10,11)
I X?12N D ; got to ask Carlene about this
.W !,"12 digit NDC number? We will proceed anyhow, but it's going",!
.W "to be truncated"
.S X=$E(X,1,6)_"-"_$E(X,7,10)_"-"_$E(X,11,12) ; put in 6-4-2 format
.W !
I X?4N1"-"4N1"-"2N G NDC1
I X?5N1"-"3N1"-"2N G NDC1
I X?5N1"-"4N1"-"1N G NDC1
I X?5N1"-"4N1"-"2N G NDC1
I X?6N1"-"4N1"-"2N G NDC1
W:'$G(SILENT) !,"Bad NDC #",! G NDC0
NDC1 ;S $P(^PSRX(ABSBRXI,2),U,7)=X ; store input NDC # in PRESCRIPTION file
; Don't store it yet - just get input now - let background job store it
W " ",$$NAME^ABSPOS9(X)
Q X ; JUST RETURN WHAT WAS INPUT!!!
ABSPOSIW ; IHS/FCS/DRS - Old-style input ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
+2 ; overflow from ABSPOSIV
BACKLOG() ;EP - from ABSPOSIV
+1 ; a rough guess on how many seconds of backlog there are
+2 NEW STATS,LOCK,TALLY
SET LOCK=1
SET TALLY=0
+3 DO FETSTAT^ABSPOS2("STATS(1)")
+4 NEW A
SET A=""
FOR
SET A=$ORDER(STATS(1,A))
IF 'A
QUIT
Begin DoDot:1
+5 ; 7 seconds of packet preparation & overhead
SET TALLY=STATS(1,A)*7
End DoDot:1
+6 DO FETPKTQ^ABSPOS2("STATS(2)")
+7 ; figure about 12 secs each
NEW CLAIMS
SET CLAIMS=$GET(STATS(2,"C"))
+8 ; figure about 3 secs each
NEW RESPS
SET RESPS=$GET(STATS(2,"R"))
+9 ;
SET TALLY=CLAIMS*12+(RESPS*3)+TALLY
+10 ; and 20 secs dialing for each one (EOT prob)
SET TALLY=CLAIMS*20+TALLY
+11 ;I CLAIMS S TALLY=TALLY+20 ; normally, just 20 secs once
+12 IF 0
IF +$HOROLOG=58107
IF $PIECE($HOROLOG,",",2)<(7*3600)
Begin DoDot:1
+13 WRITE "Computed value from $$BACKLOG=",TALLY," but change it for testing.",!
End DoDot:1
QUIT 300
+14 QUIT TALLY
GETNDC() ;EP - from ABSPOSIV
+1 ;Prompt - get NDC #
+2 ; Returns the NDC # with the "-"
+3 ; Even if pure numeric input, figure it out and put in the "-"
+4 ; "^" OR "^^" or "" if the user inputs one of those
+5 ; 0 if automatic answer input was a bad number
+6 ;
+7 ; Don't default it - they want the real, true number to always be
+8 ; scanned in from the bottle, every time.
+9 ;
+10 NEW X,NDCDEF
NDC0 ; relies on ABSBRXI, ABSBRXR
IF DEFNDCNO
SET NDCDEF=$$DEFNDC^ABSPOSIV
+1 IF '$TEST
SET NDCDEF=""
+2 SET X=$$FREETEXT^ABSPOSU2("NDC#: ",NDCDEF,1,1,15,$GET(DTIME))
+3 ;
+4 ; "the Abbot Labs bar codes are really funky"
+5 IF X?1"++3"10.11N2E
Begin DoDot:1
+6 ; strip off the surrounding junk
SET X=$EXTRACT(X,4,$LENGTH(X)-2)
+7 ; fine if it's 11N
+8 ; if it's 10N, what? leave it to the mercy of the $$NDC10^ABSPOS9?
End DoDot:1
+9 ;I X="^^" Q X ;Q:X=-1 "^" Q:X="" X
IF "^^"[X
QUIT X
+10 ; If it's entirely numeric input, figure out where the "-" go.
+11 IF X?10N
Begin DoDot:1
+12 NEW Y
SET Y=$$NDC10^ABSPOS9(X)
+13 IF Y=""
WRITE !,"We couldn't figure out ",X,!
+14 IF '$TEST
WRITE " ",Y
SET X=Y
End DoDot:1
+15 IF X?11N
Begin DoDot:1
+16 SET X=$EXTRACT(X,1,5)_"-"_$EXTRACT(X,6,9)_"-"_$EXTRACT(X,10,11)
End DoDot:1
+17 ; got to ask Carlene about this
IF X?12N
Begin DoDot:1
+18 WRITE !,"12 digit NDC number? We will proceed anyhow, but it's going",!
+19 WRITE "to be truncated"
+20 ; put in 6-4-2 format
SET X=$EXTRACT(X,1,6)_"-"_$EXTRACT(X,7,10)_"-"_$EXTRACT(X,11,12)
+21 WRITE !
End DoDot:1
+22 IF X?4N1"-"4N1"-"2N
GOTO NDC1
+23 IF X?5N1"-"3N1"-"2N
GOTO NDC1
+24 IF X?5N1"-"4N1"-"1N
GOTO NDC1
+25 IF X?5N1"-"4N1"-"2N
GOTO NDC1
+26 IF X?6N1"-"4N1"-"2N
GOTO NDC1
+27 IF '$GET(SILENT)
WRITE !,"Bad NDC #",!
GOTO NDC0
NDC1 ;S $P(^PSRX(ABSBRXI,2),U,7)=X ; store input NDC # in PRESCRIPTION file
+1 ; Don't store it yet - just get input now - let background job store it
+2 WRITE " ",$$NAME^ABSPOS9(X)
+3 ; JUST RETURN WHAT WAS INPUT!!!
QUIT X
