BARPBEN2.m

BARPBEN2 ; IHS/SD/LSL - PRINT FROM AUTO POSTING ; 

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

 ;

 ; IHS/SD/LSL - 04/29/03 - V1.8

 ;     Tweaked code for AR national release.  Thanks to California Area

 ;     for original code (AZLKAP02 - 07/10/2000)

 ;

 Q

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

 ;

PRINT ; EP

 ; PRINT

 K DUOUT,DROUT,DTOUT,DIROUT

 D SETHDR

 I BARSBY="P" D PAT

 I BARSBY="B" D BILL

 D EXIT

 Q

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

 ;

SETHDR ;

 ; Set header Array

 S BAR("HD",0)=""

 S BAR("TXT")="Auto Post Beneficiary"

 S BAR("LVL")=0

 S BAR("CONJ")=""

 D CHK^BARRHD                         ; Line 1 of Report header

 S BAR("LVL")=BAR("LVL")+1

 S BAR("HD",BAR("LVL"))=""

 S BAR("TXT")="AR Account: "_BARACNM

 S BAR("CONJ")="For "

 D CHK^BARRHD                       ; Line 2 of Report header

 S BAR("LVL")=BAR("LVL")+1

 S BAR("HD",BAR("LVL"))=""

 S BAR("TXT")=$S(BARSBY="B":"Bill",1:"Patient")

 S BAR("CONJ")="By "

 D CHK^BARRHD                       ; Line 2 of Report header

 S BAR("PG")=0

 S BAREQUAL="W !?64,""=============="""

 Q

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

 ;

PAT ; EP

 ; sort/print by Patient

 S BAR("COL")="W !?3,""PATIENT"",?29,""BILL"",?51,""DOS"",?72,""AMOUNT"""

 D HDB^BARRPSRB

 I '+BARCNT D  Q           ; No data - quit

 . W !!!!!?25,"*** NO DATA TO PRINT ***"

 . D EOP^BARUTL(0)

 ;

 S BARPATNM=0

 F  S BARPATNM=$O(^XTMP("BAR-BEN",$J,BARPATNM)) Q:BARPATNM=""  D PATBIL Q:$G(BAR("F1"))

 D TOTAL

 Q

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

 ;

PATBIL ;

 S BARBILL=""

 F  S BARBILL=$O(^XTMP("BAR-BEN",$J,BARPATNM,BARBILL)) Q:BARBILL=""  D PATPRT  Q:$G(BAR("F1"))

 Q

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

 ;

PATPRT ; EP

 ; Print one line Patient Summary

 S BARHOLD=$G(^XTMP("BAR-BEN",$J,BARPATNM,BARBILL))

 I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))

 W !,$E(BARPATNM,1,25)                         ; Patient Name

 W ?29,$E(BARBILL,1,18)                        ; Bill Number

 W ?51,$P(BARHOLD,U,2)                         ; DOS

 W ?69,$J($P(BARHOLD,U),9,2)                   ; Write off Amount

 Q

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

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

 ;

BILL ;EP

 ; sort/print by Bill    

 S BAR("COL")="W !?3,""BILL"",?22,""PATIENT"",?51,""DOS"",?72,""AMOUNT"""

 D HDB^BARRPSRB

 I '+BARCNT D  Q           ; No data - quit

 . W !!!!!?25,"*** NO DATA TO PRINT ***"

 . D EOP^BARUTL(0)

 ;

 S BARBILL=0

 F  S BARBILL=$O(^XTMP("BAR-BEN",$J,BARBILL)) Q:BARBILL=""  D BILLPRT  Q:$G(BAR("F1"))

 D TOTAL

 Q

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

 ;

BILLPRT ; EP

 ; Print one line Bill summary

 S BARHOLD=$G(^XTMP("BAR-BEN",$J,BARBILL))

 I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))

 W !,$E(BARBILL,1,18)                          ; Bill Name

 W ?22,$E($P(BARHOLD,U,3),1,25)                ; Patient Name

 W ?51,$P(BARHOLD,U,2)                         ; DOS

 W ?69,$J($P(BARHOLD,U),9,2)                   ; Write off amount

 Q

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

 ;

TOTAL ;

 ; Write report totals

 X BAREQUAL

 W !,?10,"TOTAL BILLS: ",BARCNT

 W ?40,"TOTAL AMOUNT",?64,$J(BARTOT,14,2)

 Q

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

 ;

EXIT ; EP

 ; clear variables

 K ^XTMP("BAR-BEN",$J)

 Q

BARPBEN2  ; IHS/SD/LSL - PRINT FROM AUTO POSTING ; 

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

 +2       ;

 +3       ; IHS/SD/LSL - 04/29/03 - V1.8

 +4       ;     Tweaked code for AR national release.  Thanks to California Area

 +5       ;     for original code (AZLKAP02 - 07/10/2000)

 +6       ;

 +7        QUIT 

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

 +9       ;

PRINT     ; EP

 +1       ; PRINT

 +2        KILL DUOUT,DROUT,DTOUT,DIROUT

 +3        DO SETHDR

 +4        IF BARSBY="P"

               DO PAT

 +5        IF BARSBY="B"

               DO BILL

 +6        DO EXIT

 +7        QUIT 

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

 +9       ;

