BARRNBRF ; IHS/SD/POT - Non Ben Payment Report PART5
;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69
; IHS/SD/POT 07/15/13 HEAT114352 NEW REPORT BAR*1.8*24
;
;; OVERFLOW FROM BARRNBRA
Q
; **
100 N BAR1,BAR2,BAR3,BAR4,BAR5,BARTMP
S BARNIL="^^^^"
S ^TMP($J,"BAR-NBRT")=BARNIL
S BAR1="" F S BAR1=$O(^TMP($J,"BAR-NBRT",BAR1)) Q:BAR1="" D
. S ^TMP($J,"BAR-NBRT",BAR1)=BARNIL
. S BAR3="" F S BAR3=$O(^TMP($J,"BAR-NBRT",BAR1,BAR3)) Q:BAR3="" D
. . S ^TMP($J,"BAR-NBRT",BAR1,BAR3)=BARNIL
. . S BAR4="" F S BAR4=$O(^TMP($J,"BAR-NBRT",BAR1,BAR3,BAR4)) Q:BAR4="" D
. . . S ^TMP($J,"BAR-NBRT",BAR1,BAR3,BAR4)=BARNIL
. . . S BARY="" F S BARY=$O(^TMP($J,"BAR-NBRT",BAR1,BAR3,BAR4,BARY)) Q:BARY="" D
. . . . S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR1,BAR3,BAR4,BARY))
. . . . S BARTOT=^TMP($J,"BAR-NBR9",BARY)
. . . . S ^TMP($J,"BAR-NBRT",BAR1,BAR3,BAR4,BARY)=BARTOT_"^"_$P(BARTMP,"^",5)
. . . . S BARTMP=^TMP($J,"BAR-NBRT",BAR1,BAR3,BAR4)
. . . . F I=1:1:4 S $P(BARTMP,U,I)=$P(BARTOT,U,I)+$P(BARTMP,U,I)
. . . . S ^TMP($J,"BAR-NBRT",BAR1,BAR3,BAR4)=BARTMP
. . . . S BARTMP=^TMP($J,"BAR-NBRT",BAR1,BAR3)
. . . . F I=1:1:4 S $P(BARTMP,U,I)=$P(BARTOT,U,I)+$P(BARTMP,U,I)
. . . . S ^TMP($J,"BAR-NBRT",BAR1,BAR3)=BARTMP
. . . . S BARTMP=^TMP($J,"BAR-NBRT",BAR1)
. . . . F I=1:1:4 S $P(BARTMP,U,I)=$P(BARTOT,U,I)+$P(BARTMP,U,I)
. . . . S ^TMP($J,"BAR-NBRT",BAR1)=BARTMP
. . . . S BARTMP=$G(^TMP($J,"BAR-NBRT"))
. . . . F I=1:1:4 S $P(BARTMP,U,I)=$P(BARTOT,U,I)+$P(BARTMP,U,I)
. . . . S ^TMP($J,"BAR-NBRT")=BARTMP
Q
110 N BAR1,BAR2,BARY,BARTMP
S BARNIL="^^^^"
S ^TMP($J,"BAR-NBR")=BARNIL
S BAR1="" F S BAR1=$O(^TMP($J,"BAR-NBR",BAR1)) Q:BAR1="" D
. S ^TMP($J,"BAR-NBR",BAR1)=BARNIL
. S BAR2="" F S BAR2=$O(^TMP($J,"BAR-NBR",BAR1,BAR2)) Q:BAR2="" D
. . S ^TMP($J,"BAR-NBR",BAR1,BAR2)=BARNIL
. . S BARY="" F S BARY=$O(^TMP($J,"BAR-NBR",BAR1,BAR2,BARY)) Q:BARY="" D
. . . S BARTOT=^TMP($J,"BAR-NBR9",BARY)
. . . S BARTMP=^TMP($J,"BAR-NBR",BAR1,BAR2)
. . . F I=1:1:4 S $P(BARTMP,U,I)=$P(BARTOT,U,I)+$P(BARTMP,U,I)
. . . S ^TMP($J,"BAR-NBR",BAR1,BAR2)=BARTMP
. . . S BARTMP=^TMP($J,"BAR-NBR",BAR1)
. . . F I=1:1:4 S $P(BARTMP,U,I)=$P(BARTOT,U,I)+$P(BARTMP,U,I)
. . . S ^TMP($J,"BAR-NBR",BAR1)=BARTMP
. . . S BARTMP=$G(^TMP($J,"BAR-NBR"))
. . . F I=1:1:4 S $P(BARTMP,U,I)=$P(BARTOT,U,I)+$P(BARTMP,U,I)
. . . S ^TMP($J,"BAR-NBR")=BARTMP
Q
ADDUPTR(BARY,BARBL) ;
;TXD LEVEL: BARTR("DT")^BARTR("T")^BARCR^BARDB^BARPAY^BARADJ^BARPAYAD^BARFLG
;BILL LEVEL: BILL_NUMBER-FULL^BILLED^BALANCE^INS^PAT^PATIENT_IEN
;SUM UP BILL (XXXXX-A) WITH PAYMENTS (INS or PAT)
N BARTR,BARTOT,BARP,BARDATA,I,J,BARFLG,BARAMT,BARTOT,BARPTR
S BARTOT=^TMP($J,"BAR-NBR9",BARY,BARBL)
S BARTR="" F S BARTR=$O(^TMP($J,"BAR-NBR9",BARY,BARBL,BARTR)) Q:+BARTR=0 D
. S BARDATA=^TMP($J,"BAR-NBR9",BARY,BARBL,BARTR)
. S BARFLG=$P(BARDATA,"^",8)
. S BARAMT=$P(BARDATA,"^",7)
. S BARPTR=4 ;INS
. I BARFLG S BARPTR=5 ;PAT
. S $P(BARTOT,"^",BARPTR)=$P(BARTOT,"^",BARPTR)+BARAMT
S ^TMP($J,"BAR-NBR9",BARY,BARBL)=BARTOT
Q
ADDUPBL(BARY) ;
;FROM BILL_NUMBER-FULL^BILLED^BALANCE^INS^PAT^PATIENT_IEN
;TO: ^BILLED^INS^PAT^^BALANCE
N BARTOT,BARP,BARDATA,I,J,BARBL,BARDATA
S BARTOT=""
S BARBL="" F S BARBL=$O(^TMP($J,"BAR-NBR9",BARY,BARBL)) Q:+BARBL=0 D
. S BARDATA=^TMP($J,"BAR-NBR9",BARY,BARBL)
. S $P(BARTOT,"^",1)=$P(BARTOT,"^",1)+$P(BARDATA,"^",2) ;BILLED
. S $P(BARTOT,"^",4)=$P(BARTOT,"^",4)+$P(BARDATA,"^",3) ;BAL
. S $P(BARTOT,"^",2)=$P(BARTOT,"^",2)+$P(BARDATA,"^",4) ;INS
. S $P(BARTOT,"^",3)=$P(BARTOT,"^",3)+$P(BARDATA,"^",5) ;PAT
S ^TMP($J,"BAR-NBR9",BARY)=BARTOT
Q
;---EOR----------
BARRNBRF ; IHS/SD/POT - Non Ben Payment Report PART5
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69
+2 ; IHS/SD/POT 07/15/13 HEAT114352 NEW REPORT BAR*1.8*24
+3 ;
+4 ;; OVERFLOW FROM BARRNBRA
+5 QUIT
+6 ; **
100 NEW BAR1,BAR2,BAR3,BAR4,BAR5,BARTMP
+1 SET BARNIL="^^^^"
+2 SET ^TMP($JOB,"BAR-NBRT")=BARNIL
+3 SET BAR1=""
FOR
SET BAR1=$ORDER(^TMP($JOB,"BAR-NBRT",BAR1))
IF BAR1=""
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"BAR-NBRT",BAR1)=BARNIL
+5 SET BAR3=""
FOR
SET BAR3=$ORDER(^TMP($JOB,"BAR-NBRT",BAR1,BAR3))
IF BAR3=""
QUIT
Begin DoDot:2
+6 SET ^TMP($JOB,"BAR-NBRT",BAR1,BAR3)=BARNIL
+7 SET BAR4=""
FOR
SET BAR4=$ORDER(^TMP($JOB,"BAR-NBRT",BAR1,BAR3,BAR4))
IF BAR4=""
QUIT
Begin DoDot:3
+8 SET ^TMP($JOB,"BAR-NBRT",BAR1,BAR3,BAR4)=BARNIL
+9 SET BARY=""
FOR
SET BARY=$ORDER(^TMP($JOB,"BAR-NBRT",BAR1,BAR3,BAR4,BARY))
IF BARY=""
QUIT
Begin DoDot:4
+10 SET BARTMP=$GET(^TMP($JOB,"BAR-NBRT",BAR1,BAR3,BAR4,BARY))
+11 SET BARTOT=^TMP($JOB,"BAR-NBR9",BARY)
+12 SET ^TMP($JOB,"BAR-NBRT",BAR1,BAR3,BAR4,BARY)=BARTOT_"^"_$PIECE(BARTMP,"^",5)
+13 SET BARTMP=^TMP($JOB,"BAR-NBRT",BAR1,BAR3,BAR4)
+14 FOR I=1:1:4
SET $PIECE(BARTMP,U,I)=$PIECE(BARTOT,U,I)+$PIECE(BARTMP,U,I)
+15 SET ^TMP($JOB,"BAR-NBRT",BAR1,BAR3,BAR4)=BARTMP
+16 SET BARTMP=^TMP($JOB,"BAR-NBRT",BAR1,BAR3)
+17 FOR I=1:1:4
SET $PIECE(BARTMP,U,I)=$PIECE(BARTOT,U,I)+$PIECE(BARTMP,U,I)
+18 SET ^TMP($JOB,"BAR-NBRT",BAR1,BAR3)=BARTMP
+19 SET BARTMP=^TMP($JOB,"BAR-NBRT",BAR1)
+20 FOR I=1:1:4
SET $PIECE(BARTMP,U,I)=$PIECE(BARTOT,U,I)+$PIECE(BARTMP,U,I)
+21 SET ^TMP($JOB,"BAR-NBRT",BAR1)=BARTMP
+22 SET BARTMP=$GET(^TMP($JOB,"BAR-NBRT"))
+23 FOR I=1:1:4
SET $PIECE(BARTMP,U,I)=$PIECE(BARTOT,U,I)+$PIECE(BARTMP,U,I)
+24 SET ^TMP($JOB,"BAR-NBRT")=BARTMP
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
110 NEW BAR1,BAR2,BARY,BARTMP
+1 SET BARNIL="^^^^"
+2 SET ^TMP($JOB,"BAR-NBR")=BARNIL
+3 SET BAR1=""
FOR
SET BAR1=$ORDER(^TMP($JOB,"BAR-NBR",BAR1))
IF BAR1=""
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"BAR-NBR",BAR1)=BARNIL
+5 SET BAR2=""
FOR
SET BAR2=$ORDER(^TMP($JOB,"BAR-NBR",BAR1,BAR2))
IF BAR2=""
QUIT
Begin DoDot:2
+6 SET ^TMP($JOB,"BAR-NBR",BAR1,BAR2)=BARNIL
+7 SET BARY=""
FOR
SET BARY=$ORDER(^TMP($JOB,"BAR-NBR",BAR1,BAR2,BARY))
IF BARY=""
QUIT
Begin DoDot:3
+8 SET BARTOT=^TMP($JOB,"BAR-NBR9",BARY)
+9 SET BARTMP=^TMP($JOB,"BAR-NBR",BAR1,BAR2)
+10 FOR I=1:1:4
SET $PIECE(BARTMP,U,I)=$PIECE(BARTOT,U,I)+$PIECE(BARTMP,U,I)
+11 SET ^TMP($JOB,"BAR-NBR",BAR1,BAR2)=BARTMP
+12 SET BARTMP=^TMP($JOB,"BAR-NBR",BAR1)
+13 FOR I=1:1:4
SET $PIECE(BARTMP,U,I)=$PIECE(BARTOT,U,I)+$PIECE(BARTMP,U,I)
+14 SET ^TMP($JOB,"BAR-NBR",BAR1)=BARTMP
+15 SET BARTMP=$GET(^TMP($JOB,"BAR-NBR"))
+16 FOR I=1:1:4
SET $PIECE(BARTMP,U,I)=$PIECE(BARTOT,U,I)+$PIECE(BARTMP,U,I)
+17 SET ^TMP($JOB,"BAR-NBR")=BARTMP
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
ADDUPTR(BARY,BARBL) ;
+1 ;TXD LEVEL: BARTR("DT")^BARTR("T")^BARCR^BARDB^BARPAY^BARADJ^BARPAYAD^BARFLG
+2 ;BILL LEVEL: BILL_NUMBER-FULL^BILLED^BALANCE^INS^PAT^PATIENT_IEN
+3 ;SUM UP BILL (XXXXX-A) WITH PAYMENTS (INS or PAT)
+4 NEW BARTR,BARTOT,BARP,BARDATA,I,J,BARFLG,BARAMT,BARTOT,BARPTR
+5 SET BARTOT=^TMP($JOB,"BAR-NBR9",BARY,BARBL)
+6 SET BARTR=""
FOR
SET BARTR=$ORDER(^TMP($JOB,"BAR-NBR9",BARY,BARBL,BARTR))
IF +BARTR=0
QUIT
Begin DoDot:1
+7 SET BARDATA=^TMP($JOB,"BAR-NBR9",BARY,BARBL,BARTR)
+8 SET BARFLG=$PIECE(BARDATA,"^",8)
+9 SET BARAMT=$PIECE(BARDATA,"^",7)
+10 ;INS
SET BARPTR=4
+11 ;PAT
IF BARFLG
SET BARPTR=5
+12 SET $PIECE(BARTOT,"^",BARPTR)=$PIECE(BARTOT,"^",BARPTR)+BARAMT
End DoDot:1
+13 SET ^TMP($JOB,"BAR-NBR9",BARY,BARBL)=BARTOT
+14 QUIT
ADDUPBL(BARY) ;
+1 ;FROM BILL_NUMBER-FULL^BILLED^BALANCE^INS^PAT^PATIENT_IEN
+2 ;TO: ^BILLED^INS^PAT^^BALANCE
+3 NEW BARTOT,BARP,BARDATA,I,J,BARBL,BARDATA
+4 SET BARTOT=""
+5 SET BARBL=""
FOR
SET BARBL=$ORDER(^TMP($JOB,"BAR-NBR9",BARY,BARBL))
IF +BARBL=0
QUIT
Begin DoDot:1
+6 SET BARDATA=^TMP($JOB,"BAR-NBR9",BARY,BARBL)
+7 ;BILLED
SET $PIECE(BARTOT,"^",1)=$PIECE(BARTOT,"^",1)+$PIECE(BARDATA,"^",2)
+8 ;BAL
SET $PIECE(BARTOT,"^",4)=$PIECE(BARTOT,"^",4)+$PIECE(BARDATA,"^",3)
+9 ;INS
SET $PIECE(BARTOT,"^",2)=$PIECE(BARTOT,"^",2)+$PIECE(BARDATA,"^",4)
+10 ;PAT
SET $PIECE(BARTOT,"^",3)=$PIECE(BARTOT,"^",3)+$PIECE(BARDATA,"^",5)
End DoDot:1
+11 SET ^TMP($JOB,"BAR-NBR9",BARY)=BARTOT
+12 QUIT
+13 ;---EOR----------
