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

BARDMAN.m

Go to the documentation of this file. 
  1. BARDMAN ; IHS/SD/LSL - A/R Debt Collection Process ;08/20/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
  1.  ;
  1.  ; IHS/SD/LSL - 04/08/2004 - V1.8
  1.  ;      Routine created.  Moved (modified) from BBMDC1
  1.  ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
  1.  ; ********************************************************************
  1.  ;
  1.  Q
  1.  ;
  1. EP ; EP
  1.  D:'$D(BARUSR) INIT^BARUTL        ; Set up basic A/R Variables
  1.  ;D INUSE                          ; Check process not already in use
  1.  I $D(BARQUIT) D CLEAN Q
  1.  D NOTE                           ; logged into facility, continue?
  1.  I $D(BARQUIT) D CLEAN Q
  1.  D SITE                           ; Select site (parent)
  1.  I $D(BARQUIT) D CLEAN Q
  1.  D VARS                           ; Set vars for parameters
  1.  D CHECK                          ; Check parameters
  1.  I $D(BARQUIT) D CLEAN Q
  1.  D ^BARBAN                        ; Refresh screen
  1.  D DISPDT                         ; Display last dates chosen
  1.  D ASKDT                          ; Ask new dates
  1.  Q:BARSTART<1                     ; Date range not entered
  1.  D ASKPARAM                       ; Ask other parameters
  1.  I $D(BARQUIT) D CLEAN Q
  1.  D ^BARBAN
  1.  D DISPARAM                        ; Display new parameters chosen
  1.  I $D(BARQUIT) D CLEAN Q
  1.  D PROCESS                        ; Find bills and build temp global
  1.  I $D(BARQUIT) D CLEAN Q
  1.  W !!,"Creating and sending Files..."
  1.  D SEND^BARDMAN2                  ; create and Send file to ITSC Server
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. INUSE ;
  1.  ; Process can only be run by one person at a time.
  1.  I $D(^BARTMP("DEBT COLLECTION")) D  Q
  1.  . W !!!,"This menu option is currently in use by ",$P($G(^VA(200,^BARTMP("DEBT COLLECTION"),0)),U)
  1.  . W !,"Please try again later. "
  1.  . S BARQUIT=1
  1.  . D PAZ^BARRUTL
  1.  S ^BARTMP("DEBT COLLECTION")=DUZ
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. NOTE ;
  1.  W !!,$$EN^BARVDF("HIN"),"NOTE:",$$EN^BARVDF("HIF")
  1.  W ?8,"You must be logged into the facility for which you wish to process"
  1.  W !?8,"Debt Collection.  You are logged into ",$$GET1^DIQ(90052.06,DUZ(2),.01)
  1.  W !!
  1.  K DIC,DA,DR,DIR
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Continue"
  1.  S DIR("B")="Y"
  1.  D ^DIR
  1.  S:Y'=1 BARQUIT=1
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. SITE ;
  1.  ; No debt collection parameters defined
  1.  K DIC,DA,DR,DIR
  1.  I '$D(^BAR(90052.06,DUZ(2),DUZ(2),10)) D  Q
  1.  . S BARQUIT=1
  1.  . D MSG
  1.  . D PAZ^BARRUTL
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. MSG ;
  1.  W !!,$$CJ^XLFSTR("Debt Collection parameters have not been defined for this facility,",IOM)
  1.  W !,$$CJ^XLFSTR("Please enter the missing data via the Debt Collection Site Parameters Option.",IOM)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. VARS ; EP
  1.  ; Debt Collection Parameter Values
  1.  F I=10:1:12 S BARP(I)=$G(^BAR(90052.06,DUZ(2),DUZ(2),I))
  1.  S BARINUM=$P(BARP(10),U)          ; TSI assigned insurer number
  1.  S BARSNUM=$P(BARP(10),U,4)         ; TSI assigned self pay number
  1.  S BARPATH=$P(BARP(10),U,7)       ; Directory for DCM Files
  1.  S BARIMAX=$P(BARP(10),U,2)       ; TSI contract max INS transactions
  1.  S BARSMAX=$P(BARP(10),U,5)       ; TSI contract max SELF PAY transact
  1.  S BARICUR=$P(BARP(10),U,3)       ; INSURER transactions to date
  1.  S BARSCUR=$P(BARP(10),U,6)       ; SELF PAY transaction to date
  1.  S BAREDOS=$P(BARP(11),U,3)      ; Earliest DOS to check
  1.  S BARLEND=$P(BARP(11),U,6)       ; Last end date used
  1.  S BARLSTRT=$P(BARP(11),U,5)      ; Last start date used
  1.  S BARLENDO=$$GET1^DIQ(90052.06,DUZ(2),1106)
  1.  S BARLSTRO=$$GET1^DIQ(90052.06,DUZ(2),1105)
  1.  S BARMAGE=$P(BARP(11),U,2)       ; Minumum age of bill in days
  1.  I '+BARMAGE S BARMAGE=90         ; Default to 90 days, if min undef
  1.  S BARMAGE=BARMAGE-1              ; Not sure yet.....
  1.  S BARSRCHD=$P(BARP(11),U,4)     ; Earliest date to search
  1.  S BARMAMT=$P(BARP(11),U)         ; Minimum principle amount
  1.  I +BARMAMT=0 S BARMAMT=50        ; Default minimum amount $50
  1.  S BAROS=$$VERSION^%ZOSV(1)       ; Operating system
  1.  S BARASDT=$P(BARP(11),U,8)       ; Start date for auto process
  1.  ;
  1.  K ^TMP($J,"BAR-STARTS-CNT")
  1.  K ^TMP($J,"BAR-STOPS-CNT")
  1.  K ^TMP($J,"BAR-UPD")
  1.  F I="^BARSSELF","^BARSTOPS","^BARTSELF","^BARSTART" D
  1.  . S K=0
  1.  . F  S K=$O(@I@(K)) Q:'+K  D
  1.  . . K @I@(K)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. CHECK ;
  1.  I ((BARINUM="")&(BARSNUM="")) D ERROR Q
  1.  I BARPATH="" D ERROR Q
  1.  I +BARIMAX=0 D ERROR Q
  1.  I +$L(BARSNUM),'+BARSMAX D ERROR Q
  1.  I BARINUM]"",BARICUR'<BARIMAX D  Q:$D(BARQUIT)
  1.  . K DIC,DA,DR,DIR
  1.  . S DIR("A",1)="The contract determined maximum number of INSURER transactions has been reached."
  1.  . S DIR("A")="Continue"
  1.  . S DIR(0)="Y"
  1.  . S DIR("B")="N"
  1.  . D ^DIR
  1.  . S:Y'=1 BARQUIT=1
  1.  . ;
  1.  I BARSNUM]"",+BARSMAX,BARSCUR'<BARSMAX D  Q:$D(BARQUIT)
  1.  . K DIC,DA,DR,DIR
  1.  . S DIR("A",1)="The contract determined maximum number of SELF PAY transactions has been reached."
  1.  . S DIR("A")="Continue"
  1.  . S DIR(0)="Y"
  1.  . S DIR("B")="N"
  1.  . D ^DIR
  1.  . S:Y'=1 BARQUIT=1
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. ERROR ;
  1.  ; Paramaters not complete.  If not auto, msg.  Always quit
  1.  S BARQUIT=1
  1.  D MSG
  1.  D PAZ^BARRUTL
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DISPDT ;
  1.  ; Display last date range used
  1.  W !!,"The last chosen 3P Approval date range was..."
  1.  W !!,"Starting Date: ",$S(BARLSTRO="":"None",1:BARLSTRO)
  1.  W !,"  Ending Date: ",$S(BARLENDO="":"None",1:BARLENDO)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. ASKDT ;
  1.  ; Ask for date range
  1.  W !!!!,"Select 3P Approval date range for this Debt Collection process...",!
  1.  S BARSTART=$$DATE^BARDUTL(1)
  1.  I BARSTART<1 Q
  1.  S BAREND=$$DATE^BARDUTL(2)
  1.  I BAREND<1 W ! G ASKDT
  1.  I BAREND<BARSTART D  G ASKDT
  1.  .W *7
  1.  .W !!,"The END date must not be before the START date.",!
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. ASKPARAM ;
  1.  ; Ask other parameteres
  1.  W !
  1.  K DIR,DIC,DA,DR
  1.  S DIR("B")=BARMAMT               ; Minimum Dollar amount
  1.  S DIR(0)="NO^20:5000"
  1.  S DIR("A")="Enter the Debt Collection Minimum Bill Balance Amount"
  1.  D ^DIR
  1.  K DIR
  1.  I '+Y S BARQUIT=1 Q
  1.  S BARAMT=Y
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DISPARAM ;
  1.  ; Display chosen parameters
  1.  W !!,"Start Date: ",$$SDT^BARDUTL(BARSTART)
  1.  W !,"  End Date: ",$$SDT^BARDUTL(BAREND)
  1.  W !!,"  $$ Limit: ",$J($FN(BARAMT,",",2),5),!!
  1.  K DIR,DIC,DA,DR
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you want to proceed"
  1.  S DIR("B")="N"
  1.  D ^DIR
  1.  S:Y'=1 BARQUIT=1
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. PROCESS ;
  1.  ; Find bills to send.
  1.  W !!,"...Pass 1 - Finding bills on which to STOP collections... "
  1.  D FINDSTOP^BARDMAN2
  1.  W !!,$G(^TMP($J,"BAR-STOPS-CNT"))_" bills FOUND on which to STOP collections!"
  1.  ;
  1.  I BARICUR>BARIMAX,(+BARSMAX&(BARSCUR>BARSMAX)) D  Q
  1.  . W !!,"Maximum number of STARTS have been reached.  Start Files will not be created."
  1.  . D PAZ^BARRUTL
  1.  ;
  1.  I BARICUR>BARIMAX,'+BARSMAX D  Q
  1.  . W !!,"Maximum number of STARTS have been reached.  Start Files will not be created."
  1.  . D PAZ^BARRUTL
  1.  ;
  1.  W !!!,"...Pass 2 - Finding bills on which to START collections... "
  1.  D FINDSTRT^BARDMAN2
  1.  W !!,$G(^TMP($J,"BAR-STARTS-CNT"))," bills FOUND on which to START collections!"
  1.  I +BARSRCHD W !!,"Maximum number of transactions for Self Pay Starts has been reached."
  1.  I +BARIRCHD W !!,"Maximum number of transactions for Insurer Starts has been reached."
  1.  ;
  1.  I $G(^TMP($J,"BAR-STARTS-CNT"))+$G(^TMP($J,"BAR-STOPS-CNT"))=0 D  Q
  1.  . W !!,"Sorry no bills found meeting the selection criteria.",!
  1.  . S BARQUIT=1
  1.  . K DIR
  1.  . S DIR(0)="E"
  1.  . S DIR("A")="Press 'ENTER' to continue"
  1.  . D ^DIR
  1.  . K DIR
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. CLEAN ;
  1.  ;K ^BARXTMP("DEBT COLLECTION")
  1.  D ^BARVKL0
  1.  Q