Routine: BARRTAR3

BARRTAR3 ; IHS/SD/LSL - Transaction report ;08/20/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,7**;MAR 27,2007

 ; IHS/ASDS/LSL - 10/06/00 - Routine created

 ;     Summary print of Transaction report

 ; IHS/SD/LSL - 07/10/02 - V1/6 Patch 2

 ;     Modified to print missing clinics and missing visit types

 ; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130

 ;      Modified to accomodate DUZ(2) subscript

 ;      IHS/SD/RTL - 5/23/05 - V1.8 Patch 1 - IM17362

 ;         TAR report bombing - missing collection batch

 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892

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

SUMM ; EP

 S BAR("COL")="W !,""A/R Account"",?15,""PAY-AMT"",?26,""PRV-CRD"",?37,""REFUND"",?48,""PAYMENT"",?59,""BILL AMT"",?70,""ADJUSTMENT"""

 S BAR("HD",0)="SUMMARY Transaction"_$P(BAR("HD",0),"Transaction",2,99)

 D HDB^BARRTAR2

 S BARDASH="               ---------- ---------- ---------- ---------- ---------- ----------"

 S BAREQUAL="               ========== ========== ========== ========== ========== =========="

 S (BAR("0TOTA"),BAR("0TOTB"),BAR("0TOTC"),BAR("0TOTD"),BAR("0TOTE"),BAR("0TOTF"))=0

 S (BAR("OL"),BAR("OB"),BAR("OIT"),BAR("OS"))=""

 I '$D(^TMP($J,"BAR-TARS")) D  Q

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

 . D EOP^BARUTL(0)

 S (BAR("AR"),BAR("OAR"))=""

 F  S BAR("AR")=$O(^TMP($J,"BAR-TARS",BAR("AR"))) Q:BAR("AR")']""!($G(BAR("F1")))  D

 . I +BAR("AR") W !!,"A/R Entry Clerk: ",$P(^VA(200,BAR("AR"),0),U)

 . S BAR("DUZ")=0

 . F  S BAR("DUZ")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"))) Q:'+BAR("DUZ")!($G(BAR("F1")))  D

 . . S (BAR("L"),BAR("OL"))=""

 . . F  S BAR("L")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"))) Q:BAR("L")=""!($G(BAR("F1")))  D LOC

 Q:$G(BAR("F1"))

 W !,BAREQUAL

 W !,"REPORT TOTAL"

 W ?15,$J($FN(BAR("0TOTA"),",",2),10)

 W ?26,$J($FN(BAR("0TOTB"),",",2),10)

 W ?37,$J($FN(BAR("0TOTC"),",",2),10)

 W ?48,$J($FN(BAR("0TOTD"),",",2),10)

  W ?59,$J($FN(BAR("0TOTE"),",",2),10)

  W ?70,$J($FN(BAR("0TOTF"),",",2),10)

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

LOC ;

 S BAR("B")=""

 F  S BAR("B")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"))) Q:BAR("B")=""!($G(BAR("F1")))  D BATCH

 Q:$G(BAR("F1"))

 W !,BARDASH

 W !,"Location Tot:"

 W ?15,$J($FN(BAR("1TOTA"),",",2),10)

 W ?26,$J($FN(BAR("1TOTB"),",",2),10)

 W ?37,$J($FN(BAR("1TOTC"),",",2),10)

 W ?48,$J($FN(BAR("1TOTD"),",",2),10)

 W ?59,$J($FN(BAR("1TOTE"),",",2),10)

 W ?70,$J($FN(BAR("1TOTF"),",",2),10)

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

BATCH ;

 S BAR("IT")=""

 F  S BAR("IT")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"))) Q:BAR("IT")=""!($G(BAR("F1")))  D ITEM

 Q:$G(BAR("F1"))

 W !,BARDASH

 W !,"   Batch Tot:"

 W ?15,$J($FN(BAR("2TOTA"),",",2),10)

 W ?26,$J($FN(BAR("2TOTB"),",",2),10)

 W ?37,$J($FN(BAR("2TOTC"),",",2),10)

 W ?48,$J($FN(BAR("2TOTD"),",",2),10)

 W ?59,$J($FN(BAR("2TOTE"),",",2),10)

 W ?70,$J($FN(BAR("2TOTF"),",",2),10)

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

