ABSPOSRX ; IHS/FCS/DRS - callable from RPMS pharm ; [ 01/21/2003 8:40 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,4,5,31,40,44**;JUN 21, 2001;Build 38
Q
;
; Also used by other ABSPOSR* routines to find transactions
; that need to be submitted to Point of Sale.
;
;------------------------------------------------------
; IHS/SD/lwj 11/25/02 change in the task subroutine
; There was a strange problem at Benewah only where the
; tasking to task man from "claim" was not functioning properly.
; The claim would task, but nothing would happen, and the task
; would disappear from taskman. If the same site deleted or
; editted the prescription, the same task code would work
; perfect. No other site has ever reported this problem and
; the biggest difference is ILC software running under the
; same name space at Benewah. To get around the problem
; we altered TASK to new everything. This worked, so we are
; keeping the fix in the package. This fix was generated
; by Patrick Cox of Oklahoma.
;
;-------
;IHS/SD/lwj 1/9/03 the new we added in November caused our
; "other" sites (i.e. not Benewah) problems with their posting.
; It turns out that the DUZ wasn't always being submitted with the
; task. The DUZ is required for the posting to 3rd party, so when
; it wasn't there, it didn't post correctly. Altered the new to do
; everything BUT the DUZ.
;------------------------------------------------------------
;
;-------
;IHS/OIT/SCR 4/17/09 patch 31
; MOREDATA("RXREASON") is defined and set in Outpatient Pharmacy 7.0
; when an prescription has been reversed and provides one of three
; possible reason for the reversal:
;
; Prescription logically deleted
; Returned to stock.
; Reversal caused by edit.
;
; MOREDATA("RXREASON") is only defined for 'UNCLAIM' transaction types
;
DOCU N I,X F I=0:1 S X=$T(DOCU1+I) Q:X["END OF DOCUMENTATION" D
. W $P(X,";",2,99),!
Q
DOCU1 ; There are only four callable entry points!
; $$CLAIM^ABSPOSRX Submit a claim to Point of Sale
; $$UNCLAIM^ABSPOSRX Reverse a previously submitted claim.
; $$STATUS^ABSPOSRX Inquire about a claim's status
; SHOWQ^ABSPOSRX Display queue of claims to be processed
;
; All of these routines may be called in either $$ or DO forms,
; even though the individual descriptions speak only of $$ form,
; The RXI argument is required - a pointer to ^PSRX(*
; The RXR argument is optional - a pointer to ^PSRX(RXI,1,*
; If RXR is omitted, the first fill is assumed.
; Should have MOREDATA("ORIGIN")
; = undefined - if caller is RPMS Pharmacy package
; = some assigned value - for all other callers
;
; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; $$CLAIM^ABSPOSRX - submit a claim to Point of Sale
;
; $$CLAIM^ABSPOSRX(RXI,RXR,.MOREDATA)
; Submit a claim to point of sale
; Use, for example, when a prescription is released.
; All this does is to put it on a list and start a background job.
; Return values:
; 1 = accepted for processing
; 0^reason = failure (should never happen)
;
; Note: If the claim has already been processed, and it's
; resubmitted, then a reversal will be done first,
; and then the resubmit will be done. Intervening calls
; to $$STATUS may show progress of the reversal before
; the resubmitted claim is processed.
; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; $$UNCLAIM^ABSPOSRX Reverse a previously submitted claim.
; Use, for example, if a prescription has been canceled.
;
; $$UNCLAIM^ABSPOSRX(RXI,RXR,.MOREDATA)
; Return value = 1 = will submit request for reversal
; = 0^reason = failure (should never happen)
;
; Note: The reversal will actually be done ONLY if the
; most recent processing of the claim resulted in something
; reversible, namely E PAYABLE or PAPER
; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; $$STATUS^ABSPOSRX inquire about a claim's status
;
; $$STATUS^ABSPOSRX(RXI,RXR)
; Returns result^time^description
; Returns null if there's no POS record of this RXI,RXR.
;
; result is IN PROGRESS, or if the claim is complete,
; result is one of the following:
; E PAYABLE, E REJECTED, E CAPTURED, E DUPLICATE
; E REVERSAL ACCEPTED, E REVERSAL REJECTED
; E OTHER
; PAPER, PAPER REVERSAL
; (PAPER categories include uninsured patients,
; even beneficiaries, as well as non-electronic insurances)
;
; "time" is the Fileman date and time of the last update
; in the status of this claim.
;
; = = = = = = = = END OF DOCUMENTATION = = = = = = = = =
; = = = Everything below this line is for internal use only
; = = = and subject to sudden unannounced changes!
; = = = Please don't call any of it directly, nor depend on
; = = = any of the techniques used.
; = = = = = = = = = = = = = = = = = = = = = = = = = = = =
CLAIM(RXI,RXR,MOREDATA) ;EP - ABSPOSR1
N RETVAL,STAT,TYPE S TYPE="CLAIM"
I '$D(RXR) S RXR=0
I '$$LOCK("SUBMIT") Q 0
K ^ABSPECP($T(+0),TYPE,RXI,RXR)
S ^ABSPECP($T(+0),TYPE,RXI,RXR)=$$NOW
I $D(MOREDATA) M ^ABSPECP($T(+0),TYPE,RXI,RXR,"MOREDATA")=MOREDATA
D UNLOCK("SUBMIT")
D RUNNING()
S RETVAL=1
Q:$Q RETVAL Q
;
UNCLAIM(RXI,RXR,MOREDATA) ;EP - ABSPOSR1
N RETVAL,STAT,RESULT,TYPE S TYPE="UNCLAIM"
I '$D(RXR) S RXR=0
I '$$LOCK("SUBMIT") Q 0
K ^ABSPECP($T(+0),TYPE,RXI,RXR)
S ^ABSPECP($T(+0),TYPE,RXI,RXR)=$$NOW
I $D(MOREDATA) M ^ABSPECP($T(+0),TYPE,RXI,RXR,"MOREDATA")=MOREDATA
D UNLOCK("SUBMIT")
D RUNNING()
S RETVAL=1
Q:$Q RETVAL Q
;
STATUS(RXI,RXR,MOREDATA) ;EP - ABSPOSRB
;
N RETVAL
I '$D(RXR) S RXR=0
; Loop: get data, quit if times match (i.e., no change during gather)
; Theoretically, though, something could cycle and be missed
; (e.g., from status 50 to status 50 in <1 sec.) in unimaginable
; extreme conditions
N IEN59
S IEN59=$$IEN59(RXI,RXR)
I '$D(^ABSPT(IEN59)) Q "" ; no POS record of this
N A,C,T1,T2,S1,S2 F D I T1=T2,S1=S2 Q
. S T1=$$LASTUP59(RXI,RXR)
. S S1=$$STATUS59(RXI,RXR)
. I S1=99 D ; completed
. . S A=$$RESULT59(RXI,RXR)
. . S C=$$RESTXT59(RXI,RXR)
. E D
. . S A="IN PROGRESS"
. . S C=$$STATI^ABSPOSU(S1)
. S T2=$$LASTUP59(RXI,RXR)
. S S2=$$STATUS59(RXI,RXR)
Q A_U_T1_U_$E(C,1,255-$L(A)-$L(T1)-2)
SHOWQ G SHOWQ^ABSPOSR2
;
; $$EDCLAIM(RXI,RXR,MOREDATA)
; Invoke the point of sale data input screen for this
; prescription and fill. Use this if you want the opportunity
; to edit the claim data - for example, pre-authorization numbers,
; price overrides, insurance order of billing, etc.
; The data entry screen is invoked. The claim can be submitted
; or not, at the user's option, by using Screenman <PF1>E or <PF1>Q
;
EDCLAIM(RXI,RXR,MOREDATA) ;
I 1 D IMPOSS^ABSPOSUE("P","TI","entry point not available in this release",$P($T(+2),";",3),"EDCLAIM",$T(+0)) Q
; for devel & testing, change above to I 0 and add to code below
N RETVAL S RETVAL=1
D LOCK
D UNLOCK
Q:$Q RETVAL Q
;
NOW() N %,%H,%I,X D NOW^%DTC Q %
; $$RESULT59 returns result of a finished claim in .59
; Can send RXI and have RXR defaulted
; PAPER or E PAYABLE or E REJECTED or E CAPTURED or E DUPLICATE
; or E OTHER (should never happen)
; or PAPER REVERSAL or E REVERSAL ACCEPTED or E REVERSAL REJECTED
RESULT59(RXI,RXR) ;EP - ABSPOS6D ; result as defined in CATEG^ABSPOSUC
N IEN59 I RXI["." S IEN59=RXI
E S:'$D(RXR) RXR=$$RXRDEF(RXI) S IEN59=$$IEN59(RXI,RXR)
Q $$CATEG^ABSPOSUC(IEN59)
RESTXT59(RXI,RXR) ; result text
N IEN59 I RXI["." S IEN59=RXI
E S:'$D(RXR) RXR=$$RXRDEF(RXI) S IEN59=$$IEN59(RXI,RXR)
Q $P($G(^ABSPT(IEN59,2)),U,2)
LASTUP59(RXI,RXR) ;EP - ABSPOSR1; time of last update
N IEN59 I RXI["." S IEN59=RXI
E S:'$D(RXR) RXR=$$RXRDEF(RXI) S IEN59=$$IEN59(RXI,RXR)
Q $P(^ABSPT(IEN59,0),U,8)
;
RXRDEF(RXI) ;EP - ABSPOSNC
Q +$P($G(^PSRX(RXI,1,0)),U,3) ; highest refill #
;
;
; Utilties
;
; LOCKING: Just one user of this routine at a time.
; X = "SUBMIT" to interlock the claim submission
; X = "BACKGROUND" to interlock the background job
LOCK(X) ;EP - ABSPOSRB
;L +^ABSPECP($T(+0),X):300 Q $T
;IHS/OIT/PIERAN/RAN 10/12/2010 PATCH 40 no reason for 5 minute timeout on this lock, or use of incremental locking...causing deadlocks at Toiyabe
L ^ABSPECP($T(+0),X):10 Q $T
LOCKNOW(X) ;EP - ABSPOSRB
;L +^ABSPECP($T(+0),X):0 Q $T
;IHS/OIT/PIERAN/RAN 10/12/2010 PATCH 40 no reason for use of incremental locking...causing deadlocks at Toiyabe
L ^ABSPECP($T(+0),X):0 Q $T
UNLOCK(X) ;EP - ABSPOSRB
L -^ABSPECP($T(+0),X) Q
LOCK59() L +^ABSPT:10 Q $T
UNLOCK59 L -^ABSPT Q
;
RUNNING() ;
;I '$$LOCKNOW("BACKGROUND") Q ; it is running; don't start another
;D UNLOCK("BACKGROUND") ; it's not running; release our probing lock
;IHS/OIT/PIERAN/RAN Patch 40...checking locks is not a good way to verify something isn't running
;IHS/OIT/CAS/RCS Patch 44...If the lock has not been reset for 30 minutes, reset - HEAT #78655
N QFL,LDT,LTM,CDT,CTM,X
S QFL=0
;I $P(+$G(^ABSP(9002313.99,1,"ABSPOSRX")),"^") Q ; it is running; don't start another
I $P(+$G(^ABSP(9002313.99,1,"ABSPOSRX")),"^") D ; it is possibly running
.S X=$P(^ABSP(9002313.99,1,"ABSPOSRX"),"^",2) I 'X S QFL=1 Q ;No date,time to compare
.S LDT=$P(X,","),LTM=$P(X,",",2) ;get last run date,time
.S X=$H,CDT=$P(X,","),CTM=$P(X,",",2) ;get current date,time
.I CDT=LDT,((CTM-LTM)<1800) S QFL=1 Q ;Could still be running, ran less than 30 min ago
.S $P(^ABSP(9002313.99,1,"ABSPOSRX"),"^",1)=0 ;Reset so task can run
I QFL Q ; don't start another
D TASK
H 1 ; wait a second after starting a task - so you don't clog task
; manager with too many of these (especially from back billing)
; it's possible for extras to start during this window of time
; that's okay, they'll die right away when they can't get the lock
Q
IEN59(RXI,RXR) ;EP - from ABSPOS,ABSPOSNC,ABSPOSRB
Q RXI_"."_$TR($J(RXR,4)," ","0")_"1"
;
; $$STATUS59 returns processing status from .59 record
; "" if there's no such claim note: 99 means complete
;
STATUS59(RXI,RXR) N IEN59,STAT
I RXI["." S IEN59=RXI
E S:'$D(RXR) RXR=$$RXRDEF(RXI) S IEN59=$$IEN59(RXI,RXR)
N LOCKED59 S LOCKED59=$$LOCK59
N STAT S STAT=$P($G(^ABSPT(IEN59,0)),U,2)
I LOCKED59 D UNLOCK59
Q STAT
;
; The background job
;
;IHS/SD/lwj 11/25/02 details in top of program - N command
; added on next line.
;IHS/SD/lwj 1/9/03 the "N" on the next line was remarked out
; following line was added to replace it.
TASK ;N ;IHS/SD/lwj 11/25/02 newing everything
N (DUZ) ;IHS/SD/lwj 1/9/03 newing everything except the DUZ
N X,Y,%DT S X="N",%DT="ST" D ^%DT D TASKAT(Y) Q
TASKAT(ZTDTH) ;N (DUZ,ZTDTH) ; Exclusive NEW verboten
N ZTIO S ZTIO="" ; no device
N ZTRTN S ZTRTN="BACKGR^ABSPOSRB" D ^%ZTLOAD Q
LASTLOG ; tool for test - find and print most recent log file
N X S X=999999999999
F S X=$O(^ABSPECP("LOG",X),-1) Q:'X Q:X#1=.4
I 'X W "No log file found",! Q
D PRINTLOG^ABSPOSL(X)
Q
ABSPOSRX ; IHS/FCS/DRS - callable from RPMS pharm ; [ 01/21/2003 8:40 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,4,5,31,40,44**;JUN 21, 2001;Build 38
+2 QUIT
+3 ;
+4 ; Also used by other ABSPOSR* routines to find transactions
+5 ; that need to be submitted to Point of Sale.
+6 ;
+7 ;------------------------------------------------------
+8 ; IHS/SD/lwj 11/25/02 change in the task subroutine
+9 ; There was a strange problem at Benewah only where the
+10 ; tasking to task man from "claim" was not functioning properly.
+11 ; The claim would task, but nothing would happen, and the task
+12 ; would disappear from taskman. If the same site deleted or
+13 ; editted the prescription, the same task code would work
+14 ; perfect. No other site has ever reported this problem and
+15 ; the biggest difference is ILC software running under the
+16 ; same name space at Benewah. To get around the problem
+17 ; we altered TASK to new everything. This worked, so we are
+18 ; keeping the fix in the package. This fix was generated
+19 ; by Patrick Cox of Oklahoma.
+20 ;
+21 ;-------
+22 ;IHS/SD/lwj 1/9/03 the new we added in November caused our
+23 ; "other" sites (i.e. not Benewah) problems with their posting.
+24 ; It turns out that the DUZ wasn't always being submitted with the
+25 ; task. The DUZ is required for the posting to 3rd party, so when
+26 ; it wasn't there, it didn't post correctly. Altered the new to do
+27 ; everything BUT the DUZ.
+28 ;------------------------------------------------------------
+29 ;
+30 ;-------
+31 ;IHS/OIT/SCR 4/17/09 patch 31
+32 ; MOREDATA("RXREASON") is defined and set in Outpatient Pharmacy 7.0
+33 ; when an prescription has been reversed and provides one of three
+34 ; possible reason for the reversal:
+35 ;
+36 ; Prescription logically deleted
+37 ; Returned to stock.
+38 ; Reversal caused by edit.
+39 ;
+40 ; MOREDATA("RXREASON") is only defined for 'UNCLAIM' transaction types
+41 ;
DOCU NEW I,X
FOR I=0:1
SET X=$TEXT(DOCU1+I)
IF X["END OF DOCUMENTATION"
QUIT
Begin DoDot:1
+1 WRITE $PIECE(X,";",2,99),!
End DoDot:1
+2 QUIT
DOCU1 ; There are only four callable entry points!
+1 ; $$CLAIM^ABSPOSRX Submit a claim to Point of Sale
+2 ; $$UNCLAIM^ABSPOSRX Reverse a previously submitted claim.
+3 ; $$STATUS^ABSPOSRX Inquire about a claim's status
+4 ; SHOWQ^ABSPOSRX Display queue of claims to be processed
+5 ;
+6 ; All of these routines may be called in either $$ or DO forms,
+7 ; even though the individual descriptions speak only of $$ form,
+8 ; The RXI argument is required - a pointer to ^PSRX(*
+9 ; The RXR argument is optional - a pointer to ^PSRX(RXI,1,*
+10 ; If RXR is omitted, the first fill is assumed.
+11 ; Should have MOREDATA("ORIGIN")
+12 ; = undefined - if caller is RPMS Pharmacy package
+13 ; = some assigned value - for all other callers
+14 ;
+15 ; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+16 ; $$CLAIM^ABSPOSRX - submit a claim to Point of Sale
+17 ;
+18 ; $$CLAIM^ABSPOSRX(RXI,RXR,.MOREDATA)
+19 ; Submit a claim to point of sale
+20 ; Use, for example, when a prescription is released.
+21 ; All this does is to put it on a list and start a background job.
+22 ; Return values:
+23 ; 1 = accepted for processing
+24 ; 0^reason = failure (should never happen)
+25 ;
+26 ; Note: If the claim has already been processed, and it's
+27 ; resubmitted, then a reversal will be done first,
+28 ; and then the resubmit will be done. Intervening calls
+29 ; to $$STATUS may show progress of the reversal before
+30 ; the resubmitted claim is processed.
+31 ; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+32 ; $$UNCLAIM^ABSPOSRX Reverse a previously submitted claim.
+33 ; Use, for example, if a prescription has been canceled.
+34 ;
+35 ; $$UNCLAIM^ABSPOSRX(RXI,RXR,.MOREDATA)
+36 ; Return value = 1 = will submit request for reversal
+37 ; = 0^reason = failure (should never happen)
+38 ;
+39 ; Note: The reversal will actually be done ONLY if the
+40 ; most recent processing of the claim resulted in something
+41 ; reversible, namely E PAYABLE or PAPER
+42 ; = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+43 ; $$STATUS^ABSPOSRX inquire about a claim's status
+44 ;
+45 ; $$STATUS^ABSPOSRX(RXI,RXR)
+46 ; Returns result^time^description
+47 ; Returns null if there's no POS record of this RXI,RXR.
+48 ;
+49 ; result is IN PROGRESS, or if the claim is complete,
+50 ; result is one of the following:
+51 ; E PAYABLE, E REJECTED, E CAPTURED, E DUPLICATE
+52 ; E REVERSAL ACCEPTED, E REVERSAL REJECTED
+53 ; E OTHER
+54 ; PAPER, PAPER REVERSAL
+55 ; (PAPER categories include uninsured patients,
+56 ; even beneficiaries, as well as non-electronic insurances)
+57 ;
+58 ; "time" is the Fileman date and time of the last update
+59 ; in the status of this claim.
+60 ;
+61 ; = = = = = = = = END OF DOCUMENTATION = = = = = = = = =
+62 ; = = = Everything below this line is for internal use only
+63 ; = = = and subject to sudden unannounced changes!
+64 ; = = = Please don't call any of it directly, nor depend on
+65 ; = = = any of the techniques used.
+66 ; = = = = = = = = = = = = = = = = = = = = = = = = = = = =
CLAIM(RXI,RXR,MOREDATA) ;EP - ABSPOSR1
+1 NEW RETVAL,STAT,TYPE
SET TYPE="CLAIM"
+2 IF '$DATA(RXR)
SET RXR=0
+3 IF '$$LOCK("SUBMIT")
QUIT 0
+4 KILL ^ABSPECP($TEXT(+0),TYPE,RXI,RXR)
+5 SET ^ABSPECP($TEXT(+0),TYPE,RXI,RXR)=$$NOW
+6 IF $DATA(MOREDATA)
MERGE ^ABSPECP($TEXT(+0),TYPE,RXI,RXR,"MOREDATA")=MOREDATA
+7 DO UNLOCK("SUBMIT")
+8 DO RUNNING()
+9 SET RETVAL=1
+10 IF $QUIT
QUIT RETVAL
QUIT
+11 ;
UNCLAIM(RXI,RXR,MOREDATA) ;EP - ABSPOSR1
+1 NEW RETVAL,STAT,RESULT,TYPE
SET TYPE="UNCLAIM"
+2 IF '$DATA(RXR)
SET RXR=0
+3 IF '$$LOCK("SUBMIT")
QUIT 0
+4 KILL ^ABSPECP($TEXT(+0),TYPE,RXI,RXR)
+5 SET ^ABSPECP($TEXT(+0),TYPE,RXI,RXR)=$$NOW
+6 IF $DATA(MOREDATA)
MERGE ^ABSPECP($TEXT(+0),TYPE,RXI,RXR,"MOREDATA")=MOREDATA
+7 DO UNLOCK("SUBMIT")
+8 DO RUNNING()
+9 SET RETVAL=1
+10 IF $QUIT
QUIT RETVAL
QUIT
+11 ;
STATUS(RXI,RXR,MOREDATA) ;EP - ABSPOSRB
+1 ;
+2 NEW RETVAL
+3 IF '$DATA(RXR)
SET RXR=0
+4 ; Loop: get data, quit if times match (i.e., no change during gather)
+5 ; Theoretically, though, something could cycle and be missed
+6 ; (e.g., from status 50 to status 50 in <1 sec.) in unimaginable
+7 ; extreme conditions
+8 NEW IEN59
+9 SET IEN59=$$IEN59(RXI,RXR)
+10 ; no POS record of this
IF '$DATA(^ABSPT(IEN59))
QUIT ""
+11 NEW A,C,T1,T2,S1,S2
FOR
Begin DoDot:1
+12 SET T1=$$LASTUP59(RXI,RXR)
+13 SET S1=$$STATUS59(RXI,RXR)
+14 ; completed
IF S1=99
Begin DoDot:2
+15 SET A=$$RESULT59(RXI,RXR)
+16 SET C=$$RESTXT59(RXI,RXR)
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 SET A="IN PROGRESS"
+19 SET C=$$STATI^ABSPOSU(S1)
End DoDot:2
+20 SET T2=$$LASTUP59(RXI,RXR)
+21 SET S2=$$STATUS59(RXI,RXR)
End DoDot:1
IF T1=T2
IF S1=S2
QUIT
+22 QUIT A_U_T1_U_$EXTRACT(C,1,255-$LENGTH(A)-$LENGTH(T1)-2)
SHOWQ GOTO SHOWQ^ABSPOSR2
+1 ;
+2 ; $$EDCLAIM(RXI,RXR,MOREDATA)
+3 ; Invoke the point of sale data input screen for this
+4 ; prescription and fill. Use this if you want the opportunity
+5 ; to edit the claim data - for example, pre-authorization numbers,
+6 ; price overrides, insurance order of billing, etc.
+7 ; The data entry screen is invoked. The claim can be submitted
+8 ; or not, at the user's option, by using Screenman <PF1>E or <PF1>Q
+9 ;
EDCLAIM(RXI,RXR,MOREDATA) ;
+1 IF 1
DO IMPOSS^ABSPOSUE("P","TI","entry point not available in this release",$PIECE($TEXT(+2),";",3),"EDCLAIM",$TEXT(+0))
QUIT
+2 ; for devel & testing, change above to I 0 and add to code below
+3 NEW RETVAL
SET RETVAL=1
+4 DO LOCK
+5 DO UNLOCK
+6 IF $QUIT
QUIT RETVAL
QUIT
+7 ;
NOW() NEW %,%H,%I,X
DO NOW^%DTC
QUIT %
+1 ; $$RESULT59 returns result of a finished claim in .59
+2 ; Can send RXI and have RXR defaulted
+3 ; PAPER or E PAYABLE or E REJECTED or E CAPTURED or E DUPLICATE
+4 ; or E OTHER (should never happen)
+5 ; or PAPER REVERSAL or E REVERSAL ACCEPTED or E REVERSAL REJECTED
RESULT59(RXI,RXR) ;EP - ABSPOS6D ; result as defined in CATEG^ABSPOSUC
+1 NEW IEN59
IF RXI["."
SET IEN59=RXI
+2 IF '$TEST
IF '$DATA(RXR)
SET RXR=$$RXRDEF(RXI)
SET IEN59=$$IEN59(RXI,RXR)
+3 QUIT $$CATEG^ABSPOSUC(IEN59)
RESTXT59(RXI,RXR) ; result text
+1 NEW IEN59
IF RXI["."
SET IEN59=RXI
+2 IF '$TEST
IF '$DATA(RXR)
SET RXR=$$RXRDEF(RXI)
SET IEN59=$$IEN59(RXI,RXR)
+3 QUIT $PIECE($GET(^ABSPT(IEN59,2)),U,2)
LASTUP59(RXI,RXR) ;EP - ABSPOSR1; time of last update
+1 NEW IEN59
IF RXI["."
SET IEN59=RXI
+2 IF '$TEST
IF '$DATA(RXR)
SET RXR=$$RXRDEF(RXI)
SET IEN59=$$IEN59(RXI,RXR)
+3 QUIT $PIECE(^ABSPT(IEN59,0),U,8)
+4 ;
RXRDEF(RXI) ;EP - ABSPOSNC
+1 ; highest refill #
QUIT +$PIECE($GET(^PSRX(RXI,1,0)),U,3)
+2 ;
+3 ;
+4 ; Utilties
+5 ;
+6 ; LOCKING: Just one user of this routine at a time.
+7 ; X = "SUBMIT" to interlock the claim submission
+8 ; X = "BACKGROUND" to interlock the background job
LOCK(X) ;EP - ABSPOSRB
+1 ;L +^ABSPECP($T(+0),X):300 Q $T
+2 ;IHS/OIT/PIERAN/RAN 10/12/2010 PATCH 40 no reason for 5 minute timeout on this lock, or use of incremental locking...causing deadlocks at Toiyabe
+3 LOCK ^ABSPECP($TEXT(+0),X):10
QUIT $TEST
LOCKNOW(X) ;EP - ABSPOSRB
+1 ;L +^ABSPECP($T(+0),X):0 Q $T
+2 ;IHS/OIT/PIERAN/RAN 10/12/2010 PATCH 40 no reason for use of incremental locking...causing deadlocks at Toiyabe
+3 LOCK ^ABSPECP($TEXT(+0),X):0
QUIT $TEST
UNLOCK(X) ;EP - ABSPOSRB
+1 LOCK -^ABSPECP($TEXT(+0),X)
QUIT
LOCK59() LOCK +^ABSPT:10
QUIT $TEST
UNLOCK59 LOCK -^ABSPT
QUIT
+1 ;
RUNNING() ;
+1 ;I '$$LOCKNOW("BACKGROUND") Q ; it is running; don't start another
+2 ;D UNLOCK("BACKGROUND") ; it's not running; release our probing lock
+3 ;IHS/OIT/PIERAN/RAN Patch 40...checking locks is not a good way to verify something isn't running
+4 ;IHS/OIT/CAS/RCS Patch 44...If the lock has not been reset for 30 minutes, reset - HEAT #78655
+5 NEW QFL,LDT,LTM,CDT,CTM,X
+6 SET QFL=0
+7 ;I $P(+$G(^ABSP(9002313.99,1,"ABSPOSRX")),"^") Q ; it is running; don't start another
+8 ; it is possibly running
IF $PIECE(+$GET(^ABSP(9002313.99,1,"ABSPOSRX")),"^")
Begin DoDot:1
+9 ;No date,time to compare
SET X=$PIECE(^ABSP(9002313.99,1,"ABSPOSRX"),"^",2)
IF 'X
SET QFL=1
QUIT
+10 ;get last run date,time
SET LDT=$PIECE(X,",")
SET LTM=$PIECE(X,",",2)
+11 ;get current date,time
SET X=$HOROLOG
SET CDT=$PIECE(X,",")
SET CTM=$PIECE(X,",",2)
+12 ;Could still be running, ran less than 30 min ago
IF CDT=LDT
IF ((CTM-LTM)<1800)
SET QFL=1
QUIT
+13 ;Reset so task can run
SET $PIECE(^ABSP(9002313.99,1,"ABSPOSRX"),"^",1)=0
End DoDot:1
+14 ; don't start another
IF QFL
QUIT
+15 DO TASK
+16 ; wait a second after starting a task - so you don't clog task
HANG 1
+17 ; manager with too many of these (especially from back billing)
+18 ; it's possible for extras to start during this window of time
+19 ; that's okay, they'll die right away when they can't get the lock
+20 QUIT
IEN59(RXI,RXR) ;EP - from ABSPOS,ABSPOSNC,ABSPOSRB
+1 QUIT RXI_"."_$TRANSLATE($JUSTIFY(RXR,4)," ","0")_"1"
+2 ;
+3 ; $$STATUS59 returns processing status from .59 record
+4 ; "" if there's no such claim note: 99 means complete
+5 ;
STATUS59(RXI,RXR) NEW IEN59,STAT
+1 IF RXI["."
SET IEN59=RXI
+2 IF '$TEST
IF '$DATA(RXR)
SET RXR=$$RXRDEF(RXI)
SET IEN59=$$IEN59(RXI,RXR)
+3 NEW LOCKED59
SET LOCKED59=$$LOCK59
+4 NEW STAT
SET STAT=$PIECE($GET(^ABSPT(IEN59,0)),U,2)
+5 IF LOCKED59
DO UNLOCK59
+6 QUIT STAT
+7 ;
+8 ; The background job
+9 ;
+10 ;IHS/SD/lwj 11/25/02 details in top of program - N command
+11 ; added on next line.
+12 ;IHS/SD/lwj 1/9/03 the "N" on the next line was remarked out
+13 ; following line was added to replace it.
TASK ;N ;IHS/SD/lwj 11/25/02 newing everything
+1 ;IHS/SD/lwj 1/9/03 newing everything except the DUZ
NEW (DUZ)
+2 NEW X,Y,%DT
SET X="N"
SET %DT="ST"
DO ^%DT
DO TASKAT(Y)
QUIT
TASKAT(ZTDTH) ;N (DUZ,ZTDTH) ; Exclusive NEW verboten
+1 ; no device
NEW ZTIO
SET ZTIO=""
+2 NEW ZTRTN
SET ZTRTN="BACKGR^ABSPOSRB"
DO ^%ZTLOAD
QUIT
LASTLOG ; tool for test - find and print most recent log file
+1 NEW X
SET X=999999999999
+2 FOR
SET X=$ORDER(^ABSPECP("LOG",X),-1)
IF 'X
QUIT
IF X#1=.4
QUIT
+3 IF 'X
WRITE "No log file found",!
QUIT
+4 DO PRINTLOG^ABSPOSL(X)
+5 QUIT
