ABSPOSX ; IHS/FCS/DRS - Support ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
Q
; Directory:
;ABSPOSXE - search for error log entries
;
AUTO ; EP - automatic, using setup params for date range
S RANGE=$$GETRANGE(1) Q:RANGE<1
D THELIST
Q
INTER ; EP - interactive use
S RANGE=$$GETRANGE Q:RANGE<1
INTERJ ; join
N POP D ^%ZIS Q:$G(POP)
D THELIST
D ^%ZISC
Q
TODAY ;EP
S RANGE=DT_U_DT G INTERJ
YESTER ;EP
S RANGE=$$TADD^ABSPOSUD(DT,-1),RANGE=RANGE_U_RANGE G INTERJ
WEEK ;EP
S RANGE=$$TADD^ABSPOSUD(DT,-8)_U_$$TADD^ABSPOSUD(DT,-1) G INTERJ
;
THELIST ; calls to all the little things you want to monitor
; given RANGE=fileman start^end dates
; Put errors and shouldn't-happen things first:
W "Support Utility to survey Point of Sale activity (",$T(+0),")",!
W "Site: ",$P(^DIC(4,DUZ(2),0),U),!
W "Date: ",$$NOWEXT^ABSPOSU1,!
D SEARCH^ABSPOSXE($$HRANGE(RANGE)) ; error log
D STRANDED ; stranded claims - report and cleanup
D UE ; impossible errors
; Then put informational things:
D SHOWQ^ABSPOSR2
W "Winnowing old data:",!
W " the log files are in: ",$G(^ABSP(9002313.99,1,"WINNOW LOGS")),!
W "Update of Report Master file: ",$G(^ABSP(9002313.99,1,"ABSPOSM1")),!
D TRANSACT
D PRESSANY^ABSPOSU5()
D VOLUME^ABSPOS35($P(RANGE,U),$P(RANGE,U,2)) ; pharmacy volume
Q
TRANSACT ; count 9002313.57 transactions in RANGE
; It's a date range; be sure you get them all
D TRANS1
W "Count of complete transactions: ",^TMP($J,"TRANSACT"),!
W "Tally by result type: ",!
N R S R="" F S R=$O(^TMP($J,"TRANSACT","R",R)) Q:R="" D
. W $J(^TMP($J,"TRANSACT","R",R),10)," ",R,!
W "Tally by insurer and by result type: ",!
N INS S INS="" F S INS=$O(^TMP($J,"TRANSACT","INS",INS)) Q:INS="" D
. W ?10,$J(^TMP($J,"TRANSACT","INS",INS),5)," for ",INS
. I ^TMP($J,"TRANSACT","INS",INS)=$G(^TMP($J,"TRANSACT","INS",INS,"R","PAPER")) W " - all PAPER",! Q
. E W !
. S R="" F S R=$O(^TMP($J,"TRANSACT","INS",INS,"R",R)) Q:R="" D
. . W ?20,$J(^TMP($J,"TRANSACT","INS",INS,"R",R),5)," ",R,!
W "Tally by transaction time:",!
N SECS S SECS="" F S SECS=$O(^TMP($J,"TRANSACT","TIME",SECS)) Q:SECS="" D
. W $J(^TMP($J,"TRANSACT","TIME",SECS),10)," - "
. I SECS?1N.N W $$SECSDHMS^ABSPOSUD(SECS)
. E W SECS
. I SECS'?1N.N!(SECS>120) W " - IEN57=",$O(^TMP($J,"TRANSACT","TIME",SECS,""))
. W !
Q
TRANS1 ;
; ^TMP($J,"TRANSACT")=count of 9002313.57 transactions
; ^TMP($J,"TRANSACT","R",result)=count by result type
; ^TMP($J,"TRANSACT","INS",company)=count by insurance company
; ^TMP($J,"TRANSACT","INS",company,"R",result)=count result by company
; ^TMP($J,"TRANSACT","TIME",secs)=count
; ^TMP($J,"TRANSACT","TIME",secs,IEN57) for certain too-long ones
;
K ^TMP($J,"TRANSACT") S ^TMP($J,"TRANSACT")=0 ; caller should have already NEWed this
N T,X,Y S X=$P(RANGE,U),Y=$P(RANGE,U,2)
I Y'["." S $P(Y,".",2)=24 ; thru midnight, if nothing specified
S T=X
F D S T=$O(^ABSPTL("AH",T)) Q:'T Q:T>Y
. N IEN57 S IEN57=""
. F S IEN57=$O(^ABSPTL("AH",T,IEN57)) Q:'IEN57 D
. . N IEN57C S IEN57C=IEN57_","
. . N R S R=$$GET1^DIQ(9002313.57,IEN57C,4.0098) S:R="" R="null??"
. . N INS S INS=$$GET1^DIQ(9002313.57,IEN57C,1.06) S:INS="" INS="No Insurance"
. . S ^TMP($J,"TRANSACT")=^TMP($J,"TRANSACT")+1
. . S ^TMP($J,"TRANSACT","R",R)=$G(^TMP($J,"TRANSACT","R",R))+1
. . S ^TMP($J,"TRANSACT","INS",INS)=$G(^TMP($J,"TRANSACT","INS",INS))+1
. . S ^TMP($J,"TRANSACT","INS",INS,"R",R)=$G(^TMP($J,"TRANSACT","INS",INS,"R",R))+1
. . N SECS S SECS=$$GET1^DIQ(9002313.57,IEN57C,9999.98)
. . I SECS="" S SECS="null?"
. . S ^TMP($J,"TRANSACT","TIME",SECS)=$G(^TMP($J,"TRANSACT","TIME",SECS))+1
. . I SECS>120 S ^TMP($J,"TRANSACT","TIME",SECS,IEN57)=""
Q
STRANDED ;
N HRS S HRS=$P($G(^ABSP(9002313.99,"ABSPOSX TDIF")),U,3)*24
I 'HRS S HRS=24*31 ; make it a month
D PURGE^ABSPOSU7(HRS)
Q
UE ; ^TMP("ABSPOSUE",$J)=DUZ^$H
N NDAYS S NDAYS=$P($G(^ABSP(9002313.99,"ABSPOSX TDIF")),U,3)
I 'NDAYS S NDAYS=31
N J S J="" Q:$O(^TMP("ABSPOSUE",J))=""
W "Errors which went through ABSPOSUE:",!
F S J=$O(^TMP("ABSPOSUE",J)) Q:J="" D
. N X S X=^TMP("ABSPOSUE",J)
. N H S H=$P(X,U,2)
. I H-$H>NDAYS D Q ; too old to report; winnow it if it's really old
. . I H-$H>(NDAYS+30) K ^TMP("ABSPOSUE",J)
. D ; convert H from $H to Fileman
. . N %H,%,X S %H=H D YMD^%DTC S H=X
. Q:H<$P(RANGE,U) Q:H>$P(RANGE,U,2)
. W "Encountered by ",$P($G(^VA(200,+X,0)),U)," on ",H,!
Q
GETRANGE(HOW) ; HOW = 1 - silently, from setup file
; otherwise, interactive, ask
I $G(HOW)=1 D
. N X S X=$G(^ABSP(9002313.99,"ABSPOSX TDIF"))
. I X?."^" S X="7^1",^ABSP(9002313.99,"ABSPOSX TDIF")=X
. S RANGE=$$TADD^ABSPOSUD(DT,-$P(X,U))_U_$$TADD^ABSPOSUD(DT,-$P(X,U,2))
E D
. S RANGE=$$DTR^ABSPOSU1
Q RANGE
DTRANGE() ;EP -
N DEF S DEF=$P($$NOWFM^ABSPOSU1,".")
N X S X=$$DTR^ABSPOSU1("From date: ","Thru date: ",DEF,DEF,0)
Q X
HRANGE(RANGE) ;EP - convert fileman^fileman to $H^$H
N I,X,%H,%T,%Y
F I=1:1:$L(RANGE,U) D
. S X=$P(RANGE,U,I)
. D H^%DTC
. S $P(RANGE,U,I)=%H_$S(%T:","_%T,1:"")
Q RANGE
ABSPOSX ; IHS/FCS/DRS - Support ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
+2 QUIT
+3 ; Directory:
+4 ;ABSPOSXE - search for error log entries
+5 ;
AUTO ; EP - automatic, using setup params for date range
+1 SET RANGE=$$GETRANGE(1)
IF RANGE<1
QUIT
+2 DO THELIST
+3 QUIT
INTER ; EP - interactive use
+1 SET RANGE=$$GETRANGE
IF RANGE<1
QUIT
INTERJ ; join
+1 NEW POP
DO ^%ZIS
IF $GET(POP)
QUIT
+2 DO THELIST
+3 DO ^%ZISC
+4 QUIT
TODAY ;EP
+1 SET RANGE=DT_U_DT
GOTO INTERJ
YESTER ;EP
+1 SET RANGE=$$TADD^ABSPOSUD(DT,-1)
SET RANGE=RANGE_U_RANGE
GOTO INTERJ
WEEK ;EP
+1 SET RANGE=$$TADD^ABSPOSUD(DT,-8)_U_$$TADD^ABSPOSUD(DT,-1)
GOTO INTERJ
+2 ;
THELIST ; calls to all the little things you want to monitor
+1 ; given RANGE=fileman start^end dates
+2 ; Put errors and shouldn't-happen things first:
+3 WRITE "Support Utility to survey Point of Sale activity (",$TEXT(+0),")",!
+4 WRITE "Site: ",$PIECE(^DIC(4,DUZ(2),0),U),!
+5 WRITE "Date: ",$$NOWEXT^ABSPOSU1,!
+6 ; error log
DO SEARCH^ABSPOSXE($$HRANGE(RANGE))
+7 ; stranded claims - report and cleanup
DO STRANDED
+8 ; impossible errors
DO UE
+9 ; Then put informational things:
+10 DO SHOWQ^ABSPOSR2
+11 WRITE "Winnowing old data:",!
+12 WRITE " the log files are in: ",$GET(^ABSP(9002313.99,1,"WINNOW LOGS")),!
+13 WRITE "Update of Report Master file: ",$GET(^ABSP(9002313.99,1,"ABSPOSM1")),!
+14 DO TRANSACT
+15 DO PRESSANY^ABSPOSU5()
+16 ; pharmacy volume
DO VOLUME^ABSPOS35($PIECE(RANGE,U),$PIECE(RANGE,U,2))
+17 QUIT
TRANSACT ; count 9002313.57 transactions in RANGE
+1 ; It's a date range; be sure you get them all
+2 DO TRANS1
+3 WRITE "Count of complete transactions: ",^TMP($JOB,"TRANSACT"),!
+4 WRITE "Tally by result type: ",!
+5 NEW R
SET R=""
FOR
SET R=$ORDER(^TMP($JOB,"TRANSACT","R",R))
IF R=""
QUIT
Begin DoDot:1
+6 WRITE $JUSTIFY(^TMP($JOB,"TRANSACT","R",R),10)," ",R,!
End DoDot:1
+7 WRITE "Tally by insurer and by result type: ",!
+8 NEW INS
SET INS=""
FOR
SET INS=$ORDER(^TMP($JOB,"TRANSACT","INS",INS))
IF INS=""
QUIT
Begin DoDot:1
+9 WRITE ?10,$JUSTIFY(^TMP($JOB,"TRANSACT","INS",INS),5)," for ",INS
+10 IF ^TMP($JOB,"TRANSACT","INS",INS)=$GET(^TMP($JOB,"TRANSACT","INS",INS,"R","PAPER"))
WRITE " - all PAPER",!
QUIT
+11 IF '$TEST
WRITE !
+12 SET R=""
FOR
SET R=$ORDER(^TMP($JOB,"TRANSACT","INS",INS,"R",R))
IF R=""
QUIT
Begin DoDot:2
+13 WRITE ?20,$JUSTIFY(^TMP($JOB,"TRANSACT","INS",INS,"R",R),5)," ",R,!
End DoDot:2
End DoDot:1
+14 WRITE "Tally by transaction time:",!
+15 NEW SECS
SET SECS=""
FOR
SET SECS=$ORDER(^TMP($JOB,"TRANSACT","TIME",SECS))
IF SECS=""
QUIT
Begin DoDot:1
+16 WRITE $JUSTIFY(^TMP($JOB,"TRANSACT","TIME",SECS),10)," - "
+17 IF SECS?1N.N
WRITE $$SECSDHMS^ABSPOSUD(SECS)
+18 IF '$TEST
WRITE SECS
+19 IF SECS'?1N.N!(SECS>120)
WRITE " - IEN57=",$ORDER(^TMP($JOB,"TRANSACT","TIME",SECS,""))
+20 WRITE !
End DoDot:1
+21 QUIT
TRANS1 ;
+1 ; ^TMP($J,"TRANSACT")=count of 9002313.57 transactions
+2 ; ^TMP($J,"TRANSACT","R",result)=count by result type
+3 ; ^TMP($J,"TRANSACT","INS",company)=count by insurance company
+4 ; ^TMP($J,"TRANSACT","INS",company,"R",result)=count result by company
+5 ; ^TMP($J,"TRANSACT","TIME",secs)=count
+6 ; ^TMP($J,"TRANSACT","TIME",secs,IEN57) for certain too-long ones
+7 ;
+8 ; caller should have already NEWed this
KILL ^TMP($JOB,"TRANSACT")
SET ^TMP($JOB,"TRANSACT")=0
+9 NEW T,X,Y
SET X=$PIECE(RANGE,U)
SET Y=$PIECE(RANGE,U,2)
+10 ; thru midnight, if nothing specified
IF Y'["."
SET $PIECE(Y,".",2)=24
+11 SET T=X
+12 FOR
Begin DoDot:1
+13 NEW IEN57
SET IEN57=""
+14 FOR
SET IEN57=$ORDER(^ABSPTL("AH",T,IEN57))
IF 'IEN57
QUIT
Begin DoDot:2
+15 NEW IEN57C
SET IEN57C=IEN57_","
+16 NEW R
SET R=$$GET1^DIQ(9002313.57,IEN57C,4.0098)
IF R=""
SET R="null??"
+17 NEW INS
SET INS=$$GET1^DIQ(9002313.57,IEN57C,1.06)
IF INS=""
SET INS="No Insurance"
+18 SET ^TMP($JOB,"TRANSACT")=^TMP($JOB,"TRANSACT")+1
+19 SET ^TMP($JOB,"TRANSACT","R",R)=$GET(^TMP($JOB,"TRANSACT","R",R))+1
+20 SET ^TMP($JOB,"TRANSACT","INS",INS)=$GET(^TMP($JOB,"TRANSACT","INS",INS))+1
+21 SET ^TMP($JOB,"TRANSACT","INS",INS,"R",R)=$GET(^TMP($JOB,"TRANSACT","INS",INS,"R",R))+1
+22 NEW SECS
SET SECS=$$GET1^DIQ(9002313.57,IEN57C,9999.98)
+23 IF SECS=""
SET SECS="null?"
+24 SET ^TMP($JOB,"TRANSACT","TIME",SECS)=$GET(^TMP($JOB,"TRANSACT","TIME",SECS))+1
+25 IF SECS>120
SET ^TMP($JOB,"TRANSACT","TIME",SECS,IEN57)=""
End DoDot:2
End DoDot:1
SET T=$ORDER(^ABSPTL("AH",T))
IF 'T
QUIT
IF T>Y
QUIT
+26 QUIT
STRANDED ;
+1 NEW HRS
SET HRS=$PIECE($GET(^ABSP(9002313.99,"ABSPOSX TDIF")),U,3)*24
+2 ; make it a month
IF 'HRS
SET HRS=24*31
+3 DO PURGE^ABSPOSU7(HRS)
+4 QUIT
UE ; ^TMP("ABSPOSUE",$J)=DUZ^$H
+1 NEW NDAYS
SET NDAYS=$PIECE($GET(^ABSP(9002313.99,"ABSPOSX TDIF")),U,3)
+2 IF 'NDAYS
SET NDAYS=31
+3 NEW J
SET J=""
IF $ORDER(^TMP("ABSPOSUE",J))=""
QUIT
+4 WRITE "Errors which went through ABSPOSUE:",!
+5 FOR
SET J=$ORDER(^TMP("ABSPOSUE",J))
IF J=""
QUIT
Begin DoDot:1
+6 NEW X
SET X=^TMP("ABSPOSUE",J)
+7 NEW H
SET H=$PIECE(X,U,2)
+8 ; too old to report; winnow it if it's really old
IF H-$HOROLOG>NDAYS
Begin DoDot:2
+9 IF H-$HOROLOG>(NDAYS+30)
KILL ^TMP("ABSPOSUE",J)
End DoDot:2
QUIT
+10 ; convert H from $H to Fileman
Begin DoDot:2
+11 NEW %H,%,X
SET %H=H
DO YMD^%DTC
SET H=X
End DoDot:2
+12 IF H<$PIECE(RANGE,U)
QUIT
IF H>$PIECE(RANGE,U,2)
QUIT
+13 WRITE "Encountered by ",$PIECE($GET(^VA(200,+X,0)),U)," on ",H,!
End DoDot:1
+14 QUIT
GETRANGE(HOW) ; HOW = 1 - silently, from setup file
+1 ; otherwise, interactive, ask
+2 IF $GET(HOW)=1
Begin DoDot:1
+3 NEW X
SET X=$GET(^ABSP(9002313.99,"ABSPOSX TDIF"))
+4 IF X?."^"
SET X="7^1"
SET ^ABSP(9002313.99,"ABSPOSX TDIF")=X
+5 SET RANGE=$$TADD^ABSPOSUD(DT,-$PIECE(X,U))_U_$$TADD^ABSPOSUD(DT,-$PIECE(X,U,2))
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET RANGE=$$DTR^ABSPOSU1
End DoDot:1
+8 QUIT RANGE
DTRANGE() ;EP -
+1 NEW DEF
SET DEF=$PIECE($$NOWFM^ABSPOSU1,".")
+2 NEW X
SET X=$$DTR^ABSPOSU1("From date: ","Thru date: ",DEF,DEF,0)
+3 QUIT X
HRANGE(RANGE) ;EP - convert fileman^fileman to $H^$H
+1 NEW I,X,%H,%T,%Y
+2 FOR I=1:1:$LENGTH(RANGE,U)
Begin DoDot:1
+3 SET X=$PIECE(RANGE,U,I)
+4 DO H^%DTC
+5 SET $PIECE(RANGE,U,I)=%H_$SELECT(%T:","_%T,1:"")
End DoDot:1
+6 QUIT RANGE