SETHDR    ;

 +1       ; Set header Array

 +2        SET BAR("HD",0)=""

 +3        SET BAR("TXT")="Auto Post Beneficiary"

 +4        SET BAR("LVL")=0

 +5        SET BAR("CONJ")=""

 +6       ; Line 1 of Report header

           DO CHK^BARRHD

 +7        SET BAR("LVL")=BAR("LVL")+1

 +8        SET BAR("HD",BAR("LVL"))=""

 +9        SET BAR("TXT")="AR Account: "_BARACNM

 +10       SET BAR("CONJ")="For "

 +11      ; Line 2 of Report header

           DO CHK^BARRHD

 +12       SET BAR("LVL")=BAR("LVL")+1

 +13       SET BAR("HD",BAR("LVL"))=""

 +14       SET BAR("TXT")=$SELECT(BARSBY="B":"Bill",1:"Patient")

 +15       SET BAR("CONJ")="By "

 +16      ; Line 2 of Report header

           DO CHK^BARRHD

 +17       SET BAR("PG")=0

 +18       SET BAREQUAL="W !?64,""=============="""

 +19       QUIT 

 +20      ; ********************************************************************

 +21      ;

PAT       ; EP

 +1       ; sort/print by Patient

 +2        SET BAR("COL")="W !?3,""PATIENT"",?29,""BILL"",?51,""DOS"",?72,""AMOUNT"""

 +3        DO HDB^BARRPSRB

 +4       ; No data - quit

           IF '+BARCNT

               Begin DoDot:1

 +5                WRITE !!!!!?25,"*** NO DATA TO PRINT ***"

 +6                DO EOP^BARUTL(0)

               End DoDot:1

               QUIT 

 +7       ;

 +8        SET BARPATNM=0

 +9        FOR 

               SET BARPATNM=$ORDER(^XTMP("BAR-BEN",$JOB,BARPATNM))

               IF BARPATNM=""

                   QUIT 

               DO PATBIL

               IF $GET(BAR("F1"))

                   QUIT 

 +10       DO TOTAL

 +11       QUIT 

 +12      ; ********************************************************************

 +13      ;

PATBIL    ;

 +1        SET BARBILL=""

 +2        FOR 

               SET BARBILL=$ORDER(^XTMP("BAR-BEN",$JOB,BARPATNM,BARBILL))

               IF BARBILL=""

                   QUIT 

               DO PATPRT

               IF $GET(BAR("F1"))

                   QUIT 

 +3        QUIT 

 +4       ; ********************************************************************

 +5       ;

PATPRT    ; EP

 +1       ; Print one line Patient Summary

 +2        SET BARHOLD=$GET(^XTMP("BAR-BEN",$JOB,BARPATNM,BARBILL))

 +3        IF $Y>(IOSL-5)

               DO HD^BARRPSRB

               IF $GET(BAR("F1"))

                   QUIT 

 +4       ; Patient Name

           WRITE !,$EXTRACT(BARPATNM,1,25)

 +5       ; Bill Number

           WRITE ?29,$EXTRACT(BARBILL,1,18)

 +6       ; DOS

           WRITE ?51,$PIECE(BARHOLD,U,2)

 +7       ; Write off Amount

           WRITE ?69,$JUSTIFY($PIECE(BARHOLD,U),9,2)

 +8        QUIT 

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

 +10      ; ********************************************************************

 +11      ;

BILL      ;EP

 +1       ; sort/print by Bill    

 +2        SET BAR("COL")="W !?3,""BILL"",?22,""PATIENT"",?51,""DOS"",?72,""AMOUNT"""

 +3        DO HDB^BARRPSRB

 +4       ; No data - quit

           IF '+BARCNT

               Begin DoDot:1

 +5                WRITE !!!!!?25,"*** NO DATA TO PRINT ***"

 +6                DO EOP^BARUTL(0)

               End DoDot:1

               QUIT 

 +7       ;

 +8        SET BARBILL=0

 +9        FOR 

               SET BARBILL=$ORDER(^XTMP("BAR-BEN",$JOB,BARBILL))

               IF BARBILL=""

                   QUIT 

               DO BILLPRT

               IF $GET(BAR("F1"))

                   QUIT 

 +10       DO TOTAL

 +11       QUIT 

 +12      ; ********************************************************************

 +13      ;

BILLPRT   ; EP

 +1       ; Print one line Bill summary

 +2        SET BARHOLD=$GET(^XTMP("BAR-BEN",$JOB,BARBILL))

 +3        IF $Y>(IOSL-5)

               DO HD^BARRPSRB

               IF $GET(BAR("F1"))

                   QUIT 

 +4       ; Bill Name

           WRITE !,$EXTRACT(BARBILL,1,18)

 +5       ; Patient Name

           WRITE ?22,$EXTRACT($PIECE(BARHOLD,U,3),1,25)

 +6       ; DOS

           WRITE ?51,$PIECE(BARHOLD,U,2)

 +7       ; Write off amount

           WRITE ?69,$JUSTIFY($PIECE(BARHOLD,U),9,2)

 +8        QUIT 

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

 +10      ;

TOTAL     ;

 +1       ; Write report totals

 +2        XECUTE BAREQUAL

 +3        WRITE !,?10,"TOTAL BILLS: ",BARCNT

 +4        WRITE ?40,"TOTAL AMOUNT",?64,$JUSTIFY(BARTOT,14,2)

 +5        QUIT 

 +6       ; ********************************************************************

 +7       ;

EXIT      ; EP

 +1       ; clear variables

 +2        KILL ^XTMP("BAR-BEN",$JOB)

 +3        QUIT