ITEM ;

 S BAR("S")=""

 F  S BAR("S")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"))) Q:BAR("S")=""!($G(BAR("F1")))  D SORT

 Q:$G(BAR("F1"))

 W !,BARDASH

 W !,"    Item Tot:"

 W ?15,$J($FN(BAR("3TOTA"),",",2),10)

 W ?26,$J($FN(BAR("3TOTB"),",",2),10)

 W ?37,$J($FN(BAR("3TOTC"),",",2),10)

 W ?48,$J($FN(BAR("3TOTD"),",",2),10)

 W ?59,$J($FN(BAR("3TOTE"),",",2),10)

 W ?70,$J($FN(BAR("3TOTF"),",",2),10)

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

SORT ;

 S BAR("ACCT")=""

 F  S BAR("ACCT")=$O(^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"),BAR("ACCT"))) Q:BAR("ACCT")=""!($G(BAR("F1")))  D ACCT

 Q:$G(BAR("F1"))

 W !,BARDASH

 I BARY("SORT")="C" W !,"  Clinic Tot:"

 E  W !,"   Visit Tot:"

 W ?15,$J($FN(BAR("4TOTA"),",",2),10)

 W ?26,$J($FN(BAR("4TOTB"),",",2),10)

 W ?37,$J($FN(BAR("4TOTC"),",",2),10)

 W ?48,$J($FN(BAR("4TOTD"),",",2),10)

 W ?59,$J($FN(BAR("4TOTE"),",",2),10)

 W ?70,$J($FN(BAR("4TOTF"),",",2),10)

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

ACCT ;

 Q:$G(BAR("F1"))

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

 I BAR("OL")'=BAR("L") W ! D HD1 W !

 E  I BAR("OB")'=BAR("B") W ! D HD2 W !

 E  I BAR("OIT")'=BAR("IT") W ! D HD3 W !

 E  I BAR("OS")'=BAR("S") W ! D HD4 W !

 S BAR("DATA")=^TMP($J,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"),BAR("ACCT"))

 W !,$E(BAR("ACCT"),1,14)                     ; A/R Account

 W ?15,$J($FN($P(BAR("DATA"),U,2),",",2),10)  ; Pay Amt

 W ?26,$J($FN($P(BAR("DATA"),U,3),",",2),10)  ; Prev Credit

 W ?37,$J($FN($P(BAR("DATA"),U,4),",",2),10)  ; Refunds

 W ?48,$J($FN($P(BAR("DATA"),U,5),",",2),10)  ; payment

 W ?59,$J($FN($P(BAR("DATA"),U,6),",",2),10)  ; bill amt

 W ?70,$J($FN($P(BAR("DATA"),U,7),",",2),10)  ; adjustments

 F I=0:1:4 D                                  ; Accumulate totals

 . S Y=1

 . F X="TOTA","TOTB","TOTC","TOTD","TOTE","TOTF" D

 . . S Y=Y+1

 . . S BARV=I_X

 . . S BARV2="BAR("""_BARV_""")"

 . . S @BARV2=@BARV2+$P(BAR("DATA"),U,Y)

 K I,X,Y

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

HD1 ;

 W !?10,"Visit Location.......: ",BAR("L")

 S BAR("OL")=BAR("L")

 S (BAR("1TOTA"),BAR("1TOTB"),BAR("1TOTC"),BAR("1TOTD"),BAR("1TOTE"),BAR("1TOTF"))=0

 D HD2

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

HD2 ;

 W !?10,"Collection Batch.....: "

 ;I +BAR("B") W $P(^BARCOL(DUZ(2),BAR("B"),0),U)

 I +BAR("B"),$P($G(^BARCOL(DUZ(2),BAR("B"),0)),U)'="" D

 .W $P(^BARCOL(DUZ(2),BAR("B"),0),U)  ;IM17362

 E  W BAR("B")

 S BAR("OB")=BAR("B")

 S (BAR("2TOTA"),BAR("2TOTB"),BAR("2TOTC"),BAR("2TOTD"),BAR("2TOTE"),BAR("2TOTF"))=0

 D HD3

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

HD3 ;

 W !?10,"Collection Batch Item: ",BAR("IT")

 S BAR("OIT")=BAR("IT")

 S (BAR("3TOTA"),BAR("3TOTB"),BAR("3TOTC"),BAR("3TOTD"),BAR("3TOTE"),BAR("3TOTF"))=0

 D HD4

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

HD4 ;

 W !?10

 I BARY("SORT")="C" D

 . W "Clinic Type..........: "

 . I BAR("S")=99999 W "NO CLINIC" Q

 . W $P(^DIC(40.7,BAR("S"),0),U)

 I BARY("SORT")="V" D

 . W "Visit Type...........: "

 . I BAR("S")=99999 W "NO VISIT TYPE" Q

 . W $P(^ABMDVTYP(BAR("S"),0),U)

 S BAR("OS")=BAR("S")

 S (BAR("4TOTA"),BAR("4TOTB"),BAR("4TOTC"),BAR("4TOTD"),BAR("4TOTE"),BAR("4TOTF"))=0

BARRTAR3  ; IHS/SD/LSL - Transaction report ;08/20/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,7**;MAR 27,2007

 +2       ;

 +3       ; IHS/ASDS/LSL - 10/06/00 - Routine created

 +4       ;     Summary print of Transaction report

 +5       ;

 +6       ; IHS/SD/LSL - 07/10/02 - V1/6 Patch 2

 +7       ;     Modified to print missing clinics and missing visit types

 +8       ;

 +9       ; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130

 +10      ;      Modified to accomodate DUZ(2) subscript

 +11      ;

 +12      ;      IHS/SD/RTL - 5/23/05 - V1.8 Patch 1 - IM17362

 +13      ;         TAR report bombing - missing collection batch

 +14      ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892

 +15       QUIT

 +16      ; *********************************************************************

 +17      ;

SUMM      ; EP

 +1        SET BAR("COL")="W !,""A/R Account"",?15,""PAY-AMT"",?26,""PRV-CRD"",?37,""REFUND"",?48,""PAYMENT"",?59,""BILL AMT"",?70,""ADJUSTMENT"""

 +2        SET BAR("HD",0)="SUMMARY Transaction"_$PIECE(BAR("HD",0),"Transaction",2,99)

 +3        DO HDB^BARRTAR2

 +4        SET BARDASH="               ---------- ---------- ---------- ---------- ---------- ----------"

 +5        SET BAREQUAL="               ========== ========== ========== ========== ========== =========="

 +6        SET (BAR("0TOTA"),BAR("0TOTB"),BAR("0TOTC"),BAR("0TOTD"),BAR("0TOTE"),BAR("0TOTF"))=0

 +7        SET (BAR("OL"),BAR("OB"),BAR("OIT"),BAR("OS"))=""

 +8        IF '$DATA(^TMP($JOB,"BAR-TARS"))

               Begin DoDot:1

 +9                WRITE !!!,"*** NO DATA TO PRINT ***"

 +10               DO EOP^BARUTL(0)

               End DoDot:1

               QUIT

 +11       SET (BAR("AR"),BAR("OAR"))=""

 +12       FOR

               SET BAR("AR")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR")))

               IF BAR("AR")']""!($GET(BAR("F1")))

                   QUIT

               Begin DoDot:1

 +13               IF +BAR("AR")

                       WRITE !!,"A/R Entry Clerk: ",$PIECE(^VA(200,BAR("AR"),0),U)

 +14               SET BAR("DUZ")=0

 +15               FOR

                       SET BAR("DUZ")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ")))

                       IF '+BAR("DUZ")!($GET(BAR("F1")))

                           QUIT

                       Begin DoDot:2

 +16                       SET (BAR("L"),BAR("OL"))=""

 +17                       FOR

                               SET BAR("L")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L")))

                               IF BAR("L")=""!($GET(BAR("F1")))

                                   QUIT

                               DO LOC

                       End DoDot:2

               End DoDot:1

 +18       IF $GET(BAR("F1"))

               QUIT

 +19       WRITE !,BAREQUAL

 +20       WRITE !,"REPORT TOTAL"

 +21       WRITE ?15,$JUSTIFY($FNUMBER(BAR("0TOTA"),",",2),10)

 +22       WRITE ?26,$JUSTIFY($FNUMBER(BAR("0TOTB"),",",2),10)

 +23       WRITE ?37,$JUSTIFY($FNUMBER(BAR("0TOTC"),",",2),10)

 +24       WRITE ?48,$JUSTIFY($FNUMBER(BAR("0TOTD"),",",2),10)

 +25       WRITE ?59,$JUSTIFY($FNUMBER(BAR("0TOTE"),",",2),10)

 +26       WRITE ?70,$JUSTIFY($FNUMBER(BAR("0TOTF"),",",2),10)

 +27       QUIT

 +28      ; *********************************************************************

 +29      ;

LOC       ;

 +1        SET BAR("B")=""

 +2        FOR

               SET BAR("B")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B")))

               IF BAR("B")=""!($GET(BAR("F1")))

                   QUIT

               DO BATCH

 +3        IF $GET(BAR("F1"))

               QUIT

 +4        WRITE !,BARDASH

 +5        WRITE !,"Location Tot:"

 +6        WRITE ?15,$JUSTIFY($FNUMBER(BAR("1TOTA"),",",2),10)

 +7        WRITE ?26,$JUSTIFY($FNUMBER(BAR("1TOTB"),",",2),10)

 +8        WRITE ?37,$JUSTIFY($FNUMBER(BAR("1TOTC"),",",2),10)

 +9        WRITE ?48,$JUSTIFY($FNUMBER(BAR("1TOTD"),",",2),10)

 +10       WRITE ?59,$JUSTIFY($FNUMBER(BAR("1TOTE"),",",2),10)

 +11       WRITE ?70,$JUSTIFY($FNUMBER(BAR("1TOTF"),",",2),10)

 +12       QUIT

 +13      ; *********************************************************************

 +14      ;

BATCH     ;

 +1        SET BAR("IT")=""

 +2        FOR

               SET BAR("IT")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT")))

               IF BAR("IT")=""!($GET(BAR("F1")))

                   QUIT

               DO ITEM

 +3        IF $GET(BAR("F1"))

               QUIT

 +4        WRITE !,BARDASH

 +5        WRITE !,"   Batch Tot:"

 +6        WRITE ?15,$JUSTIFY($FNUMBER(BAR("2TOTA"),",",2),10)

 +7        WRITE ?26,$JUSTIFY($FNUMBER(BAR("2TOTB"),",",2),10)

 +8        WRITE ?37,$JUSTIFY($FNUMBER(BAR("2TOTC"),",",2),10)

 +9        WRITE ?48,$JUSTIFY($FNUMBER(BAR("2TOTD"),",",2),10)

 +10       WRITE ?59,$JUSTIFY($FNUMBER(BAR("2TOTE"),",",2),10)

 +11       WRITE ?70,$JUSTIFY($FNUMBER(BAR("2TOTF"),",",2),10)

 +12       QUIT

 +13      ; *********************************************************************

 +14      ;

ITEM      ;

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

 +2        FOR

               SET BAR("S")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S")))

               IF BAR("S")=""!($GET(BAR("F1")))

                   QUIT

               DO SORT

 +3        IF $GET(BAR("F1"))

               QUIT

 +4        WRITE !,BARDASH

 +5        WRITE !,"    Item Tot:"

 +6        WRITE ?15,$JUSTIFY($FNUMBER(BAR("3TOTA"),",",2),10)

 +7        WRITE ?26,$JUSTIFY($FNUMBER(BAR("3TOTB"),",",2),10)

 +8        WRITE ?37,$JUSTIFY($FNUMBER(BAR("3TOTC"),",",2),10)

 +9        WRITE ?48,$JUSTIFY($FNUMBER(BAR("3TOTD"),",",2),10)

 +10       WRITE ?59,$JUSTIFY($FNUMBER(BAR("3TOTE"),",",2),10)

 +11       WRITE ?70,$JUSTIFY($FNUMBER(BAR("3TOTF"),",",2),10)

 +12       QUIT

 +13      ; *********************************************************************

 +14      ;

SORT      ;

 +1        SET BAR("ACCT")=""

 +2        FOR

               SET BAR("ACCT")=$ORDER(^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"),BAR("ACCT")))

               IF BAR("ACCT")=""!($GET(BAR("F1")))

                   QUIT

               DO ACCT

 +3        IF $GET(BAR("F1"))

               QUIT

 +4        WRITE !,BARDASH

 +5        IF BARY("SORT")="C"

               WRITE !,"  Clinic Tot:"

 +6       IF '$TEST

               WRITE !,"   Visit Tot:"

 +7        WRITE ?15,$JUSTIFY($FNUMBER(BAR("4TOTA"),",",2),10)

 +8        WRITE ?26,$JUSTIFY($FNUMBER(BAR("4TOTB"),",",2),10)

 +9        WRITE ?37,$JUSTIFY($FNUMBER(BAR("4TOTC"),",",2),10)

 +10       WRITE ?48,$JUSTIFY($FNUMBER(BAR("4TOTD"),",",2),10)

 +11       WRITE ?59,$JUSTIFY($FNUMBER(BAR("4TOTE"),",",2),10)

 +12       WRITE ?70,$JUSTIFY($FNUMBER(BAR("4TOTF"),",",2),10)

 +13       QUIT

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

 +15      ;

ACCT      ;

 +1        IF $GET(BAR("F1"))

               QUIT

 +2        IF $Y>(IOSL-5)

               DO HD^BARRTAR2

               IF $GET(BAR("F1"))

                   QUIT

 +3        IF BAR("OL")'=BAR("L")

               WRITE !

               DO HD1

               WRITE !

 +4       IF '$TEST

               IF BAR("OB")'=BAR("B")

                   WRITE !

                   DO HD2

                   WRITE !

 +5       IF '$TEST

               IF BAR("OIT")'=BAR("IT")

                   WRITE !

                   DO HD3

                   WRITE !

 +6       IF '$TEST

               IF BAR("OS")'=BAR("S")

                   WRITE !

                   DO HD4

                   WRITE !

 +7        SET BAR("DATA")=^TMP($JOB,"BAR-TARS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("B"),BAR("IT"),BAR("S"),BAR("ACCT"))

 +8       ; A/R Account

           WRITE !,$EXTRACT(BAR("ACCT"),1,14)

 +9       ; Pay Amt

           WRITE ?15,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,2),",",2),10)

 +10      ; Prev Credit

           WRITE ?26,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,3),",",2),10)

 +11      ; Refunds

           WRITE ?37,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,4),",",2),10)

 +12      ; payment

           WRITE ?48,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,5),",",2),10)

 +13      ; bill amt

           WRITE ?59,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,6),",",2),10)

 +14      ; adjustments

           WRITE ?70,$JUSTIFY($FNUMBER($PIECE(BAR("DATA"),U,7),",",2),10)

 +15      ; Accumulate totals

           FOR I=0:1:4

               Begin DoDot:1

 +16               SET Y=1

 +17               FOR X="TOTA","TOTB","TOTC","TOTD","TOTE","TOTF"

                       Begin DoDot:2

 +18                       SET Y=Y+1

 +19                       SET BARV=I_X

 +20                       SET BARV2="BAR("""_BARV_""")"

 +21                       SET @BARV2=@BARV2+$PIECE(BAR("DATA"),U,Y)

                       End DoDot:2

               End DoDot:1

 +22       KILL I,X,Y

 +23       QUIT

 +24      ; *********************************************************************

 +25      ;

HD1       ;

 +1        WRITE !?10,"Visit Location.......: ",BAR("L")

 +2        SET BAR("OL")=BAR("L")

 +3        SET (BAR("1TOTA"),BAR("1TOTB"),BAR("1TOTC"),BAR("1TOTD"),BAR("1TOTE"),BAR("1TOTF"))=0

 +4        DO HD2

 +5        QUIT

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

 +7       ;

HD2       ;

 +1        WRITE !?10,"Collection Batch.....: "

 +2       ;I +BAR("B") W $P(^BARCOL(DUZ(2),BAR("B"),0),U)

 +3        IF +BAR("B")

               IF $PIECE($GET(^BARCOL(DUZ(2),BAR("B"),0)),U)'=""

                   Begin DoDot:1

 +4       ;IM17362

                       WRITE $PIECE(^BARCOL(DUZ(2),BAR("B"),0),U)

                   End DoDot:1

 +5       IF '$TEST

               WRITE BAR("B")

 +6        SET BAR("OB")=BAR("B")

 +7        SET (BAR("2TOTA"),BAR("2TOTB"),BAR("2TOTC"),BAR("2TOTD"),BAR("2TOTE"),BAR("2TOTF"))=0

 +8        DO HD3

 +9        QUIT

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

 +11      ;

HD3       ;

 +1        WRITE !?10,"Collection Batch Item: ",BAR("IT")

 +2        SET BAR("OIT")=BAR("IT")

 +3        SET (BAR("3TOTA"),BAR("3TOTB"),BAR("3TOTC"),BAR("3TOTD"),BAR("3TOTE"),BAR("3TOTF"))=0

 +4        DO HD4

 +5        QUIT

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

 +7       ;

HD4       ;

 +1        WRITE !?10

 +2        IF BARY("SORT")="C"

               Begin DoDot:1

 +3                WRITE "Clinic Type..........: "

 +4                IF BAR("S")=99999

                       WRITE "NO CLINIC"

                       QUIT

 +5                WRITE $PIECE(^DIC(40.7,BAR("S"),0),U)

               End DoDot:1

 +6        IF BARY("SORT")="V"

               Begin DoDot:1

 +7                WRITE "Visit Type...........: "

 +8                IF BAR("S")=99999

                       WRITE "NO VISIT TYPE"

                       QUIT

 +9                WRITE $PIECE(^ABMDVTYP(BAR("S"),0),U)

               End DoDot:1

 +10       SET BAR("OS")=BAR("S")

 +11       SET (BAR("4TOTA"),BAR("4TOTB"),BAR("4TOTC"),BAR("4TOTD"),BAR("4TOTE"),BAR("4TOTF"))=0

 +12       QUIT

BARRTAR3.m