Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSRX

ABSPOSRX.m

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