ABSPOSBX ; IHS/FCS/DRS - Billing - FSI/ILC A/R v1,2;
;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
Q
ENABLED() Q 1
EN ; Taskman routine begins here
; with KEY15=visit/insurer/time sched for
; Does posting for just this one visit and insurer
;
; ^ABSPTL("AR",KEY15,IEN57)="" is defined for one or more IEN57's
; These are all charges.
; None are reversals - the reversals were dealt with in ABSPOSBW.
; But some of these charges may already have reversals outstanding!
;
N PCNDFN
;
; Same interlock as other billing
; Unlock happens implicitly when Taskman job stops
;
I '$$LOCK^ABSPOSBD D RESCHED(5*60) Q ; 5 minutes later
D INIT^ABSPOSL(DT+.2,1) ; same log file
;
; If posting is turned off, then reschedule this to run much later.
;
I '$$ENABLED D RESCHED(3*60*60) Q ; 3 hours later
;
; Gather all the IEN57's with the same visit/insurer as KEY15 has
; Put them into CHGLIST(IEN57)=""
; But for those which were reversed, put them into REVLIST(IEN57)
;
N CHGLIST,REVLIST D
. N X S X=$P(KEY15,"/",1,2)
. F S X=$O(^ABSPTL("AR",X)) Q:$P(X,"/",1,2)'=$P(KEY15,"/",1,2) D
. . N IEN57 S IEN57=0
. . F S IEN57=$O(^ABSPTL("AR",X,IEN57)) Q:'IEN57 D
. . . S @$$LIST57@(IEN57)=""
;
; If charges for the visit/insurer are still coming in,
; then reschedule this to run later.
; (DT test is to facilitate testing on the date shown)
;
I DT>3010327,'$$SETTLED D Q
. D RESCHED($$DELAY2^ABSPOSBW)
. D LOG(KEY15_" still busy; billing rescheduled for later")
;
; Post everything in CHGLIST(IEN57)=""
; except those which have been reversed
;
I $D(CHGLIST) D
. S PCNDFN=$$CHGLIST^ABSPOSBM ; 03/26/2001
;
; If any of these charges had been posted before,
; adjust off the old charges. (Should not happen any more, since
; we enforce a reverse-first-then-resubmit policy, even for paper.)
;
D REBILLED
;
; Clear the KEY15 values (thus removing these charges
; from the ^ABSPTL("AR",key15,ien57) index)
; and Mark each of these as having been posted to ILC A/R.
;
D
. I '$G(PCNDFN) N PCNDFN S PCNDFN="not posted"
. N FDA,MSG
. S IEN57=0 F S IEN57=$O(CHGLIST(IEN57)) Q:'IEN57 D
. . S FDA(9002313.57,IEN57_",",2)=PCNDFN
. . S FDA(9002313.57,IEN57_",",.15)=PCNDFN
. S IEN57=0 F S IEN57=$O(REVLIST(IEN57)) Q:'IEN57 D
. . S FDA(9002313.57,IEN57_",",.15)=PCNDFN
. . D LOG^ABSPOSL("Transaction "_IEN57_" was already reversed; we did not post it.")
F . I $D(FDA) D FILE^DIE("","FDA","MSG")
. I $D(MSG) D LOG^ABSPOSL2("F^ABSPOSBX",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
. I $D(MSG) D G F:$$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",.MSG,,$T(+0))
. . D LOG^ABSPOSL("Failed - trying to store in fields .15 and 2")
. . D LOGARRAY^ABSPOSL("FDA")
. . D LOGARRAY^ABSPOSL("MSG")
;
;
D DONE^ABSPOSL ; done with log file
D UNLOCK^ABSPOSBD ; release billing interlock
Q
LIST57() ; given IEN57 ; return "CHGLIST" or "REVLIST"
; "CHGLIST" - this is a charge which should be posted to a/r
; "REVLIST" - this charge was subsequently reversed; do not post it
N X S X=$P(^ABSPTL(IEN57,0),U) ; RXIRXR
I '$O(^ABSPTL("B",X,IEN57)) Q "CHGLIST" ; no subsequent transactions
N NXT57 S NXT57=$O(^ABSPTL("B",X,IEN57))
S X=$$GET1^DIQ(9002313.57,NXT57_",","RESULT WITH REVERSAL")
I X="E REVERSAL ACCEPTED" Q "REVLIST"
E I X="PAPER REVERSAL" Q "REVLIST"
E Q "CHGLIST"
REBILLED ; if anything in CHGLIST() was previously posted to A/R,
; write off the old charges and make comments on both old and new bills
S IEN57=0 F S IEN57=$O(CHGLIST(IEN57)) Q:'IEN57 D
. N OLD57,OLDPCNI,OLDPCNE,OLDAMT ; internal, external id's of the old bill
. S OLD57=$$PREVIOUS^ABSPOS57(IEN57) Q:'OLD57
. S OLDPCNI=$P(^ABSPTL(OLD57,0),U,3) Q:'OLDPCNI
. S OLDAMT=$P(^ABSPTL(OLD57,5),U,5)
. S OLDPCNE=$P(^ABSBITMS(9002302,OLDPCNI,0),U)
. ; comment on old bill to say "rebilled"
. N NEWPCNI,NEWPCNE
. N DRUG S DRUG=$$DRGNAME^ABSPOS57
. S NEWPCNI=PCNDFN,NEWPCNE=$P(^ABSBITMS(9002302,NEWPCNI,0),U)
. D ADJUST(OLDPCNI,OLDAMT,"Rebilled "_DRUG_" on "_NEWPCNE)
. D COMMENT^ABSPOSBF(NEWPCNI,"Rebilling of "_DRUG_" from "_OLDPCNE)
Q
ADJUST(PCNDFN,AMTOLD,REASON) ; EP - used by reversals handling in ABSPOSBW
N BATCH S BATCH=$$ADJBATCH
; Do we need to release this batch?
I $$NEEDREL D:BATCH'=0 ; batch old enough to need to be released
. ;No, don't actually release the batch here.
. ;Let someone do it from the A/R Menu.
. S BATCH=0 ; force a new one to be created
; Do we need a new batch?
AB I 'BATCH D
. S BATCH=$$NEWBATCH^ABSPOSP(0)
. D LOG^ABSPOSL("Opened new adjustments batch "_BATCH)
. D SET235(5,BATCH)
I 'BATCH G AB:$$IMPOSS^ABSPOSUE("P,DB,FM,L","TRI","Failed to obtain a new batch",,"ADJUST",$T(+0))
D ADJUST^ABSPOSP(PCNDFN,BATCH,AMTOLD,REASON)
D LOG^ABSPOSL("Adjustment recorded in payments batch "_BATCH)
D SET235(6,DT) ; record the date we last used this batch
Q
NEEDREL() Q:'BATCH 0 ; no batch on record
I $P(^ABSBPMNT(BATCH,0),U,5)'="A" Q 0 ; prev. batch no longer active
N X1,X2,X,%Y S X1=DT,X2=$$BLASTDT D ^%DTC
Q X>$$BLIFE ; 1 if it's older than that, 0 if not older
ADJBATCH() N B S B=$P($$GET235,U,5) Q:'B B ; batch # of last adjustments batch
Q $S($P($G(^ABSBPMNT(B,0)),U,5)="A":B,1:"") ; but only if Active batch
BLASTDT() Q $P($$GET235,U,6) ; date we last made an entry in it
BLIFE() Q $P($$GET235,U,7) ; how many days a batch is good for
GET235() Q $G(^ABSP(9002313.99,1,"BILLING - NEW"))
SET235(PIECE,VALUE) S $P(^ABSP(9002313.99,1,"BILLING - NEW"),U,PIECE)=VALUE Q
SETTLED() ; has the flow of new charges for this KEY15 settled?
; yes, if all of them are at least $$DELAY2^ABSPOSBW seconds old
N RET S RET=1 ; assume yes
N IEN57 S IEN57=0
F S IEN57=$O(^ABSPTL("AR",KEY15,IEN57)) Q:'IEN57 D Q:'RET
. N T1 S T1=$P(^ABSPTL(IEN57,0),U,8) ; LAST UPDATE
. N DIF S DIF=$$TIMEDIFI^ABSPOSUD(T1,$$NOW^ABSPOS) ; how old?
. I DIF<$$DELAY2^ABSPOSBW S RET=0
Q RET
RESCHED(DELTA) ;
N ZTDTH,ZTIO,ZTSAVE,ZTRTN
S ZTDTH=$$TADDNOWS^ABSPOSUD(DELTA)
S ZTIO="",ZTSAVE("KEY15")=""
S ZTRTN="EN^ABSPOSBX"
D ^%ZTLOAD
Q
LOG(X) D LOG^ABSPOSL(X) Q
LOGCLAIM(X) D LOG59^ABSPOS57(X) Q
ABSPOSBX ; IHS/FCS/DRS - Billing - FSI/ILC A/R v1,2;
+1 ;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
+2 QUIT
ENABLED() QUIT 1
EN ; Taskman routine begins here
+1 ; with KEY15=visit/insurer/time sched for
+2 ; Does posting for just this one visit and insurer
+3 ;
+4 ; ^ABSPTL("AR",KEY15,IEN57)="" is defined for one or more IEN57's
+5 ; These are all charges.
+6 ; None are reversals - the reversals were dealt with in ABSPOSBW.
+7 ; But some of these charges may already have reversals outstanding!
+8 ;
+9 NEW PCNDFN
+10 ;
+11 ; Same interlock as other billing
+12 ; Unlock happens implicitly when Taskman job stops
+13 ;
+14 ; 5 minutes later
IF '$$LOCK^ABSPOSBD
DO RESCHED(5*60)
QUIT
+15 ; same log file
DO INIT^ABSPOSL(DT+.2,1)
+16 ;
+17 ; If posting is turned off, then reschedule this to run much later.
+18 ;
+19 ; 3 hours later
IF '$$ENABLED
DO RESCHED(3*60*60)
QUIT
+20 ;
+21 ; Gather all the IEN57's with the same visit/insurer as KEY15 has
+22 ; Put them into CHGLIST(IEN57)=""
+23 ; But for those which were reversed, put them into REVLIST(IEN57)
+24 ;
+25 NEW CHGLIST,REVLIST
Begin DoDot:1
+26 NEW X
SET X=$PIECE(KEY15,"/",1,2)
+27 FOR
SET X=$ORDER(^ABSPTL("AR",X))
IF $PIECE(X,"/",1,2)'=$PIECE(KEY15,"/",1,2)
QUIT
Begin DoDot:2
+28 NEW IEN57
SET IEN57=0
+29 FOR
SET IEN57=$ORDER(^ABSPTL("AR",X,IEN57))
IF 'IEN57
QUIT
Begin DoDot:3
+30 SET @$$LIST57@(IEN57)=""
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 ; If charges for the visit/insurer are still coming in,
+33 ; then reschedule this to run later.
+34 ; (DT test is to facilitate testing on the date shown)
+35 ;
+36 IF DT>3010327
IF '$$SETTLED
Begin DoDot:1
+37 DO RESCHED($$DELAY2^ABSPOSBW)
+38 DO LOG(KEY15_" still busy; billing rescheduled for later")
End DoDot:1
QUIT
+39 ;
+40 ; Post everything in CHGLIST(IEN57)=""
+41 ; except those which have been reversed
+42 ;
+43 IF $DATA(CHGLIST)
Begin DoDot:1
+44 ; 03/26/2001
SET PCNDFN=$$CHGLIST^ABSPOSBM
End DoDot:1
+45 ;
+46 ; If any of these charges had been posted before,
+47 ; adjust off the old charges. (Should not happen any more, since
+48 ; we enforce a reverse-first-then-resubmit policy, even for paper.)
+49 ;
+50 DO REBILLED
+51 ;
+52 ; Clear the KEY15 values (thus removing these charges
+53 ; from the ^ABSPTL("AR",key15,ien57) index)
+54 ; and Mark each of these as having been posted to ILC A/R.
+55 ;
+56 Begin DoDot:1
+57 IF '$GET(PCNDFN)
NEW PCNDFN
SET PCNDFN="not posted"
+58 NEW FDA,MSG
+59 SET IEN57=0
FOR
SET IEN57=$ORDER(CHGLIST(IEN57))
IF 'IEN57
QUIT
Begin DoDot:2
+60 SET FDA(9002313.57,IEN57_",",2)=PCNDFN
+61 SET FDA(9002313.57,IEN57_",",.15)=PCNDFN
End DoDot:2
+62 SET IEN57=0
FOR
SET IEN57=$ORDER(REVLIST(IEN57))
IF 'IEN57
QUIT
Begin DoDot:2
+63 SET FDA(9002313.57,IEN57_",",.15)=PCNDFN
+64 DO LOG^ABSPOSL("Transaction "_IEN57_" was already reversed; we did not post it.")
End DoDot:2
F IF $DATA(FDA)
DO FILE^DIE("","FDA","MSG")
+1 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("F^ABSPOSBX",.MSG)
+2 IF $DATA(MSG)
Begin DoDot:2
+3 DO LOG^ABSPOSL("Failed - trying to store in fields .15 and 2")
+4 DO LOGARRAY^ABSPOSL("FDA")
+5 DO LOGARRAY^ABSPOSL("MSG")
End DoDot:2
IF $$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",.MSG,,$TEXT(+0))
GOTO F
End DoDot:1
+6 ;
+7 ;
+8 ; done with log file
DO DONE^ABSPOSL
+9 ; release billing interlock
DO UNLOCK^ABSPOSBD
+10 QUIT
LIST57() ; given IEN57 ; return "CHGLIST" or "REVLIST"
+1 ; "CHGLIST" - this is a charge which should be posted to a/r
+2 ; "REVLIST" - this charge was subsequently reversed; do not post it
+3 ; RXIRXR
NEW X
SET X=$PIECE(^ABSPTL(IEN57,0),U)
+4 ; no subsequent transactions
IF '$ORDER(^ABSPTL("B",X,IEN57))
QUIT "CHGLIST"
+5 NEW NXT57
SET NXT57=$ORDER(^ABSPTL("B",X,IEN57))
+6 SET X=$$GET1^DIQ(9002313.57,NXT57_",","RESULT WITH REVERSAL")
+7 IF X="E REVERSAL ACCEPTED"
QUIT "REVLIST"
+8 IF '$TEST
IF X="PAPER REVERSAL"
QUIT "REVLIST"
+9 IF '$TEST
QUIT "CHGLIST"
REBILLED ; if anything in CHGLIST() was previously posted to A/R,
+1 ; write off the old charges and make comments on both old and new bills
+2 SET IEN57=0
FOR
SET IEN57=$ORDER(CHGLIST(IEN57))
IF 'IEN57
QUIT
Begin DoDot:1
+3 ; internal, external id's of the old bill
NEW OLD57,OLDPCNI,OLDPCNE,OLDAMT
+4 SET OLD57=$$PREVIOUS^ABSPOS57(IEN57)
IF 'OLD57
QUIT
+5 SET OLDPCNI=$PIECE(^ABSPTL(OLD57,0),U,3)
IF 'OLDPCNI
QUIT
+6 SET OLDAMT=$PIECE(^ABSPTL(OLD57,5),U,5)
+7 SET OLDPCNE=$PIECE(^ABSBITMS(9002302,OLDPCNI,0),U)
+8 ; comment on old bill to say "rebilled"
+9 NEW NEWPCNI,NEWPCNE
+10 NEW DRUG
SET DRUG=$$DRGNAME^ABSPOS57
+11 SET NEWPCNI=PCNDFN
SET NEWPCNE=$PIECE(^ABSBITMS(9002302,NEWPCNI,0),U)
+12 DO ADJUST(OLDPCNI,OLDAMT,"Rebilled "_DRUG_" on "_NEWPCNE)
+13 DO COMMENT^ABSPOSBF(NEWPCNI,"Rebilling of "_DRUG_" from "_OLDPCNE)
End DoDot:1
+14 QUIT
ADJUST(PCNDFN,AMTOLD,REASON) ; EP - used by reversals handling in ABSPOSBW
+1 NEW BATCH
SET BATCH=$$ADJBATCH
+2 ; Do we need to release this batch?
+3 ; batch old enough to need to be released
IF $$NEEDREL
IF BATCH'=0
Begin DoDot:1
+4 ;No, don't actually release the batch here.
+5 ;Let someone do it from the A/R Menu.
+6 ; force a new one to be created
SET BATCH=0
End DoDot:1
+7 ; Do we need a new batch?
AB IF 'BATCH
Begin DoDot:1
+1 SET BATCH=$$NEWBATCH^ABSPOSP(0)
+2 DO LOG^ABSPOSL("Opened new adjustments batch "_BATCH)
+3 DO SET235(5,BATCH)
End DoDot:1
+4 IF 'BATCH
IF $$IMPOSS^ABSPOSUE("P,DB,FM,L","TRI","Failed to obtain a new batch",,"ADJUST",$TEXT(+0))
GOTO AB
+5 DO ADJUST^ABSPOSP(PCNDFN,BATCH,AMTOLD,REASON)
+6 DO LOG^ABSPOSL("Adjustment recorded in payments batch "_BATCH)
+7 ; record the date we last used this batch
DO SET235(6,DT)
+8 QUIT
NEEDREL() ; no batch on record
IF 'BATCH
QUIT 0
+1 ; prev. batch no longer active
IF $PIECE(^ABSBPMNT(BATCH,0),U,5)'="A"
QUIT 0
+2 NEW X1,X2,X,%Y
SET X1=DT
SET X2=$$BLASTDT
DO ^%DTC
+3 ; 1 if it's older than that, 0 if not older
QUIT X>$$BLIFE
ADJBATCH() ; batch # of last adjustments batch
NEW B
SET B=$PIECE($$GET235,U,5)
IF 'B
QUIT B
+1 ; but only if Active batch
QUIT $SELECT($PIECE($GET(^ABSBPMNT(B,0)),U,5)="A":B,1:"")
BLASTDT() ; date we last made an entry in it
QUIT $PIECE($$GET235,U,6)
BLIFE() ; how many days a batch is good for
QUIT $PIECE($$GET235,U,7)
GET235() QUIT $GET(^ABSP(9002313.99,1,"BILLING - NEW"))
SET235(PIECE,VALUE) SET $PIECE(^ABSP(9002313.99,1,"BILLING - NEW"),U,PIECE)=VALUE
QUIT
SETTLED() ; has the flow of new charges for this KEY15 settled?
+1 ; yes, if all of them are at least $$DELAY2^ABSPOSBW seconds old
+2 ; assume yes
NEW RET
SET RET=1
+3 NEW IEN57
SET IEN57=0
+4 FOR
SET IEN57=$ORDER(^ABSPTL("AR",KEY15,IEN57))
IF 'IEN57
QUIT
Begin DoDot:1
+5 ; LAST UPDATE
NEW T1
SET T1=$PIECE(^ABSPTL(IEN57,0),U,8)
+6 ; how old?
NEW DIF
SET DIF=$$TIMEDIFI^ABSPOSUD(T1,$$NOW^ABSPOS)
+7 IF DIF<$$DELAY2^ABSPOSBW
SET RET=0
End DoDot:1
IF 'RET
QUIT
+8 QUIT RET
RESCHED(DELTA) ;
+1 NEW ZTDTH,ZTIO,ZTSAVE,ZTRTN
+2 SET ZTDTH=$$TADDNOWS^ABSPOSUD(DELTA)
+3 SET ZTIO=""
SET ZTSAVE("KEY15")=""
+4 SET ZTRTN="EN^ABSPOSBX"
+5 DO ^%ZTLOAD
+6 QUIT
LOG(X) DO LOG^ABSPOSL(X)
QUIT
LOGCLAIM(X) DO LOG59^ABSPOS57(X)
QUIT
