ABSPOSP1 ; IHS/FCS/DRS - POS Writeoffs batch ; [ 09/12/2002 10:17 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,48**;JUN 21, 2001;Build 38
Q
INDEX() Q "APBWO" ; which one is the index for these?
ISEMPTY() Q '$O(^ABSBITMS(9002302,$$INDEX,1,0)) ; true if there's none to do
WHAT W !,"This program takes accounts from the AUTOMATIC WRITEOFFS list",!
W "and creates a PAYMENTS BATCH to ADJUST each of these accounts",!
W "to a ZERO BALANCE.",!
W !
Q
WRITEOFF ;EP - option: ABSP AUTO-WRITEOFF BAT
; based on the automatic writeoff list
Q:'$$MUSTILC^ABSPOSB ; ILC A/R only
N THRUDATE,X,BATCH
Q:$$ISEMPTY
D WHAT
A S THRUDATE=$$DATE Q:'THRUDATE
S X=$$OKAY G:X="^" A Q:'X
W !,"Creating the automatic writeoffs batch, please wait...",!
S BATCH=$$BATCH(THRUDATE)
W !,"Batch ",BATCH," created, but it isn't automatically posted.",!
W "To post it to Accounts Receivable, use the PAY option",!
W "from the main menu.",!
I '$$UPDATE Q
D CLRFLAGS
W !,"Don't forget to post batch ",BATCH,!
W "You may print or edit the batch as needed before posting.",!
Q
BATCH(THRUDATE) ; $$ this, it returns batch number
N BATCH S BATCH=$$NEWBATCH^ABSPOSP I 'BATCH D IMPOSS^ABSPOSUE("FM,DB,P","TI","$$NEWBATCH^ABSPOSP failed",,"BATCH",$T(+0))
N PCNDFN S PCNDFN=0
F S PCNDFN=$O(^ABSBITMS(9002302,$$INDEX,1,PCNDFN)) Q:'PCNDFN D
. D BATCH1,DOT
Q BATCH
BATCH1 ; given BATCH, PCNDFN, THRUDATE
N VSTDFN S VSTDFN=$P(^ABSBITMS(9002302,PCNDFN,1,1,0),U,3)
N PCN S PCN=$P(^ABSBITMS(9002302,PCNDFN,0),U)
I $P(VSTDFN,U)>THRUDATE Q
I $P(^ABSBITMS(9002302,PCNDFN,6),U,2)'="A" D Q ; closed account?
. W PCN," status is not ACTIVE; we will remove it from writeoff list",!
. W " but no adjustment will be made.",!
. D CLRFLAG(PCNDFN)
N BAL S BAL=$P(^ABSBITMS(9002302,PCNDFN,3),U)
I 'BAL D Q
. W PCN," has a zero balance",!
. ; continue and generate a zero writeoff so as to close the account
N INS,REASON S INS=$P(^ABSBITMS(9002302,PCNDFN,0),U,3)
S REASON="RX POS - "
I INS="SELF PAY" S REASON=REASON_"Beneficiary, No Insurance"
E S REASON=REASON_INS
I $L(REASON)>80 S REASON=$E(REASON,1,77)_"..." ; ^DD(9002302.02,2)
D ADJUST^ABSPOSP(PCNDFN,BATCH,BAL,REASON)
Q
CLRFLAGS ; remove these accounts from the automatic writeoff list
W !,"Now that the adjustments are in the batch, we will",!
W "remove these accounts from the automatic writeoff list...",!
N PCNDFN S PCNDFN=0
F S PCNDFN=$O(^ABSTMP(BATCH,"TOT",PCNDFN)) Q:'PCNDFN D
. D CLRFLAG(PCNDFN),DOT
W "Done",!
Q
CLRFLAG(PCNDFN) ;
N FDA,MSG
S FDA(9002302,PCNDFN_",",600.01)=0
C5 D FILE^DIE("","FDA","MSG")
I $D(MSG) D LOG^ABSPOSL2("C5^ABSPOSP1",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
Q:'$D(MSG) ; success
D ZWRITE^ABSPOS("FDA","MSG")
G C5:$$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",,"CLRFLAG",$T(+0))
Q
DOT W "." W:$X>70 !?10 Q
DATE() ;Create automatic writeoff adjustments for visits THRU DATE:
N X S X=$$DTP^ABSPOSU1($P($T(DATE),";",2)_" ","T") W !
Q X ; X false if no date entered
OKAY() ;
W "Okay to create a batch of writeoff adjustments for visits",!
W "on the automatic writeoff list with visit dates through",!
W "up to and including ",$P(THRUDATE,U,2),"? ",!
Q $$YNCOMMON
YNCOMMON() N X S X=$$YESNO^ABSPOSU3("Yes or No? ","YES",0)
W ! Q $S(X=1:1,X=-1:"^",1:0)
UPDATE() ;
Q 1 ; it's just a lot simpler this way
W "Now that the batch has been created, is it okay",!
W "to REMOVE these accounts from the automatic writeoff list?",!
N X S X=$$YNCOMMON
Q
ABSPOSP1 ; IHS/FCS/DRS - POS Writeoffs batch ; [ 09/12/2002 10:17 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,48**;JUN 21, 2001;Build 38
+2 QUIT
INDEX() ; which one is the index for these?
QUIT "APBWO"
ISEMPTY() ; true if there's none to do
QUIT '$ORDER(^ABSBITMS(9002302,$$INDEX,1,0))
WHAT WRITE !,"This program takes accounts from the AUTOMATIC WRITEOFFS list",!
+1 WRITE "and creates a PAYMENTS BATCH to ADJUST each of these accounts",!
+2 WRITE "to a ZERO BALANCE.",!
+3 WRITE !
+4 QUIT
WRITEOFF ;EP - option: ABSP AUTO-WRITEOFF BAT
+1 ; based on the automatic writeoff list
+2 ; ILC A/R only
IF '$$MUSTILC^ABSPOSB
QUIT
+3 NEW THRUDATE,X,BATCH
+4 IF $$ISEMPTY
QUIT
+5 DO WHAT
A SET THRUDATE=$$DATE
IF 'THRUDATE
QUIT
+1 SET X=$$OKAY
IF X="^"
GOTO A
IF 'X
QUIT
+2 WRITE !,"Creating the automatic writeoffs batch, please wait...",!
+3 SET BATCH=$$BATCH(THRUDATE)
+4 WRITE !,"Batch ",BATCH," created, but it isn't automatically posted.",!
+5 WRITE "To post it to Accounts Receivable, use the PAY option",!
+6 WRITE "from the main menu.",!
+7 IF '$$UPDATE
QUIT
+8 DO CLRFLAGS
+9 WRITE !,"Don't forget to post batch ",BATCH,!
+10 WRITE "You may print or edit the batch as needed before posting.",!
+11 QUIT
BATCH(THRUDATE) ; $$ this, it returns batch number
+1 NEW BATCH
SET BATCH=$$NEWBATCH^ABSPOSP
IF 'BATCH
DO IMPOSS^ABSPOSUE("FM,DB,P","TI","$$NEWBATCH^ABSPOSP failed",,"BATCH",$TEXT(+0))
+2 NEW PCNDFN
SET PCNDFN=0
+3 FOR
SET PCNDFN=$ORDER(^ABSBITMS(9002302,$$INDEX,1,PCNDFN))
IF 'PCNDFN
QUIT
Begin DoDot:1
+4 DO BATCH1
DO DOT
End DoDot:1
+5 QUIT BATCH
BATCH1 ; given BATCH, PCNDFN, THRUDATE
+1 NEW VSTDFN
SET VSTDFN=$PIECE(^ABSBITMS(9002302,PCNDFN,1,1,0),U,3)
+2 NEW PCN
SET PCN=$PIECE(^ABSBITMS(9002302,PCNDFN,0),U)
+3 IF $PIECE(VSTDFN,U)>THRUDATE
QUIT
+4 ; closed account?
IF $PIECE(^ABSBITMS(9002302,PCNDFN,6),U,2)'="A"
Begin DoDot:1
+5 WRITE PCN," status is not ACTIVE; we will remove it from writeoff list",!
+6 WRITE " but no adjustment will be made.",!
+7 DO CLRFLAG(PCNDFN)
End DoDot:1
QUIT
+8 NEW BAL
SET BAL=$PIECE(^ABSBITMS(9002302,PCNDFN,3),U)
+9 IF 'BAL
Begin DoDot:1
+10 WRITE PCN," has a zero balance",!
+11 ; continue and generate a zero writeoff so as to close the account
End DoDot:1
QUIT
+12 NEW INS,REASON
SET INS=$PIECE(^ABSBITMS(9002302,PCNDFN,0),U,3)
+13 SET REASON="RX POS - "
+14 IF INS="SELF PAY"
SET REASON=REASON_"Beneficiary, No Insurance"
+15 IF '$TEST
SET REASON=REASON_INS
+16 ; ^DD(9002302.02,2)
IF $LENGTH(REASON)>80
SET REASON=$EXTRACT(REASON,1,77)_"..."
+17 DO ADJUST^ABSPOSP(PCNDFN,BATCH,BAL,REASON)
+18 QUIT
CLRFLAGS ; remove these accounts from the automatic writeoff list
+1 WRITE !,"Now that the adjustments are in the batch, we will",!
+2 WRITE "remove these accounts from the automatic writeoff list...",!
+3 NEW PCNDFN
SET PCNDFN=0
+4 FOR
SET PCNDFN=$ORDER(^ABSTMP(BATCH,"TOT",PCNDFN))
IF 'PCNDFN
QUIT
Begin DoDot:1
+5 DO CLRFLAG(PCNDFN)
DO DOT
End DoDot:1
+6 WRITE "Done",!
+7 QUIT
CLRFLAG(PCNDFN) ;
+1 NEW FDA,MSG
+2 SET FDA(9002302,PCNDFN_",",600.01)=0
C5 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("C5^ABSPOSP1",.MSG)
+2 ; success
IF '$DATA(MSG)
QUIT
+3 DO ZWRITE^ABSPOS("FDA","MSG")
+4 IF $$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",,"CLRFLAG",$TEXT(+0))
GOTO C5
+5 QUIT
DOT WRITE "."
IF $X>70
WRITE !?10
QUIT
DATE() ;Create automatic writeoff adjustments for visits THRU DATE:
+1 NEW X
SET X=$$DTP^ABSPOSU1($PIECE($TEXT(DATE),";",2)_" ","T")
WRITE !
+2 ; X false if no date entered
QUIT X
OKAY() ;
+1 WRITE "Okay to create a batch of writeoff adjustments for visits",!
+2 WRITE "on the automatic writeoff list with visit dates through",!
+3 WRITE "up to and including ",$PIECE(THRUDATE,U,2),"? ",!
+4 QUIT $$YNCOMMON
YNCOMMON() NEW X
SET X=$$YESNO^ABSPOSU3("Yes or No? ","YES",0)
+1 WRITE !
QUIT $SELECT(X=1:1,X=-1:"^",1:0)
UPDATE() ;
+1 ; it's just a lot simpler this way
QUIT 1
+2 WRITE "Now that the batch has been created, is it okay",!
+3 WRITE "to REMOVE these accounts from the automatic writeoff list?",!
+4 NEW X
SET X=$$YNCOMMON
+5 QUIT
