- 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----------
