- 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
