Routine: BARDMAN2

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)

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

INACTREC ;

 K DIE,DA,DR

 S DIE="^BARDEBT("

 S DA=BARL

 S DR=".05////^S X=0"

 D ^DIE

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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

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

BARDMAN2.m