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

ABSPOSP2.m

Go to the documentation of this file. 
  1. ABSPOSP2 ; IHS/FCS/DRS - EOB to Payments Batch ;   [ 09/12/2002  10:17 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
  1.  ; Payments & Adjustments - ScreenMan front-end to create batch
  1.  ; with parameters to assemble what should match the EOB.
  1.  I DUZ(0)="@" W "Going to the TEST entry point..." H 2 G TEST
  1.  Q
  1.  ;
  1. MAIN ;EP - option ABSP EOB TO BATCH
  1.  Q:$$MUSTILC^ABSPOSB
  1.  N X D
  1.  . N LOCKREF S LOCKREF="^ABSP(9002313.99,1,""EOB-SCREEN"")"
  1.  . L +@LOCKREF:0 I '$T D  S X="" Q
  1.  . . W "Someone else is using the EOB program.",!
  1.  . S X=$$MYSCREEN
  1.  . I X S X=$G(^ABSP(9002313.99,1,"EOB-SCREEN"))
  1.  . E  S X=""
  1.  . L -@LOCKREF
  1.  I X="" W "Nothing done",! H 2 Q  ; didn't get <F1>E
  1.  N PARAMS M PARAMS=^ABSP(9002313.99,1,"EOB-SCREEN")
  1.  ;
  1.  N ROU S ROU=$T(+0)
  1.  ;
  1.  ; Build ^TMP($J,ROU,1,pt9002313.02,pt9002313.03)=""
  1.  ;
  1.  W !,"Please wait... searching our records of POS payments...",!
  1.  D SEARCH
  1.  ;
  1.  ; Build ^TMP($J,ROU,2,PATNAME,DATERECD,RXI,RXR,pt9002313.02,position)
  1.  ;   = amount paid^pt9002313.03
  1.  ; This is to mimic the order of the EOB.
  1.  ; We may need to do different sort orders for different insurers.
  1.  ;
  1.  W !,"Now sorting the payment records...",!
  1.  D SORT
  1.  ;
  1.  W "Creating a payments batch...",!
  1.  N BATCH S BATCH=$$NEWBATCH^ABSPOSP(1)
  1.  I 'BATCH W "Can't create a batch - Stopping",! Q
  1.  W "The batch is payment batch #",BATCH,!
  1.  N PATNAME,DATERECD,RXI,RXR,CLAIM,POSITN,DATA,AMT,RESP
  1.  S PATNAME=""
  1.  F  S PATNAME=$O(^TMP($J,ROU,2,PATNAME)) Q:PATNAME=""  D
  1.  . S DATERECD=""
  1.  . F  S DATERECD=$O(^TMP($J,ROU,2,PATNAME,DATERECD)) Q:DATERECD=""  D
  1.  . . S RXI=""
  1.  . . F  S RXI=$O(^TMP($J,ROU,2,PATNAME,DATERECD,RXI)) Q:RXI=""  D
  1.  . . . S RXR=""
  1.  . . . F  S RXR=$O(^TMP($J,ROU,2,PATNAME,DATERECD,RXI,RXR)) Q:RXR=""  D
  1.  . . . . S CLAIM=""
  1.  . . . . F  S CLAIM=$O(^TMP($J,ROU,2,PATNAME,DATERECD,RXI,RXR,CLAIM)) Q:CLAIM=""  D
  1.  . . . . . S POSITN=""
  1.  . . . . . F  S POSITN=$O(^TMP($J,ROU,2,PATNAME,DATERECD,RXI,RXR,CLAIM,POSITN)) Q:POSITN=""  D
  1.  . . . . . . S DATA=^TMP($J,ROU,2,PATNAME,DATERECD,RXI,RXR,CLAIM,POSITN)
  1.  . . . . . . D ONEPMT
  1.  I $P(PARAMS,U,5) D  ; control total
  1.  . ; Note: do it here at the end - because individual transactions
  1.  . ; each added to total (in ABSPOSP).  But if '$P(PARAMS,U,5),
  1.  . ; then user must not have entered a control total - so just take
  1.  . ; the total of transactions as ABSPOSP tallied them.
  1.  . D SETAMT^ABSPOSP(BATCH,$P(PARAMS,U,5),.04)
  1.  W "Done",!!
  1.  W "Note:  the batch is still open; it is not automatically posted.",!
  1.  W "You are responsible for making sure that you really want",!
  1.  W "to post the batch and that the control total is correct.",!
  1.  D PRESSANY^ABSPOSU5()
  1.  Q
  1. ONEPMT ;
  1.  N PCNDFN S PCNDFN=$P(^ABSPC(CLAIM,0),U,3)
  1.  N AMT S AMT=$P(DATA,U)
  1.  N DEPDATE S DEPDATE=$P(PARAMS,U,4)
  1.  N INSDFN S INSDFN=$P(PARAMS,U)
  1.  I 'PCNDFN D  Q  ; no PCNDFN?!  Put it into unallocated cash
  1.  . W "Unallocated Cash $",$J(AMT,0,2)," for ",PATNAME,!
  1.  . W ?10,"See Claim ID ",$P(^ABSPC(CLAIM,0),U),!
  1.  . S ^ABSTMP(BATCH,"UC")=$G(^ABSTMP(BATCH,"UC"))+AMT
  1.  . ; and you want to put an entry in ^ABSBUC()
  1.  D PAYMENT^ABSPOSP(PCNDFN,BATCH,AMT,INSDFN,DEPDATE)
  1.  Q
  1. SORT K ^TMP($J,ROU,2)
  1.  N PATNAME,DATERECD,RXI,RXR,CLAIM,RESP
  1.  S CLAIM=0
  1.  F  S CLAIM=$O(^TMP($J,ROU,1,CLAIM)) Q:'CLAIM  D
  1.  . I $$ISREVERS^ABSPOSU(CLAIM) Q  ; reversal - elsewhere
  1.  . S RESP=0
  1.  . F  S RESP=$O(^TMP($J,ROU,1,CLAIM,RESP)) Q:'RESP  D SORT1
  1.  Q
  1. SORT1 ;
  1.  I $$RESP500^ABSPOSQ4(RESP,"I")'="A" Q  ; header not accepted
  1.  S PATNAME=$P(^ABSPC(CLAIM,1),U)
  1.  S DATERECD=$P(^ABSPR(RESP,0),U,2)
  1.  S DATERECD=$P(DATERECD,".")
  1.  N POSITN S POSITN=0
  1.  F  S POSITN=$O(^ABSPR(RESP,1000,POSITN)) Q:'POSITN  D
  1.  . I $$RESP1000^ABSPOSQ4(RESP,POSITN,"I")'="P" Q  ; only if Payable
  1.  . ; RXI, RXR as fetched here:
  1.  . ; * They should already be in the EOB's format
  1.  . ; * The RXR does not necessarily correspond to the index into
  1.  . ;   the multiple in ^PSRX(+RXI,1,...)
  1.  . S RXI=$P(^ABSPC(CLAIM,400,POSITN,400),U,2)
  1.  . S RXR=$P(^ABSPC(CLAIM,400,POSITN,400),U,3)
  1.  . N X S X=^ABSPR(RESP,1000,POSITN,500)
  1.  . N AMT S AMT("PATIENT")=$P(X,U,5)
  1.  . S AMT("INGR")=$P(X,U,6),AMT("DISPFEE")=$P(X,U,7)
  1.  . S AMT("TAX")=$P(X,U,8),AMT("TOT")=$P(X,U,9),AMT("COPAY")=$P(X,U,18)
  1.  . S AMT("INCENT")=$P(X,U,21)
  1.  . ; convert signed overpunch numeric mess
  1.  . N X S X="" F  S X=$O(AMT(X)) Q:X=""  I AMT(X)]"",AMT(X)'?1N.N D
  1.  . . S AMT(X)=$$DFF2EXT^ABSPECFM(AMT(X))
  1.  . ; Assemble data value
  1.  . ; we have lots of AMT(*) available; let's go with total amt. for now
  1.  . N DATA S DATA=AMT("TOT")_U_RESP
  1.  . ; Store it!
  1.  . ; But not if the claim was reversed in this same time frame
  1.  . I $$SUCCREV D  Q
  1.  . . ;W "TEMP - ",CLAIM," was successfully reversed by ",$$SUCCREV,!
  1.  . S ^TMP($J,ROU,2,PATNAME,DATERECD,RXI,RXR,CLAIM,POSITN)=DATA
  1.  Q
  1. SUCCREV()     ; was the CLAIM,POSITN in 9002313.02 successfully reversed, ever?
  1.  ; return pointer to 9002313.02 reversal claim if it was
  1.  N CLAIMID S CLAIMID=$P(^ABSPC(CLAIM,0),U)
  1.  N REVID S REVID=CLAIMID_"R"_POSITN
  1.  N REVCLAIM S REVCLAIM=0
  1.  N RETVAL S RETVAL=0 ; assume No
  1.  ; In most cases, this For loop body never runs,
  1.  ; because reversals are relatively uncommon.  
  1.  ; And when it does run, instances of multiple responses should
  1.  ; never really happen, but if they do, just take latest response.
  1.  ; Conceivable only if the reversal was attempted when the 
  1.  ; host was down?
  1.  F  S REVCLAIM=$O(^ABSPC("B",REVID,REVCLAIM)) Q:'REVCLAIM  D
  1.  . ; In oddball case of multiple responses to this claim, take latest
  1.  . N REVRESP S REVRESP=$O(^ABSPR("B",REVCLAIM,""),-1)
  1.  . I 'REVRESP Q  ; got no response?  oh well
  1.  . ; accepted reversal?  you tell by whether header was accepted.
  1.  . I $$RESP500^ABSPOSQ4(REVRESP,"I")="A" S RETVAL=REVCLAIM
  1.  Q RETVAL
  1.  N INSURER S INSURER=$P(PARAMS,U)
  1.  N START S START=$P(PARAMS,U,2)
  1.  N END S END=$P(PARAMS,U,3)
  1.  I $P(END,".",2)="" S $P(END,".",2)="99999999" ; default to entire day
  1.  N DATE S DATE=START
  1.  F  D  S DATE=$O(^ABSPR("AE",DATE)) Q:DATE>END
  1.  . N RESP S RESP=0
  1.  . F  S RESP=$O(^ABSPR("AE",DATE,RESP)) Q:'RESP  D
  1.  . . N CLAIM S CLAIM=$P(^ABSPR(RESP,0),U) Q:'CLAIM
  1.  . . I $P(^ABSPC(CLAIM,0),U,2)'=INSURER Q
  1.  . . ;
  1.  . . ; Yes - the response is from this insurer for this date.
  1.  . . ;
  1.  . . S ^TMP($J,ROU,1,CLAIM,RESP)=""
  1.  Q
  1. MYSCREEN()       ; returns 1 if <F1>E (or the equivalent) was used
  1.  ; if the user quits out (<F1>Q or the equivalent), returns 0
  1.  N DDSFILE,DR,DDSPAGE,DDSPARM
  1.  N DDSCHANG,DDSSAVE,DIMSG,DTOUT
  1.  N DA
  1.  S DDSFILE=9002313.99,DA=1
  1.  S DR="[ABSP EOB TO BATCH]"
  1. AA S DDSPARM="CS"
  1.  D ^DDS
  1.  Q:'$Q
  1.  I $G(DDSSAVE) Q 1
  1.  E  Q 0
  1. TEST ;
  1.  W "Just GOTO MAIN",! H 1
  1.  G MAIN
  1.  W "Outputs:",!
  1.  D ZWRITE^ABSPOS("DDSCHANG","DDSSAVE","DIMSG","DTOUT")
  1.  N X S X=$G(^ABSP(9002313.99,1,"EOB-SCREEN"))
  1.  W "9002313.99,EOB-SCREEN node=",X,!
  1.  Q