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

ABSPOSP1.m

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