BARDAUTO.m

BARDAUTO ; IHS/SD/LSL - A/R Debt Collection Process ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 ;

 ; IHS/SD/LSL - 04/08/2004 - V1.8

 ;      Routine created.  Moved (modified) from BBMDC1

 ;      Called by taskable menu option BAR DEBT COLLECTION AUTO

 ;

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

 ;

 Q

 ;

EP ; EP

 ; Loop parent facilities and see if they are set up.

 S BARHOLD=DUZ(2)

 S DUZ(2)=0

 F  S DUZ(2)=$O(^BAR(90052.06,DUZ(2))) Q:'+DUZ(2)  D PARENT

 S DUZ(2)=BARHOLD

 Q

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

 ;

PARENT ;

 Q:'$D(^BAR(90052.06,DUZ(2),DUZ(2),0))

 Q:'+$P($G(^BAR(90052.06,DUZ(2),DUZ(2),11)),U,7)    ; not set up auto

 D VARS^BARDMAN                   ; Get site parameter values

 S BARQUIT=$$CHECK()              ; Check parameters

 I +BARQUIT D CLEAN Q

 K BARQUIT

 D DATE                           ; Determine start and end dates

 I '+BARSTART D CLEAN Q           ; Date range not entered

 S BARAMT=BARMAMT                 ; Minimum bill amount

 D PROCESS                        ; Find bills and build temp global

 I $D(BARQUIT) D CLEAN Q

 D SEND^BARDMAN2                  ; create and Send file to ITSC Server

 Q

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

 ;

CHECK(BARQUIT) ;

 I ((BARINUM="")&(BARSNUM="")) Q 1

 I BARPATH="" Q 1

 I +BARIMAX=0 Q 1

 I +$L(BARSNUM),'+BARSMAX Q 1

 I BARINUM]"",BARICUR'<BARIMAX Q 1

 I BARSNUM]"",+BARSMAX,BARSCUR'<BARSMAX Q 1

 Q 0

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

 ;

DATE ;

 S BARSTART=BARASDT               ; Start date for auto(def'd in param)

 I '+BARSTART S BARSTART=BARSRCHD    ; default earliest date to search

 Q:'+BARSTART                     ; quit if neither parameter set

 S X1=DT                          ; today

 S X2=-BARMAGE                    ; Minimum bill age (90 days if undef)

 D C^%DTC

 S BAREND=X                       ; End date

 Q

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

 ;

PROCESS ;

 ; Find bills to send.

 S BARQUIET=1

 D FINDSTOP^BARDMAN2

 I BARICUR>BARIMAX,(+BARSMAX&(BARSCUR>BARSMAX)) Q

 I BARICUR>BARIMAX,'+BARSMAX Q

 D FINDSTRT^BARDMAN2

 Q

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

 ;

CLEAN ;

 D ^BARVKL0

 Q

BARDAUTO  ; IHS/SD/LSL - A/R Debt Collection Process ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/LSL - 04/08/2004 - V1.8

 +4       ;      Routine created.  Moved (modified) from BBMDC1

 +5       ;      Called by taskable menu option BAR DEBT COLLECTION AUTO

 +6       ;

 +7       ; ********************************************************************

 +8       ;

 +9        QUIT 

 +10      ;

EP        ; EP

 +1       ; Loop parent facilities and see if they are set up.

 +2        SET BARHOLD=DUZ(2)

 +3        SET DUZ(2)=0

 +4        FOR 

               SET DUZ(2)=$ORDER(^BAR(90052.06,DUZ(2)))

               IF '+DUZ(2)

                   QUIT 

               DO PARENT

 +5        SET DUZ(2)=BARHOLD

 +6        QUIT 

 +7       ; ********************************************************************

 +8       ;

PARENT    ;

 +1        IF '$DATA(^BAR(90052.06,DUZ(2),DUZ(2),0))

               QUIT 

 +2       ; not set up auto

           IF '+$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),11)),U,7)

               QUIT 

 +3       ; Get site parameter values

           DO VARS^BARDMAN

 +4       ; Check parameters

           SET BARQUIT=$$CHECK()

 +5        IF +BARQUIT

               DO CLEAN

               QUIT 

 +6        KILL BARQUIT

 +7       ; Determine start and end dates

           DO DATE

 +8       ; Date range not entered

           IF '+BARSTART

               DO CLEAN

               QUIT 

 +9       ; Minimum bill amount

           SET BARAMT=BARMAMT

 +10      ; Find bills and build temp global

           DO PROCESS

 +11       IF $DATA(BARQUIT)

               DO CLEAN

               QUIT 

 +12      ; create and Send file to ITSC Server

           DO SEND^BARDMAN2

 +13       QUIT 

 +14      ; ********************************************************************

 +15      ;

CHECK(BARQUIT) ;

 +1        IF ((BARINUM="")&(BARSNUM=""))

               QUIT 1

 +2        IF BARPATH=""

               QUIT 1

 +3        IF +BARIMAX=0

               QUIT 1

 +4        IF +$LENGTH(BARSNUM)

               IF '+BARSMAX

                   QUIT 1

 +5        IF BARINUM]""

               IF BARICUR'<BARIMAX

                   QUIT 1

 +6        IF BARSNUM]""

               IF +BARSMAX

                   IF BARSCUR'<BARSMAX

                       QUIT 1

 +7        QUIT 0

 +8       ; ********************************************************************

 +9       ;

DATE      ;

 +1       ; Start date for auto(def'd in param)

           SET BARSTART=BARASDT

 +2       ; default earliest date to search

           IF '+BARSTART

               SET BARSTART=BARSRCHD

 +3       ; quit if neither parameter set

           IF '+BARSTART

               QUIT 

 +4       ; today

           SET X1=DT

 +5       ; Minimum bill age (90 days if undef)

           SET X2=-BARMAGE

 +6        DO C^%DTC

 +7       ; End date

           SET BAREND=X

 +8        QUIT 

 +9       ; ********************************************************************

 +10      ;

PROCESS   ;

 +1       ; Find bills to send.

 +2        SET BARQUIET=1

 +3        DO FINDSTOP^BARDMAN2

 +4        IF BARICUR>BARIMAX

               IF (+BARSMAX&(BARSCUR>BARSMAX))

                   QUIT 

 +5        IF BARICUR>BARIMAX

               IF '+BARSMAX

                   QUIT 

 +6        DO FINDSTRT^BARDMAN2

 +7        QUIT 

 +8       ; ********************************************************************

 +9       ;

CLEAN     ;

 +1        DO ^BARVKL0

 +2        QUIT