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