ABSPOSQ4 ; IHS/FCS/DRS - Process responses ; [ 10/07/2002 10:36 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,6,31**;JUN 21, 2001;Build 38
; Called from ABSPOSQ3 at RESPONSE()
;
; What's here: the main LOOP and several miscellaneous subroutines,
; many of which are called from outside.
;
; The meat of the response packet processing is in RESPONSE^ABSPOSQL
; and its subroutines, ONE, ONE1, RESP1
;
;---------------------------------------------------------
;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes
; The responses are exactly the same between 5.1 and 3.2 - we needed
; to add new logic to RESP1000 and RESPMSG to capture the newer
; information
;
;----------------------------------------------------------
;IHS/SD/lwj 6/10/03 Patch 6 - insurer sleep override
; Usually a rejection code of 99 on a claim indicates that
; the insurer/processor is not able to accept or process
; claims at this time. POS puts the insurer in a sleep state
; and probes the insurer for response. This was done to cut
; cost and traffic from sending claims when the insurer is down.
; Unfortunately, some insurers send the 99 to reflect that the
; patient simply isn't on their plan - this was causing the insurer
; to stay in a permanent sleep state. Changes were made to REJSLEEP
; to check a new flag in the insurer file (101.07 99 REJECT SLEEP
; OVERRIDE) - when set, we will not put the insurer to sleep,
; even when we get a rejection of 99.
;---------------------------------------------------------
Q
EN ; the task from ABSPOSQ3 starts here
; for a specific DIALOUT
; Q4WAIT might be defined, too
I '$G(Q4WAIT),'$O(^ABSPECX("POS",DIALOUT,"R",0)) Q ; not waiting; nothing ready
N A,B,BLIMIT,ODIALOUT,GOTLOCK ; "O" as in "Original"
S ODIALOUT=DIALOUT,BLIMIT=$G(Q4WAIT,10)
D INIT^ABSPOSL(.11)
D LOG($T(+0)_" - Job "_$J_" processing POS responses.")
LOOP ;
; The task may have been started before the responses were ready yet.
; For example, it may have been started before dialing - figure up
; to a minute before something might be available.
S B=0 F A=5:5:BLIMIT D Q:B
. S B=$O(^ABSPECX("POS",DIALOUT,"R","")) Q:B
. HANG 2+$R(6) ; averages out to 5 seconds between checking
I 'B G LOOP7 ; no responses ready for this DIALOUT
LOOP1 ;
D LOG($T(+0)_" - Processing responses for DIALOUT="_DIALOUT)
L +^TMP("ABSPOSQ4",DIALOUT):5 ; only one job per DIALOUT (overcautious)
S GOTLOCK=$T
I GOTLOCK D
. D RESPONSE^ABSPOSQL(DIALOUT) ; process all responses for this DIALOUT
. L -^TMP("ABSPOSQ4",DIALOUT)
. D LOG($T(+0)_" - Done for DIALOUT="_DIALOUT)
E D G LOOP9
. D LOG($T(+0)_" - couldn't get LOCK? Another one already running?")
. D TASKAT^ABSPOSQ3($$TADDNOW^ABSPOSUD(.0002)) ; try again in 2 mins.
LOOP7 S DIALOUT=$$ANYRESPS(0) ; any others for anybody else we can do now?
I DIALOUT G LOOP1
I B S DIALOUT=ODIALOUT,BLIMIT=10 G LOOP ; worth looping back to check original
LOOP9 D LOG($T(+0)_" - Job "_$J_" completed.")
D RELSLOT^ABSPOSL
; If there are any Status 19's, rev up a processor to rescue them
I $D(^ABSPT("AD",19)) D TASK^ABSPOSIZ ; ABSPOSQ1
Q
LOG(X) D LOG^ABSPOSL(X) Q
ANYRESPS(DIALOUT) ;EP - ABSPOS2D ;
; are there any responses waiting to be processed?
; Also called from POKE^ABSPOSUD
I $G(DIALOUT) Q $S($O(^ABSPECX("POS",DIALOUT,"R","")):DIALOUT,1:0)
; DIALOUT not given, so look for any DIALOUTs that need work
; If any waiting, return DIALOUT where there are
; Else return ""
N SET,RET S (SET,RET)=0
F S SET=$O(^ABSP(9002313.55,SET)) Q:'SET I $$ANYRESPS(SET) S RET=SET Q
Q RET
;
; The following are separate little utilities called from elsewhere.
;
PAID(IEN59) ;EP - ABSPOSQS ;quick query to see if it's paid
N TMP D RESPINFO(IEN59,.TMP) Q:'$D(TMP("RSP")) 0
N X S X=TMP("RSP")
I X="Payable" Q 1
;I X="Captured" Q .5 ; should we?
Q 0
RESPINFO(RXI,DST) ;EP - ABSPOS6B,ABSPOSNC,ABSPOSUA
; quick way to get all the response info for a given RXI
; IMPORTANT!! D not change spelling, case, wording, or spacing!!!
; Callers such as ABSPOSNC are depending on the exact DST("RSP")
; If a reversal was attempted, it complicates things.
; fills DST array as follows:
; DST("HDR")=Response Status (header)
; DST("RSP")=Response Status (prescription)
; This could be: "Payable" "Rejected" "Captured" "Duplicate"
; or "Accepted reversal" or "Rejected reversal"
; or "null" or "null reversal" (no response or corrupt response
; or maybe someone without insurance, so no request was sent)
; DST("REJ",0)=count of reject codes
; DST("REJ",n)=each reject code
; DST("MSG")=message with the response
; All of these are defined, even if originals were '$D.
; The external forms are returned.
N REVERSAL S REVERSAL=$G(^ABSPT(RXI,4))>0
N RESP
I 'REVERSAL S RESP=$P(^ABSPT(RXI,0),U,5)
E S RESP=$P(^ABSPT(RXI,4),U,2)
Q:'RESP
N POS S POS=$P(^ABSPT(RXI,0),U,9) Q:'POS
N FMT S FMT="E"
S DST("HDR")=$$RESP500(RESP,FMT)
S DST("RSP")=$$RESP1000(RESP,POS,FMT)
S DST("REJ",0)=$$REJCOUNT(RESP,POS,FMT)
I DST("REJ",0) D
.N I F I=1:1:DST("REJ",0) S DST("REJ",I)=$$REJCODE(RESP,POS,I,FMT)
S DST("MSG")=$$RESPMSG(RESP,POS,FMT)
; Dealing with oddities of PCS (and others'?) response to reversals
I REVERSAL,DST("RSP")["null" D
.I DST("RSP")["null" S DST("RSP")=DST("HDR")_" reversal"
Q
; In the following quickies:
; RESP = RESPIEN, pointer to 9002313.03
; FMT = "I" for internal, "E" for external, defaults to internal
RESP500(RESP,FMT) ;EP - ABSPOS57,ABSPOSP2,ABSPOSUC
; returns the response header status
N X S X=$P($G(^ABSPR(RESP,500)),U)
I $G(FMT)'="E" Q X
I X="" S X="null"
S X=$S(X="A":"Accepted",X="R":"Rejected",1:"?"_X)
Q X
RESP1000(RESP,POS,FMT) ;EP - ABSPOSP2,ABSPOSUC
; returns the prescription response status
; Note! Could be DP or DC for duplicates
N X S X=$P($G(^ABSPR(RESP,1000,POS,500)),U)
I $G(FMT)'="E" Q X
I X="" S X="null"
;
;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes - they will send an "A" back
; now on the transaction level to indicate that it has been accepted
; Next code line remarked out - following added
;
;S X=$S(X="P":"Payable",X="R":"Rejected",X="C":"Captured",X="D"!(X="DP")!(X="DC"):"Duplicate",1:"?"_X)
S X=$S(X="A":"Accepted",X="P":"Payable",X="R":"Rejected",X="C":"Captured",X="D"!(X="DP")!(X="DC"):"Duplicate",1:"?"_X)
Q X
REJCOUNT(RESP,POS,FMT) ; returns rejection count
Q +$P($G(^ABSPR(RESP,1000,POS,511,0)),U,3)
REJCODE(RESP,POS,N,FMT) ; returns Nth rejection code
; if FMT="E", returns code:text
N CODE S CODE=$P($G(^ABSPR(RESP,1000,POS,511,N,0)),U)
I CODE="" S CODE="null"
I FMT'="E" Q CODE
N X S X=$O(^ABSPF(9002313.93,"B",CODE,0))
I X]"" S CODE=CODE_":"_$P($G(^ABSPF(9002313.93,X,0)),U,2)
E S CODE="?"_CODE
Q CODE
;
;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes - message may not come
; back in 504 - may come back in 526 instead
;
RESPMSG(RESP,POS,FMT) ; response message - additional text from insurer
;
N MSG
S MSG=""
S MSG=$G(^ABSPR(RESP,1000,POS,504))
S:MSG="" MSG=$G(^ABSPR(RESP,1000,POS,526))
;Q $G(^ABSPR(RESP,1000,POS,504))
Q MSG
;
;IHS/SD/lwj 10/07/02 end of NCPDP 5.1 changes to RESPMSG
;
NOW() N %,%H,%I,X D NOW^%DTC Q %
;
; The xxxSLEEP functions are called from ABSPOSQL
;
CLRSLEEP(INS,WHY) ;EP - ABSPOSQL
; clear insurer sleeping condition
; also called from CANCEL^ABSPOSUD
; WHY = 1 - we know for sure they're awake now
Q:$G(INS)="" ;IHS/OIT/SCR 05/07/09 avoid undefined patch 31
N X S X=$G(^ABSPEI(INS,101)) Q:'X ; not asleep
S $P(X,U)="",$P(X,U,5)="",$P(X,U,6)="",^ABSPEI(INS,101)=X
I $D(^ABSPT("AD",31)) D
. D TASK^ABSPOSQ1 ; awaken any other 31s waiting for this insurer
Q
REJSLEEP(RESP,POS) ;EP - ABSPOSQL
; return TRUE if this claim was rejected because the
; insurer is sleeping
; Reject codes we look for depend on which switch.
; Envoy's:
I $G(^ABSPR(RESP,1000,POS,504))?1"EV16-".E Q 1
I $G(^ABSPR(RESP,1000,POS,504))?1"EV38-".E Q 1
I $G(^ABSPR(RESP,1000,POS,504))?1"EV32-".E Q 1
I $G(^ABSPR(RESP,1000,POS,504))?1"EV25-".E Q 1 ; ABSP*1.0T7*4
; NDC's, and theoretically, Envoy too, though they seem to do EV- msgs
I $O(^ABSPR(RESP,1000,POS,511,"B",90))="" Q 0 ; cheap check
; But for a PCS case we see, Code 99 + some code < 90 ; ABSP*1.0T7*2
; isn't "asleep" - 99 is something PCS threw in ; ABSP*1.0T7*2
; so require 99 to be accompanied by something <99 too ; ABSP*1.0T7*2
N RET S RET=0 N I F I=92,93,99 D Q:RET
. I $D(^ABSPR(RESP,1000,POS,511,"B",I)) S RET=1
. Q:I'=99 Q:'RET ; ABSP*1.0T7*2
. I I=99,$O(^ABSPR(RESP,1000,POS,511,"B",0))<90 S RET=0 ; ABSP*1.0T7*2
;
;IHS/SD/lwj 06/10/03 Patch 6 Version 1.0
;Check for sleep override - some insurers naturally return a
;rejection of 99 - it doesn't mean they're asleep, and we need
;to bypass putting them in a sleep state
;
I RET=1 D
. N ABSPCID,ABSPIID,ABSPSLP
. S (ABSPCID,ABSPIID,ABSPSLP)=""
. S ABSPCID=$P($G(^ABSPR(RESP,0)),U) ;pointer to claim file
. Q:ABSPCID=""
. S ABSPIID=$P($G(^ABSPC(ABSPCID,0)),U,2) ;pntr to insurer file
. Q:ABSPIID=""
. S ABSPSLP=$P($G(^ABSPEI(ABSPIID,101)),U,7) ;99 rej slp ovr
. S:ABSPSLP RET=0 ;don't go to sleep
;
;IHS/SD/lwj 6/10/03 end of changes
;
Q RET
INCSLEEP(INS) ;EP - ABSPOSQL
; Increment sleep time for this insurer, if necessary.
; Return the scheduled retry time
N X S X=$G(^ABSPEI(INSURER,101))
I $P(X,U)<$$NOW D ; previous retry expired, let's retry:
. I '$P(X,U,2) S $P(X,U,2)=600 ; base time = 10 minutes
. I '$P(X,U,3) S $P(X,U,3)=3 ; multiplier
. I '$P(X,U,4) S $P(X,U,4)=2.5*60*60 ; max wait time ; 2.5 hrs
. I '$P(X,U,5) S $P(X,U,5)=$P(X,U,2) ; current wait time (either init
. E S $P(X,U,5)=$P(X,U,5)*$P(X,U,3) ; or multiply)
. S $P(X,U,5)=$P(X,U,5)\1
. S:$P(X,U,5)>$P(X,U,4) $P(X,U,5)=$P(X,U,4) ; apply max if needed
. S $P(X,U)=$$TADDNOWS^ABSPOSUD($P(X,U,5)) ; set retry time
. S ^ABSPEI(INSURER,101)=X
. D TASKAT^ABSPOSQ1($P(X,U)) ; ABSPOSQ2 will run again upon expiry
. D TASK^ABSPOSQ1 ; and run it again right away, too, to stamp new times on the others in status 31
Q $P(X,U)
ABSPOSQ4 ; IHS/FCS/DRS - Process responses ; [ 10/07/2002 10:36 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,6,31**;JUN 21, 2001;Build 38
+2 ; Called from ABSPOSQ3 at RESPONSE()
+3 ;
+4 ; What's here: the main LOOP and several miscellaneous subroutines,
+5 ; many of which are called from outside.
+6 ;
+7 ; The meat of the response packet processing is in RESPONSE^ABSPOSQL
+8 ; and its subroutines, ONE, ONE1, RESP1
+9 ;
+10 ;---------------------------------------------------------
+11 ;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes
+12 ; The responses are exactly the same between 5.1 and 3.2 - we needed
+13 ; to add new logic to RESP1000 and RESPMSG to capture the newer
+14 ; information
+15 ;
+16 ;----------------------------------------------------------
+17 ;IHS/SD/lwj 6/10/03 Patch 6 - insurer sleep override
+18 ; Usually a rejection code of 99 on a claim indicates that
+19 ; the insurer/processor is not able to accept or process
+20 ; claims at this time. POS puts the insurer in a sleep state
+21 ; and probes the insurer for response. This was done to cut
+22 ; cost and traffic from sending claims when the insurer is down.
+23 ; Unfortunately, some insurers send the 99 to reflect that the
+24 ; patient simply isn't on their plan - this was causing the insurer
+25 ; to stay in a permanent sleep state. Changes were made to REJSLEEP
+26 ; to check a new flag in the insurer file (101.07 99 REJECT SLEEP
+27 ; OVERRIDE) - when set, we will not put the insurer to sleep,
+28 ; even when we get a rejection of 99.
+29 ;---------------------------------------------------------
+30 QUIT
EN ; the task from ABSPOSQ3 starts here
+1 ; for a specific DIALOUT
+2 ; Q4WAIT might be defined, too
+3 ; not waiting; nothing ready
IF '$GET(Q4WAIT)
IF '$ORDER(^ABSPECX("POS",DIALOUT,"R",0))
QUIT
+4 ; "O" as in "Original"
NEW A,B,BLIMIT,ODIALOUT,GOTLOCK
+5 SET ODIALOUT=DIALOUT
SET BLIMIT=$GET(Q4WAIT,10)
+6 DO INIT^ABSPOSL(.11)
+7 DO LOG($TEXT(+0)_" - Job "_$JOB_" processing POS responses.")
LOOP ;
+1 ; The task may have been started before the responses were ready yet.
+2 ; For example, it may have been started before dialing - figure up
+3 ; to a minute before something might be available.
+4 SET B=0
FOR A=5:5:BLIMIT
Begin DoDot:1
+5 SET B=$ORDER(^ABSPECX("POS",DIALOUT,"R",""))
IF B
QUIT
+6 ; averages out to 5 seconds between checking
HANG 2+$RANDOM(6)
End DoDot:1
IF B
QUIT
+7 ; no responses ready for this DIALOUT
IF 'B
GOTO LOOP7
LOOP1 ;
+1 DO LOG($TEXT(+0)_" - Processing responses for DIALOUT="_DIALOUT)
+2 ; only one job per DIALOUT (overcautious)
LOCK +^TMP("ABSPOSQ4",DIALOUT):5
+3 SET GOTLOCK=$TEST
+4 IF GOTLOCK
Begin DoDot:1
+5 ; process all responses for this DIALOUT
DO RESPONSE^ABSPOSQL(DIALOUT)
+6 LOCK -^TMP("ABSPOSQ4",DIALOUT)
+7 DO LOG($TEXT(+0)_" - Done for DIALOUT="_DIALOUT)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 DO LOG($TEXT(+0)_" - couldn't get LOCK? Another one already running?")
+10 ; try again in 2 mins.
DO TASKAT^ABSPOSQ3($$TADDNOW^ABSPOSUD(.0002))
End DoDot:1
GOTO LOOP9
LOOP7 ; any others for anybody else we can do now?
SET DIALOUT=$$ANYRESPS(0)
+1 IF DIALOUT
GOTO LOOP1
+2 ; worth looping back to check original
IF B
SET DIALOUT=ODIALOUT
SET BLIMIT=10
GOTO LOOP
LOOP9 DO LOG($TEXT(+0)_" - Job "_$JOB_" completed.")
+1 DO RELSLOT^ABSPOSL
+2 ; If there are any Status 19's, rev up a processor to rescue them
+3 ; ABSPOSQ1
IF $DATA(^ABSPT("AD",19))
DO TASK^ABSPOSIZ
+4 QUIT
LOG(X) DO LOG^ABSPOSL(X)
QUIT
ANYRESPS(DIALOUT) ;EP - ABSPOS2D ;
+1 ; are there any responses waiting to be processed?
+2 ; Also called from POKE^ABSPOSUD
+3 IF $GET(DIALOUT)
QUIT $SELECT($ORDER(^ABSPECX("POS",DIALOUT,"R","")):DIALOUT,1:0)
+4 ; DIALOUT not given, so look for any DIALOUTs that need work
+5 ; If any waiting, return DIALOUT where there are
+6 ; Else return ""
+7 NEW SET,RET
SET (SET,RET)=0
+8 FOR
SET SET=$ORDER(^ABSP(9002313.55,SET))
IF 'SET
QUIT
IF $$ANYRESPS(SET)
SET RET=SET
QUIT
+9 QUIT RET
+10 ;
+11 ; The following are separate little utilities called from elsewhere.
+12 ;
PAID(IEN59) ;EP - ABSPOSQS ;quick query to see if it's paid
+1 NEW TMP
DO RESPINFO(IEN59,.TMP)
IF '$DATA(TMP("RSP"))
QUIT 0
+2 NEW X
SET X=TMP("RSP")
+3 IF X="Payable"
QUIT 1
+4 ;I X="Captured" Q .5 ; should we?
+5 QUIT 0
RESPINFO(RXI,DST) ;EP - ABSPOS6B,ABSPOSNC,ABSPOSUA
+1 ; quick way to get all the response info for a given RXI
+2 ; IMPORTANT!! D not change spelling, case, wording, or spacing!!!
+3 ; Callers such as ABSPOSNC are depending on the exact DST("RSP")
+4 ; If a reversal was attempted, it complicates things.
+5 ; fills DST array as follows:
+6 ; DST("HDR")=Response Status (header)
+7 ; DST("RSP")=Response Status (prescription)
+8 ; This could be: "Payable" "Rejected" "Captured" "Duplicate"
+9 ; or "Accepted reversal" or "Rejected reversal"
+10 ; or "null" or "null reversal" (no response or corrupt response
+11 ; or maybe someone without insurance, so no request was sent)
+12 ; DST("REJ",0)=count of reject codes
+13 ; DST("REJ",n)=each reject code
+14 ; DST("MSG")=message with the response
+15 ; All of these are defined, even if originals were '$D.
+16 ; The external forms are returned.
+17 NEW REVERSAL
SET REVERSAL=$GET(^ABSPT(RXI,4))>0
+18 NEW RESP
+19 IF 'REVERSAL
SET RESP=$PIECE(^ABSPT(RXI,0),U,5)
+20 IF '$TEST
SET RESP=$PIECE(^ABSPT(RXI,4),U,2)
+21 IF 'RESP
QUIT
+22 NEW POS
SET POS=$PIECE(^ABSPT(RXI,0),U,9)
IF 'POS
QUIT
+23 NEW FMT
SET FMT="E"
+24 SET DST("HDR")=$$RESP500(RESP,FMT)
+25 SET DST("RSP")=$$RESP1000(RESP,POS,FMT)
+26 SET DST("REJ",0)=$$REJCOUNT(RESP,POS,FMT)
+27 IF DST("REJ",0)
Begin DoDot:1
+28 NEW I
FOR I=1:1:DST("REJ",0)
SET DST("REJ",I)=$$REJCODE(RESP,POS,I,FMT)
End DoDot:1
+29 SET DST("MSG")=$$RESPMSG(RESP,POS,FMT)
+30 ; Dealing with oddities of PCS (and others'?) response to reversals
+31 IF REVERSAL
IF DST("RSP")["null"
Begin DoDot:1
+32 IF DST("RSP")["null"
SET DST("RSP")=DST("HDR")_" reversal"
End DoDot:1
+33 QUIT
+34 ; In the following quickies:
+35 ; RESP = RESPIEN, pointer to 9002313.03
+36 ; FMT = "I" for internal, "E" for external, defaults to internal
RESP500(RESP,FMT) ;EP - ABSPOS57,ABSPOSP2,ABSPOSUC
+1 ; returns the response header status
+2 NEW X
SET X=$PIECE($GET(^ABSPR(RESP,500)),U)
+3 IF $GET(FMT)'="E"
QUIT X
+4 IF X=""
SET X="null"
+5 SET X=$SELECT(X="A":"Accepted",X="R":"Rejected",1:"?"_X)
+6 QUIT X
RESP1000(RESP,POS,FMT) ;EP - ABSPOSP2,ABSPOSUC
+1 ; returns the prescription response status
+2 ; Note! Could be DP or DC for duplicates
+3 NEW X
SET X=$PIECE($GET(^ABSPR(RESP,1000,POS,500)),U)
+4 IF $GET(FMT)'="E"
QUIT X
+5 IF X=""
SET X="null"
+6 ;
+7 ;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes - they will send an "A" back
+8 ; now on the transaction level to indicate that it has been accepted
+9 ; Next code line remarked out - following added
+10 ;
+11 ;S X=$S(X="P":"Payable",X="R":"Rejected",X="C":"Captured",X="D"!(X="DP")!(X="DC"):"Duplicate",1:"?"_X)
+12 SET X=$SELECT(X="A":"Accepted",X="P":"Payable",X="R":"Rejected",X="C":"Captured",X="D"!(X="DP")!(X="DC"):"Duplicate",1:"?"_X)
+13 QUIT X
REJCOUNT(RESP,POS,FMT) ; returns rejection count
+1 QUIT +$PIECE($GET(^ABSPR(RESP,1000,POS,511,0)),U,3)
REJCODE(RESP,POS,N,FMT) ; returns Nth rejection code
+1 ; if FMT="E", returns code:text
+2 NEW CODE
SET CODE=$PIECE($GET(^ABSPR(RESP,1000,POS,511,N,0)),U)
+3 IF CODE=""
SET CODE="null"
+4 IF FMT'="E"
QUIT CODE
+5 NEW X
SET X=$ORDER(^ABSPF(9002313.93,"B",CODE,0))
+6 IF X]""
SET CODE=CODE_":"_$PIECE($GET(^ABSPF(9002313.93,X,0)),U,2)
+7 IF '$TEST
SET CODE="?"_CODE
+8 QUIT CODE
+9 ;
+10 ;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes - message may not come
+11 ; back in 504 - may come back in 526 instead
+12 ;
RESPMSG(RESP,POS,FMT) ; response message - additional text from insurer
+1 ;
+2 NEW MSG
+3 SET MSG=""
+4 SET MSG=$GET(^ABSPR(RESP,1000,POS,504))
+5 IF MSG=""
SET MSG=$GET(^ABSPR(RESP,1000,POS,526))
+6 ;Q $G(^ABSPR(RESP,1000,POS,504))
+7 QUIT MSG
+8 ;
+9 ;IHS/SD/lwj 10/07/02 end of NCPDP 5.1 changes to RESPMSG
+10 ;
NOW() NEW %,%H,%I,X
DO NOW^%DTC
QUIT %
+1 ;
+2 ; The xxxSLEEP functions are called from ABSPOSQL
+3 ;
CLRSLEEP(INS,WHY) ;EP - ABSPOSQL
+1 ; clear insurer sleeping condition
+2 ; also called from CANCEL^ABSPOSUD
+3 ; WHY = 1 - we know for sure they're awake now
+4 ;IHS/OIT/SCR 05/07/09 avoid undefined patch 31
IF $GET(INS)=""
QUIT
+5 ; not asleep
NEW X
SET X=$GET(^ABSPEI(INS,101))
IF 'X
QUIT
+6 SET $PIECE(X,U)=""
SET $PIECE(X,U,5)=""
SET $PIECE(X,U,6)=""
SET ^ABSPEI(INS,101)=X
+7 IF $DATA(^ABSPT("AD",31))
Begin DoDot:1
+8 ; awaken any other 31s waiting for this insurer
DO TASK^ABSPOSQ1
End DoDot:1
+9 QUIT
REJSLEEP(RESP,POS) ;EP - ABSPOSQL
+1 ; return TRUE if this claim was rejected because the
+2 ; insurer is sleeping
+3 ; Reject codes we look for depend on which switch.
+4 ; Envoy's:
+5 IF $GET(^ABSPR(RESP,1000,POS,504))?1"EV16-".E
QUIT 1
+6 IF $GET(^ABSPR(RESP,1000,POS,504))?1"EV38-".E
QUIT 1
+7 IF $GET(^ABSPR(RESP,1000,POS,504))?1"EV32-".E
QUIT 1
+8 ; ABSP*1.0T7*4
IF $GET(^ABSPR(RESP,1000,POS,504))?1"EV25-".E
QUIT 1
+9 ; NDC's, and theoretically, Envoy too, though they seem to do EV- msgs
+10 ; cheap check
IF $ORDER(^ABSPR(RESP,1000,POS,511,"B",90))=""
QUIT 0
+11 ; But for a PCS case we see, Code 99 + some code < 90 ; ABSP*1.0T7*2
+12 ; isn't "asleep" - 99 is something PCS threw in ; ABSP*1.0T7*2
+13 ; so require 99 to be accompanied by something <99 too ; ABSP*1.0T7*2
+14 NEW RET
SET RET=0
NEW I
FOR I=92,93,99
Begin DoDot:1
+15 IF $DATA(^ABSPR(RESP,1000,POS,511,"B",I))
SET RET=1
+16 ; ABSP*1.0T7*2
IF I'=99
QUIT
IF 'RET
QUIT
+17 ; ABSP*1.0T7*2
IF I=99
IF $ORDER(^ABSPR(RESP,1000,POS,511,"B",0))<90
SET RET=0
End DoDot:1
IF RET
QUIT
+18 ;
+19 ;IHS/SD/lwj 06/10/03 Patch 6 Version 1.0
+20 ;Check for sleep override - some insurers naturally return a
+21 ;rejection of 99 - it doesn't mean they're asleep, and we need
+22 ;to bypass putting them in a sleep state
+23 ;
+24 IF RET=1
Begin DoDot:1
+25 NEW ABSPCID,ABSPIID,ABSPSLP
+26 SET (ABSPCID,ABSPIID,ABSPSLP)=""
+27 ;pointer to claim file
SET ABSPCID=$PIECE($GET(^ABSPR(RESP,0)),U)
+28 IF ABSPCID=""
QUIT
+29 ;pntr to insurer file
SET ABSPIID=$PIECE($GET(^ABSPC(ABSPCID,0)),U,2)
+30 IF ABSPIID=""
QUIT
+31 ;99 rej slp ovr
SET ABSPSLP=$PIECE($GET(^ABSPEI(ABSPIID,101)),U,7)
+32 ;don't go to sleep
IF ABSPSLP
SET RET=0
End DoDot:1
+33 ;
+34 ;IHS/SD/lwj 6/10/03 end of changes
+35 ;
+36 QUIT RET
INCSLEEP(INS) ;EP - ABSPOSQL
+1 ; Increment sleep time for this insurer, if necessary.
+2 ; Return the scheduled retry time
+3 NEW X
SET X=$GET(^ABSPEI(INSURER,101))
+4 ; previous retry expired, let's retry:
IF $PIECE(X,U)<$$NOW
Begin DoDot:1
+5 ; base time = 10 minutes
IF '$PIECE(X,U,2)
SET $PIECE(X,U,2)=600
+6 ; multiplier
IF '$PIECE(X,U,3)
SET $PIECE(X,U,3)=3
+7 ; max wait time ; 2.5 hrs
IF '$PIECE(X,U,4)
SET $PIECE(X,U,4)=2.5*60*60
+8 ; current wait time (either init
IF '$PIECE(X,U,5)
SET $PIECE(X,U,5)=$PIECE(X,U,2)
+9 ; or multiply)
IF '$TEST
SET $PIECE(X,U,5)=$PIECE(X,U,5)*$PIECE(X,U,3)
+10 SET $PIECE(X,U,5)=$PIECE(X,U,5)\1
+11 ; apply max if needed
IF $PIECE(X,U,5)>$PIECE(X,U,4)
SET $PIECE(X,U,5)=$PIECE(X,U,4)
+12 ; set retry time
SET $PIECE(X,U)=$$TADDNOWS^ABSPOSUD($PIECE(X,U,5))
+13 SET ^ABSPEI(INSURER,101)=X
+14 ; ABSPOSQ2 will run again upon expiry
DO TASKAT^ABSPOSQ1($PIECE(X,U))
+15 ; and run it again right away, too, to stamp new times on the others in status 31
DO TASK^ABSPOSQ1
End DoDot:1
+16 QUIT $PIECE(X,U)
