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