BARDMAN2 ; IHS/SD/LSL - A/R Debt Collection Process (2) ;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 BBMDC2
; Callable entry points from BARDMAN that will find bills
; needing to be sent to Transworld for Stop/Start Collection.
; This routine calls one of four entry points to BARDMAN3 that
; build a temporary global of the necessary data.
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; ********************************************************************
;
; Verify the following 2 entries exist in ZISH SEND PARAMETERS file or
; the creation and sending of files won't work.
;
; 1. BAR DCM F (foreground)
; 2. BAR DCM B (background or queued)
;
; ********************************************************************
Q
;
FINDSTOP ; EP
; Loop log and create stops for bills with a changed balance in this DUZ(2)
; code of 1 - bill is adjusted to 0 - stop collection service
; code of 5 = bill is paid in full - stop collection service
; code of A = an adjustment has been made to the previous service
S BARSYMB=0
S BARTCNT=0
S BARL=0
S BARSSELF=0 ; Initialize self pay stop counter
S BARSINS=0 ; Initialize insurer stop counter
;
; Loop Active log entries
F S BARL=$O(^BARDEBT("AD",1,BARL)) Q:'+BARL D ACTLOG
S ^TMP($J,"BAR-STOPS-CNT")=BARTCNT
Q
; ********************************************************************
;
ACTLOG ;
; For each active log entry do the following...
S BARSYMB=BARSYMB+1
S:BARSYMB>10 BARSYMB=1
W:'$D(BARQUIET) $C(32+BARSYMB),$C(8)
Q:($P($G(^BARDEBT(BARL,0)),U,8)'=DUZ(2)) ; log entry not this fac
Q:($P($G(^BARDEBT(BARL,0)),U,2)="") ; No bill # this log ent
S BARLDT=$P($G(^BARDEBT(BARL,0)),U) ; Log date
S X1=DT
S X2=-160 ; Changed from 100 per Sandra Lahi 4/13/04
D C^%DTC
S BARCHKDT=X
;
; Log entry 100 days old, mark inactive, don't send stop
I +BARLDT,BARLDT<BARCHKDT D INACTREC Q
S BARLBAL=$P($G(^BARDEBT(BARL,0)),U,3) ; Bill Balance on log
S BARBL=$P(^BARDEBT(BARL,0),U,2) ; IEN A/R Bill File
S BARBAL=$P($G(^BARBL(DUZ(2),BARBL,0)),U,15) ; Bill Bal AR bill
Q:+BARLBAL=+BARBAL ; Balances same, no stop
I BARBAL>0 S BARACT="A"
E S BARACT=$$GETTX(BARBL)
S BARBLNM=$$GET1^DIQ(90050.01,BARBL,.01)
S BARBLNM=$TR(BARBLNM,"-","") ; Don;t send - in bill name
S:BARBAL<0 BARBAL=0 ; Don't send negative
S BARX=$P(BARBAL,".")_"."_$P(BARBAL,".",2)_"00"
S BARBAL=$P(BARX,".")_$E($P(BARX,".",2),1,2)
I $P($G(^BARDEBT(BARL,0)),U,6)="S",$L(BARSNUM) D Q
. D SSELFILE^BARDMAN3 ; Build self pay stops global
. S BARTCNT=BARTCNT+1
I $P($G(^BARDEBT(BARL,0)),U,6)="I",$L(BARINUM) D Q
. D SINSFILE^BARDMAN3 ; Build insurer stops global
. S BARTCNT=BARTCNT+1
Q
; ********************************************************************
;
INACTREC ;
K DIE,DA,DR
S DIE="^BARDEBT("
S DA=BARL
S DR=".05////^S X=0"
D ^DIE
Q
; ********************************************************************
;
GETTX(BARBL) ; EP
;
;** this function is only called if the current balance is 0
;** find last transaction - determine if it is a payment
; if last tx is a payment, pass the action code 5 (paid in full)
; if last tx is an adj., pass the action code 1 (cancel)
;
N BARPMT
S BARTR=$O(^BARTR(DUZ(2),"AC",BARBL,""),-1)
I '+BARTR Q 1
S BARPMT=$$GET1^DIQ(90050.03,BARTR,3.6)
Q $S(+BARPMT:5,1:1)
; ********************************************************************
; ********************************************************************
;
FINDSTRT ; EP
; search A/R Bill file for this DUZ(2) for matches to extract to data file
S X1=DT
S X2=-365
D C^%DTC
S BARYRCHK=X ; Date 1 yr ago
S BARTCNT=0
S BARSYMB=0
S BARTSELF=0 ; Initialize self pay start counter
S BARTSINS=0 ; Initialize insurer start counter
S BARIRCHD=0 ; Max ins transaction reached
S BARSRCHD=0 ; Max self pay transaction reached
S BARDT=BARSTART-.5
S BAREND=BAREND_".9999999"
;
; Loop 3P Approval Date x-ref of AR bill for approval dates within
; selected range.
F S BARDT=$O(^BARBL(DUZ(2),"AG",BARDT)) Q:'+BARDT!(BARDT>BAREND) D LOOP
S ^TMP($J,"BAR-STARTS-CNT")=BARTCNT
Q
; ********************************************************************
;
LOOP ;
; For each valid 3P approval date do...
S BARBL=0
F S BARBL=$O(^BARBL(DUZ(2),"AG",BARDT,BARBL)) Q:'+BARBL D BILL
Q
; ********************************************************************
;
BILL ;
S BARSYMB=BARSYMB+1
S:BARSYMB>10 BARSYMB=1
W:'$D(BARQUIET) $C(32+BARSYMB),$C(8)
;
; Check balance on greater than limit
S BARBAL=$$GET1^DIQ(90050.01,BARBL,15)
Q:(BARBAL<BARAMT)
;
; Check DOS after earliest DOS allowed
S BARDOS=$$GET1^DIQ(90050.01,BARBL,102,"I") ; DOS Begin of AR bill
I $G(BAREDOS),BARDOS<BAREDOS Q
;
; Check A/R Bill already sent for collection
S BARL=$O(^BARDEBT("C",BARBL,0))
I +BARL D Q:(BARLOC=DUZ(2)) ; AR bill IEN in log
. S BARLOC=$P($G(^BARDEBT(BARL,0)),U,8)
;
; Check to see if A/R Account on bill is restricted
S BARAC=$$GET1^DIQ(90050.01,BARBL,"3","I")
Q:'+BARAC ; No AR Account on bill
S BARACTP=$$GET1^DIQ(90050.02,BARAC,1)
K BARNOGO
I BARACTP=9999999.18 D Q:$D(BARNOGO)
. I $D(^BAR(90052.06,DUZ(2),DUZ(2),13,"B",BARAC)) D
. . S BAR13IEN=$O(^BAR(90052.06,DUZ(2),DUZ(2),13,"B",BARAC,""))
. . S BARESTRT=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),13,BAR13IEN,0)),U,2)
. . S:BARESTRT=1 BARNOGO=1
. I (BARICUR>BARIMAX!(BARICUR=BARIMAX)) S BARNOGO=1
S BARCAT=""
;
; Check if AR Account, TSI Account Number
I BARACTP=9999999.18,$L(BARINUM) S BARCAT="I"
;
; Check if Self Pay, age less 1 yr, TSI Self Pay Number
I BARACTP=9000001 D
. Q:BARSNUM=""
. Q:BARSCUR>BARSMAX
. Q:BARSCUR=BARSMAX
. Q:(BARDT<BARYRCHK)
. S BARCAT="S"
Q:BARCAT=""
S BARBLNMD=$$GET1^DIQ(90050.01,BARBL,.01) ;bill number - w/dashes
S BARBLNM=$TR(BARBLNMD,"-","") ;bill number - strip dashes
S BARX=$P(BARBAL,".")_"."_$P(BARBAL,".",2)_"00"
S BARBAL=$P(BARX,".")_$E($P(BARX,".",2),1,2)
I BARCAT="I" D Q:+BARIRCHD
. S BARICUR=BARICUR+1
. I BARICUR>BARIMAX S BARIRCHD=BARICUR Q
. D TINSFILE^BARDMAN3 ; Build Insurer Starts global
I BARCAT="S" D Q:+BARSRCHD
. S BARSCUR=BARSCUR+1
. I BARSCUR>BARSMAX S BARSRCHD=BARSCUR Q
. D TSELFILE^BARDMAN3 ; Build Self Pay Starts global
S BARTCNT=BARTCNT+1
Q
; ********************************************************************
;
SEND ; EP
; Using XBGSAVE, create local files from the 4 globals and send them
; to the ITSC Server.
D NOW^%DTC
S BARTM=$E($P(%,".",2),1,4)
S BARJDT=$$JDT^XBFUNC(DT)
;
I $D(^BARSSELF) D
. S (XBFN,BARSSFN)="bar-stop-self-"_BARSNUM_"-"_BARTM_"-"_BARJDT_".dat"
. S XBGL="BARSSELF("
. D SENDFILE
. I XBFLG=0 D
. . W:'$D(BARQUIET) !!,"File ",BARSSFN," sent. Updating LOG with Self Pay Stops"
. . D LOGSSELF^BARDMAN4
. I +XBFLG,'$D(BARQUIET) D
. . W !!,"Creation/Send of file ",BARSSFN," was unsuccessful."
. . W !,XBFLG(1)
. D:$D(BARQUIET) PAZ^BARRUTL
;
I $D(^BARSTOPS) D
. S (XBFN,BARSIFN)="bar-stop-ins-"_BARINUM_"-"_BARTM_"-"_BARJDT_".dat"
. S XBGL="BARSTOPS("
. D SENDFILE
. I XBFLG=0 D
. . W:'$D(BARQUIET) !!,"File ",BARSIFN," sent. Updating LOG with Insurer Stops"
. . D LOGSTOP^BARDMAN4
. I +XBFLG,'$D(BARQUIET) D
. . W !!,"Creation/Send of file ",BARSIFN," was unsuccessful."
. . W !,XBFLG(1)
. D:'$D(BARQUIET) PAZ^BARRUTL
;
I $D(^BARTSELF) D
. S (XBFN,BARTSFN)="bar-start-self-"_BARSNUM_"-"_BARTM_"-"_BARJDT_".dat"
. S XBGL="BARTSELF("
. D SENDFILE
. I XBFLG=0 D
. . W:'$D(BARQUIET) !!,"File ",BARTSFN," sent. Updating LOG with Self Pay Starts"
. . D LOGTSELF^BARDMAN4
. I +XBFLG,'$D(BARQUIET) D
. . W !!,"Creation/Send of file ",BARTSFN," was unsuccessful."
. . W !,XBFLG(1)
. D:'$D(BARQUIET) PAZ^BARRUTL
;
I $D(^BARSTART) D
. S (XBFN,BARTIFN)="bar-start-ins-"_BARINUM_"-"_BARTM_"-"_BARJDT_".dat"
. S XBGL="BARSTART("
. D SENDFILE
. I XBFLG=0 D
. . W:'$D(BARQUIET) !!,"File ",BARTIFN," sent. Updating LOG with Insurer Starts"
. . D LOGSTART^BARDMAN4
. I +XBFLG,'$D(BARQUIET) D
. . W !!,"Creation/Send of file ",BARTIFN," was unsuccessful."
. . W !,XBFLG(1)
. D:'$D(BARQUIET) PAZ^BARRUTL
Q
; ********************************************************************
;
SENDFILE ; EP
; Create self pay stops and send file to ITSC Server
S XBQSHO=""
S XBF=$J ; Beginning 1st level numeric subscript
S XBE=$J ; Ending 1st level numeric subscript
S XBFLT=1 ; indicates flat file
S XBMED="F" ; Flag indicates file as media
S XBCON=1 ; Q if non-cononic
S XBS1="BAR DCM F" ; ZISH SEND PARAMETERS entry
I $D(ZTQUEUED) S XBS1="BAR DCM B"
S XBQ="N"
;S BARITSC=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),10)),U,9,11)
S XBUF=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),10)),U,7) ; Local directory for file creation
;S BARUNAM=$P(BARITSC,U,2) ; Username of system receiving file
;S BARUPASS=$P(BARITSC,U,3) ; Password of system receiving file
;S XBQTO=$P(BARITSC,U) ; System id to receive file
; Include username and password in system id
;S XBQTO="-l """_BARUNAM_":"_BARUPASS_""" "_XBQTO
;I XBUF=""!(BARUNAM="")!(BARUPASS="")!(XBQTO="") D Q
I XBUF="" D Q
. S XBFLG=-1
. S XBFLG(1)="Missing local directory. Please check Debt Collection Parameters"
I IO=IO(0) W !!
D ^XBGSAVE
Q
BARDMAN2 ; IHS/SD/LSL - A/R Debt Collection Process (2) ;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 BBMDC2
+5 ; Callable entry points from BARDMAN that will find bills
+6 ; needing to be sent to Transworld for Stop/Start Collection.
+7 ; This routine calls one of four entry points to BARDMAN3 that
+8 ; build a temporary global of the necessary data.
+9 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+10 ; ********************************************************************
+11 ;
+12 ; Verify the following 2 entries exist in ZISH SEND PARAMETERS file or
+13 ; the creation and sending of files won't work.
+14 ;
+15 ; 1. BAR DCM F (foreground)
+16 ; 2. BAR DCM B (background or queued)
+17 ;
+18 ; ********************************************************************
+19 QUIT
+20 ;
FINDSTOP ; EP
+1 ; Loop log and create stops for bills with a changed balance in this DUZ(2)
+2 ; code of 1 - bill is adjusted to 0 - stop collection service
+3 ; code of 5 = bill is paid in full - stop collection service
+4 ; code of A = an adjustment has been made to the previous service
+5 SET BARSYMB=0
+6 SET BARTCNT=0
+7 SET BARL=0
+8 ; Initialize self pay stop counter
SET BARSSELF=0
+9 ; Initialize insurer stop counter
SET BARSINS=0
+10 ;
+11 ; Loop Active log entries
+12 FOR
SET BARL=$ORDER(^BARDEBT("AD",1,BARL))
IF '+BARL
QUIT
DO ACTLOG
+13 SET ^TMP($JOB,"BAR-STOPS-CNT")=BARTCNT
+14 QUIT
+15 ; ********************************************************************
+16 ;
ACTLOG ;
+1 ; For each active log entry do the following...
+2 SET BARSYMB=BARSYMB+1
+3 IF BARSYMB>10
SET BARSYMB=1
+4 IF '$DATA(BARQUIET)
WRITE $CHAR(32+BARSYMB),$CHAR(8)
+5 ; log entry not this fac
IF ($PIECE($GET(^BARDEBT(BARL,0)),U,8)'=DUZ(2))
QUIT
+6 ; No bill # this log ent
IF ($PIECE($GET(^BARDEBT(BARL,0)),U,2)="")
QUIT
+7 ; Log date
SET BARLDT=$PIECE($GET(^BARDEBT(BARL,0)),U)
+8 SET X1=DT
+9 ; Changed from 100 per Sandra Lahi 4/13/04
SET X2=-160
+10 DO C^%DTC
+11 SET BARCHKDT=X
+12 ;
+13 ; Log entry 100 days old, mark inactive, don't send stop
+14 IF +BARLDT
IF BARLDT<BARCHKDT
DO INACTREC
QUIT
+15 ; Bill Balance on log
SET BARLBAL=$PIECE($GET(^BARDEBT(BARL,0)),U,3)
+16 ; IEN A/R Bill File
SET BARBL=$PIECE(^BARDEBT(BARL,0),U,2)
+17 ; Bill Bal AR bill
SET BARBAL=$PIECE($GET(^BARBL(DUZ(2),BARBL,0)),U,15)
+18 ; Balances same, no stop
IF +BARLBAL=+BARBAL
QUIT
+19 IF BARBAL>0
SET BARACT="A"
+20 IF '$TEST
SET BARACT=$$GETTX(BARBL)
+21 SET BARBLNM=$$GET1^DIQ(90050.01,BARBL,.01)
+22 ; Don;t send - in bill name
SET BARBLNM=$TRANSLATE(BARBLNM,"-","")
+23 ; Don't send negative
IF BARBAL<0
SET BARBAL=0
+24 SET BARX=$PIECE(BARBAL,".")_"."_$PIECE(BARBAL,".",2)_"00"
+25 SET BARBAL=$PIECE(BARX,".")_$EXTRACT($PIECE(BARX,".",2),1,2)
+26 IF $PIECE($GET(^BARDEBT(BARL,0)),U,6)="S"
IF $LENGTH(BARSNUM)
Begin DoDot:1
+27 ; Build self pay stops global
DO SSELFILE^BARDMAN3
+28 SET BARTCNT=BARTCNT+1
End DoDot:1
QUIT
+29 IF $PIECE($GET(^BARDEBT(BARL,0)),U,6)="I"
IF $LENGTH(BARINUM)
Begin DoDot:1
+30 ; Build insurer stops global
DO SINSFILE^BARDMAN3
+31 SET BARTCNT=BARTCNT+1
End DoDot:1
QUIT
+32 QUIT
+33 ; ********************************************************************
+34 ;
INACTREC ;
+1 KILL DIE,DA,DR
+2 SET DIE="^BARDEBT("
+3 SET DA=BARL
+4 SET DR=".05////^S X=0"
+5 DO ^DIE
+6 QUIT
+7 ; ********************************************************************
+8 ;
GETTX(BARBL) ; EP
+1 ;
+2 ;** this function is only called if the current balance is 0
+3 ;** find last transaction - determine if it is a payment
+4 ; if last tx is a payment, pass the action code 5 (paid in full)
+5 ; if last tx is an adj., pass the action code 1 (cancel)
+6 ;
+7 NEW BARPMT
+8 SET BARTR=$ORDER(^BARTR(DUZ(2),"AC",BARBL,""),-1)
+9 IF '+BARTR
QUIT 1
+10 SET BARPMT=$$GET1^DIQ(90050.03,BARTR,3.6)
+11 QUIT $SELECT(+BARPMT:5,1:1)
+12 ; ********************************************************************
+13 ; ********************************************************************
+14 ;
FINDSTRT ; EP
+1 ; search A/R Bill file for this DUZ(2) for matches to extract to data file
+2 SET X1=DT
+3 SET X2=-365
+4 DO C^%DTC
+5 ; Date 1 yr ago
SET BARYRCHK=X
+6 SET BARTCNT=0
+7 SET BARSYMB=0
+8 ; Initialize self pay start counter
SET BARTSELF=0
+9 ; Initialize insurer start counter
SET BARTSINS=0
+10 ; Max ins transaction reached
SET BARIRCHD=0
+11 ; Max self pay transaction reached
SET BARSRCHD=0
+12 SET BARDT=BARSTART-.5
+13 SET BAREND=BAREND_".9999999"
+14 ;
+15 ; Loop 3P Approval Date x-ref of AR bill for approval dates within
+16 ; selected range.
+17 FOR
SET BARDT=$ORDER(^BARBL(DUZ(2),"AG",BARDT))
IF '+BARDT!(BARDT>BAREND)
QUIT
DO LOOP
+18 SET ^TMP($JOB,"BAR-STARTS-CNT")=BARTCNT
+19 QUIT
+20 ; ********************************************************************
+21 ;
LOOP ;
+1 ; For each valid 3P approval date do...
+2 SET BARBL=0
+3 FOR
SET BARBL=$ORDER(^BARBL(DUZ(2),"AG",BARDT,BARBL))
IF '+BARBL
QUIT
DO BILL
+4 QUIT
+5 ; ********************************************************************
+6 ;
BILL ;
+1 SET BARSYMB=BARSYMB+1
+2 IF BARSYMB>10
SET BARSYMB=1
+3 IF '$DATA(BARQUIET)
WRITE $CHAR(32+BARSYMB),$CHAR(8)
+4 ;
+5 ; Check balance on greater than limit
+6 SET BARBAL=$$GET1^DIQ(90050.01,BARBL,15)
+7 IF (BARBAL<BARAMT)
QUIT
+8 ;
+9 ; Check DOS after earliest DOS allowed
+10 ; DOS Begin of AR bill
SET BARDOS=$$GET1^DIQ(90050.01,BARBL,102,"I")
+11 IF $GET(BAREDOS)
IF BARDOS<BAREDOS
QUIT
+12 ;
+13 ; Check A/R Bill already sent for collection
+14 SET BARL=$ORDER(^BARDEBT("C",BARBL,0))
+15 ; AR bill IEN in log
IF +BARL
Begin DoDot:1
+16 SET BARLOC=$PIECE($GET(^BARDEBT(BARL,0)),U,8)
End DoDot:1
IF (BARLOC=DUZ(2))
QUIT
+17 ;
+18 ; Check to see if A/R Account on bill is restricted
+19 SET BARAC=$$GET1^DIQ(90050.01,BARBL,"3","I")
+20 ; No AR Account on bill
IF '+BARAC
QUIT
+21 SET BARACTP=$$GET1^DIQ(90050.02,BARAC,1)
+22 KILL BARNOGO
+23 IF BARACTP=9999999.18
Begin DoDot:1
+24 IF $DATA(^BAR(90052.06,DUZ(2),DUZ(2),13,"B",BARAC))
Begin DoDot:2
+25 SET BAR13IEN=$ORDER(^BAR(90052.06,DUZ(2),DUZ(2),13,"B",BARAC,""))
+26 SET BARESTRT=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),13,BAR13IEN,0)),U,2)
+27 IF BARESTRT=1
SET BARNOGO=1
End DoDot:2
+28 IF (BARICUR>BARIMAX!(BARICUR=BARIMAX))
SET BARNOGO=1
End DoDot:1
IF $DATA(BARNOGO)
QUIT
+29 SET BARCAT=""
+30 ;
+31 ; Check if AR Account, TSI Account Number
+32 IF BARACTP=9999999.18
IF $LENGTH(BARINUM)
SET BARCAT="I"
+33 ;
+34 ; Check if Self Pay, age less 1 yr, TSI Self Pay Number
+35 IF BARACTP=9000001
Begin DoDot:1
+36 IF BARSNUM=""
QUIT
+37 IF BARSCUR>BARSMAX
QUIT
+38 IF BARSCUR=BARSMAX
QUIT
+39 IF (BARDT<BARYRCHK)
QUIT
+40 SET BARCAT="S"
End DoDot:1
+41 IF BARCAT=""
QUIT
+42 ;bill number - w/dashes
SET BARBLNMD=$$GET1^DIQ(90050.01,BARBL,.01)
+43 ;bill number - strip dashes
SET BARBLNM=$TRANSLATE(BARBLNMD,"-","")
+44 SET BARX=$PIECE(BARBAL,".")_"."_$PIECE(BARBAL,".",2)_"00"
+45 SET BARBAL=$PIECE(BARX,".")_$EXTRACT($PIECE(BARX,".",2),1,2)
+46 IF BARCAT="I"
Begin DoDot:1
+47 SET BARICUR=BARICUR+1
+48 IF BARICUR>BARIMAX
SET BARIRCHD=BARICUR
QUIT
+49 ; Build Insurer Starts global
DO TINSFILE^BARDMAN3
End DoDot:1
IF +BARIRCHD
QUIT
+50 IF BARCAT="S"
Begin DoDot:1
+51 SET BARSCUR=BARSCUR+1
+52 IF BARSCUR>BARSMAX
SET BARSRCHD=BARSCUR
QUIT
+53 ; Build Self Pay Starts global
DO TSELFILE^BARDMAN3
End DoDot:1
IF +BARSRCHD
QUIT
+54 SET BARTCNT=BARTCNT+1
+55 QUIT
+56 ; ********************************************************************
+57 ;
SEND ; EP
+1 ; Using XBGSAVE, create local files from the 4 globals and send them
+2 ; to the ITSC Server.
+3 DO NOW^%DTC
+4 SET BARTM=$EXTRACT($PIECE(%,".",2),1,4)
+5 SET BARJDT=$$JDT^XBFUNC(DT)
+6 ;
+7 IF $DATA(^BARSSELF)
Begin DoDot:1
+8 SET (XBFN,BARSSFN)="bar-stop-self-"_BARSNUM_"-"_BARTM_"-"_BARJDT_".dat"
+9 SET XBGL="BARSSELF("
+10 DO SENDFILE
+11 IF XBFLG=0
Begin DoDot:2
+12 IF '$DATA(BARQUIET)
WRITE !!,"File ",BARSSFN," sent. Updating LOG with Self Pay Stops"
+13 DO LOGSSELF^BARDMAN4
End DoDot:2
+14 IF +XBFLG
IF '$DATA(BARQUIET)
Begin DoDot:2
+15 WRITE !!,"Creation/Send of file ",BARSSFN," was unsuccessful."
+16 WRITE !,XBFLG(1)
End DoDot:2
+17 IF $DATA(BARQUIET)
DO PAZ^BARRUTL
End DoDot:1
+18 ;
+19 IF $DATA(^BARSTOPS)
Begin DoDot:1
+20 SET (XBFN,BARSIFN)="bar-stop-ins-"_BARINUM_"-"_BARTM_"-"_BARJDT_".dat"
+21 SET XBGL="BARSTOPS("
+22 DO SENDFILE
+23 IF XBFLG=0
Begin DoDot:2
+24 IF '$DATA(BARQUIET)
WRITE !!,"File ",BARSIFN," sent. Updating LOG with Insurer Stops"
+25 DO LOGSTOP^BARDMAN4
End DoDot:2
+26 IF +XBFLG
IF '$DATA(BARQUIET)
Begin DoDot:2
+27 WRITE !!,"Creation/Send of file ",BARSIFN," was unsuccessful."
+28 WRITE !,XBFLG(1)
End DoDot:2
+29 IF '$DATA(BARQUIET)
DO PAZ^BARRUTL
End DoDot:1
+30 ;
+31 IF $DATA(^BARTSELF)
Begin DoDot:1
+32 SET (XBFN,BARTSFN)="bar-start-self-"_BARSNUM_"-"_BARTM_"-"_BARJDT_".dat"
+33 SET XBGL="BARTSELF("
+34 DO SENDFILE
+35 IF XBFLG=0
Begin DoDot:2
+36 IF '$DATA(BARQUIET)
WRITE !!,"File ",BARTSFN," sent. Updating LOG with Self Pay Starts"
+37 DO LOGTSELF^BARDMAN4
End DoDot:2
+38 IF +XBFLG
IF '$DATA(BARQUIET)
Begin DoDot:2
+39 WRITE !!,"Creation/Send of file ",BARTSFN," was unsuccessful."
+40 WRITE !,XBFLG(1)
End DoDot:2
+41 IF '$DATA(BARQUIET)
DO PAZ^BARRUTL
End DoDot:1
+42 ;
+43 IF $DATA(^BARSTART)
Begin DoDot:1
+44 SET (XBFN,BARTIFN)="bar-start-ins-"_BARINUM_"-"_BARTM_"-"_BARJDT_".dat"
+45 SET XBGL="BARSTART("
+46 DO SENDFILE
+47 IF XBFLG=0
Begin DoDot:2
+48 IF '$DATA(BARQUIET)
WRITE !!,"File ",BARTIFN," sent. Updating LOG with Insurer Starts"
+49 DO LOGSTART^BARDMAN4
End DoDot:2
+50 IF +XBFLG
IF '$DATA(BARQUIET)
Begin DoDot:2
+51 WRITE !!,"Creation/Send of file ",BARTIFN," was unsuccessful."
+52 WRITE !,XBFLG(1)
End DoDot:2
+53 IF '$DATA(BARQUIET)
DO PAZ^BARRUTL
End DoDot:1
+54 QUIT
+55 ; ********************************************************************
+56 ;
SENDFILE ; EP
+1 ; Create self pay stops and send file to ITSC Server
+2 SET XBQSHO=""
+3 ; Beginning 1st level numeric subscript
SET XBF=$JOB
+4 ; Ending 1st level numeric subscript
SET XBE=$JOB
+5 ; indicates flat file
SET XBFLT=1
+6 ; Flag indicates file as media
SET XBMED="F"
+7 ; Q if non-cononic
SET XBCON=1
+8 ; ZISH SEND PARAMETERS entry
SET XBS1="BAR DCM F"
+9 IF $DATA(ZTQUEUED)
SET XBS1="BAR DCM B"
+10 SET XBQ="N"
+11 ;S BARITSC=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),10)),U,9,11)
+12 ; Local directory for file creation
SET XBUF=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),10)),U,7)
+13 ;S BARUNAM=$P(BARITSC,U,2) ; Username of system receiving file
+14 ;S BARUPASS=$P(BARITSC,U,3) ; Password of system receiving file
+15 ;S XBQTO=$P(BARITSC,U) ; System id to receive file
+16 ; Include username and password in system id
+17 ;S XBQTO="-l """_BARUNAM_":"_BARUPASS_""" "_XBQTO
+18 ;I XBUF=""!(BARUNAM="")!(BARUPASS="")!(XBQTO="") D Q
+19 IF XBUF=""
Begin DoDot:1
+20 SET XBFLG=-1
+21 SET XBFLG(1)="Missing local directory. Please check Debt Collection Parameters"
End DoDot:1
QUIT
+22 IF IO=IO(0)
WRITE !!
+23 DO ^XBGSAVE
+24 QUIT
