BARTRNS2.m

BARTRNS2 ; IHS/SD/SDR - Transaction Summary/Detail Report ; 03/10/2009

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26, 2005;Build 92

 ;IHS/SD/POT - 1.8*28 - CR8397 HEAT155084 - NEW ROUTINE CLONED FROM BARTRNS1; CALLED FROM BARTRNT

 ;IHS/SD/SDR - 1.8*28 - CR8397 HEAT155084 Corrected column header from Adj Amt to Adj Cat.  Added column  for Adj Amt.

 ;    Added #DAYS (APPR.DT-ADJ.DT) (Header was printing without data).  Changed loop to look thru transaction file, not bill file.

 ;

 Q

COMPUTE ; EP

 S BAR("SUBR")="BAR-TRANS"

 K ^TMP($J,"BAR-TRANS")

 K ^TMP($J,"BAR-TRANST")

 I BAR("LOC")="BILLING" D LOOP Q

 S BARDUZ2=DUZ(2)

 S DUZ(2)=0

 S BARY("DT",3)=BARY("DT",2)+.99

 F  S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2)  D LOOP

 S DUZ(2)=BARDUZ2

 Q

LOOP ;EP for Loop thru Bill File

 S BARP("DT")=BARY("DT",1)-1+.9  ;PKD 9/24/10 1.8*19 don't go back extra day

 ;PKD 1.8*19 BARY("DT",3) - corrected end date

 F  S BARP("DT")=$O(^BARTR(DUZ(2),"B",BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>BARY("DT",3))  D

 .S BARTR=BARP("DT")  ;A/R Trans IEN

 .S BARIEN=$P($G(^BARTR(DUZ(2),BARP("DT"),0)),U,4)  ;A/R Bill IEN

 .Q:+BARIEN=0  ;transaction not associated with A/R Bill

 .;get bill info

 .S BAR(0)=$G(^BARBL(DUZ(2),BARIEN,0))  ;A/R Bill 0 node

 .S BAR(1)=$G(^BARBL(DUZ(2),BARIEN,1))  ;A/R Bill 1 node

 .S BAR("LOC")=$P(BAR(1),U,8)  ;Visit loc (A/R Parent/Sat)

 .S BAR("INS")=$P(BAR(0),U,3)  ;A/R Acct

 .S BAR("DOS")=$P(BAR(1),U,2)  ;DOS Begin

 .S BAR("APPDT")=$P(BAR(0),U,18)  ;3P Appr. date

 .S BAR("BAMT")=$P(BAR(0),U,13)  ;total bill amt

 .I BAR("INS")]"" D

 ..S D0=BAR("INS")

 ..S BAR("ITYP")=$$VALI^BARVPM(8)  ;Ins Type CODE

 .I BAR("INS")="" S BAR("INS")=0

 .I $D(BARY("ITYP")),$G(BARY("ITYP"))'=BAR("ITYP") Q  ;look for specific ins typ

 .I $D(BARY("LOC")),$G(BARY("LOC"))'=BAR("LOC") Q  ;look for specific loc and this isn't it

 .I $D(BARY("ARACCT")),'$D(BARY("ARACCT",BAR("INS"))) Q  ;not the a/r acct we want

 .I $G(BAR("ITYP"))="" S BAR("ITYP")="No Billing Entity"  ;bar*1.8*20 pkd <undef> correction

 .I BAR("ITYP")'="No Billing Entity" D

 ..S BAR("ALL")="O"  ;Other Allow Cat

 ..I ",R,MD,MH,MC,MMC"[(","_BAR("ITYP")_",") S BAR("ALL")="R" Q  ;MCR

 ..I ",D,K,FPL,"[(","_BAR("ITYP")_",") S BAR("ALL")="D" Q        ;MCD

 ..I ",F,M,H,P,"[(","_BAR("ITYP")_",") S BAR("ALL")="P" Q        ;PVT

 ..I ",V,"[(","_BAR("ITYP")_",") S BAR("ALL")="V" Q

 .I $G(BAR("ALL"))=""  S BAR("ALL")="No Allowance Category"

 .I $D(BARY("ALL")),(+BARY("ALL")=BARY("ALL")) S BARY("ALL")=$$CONVERT^BARRSL2(BARY("ALL"))

 .I $D(BARY("ALL")),BARY("ALL")'=BAR("ALL") Q  ;Not chosen Allow Cat

 .;

 .S BARBILL=$P($G(^BARBL(DUZ(2),BARIEN,0)),U)

 .I BAR("LOC")="" D  S BAR("LOC")="????"

 .I BARY("RTYP")=1 D

 ..S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U)=+$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U)+1

 ..S $P(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U,2)=+$P($G(^TMP($J,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U,2)+$G(BAR("BAMT"))

 .;NEED TO ADD CHECK FOR INS TYPE

 .D TRANS^BARTRNS3  ;trans info for bill

 Q

 ;EOR - IHS/DIT/CPC 1.8*28

BARTRNS2  ; IHS/SD/SDR - Transaction Summary/Detail Report ; 03/10/2009

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26, 2005;Build 92

 +2       ;IHS/SD/POT - 1.8*28 - CR8397 HEAT155084 - NEW ROUTINE CLONED FROM BARTRNS1; CALLED FROM BARTRNT

 +3       ;IHS/SD/SDR - 1.8*28 - CR8397 HEAT155084 Corrected column header from Adj Amt to Adj Cat.  Added column  for Adj Amt.

 +4       ;    Added #DAYS (APPR.DT-ADJ.DT) (Header was printing without data).  Changed loop to look thru transaction file, not bill file.

 +5       ;

 +6        QUIT 

COMPUTE   ; EP

 +1        SET BAR("SUBR")="BAR-TRANS"

 +2        KILL ^TMP($JOB,"BAR-TRANS")

 +3        KILL ^TMP($JOB,"BAR-TRANST")

 +4        IF BAR("LOC")="BILLING"

               DO LOOP

               QUIT 

 +5        SET BARDUZ2=DUZ(2)

 +6        SET DUZ(2)=0

 +7        SET BARY("DT",3)=BARY("DT",2)+.99

 +8        FOR 

               SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))

               IF 'DUZ(2)

                   QUIT 

               DO LOOP

 +9        SET DUZ(2)=BARDUZ2

 +10       QUIT 

LOOP      ;EP for Loop thru Bill File

 +1       ;PKD 9/24/10 1.8*19 don't go back extra day

           SET BARP("DT")=BARY("DT",1)-1+.9

 +2       ;PKD 1.8*19 BARY("DT",3) - corrected end date

 +3        FOR 

               SET BARP("DT")=$ORDER(^BARTR(DUZ(2),"B",BARP("DT")))

               IF 'BARP("DT")!(BARP("DT")>BARY("DT",3))

                   QUIT 

               Begin DoDot:1

 +4       ;A/R Trans IEN

                   SET BARTR=BARP("DT")

 +5       ;A/R Bill IEN

                   SET BARIEN=$PIECE($GET(^BARTR(DUZ(2),BARP("DT"),0)),U,4)

 +6       ;transaction not associated with A/R Bill

                   IF +BARIEN=0

                       QUIT 

 +7       ;get bill info

 +8       ;A/R Bill 0 node

                   SET BAR(0)=$GET(^BARBL(DUZ(2),BARIEN,0))

 +9       ;A/R Bill 1 node

                   SET BAR(1)=$GET(^BARBL(DUZ(2),BARIEN,1))

 +10      ;Visit loc (A/R Parent/Sat)

                   SET BAR("LOC")=$PIECE(BAR(1),U,8)

 +11      ;A/R Acct

                   SET BAR("INS")=$PIECE(BAR(0),U,3)

 +12      ;DOS Begin

                   SET BAR("DOS")=$PIECE(BAR(1),U,2)

 +13      ;3P Appr. date

                   SET BAR("APPDT")=$PIECE(BAR(0),U,18)

 +14      ;total bill amt

                   SET BAR("BAMT")=$PIECE(BAR(0),U,13)

 +15               IF BAR("INS")]""

                       Begin DoDot:2

 +16                       SET D0=BAR("INS")

 +17      ;Ins Type CODE

                           SET BAR("ITYP")=$$VALI^BARVPM(8)

                       End DoDot:2

 +18               IF BAR("INS")=""

                       SET BAR("INS")=0

 +19      ;look for specific ins typ

                   IF $DATA(BARY("ITYP"))

                       IF $GET(BARY("ITYP"))'=BAR("ITYP")

                           QUIT 

 +20      ;look for specific loc and this isn't it

                   IF $DATA(BARY("LOC"))

                       IF $GET(BARY("LOC"))'=BAR("LOC")

                           QUIT 

 +21      ;not the a/r acct we want

                   IF $DATA(BARY("ARACCT"))

                       IF '$DATA(BARY("ARACCT",BAR("INS")))

                           QUIT 

 +22      ;bar*1.8*20 pkd <undef> correction

                   IF $GET(BAR("ITYP"))=""

                       SET BAR("ITYP")="No Billing Entity"

 +23               IF BAR("ITYP")'="No Billing Entity"

                       Begin DoDot:2

 +24      ;Other Allow Cat

                           SET BAR("ALL")="O"

 +25      ;MCR

                           IF ",R,MD,MH,MC,MMC"[(","_BAR("ITYP")_",")

                               SET BAR("ALL")="R"

                               QUIT 

 +26      ;MCD

                           IF ",D,K,FPL,"[(","_BAR("ITYP")_",")

                               SET BAR("ALL")="D"

                               QUIT 

 +27      ;PVT

                           IF ",F,M,H,P,"[(","_BAR("ITYP")_",")

                               SET BAR("ALL")="P"

                               QUIT 

 +28                       IF ",V,"[(","_BAR("ITYP")_",")

                               SET BAR("ALL")="V"

                               QUIT 

                       End DoDot:2

 +29               IF $GET(BAR("ALL"))=""

                       SET BAR("ALL")="No Allowance Category"

 +30               IF $DATA(BARY("ALL"))

                       IF (+BARY("ALL")=BARY("ALL"))

                           SET BARY("ALL")=$$CONVERT^BARRSL2(BARY("ALL"))

 +31      ;Not chosen Allow Cat

                   IF $DATA(BARY("ALL"))

                       IF BARY("ALL")'=BAR("ALL")

                           QUIT 

 +32      ;

 +33               SET BARBILL=$PIECE($GET(^BARBL(DUZ(2),BARIEN,0)),U)

 +34               IF BAR("LOC")=""

                       Begin DoDot:2

                       End DoDot:2

                       SET BAR("LOC")="????"

 +35               IF BARY("RTYP")=1

                       Begin DoDot:2

 +36                       SET $PIECE(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U)=+$PIECE($GET(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U)+1

 +37                       SET $PIECE(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS")),U,2)=+$PIECE($GET(^TMP($JOB,"BAR-TRANST",BAR("LOC"),BAR("ITYP"),BAR("INS"))),U,2)+$GET(BAR("BAMT"))

                       End DoDot:2

 +38      ;NEED TO ADD CHECK FOR INS TYPE

 +39      ;trans info for bill

                   DO TRANS^BARTRNS3

               End DoDot:1

 +40       QUIT 

 +41      ;EOR - IHS/DIT/CPC 1.8*28