BARRNEGB ; IHS/SD/LSL - Print Synch Reports ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**6,7,23,24**;OCT 26, 2005;Build 69
;
; IHS/SD/SDR - v1.8 p6 - DD 4.1.3
; New Negative Balance report
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; IHS/SD/POT MAR 2013 ADDED NEW VA billing BAR*1.8*23
; IHS/SD/POT HEAT159172 04/03/2014 BAR*1.8*24 FIXED <UNDEFINED>ASKAGAIN+3^BARRSEL *BARP("RTN")
; *********************************************************************
NB ;EP - negative balance
S BAR("LOC")="BILLING"
S BARP("RTN")="BARRNEGB" ; LINE MOVED BEFORE CALLING BARRSEL 4/3/2014 BAR*1.8*24 HEAT159172
D ^BARRSEL
I $D(BARY("ALL")) S BARY("ALL")=$$CONVERT^BARRSL2(BARY("ALL"))
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
S BAR("HD",0)=BARMENU
D ^BARRHD ; Report header
S BARQ("RC")="COMPUTE^BARRNEGB" ; Compute routine
S BARQ("RP")="PRINT^BARRNEGB" ; Print routine
S BARQ("NS")="BAR" ; Namespace for variables
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
D ^BARDBQUE ; Double queuing
D PAZ^BARRUTL
Q
COMPUTE ;
;
S BAR("SUBR")="BAR-NEG"
K ^TMP($J,"BAR-NEG")
S BARP("RTN")="BARRNEGB" ; Routine used to get data if no parameters
I BAR("LOC")="BILLING" D LOOP^BARRUTL Q
S BARDUZ2=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2) D LOOP^BARRUTL
S DUZ(2)=BARDUZ2
Q
DATA ;
S BARBAL=$$GET1^DIQ(90050.01,BAR,15)
Q:BARBAL'<0
S BARP("HIT")=0
D BILL^BARRCHK
Q:'BARP("HIT")
S BARLOC=""
S:BAR("L")]"" BARLOC=$$GET1^DIQ(4,BAR("L"),.01)
S:BARLOC="" BARLOC="No Visit Location" ; Visit Location Name
S BARACCT=""
S:BAR("I")]"" BARACCT=$$GET1^DIQ(90050.02,BAR("I"),.01)
S:BARACCT="" BARACCT="No A/R Account" ; A/R Account Name
S:'+BAR("A") BAR("A")=9999999
I $G(BARY("SORT"))="C" D
. S BAR2=BAR("C")
. I BAR2]"",BAR2'=99999 S BAR2=$$GET1^DIQ(40.7,BAR2,.01)
. S:BAR2=""!(BAR2=99999) BAR2="No Clinic Type"
I $G(BARY("SORT"))="V" D
. S BAR2=BAR("V")
. I BAR2]"",BAR2'=99999 S BAR2=$$GET1^DIQ(9002274.8,BAR2,.01)
. S:BAR2=""!(BAR2=99999) BAR2="No Visit Type"
S BARBILL=$P(BAR(0),U,13)
S BARBL=$P(BAR(0),U)
;
S D0=BAR("I")
S BARALLC=$$VALI^BARVPM(8) ;insurer type CODE
S BARALLC=$P($T(@BARALLC),";;",2)
I BARALLC="" S BARALLC="UNK" ;P.OTT
;
D GETTRANS ;get pymts and adjs for bill
;
I $D(BARY("SORT")) D CLINVIS
E D ACCT
;
S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC))
S $P(^TMP($J,"BAR-NEG",BARLOC),U,2)=$P(BARHOLD,U,2)+BARBILL
S $P(^TMP($J,"BAR-NEG",BARLOC),U,3)=$P(BARHOLD,U,3)+BARTPAY
S $P(^TMP($J,"BAR-NEG",BARLOC),U,4)=$P(BARHOLD,U,4)+BARTADJ
S $P(^TMP($J,"BAR-NEG",BARLOC),U,5)=$P(BARHOLD,U,5)+BARBAL
;
S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC,BARALLC))
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC),U,2)=$P(BARHOLD,U,2)+BARBILL
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC),U,3)=$P(BARHOLD,U,3)+BARTPAY
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC),U,4)=$P(BARHOLD,U,4)+BARTADJ
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC),U,5)=$P(BARHOLD,U,5)+BARBAL
;
S BARHOLD=$G(^TMP($J,"BAR-NEG"))
S $P(^TMP($J,"BAR-NEG"),U,2)=$P(BARHOLD,U,2)+BARBILL
S $P(^TMP($J,"BAR-NEG"),U,3)=$P(BARHOLD,U,3)+BARTPAY
S $P(^TMP($J,"BAR-NEG"),U,4)=$P(BARHOLD,U,4)+BARTADJ
S $P(^TMP($J,"BAR-NEG"),U,5)=$P(BARHOLD,U,5)+BARBAL
Q
GETTRANS ;
S (BARTPAY,BARTADJ)=0
S BARTIEN=0
F S BARTIEN=$O(^BARTR(DUZ(2),"AC",BAR,BARTIEN)) Q:+BARTIEN=0 D
.S BARTTYP=$P($G(^BARTR(DUZ(2),BARTIEN,1)),U)
.Q:BARTTYP'=40&(BARTTYP'=43) ;payments and adjustments only
.I BARTTYP=40 S BARTPAY=+$G(BARTPAY)+$$GET1^DIQ(90050.03,BARTIEN,3.5)
.I BARTTYP=43 S BARTADJ=+$G(BARTADJ)+$$GET1^DIQ(90050.03,BARTIEN,3.5)
Q
ACCT ;
; Store data by AR Account
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U)=BAR("D")
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,2)=BARBILL
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,3)=+$G(BARTPAY)
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,4)=+$G(BARTADJ)
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,5)=BARBAL
;
S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT))
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U)=$P(BARHOLD,U)+BARBILL
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,2)=$P(BARHOLD,U,2)+BARBILL
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,3)=$P(BARHOLD,U,3)+BARTPAY
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,4)=$P(BARHOLD,U,4)+BARTADJ
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,5)=$P(BARHOLD,U,5)+BARBAL
Q
CLINVIS ;
; Store data by Clinic/Visit Type
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U)=BAR("D")
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,2)=BARBILL
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,3)=+$G(BARTPAY)
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,4)=+$G(BARTADJ)
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,5)=BARBAL
;
S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT))
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U)=BAR("D")
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,2)=$P(BARHOLD,U,2)+BARBILL
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,3)=$P(BARHOLD,U,3)+$G(BARTPAY)
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,4)=$P(BARHOLD,U,4)+$G(BARTADJ)
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,5)=$P(BARHOLD,U,5)+BARBAL
;
S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2))
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U)=BAR("D")
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U,2)=$P(BARHOLD,U,2)+BARBILL
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U,3)=$P(BARHOLD,U,3)+$G(BARTPAY)
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U,4)=$P(BARHOLD,U,4)+$G(BARTADJ)
S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U,5)=$P(BARHOLD,U,5)+BARBAL
Q
PRINT ;
; Print reports
K BAR2,BARHOLD,BARBILL,BAR3P,BARACCT,BARLOC,BARDTB,BAR("D"),BAR("A")
K BARBAL,BARAGE,BARALLC
D NEGB^BARRNEG2
Q
; ********************************************************************
;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) BAR*1.8*23
;AND MAPS INSURER TYPE CODE TO CATEGORY (IE: W --> OTHER)
H ;;PRIVATE INSURANCE;;HMO
M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
D ;;MEDICAID;;MEDICAID FI
R ;;MEDICARE;;MEDICARE FI
P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
W ;;OTHER;;WORKMEN'S COMP
C ;;OTHER;;CHAMPUS
N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
I ;;OTHER;;INDIAN PATIENT
K ;;MEDICAID;;CHIP (KIDSCARE)
T ;;OTHER;;THIRD PARTY LIABILITY
G ;;OTHER;;GUARANTOR
MD ;;MEDICARE;;MCR PART D
MH ;;MEDICARE;;MEDICARE HMO
MMC ;;MEDICARE;;MCR MANAGED CARE
TSI ;;OTHER;;TRIBAL SELF INSURED
SEP ;;OTHER;;STATE EXCHANGE PLAN
FPL ;;MEDICAID;;FPL 133 PERCENT
MC ;;MEDICARE;;MCR PART C
F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
V ;;VETERAN;;VETERANS MEDICAL BENEFITS
;;***END OF TABLE**
BARRNEGB ; IHS/SD/LSL - Print Synch Reports ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,7,23,24**;OCT 26, 2005;Build 69
+2 ;
+3 ; IHS/SD/SDR - v1.8 p6 - DD 4.1.3
+4 ; New Negative Balance report
+5 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+6 ; IHS/SD/POT MAR 2013 ADDED NEW VA billing BAR*1.8*23
+7 ; IHS/SD/POT HEAT159172 04/03/2014 BAR*1.8*24 FIXED <UNDEFINED>ASKAGAIN+3^BARRSEL *BARP("RTN")
+8 ; *********************************************************************
NB ;EP - negative balance
+1 SET BAR("LOC")="BILLING"
+2 ; LINE MOVED BEFORE CALLING BARRSEL 4/3/2014 BAR*1.8*24 HEAT159172
SET BARP("RTN")="BARRNEGB"
+3 DO ^BARRSEL
+4 IF $DATA(BARY("ALL"))
SET BARY("ALL")=$$CONVERT^BARRSL2(BARY("ALL"))
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+6 SET BAR("HD",0)=BARMENU
+7 ; Report header
DO ^BARRHD
+8 ; Compute routine
SET BARQ("RC")="COMPUTE^BARRNEGB"
+9 ; Print routine
SET BARQ("RP")="PRINT^BARRNEGB"
+10 ; Namespace for variables
SET BARQ("NS")="BAR"
+11 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+12 ; Double queuing
DO ^BARDBQUE
+13 DO PAZ^BARRUTL
+14 QUIT
COMPUTE ;
+1 ;
+2 SET BAR("SUBR")="BAR-NEG"
+3 KILL ^TMP($JOB,"BAR-NEG")
+4 ; Routine used to get data if no parameters
SET BARP("RTN")="BARRNEGB"
+5 IF BAR("LOC")="BILLING"
DO LOOP^BARRUTL
QUIT
+6 SET BARDUZ2=DUZ(2)
+7 SET DUZ(2)=0
+8 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF 'DUZ(2)
QUIT
DO LOOP^BARRUTL
+9 SET DUZ(2)=BARDUZ2
+10 QUIT
DATA ;
+1 SET BARBAL=$$GET1^DIQ(90050.01,BAR,15)
+2 IF BARBAL'<0
QUIT
+3 SET BARP("HIT")=0
+4 DO BILL^BARRCHK
+5 IF 'BARP("HIT")
QUIT
+6 SET BARLOC=""
+7 IF BAR("L")]""
SET BARLOC=$$GET1^DIQ(4,BAR("L"),.01)
+8 ; Visit Location Name
IF BARLOC=""
SET BARLOC="No Visit Location"
+9 SET BARACCT=""
+10 IF BAR("I")]""
SET BARACCT=$$GET1^DIQ(90050.02,BAR("I"),.01)
+11 ; A/R Account Name
IF BARACCT=""
SET BARACCT="No A/R Account"
+12 IF '+BAR("A")
SET BAR("A")=9999999
+13 IF $GET(BARY("SORT"))="C"
Begin DoDot:1
+14 SET BAR2=BAR("C")
+15 IF BAR2]""
IF BAR2'=99999
SET BAR2=$$GET1^DIQ(40.7,BAR2,.01)
+16 IF BAR2=""!(BAR2=99999)
SET BAR2="No Clinic Type"
End DoDot:1
+17 IF $GET(BARY("SORT"))="V"
Begin DoDot:1
+18 SET BAR2=BAR("V")
+19 IF BAR2]""
IF BAR2'=99999
SET BAR2=$$GET1^DIQ(9002274.8,BAR2,.01)
+20 IF BAR2=""!(BAR2=99999)
SET BAR2="No Visit Type"
End DoDot:1
+21 SET BARBILL=$PIECE(BAR(0),U,13)
+22 SET BARBL=$PIECE(BAR(0),U)
+23 ;
+24 SET D0=BAR("I")
+25 ;insurer type CODE
SET BARALLC=$$VALI^BARVPM(8)
+26 SET BARALLC=$PIECE($TEXT(@BARALLC),";;",2)
+27 ;P.OTT
IF BARALLC=""
SET BARALLC="UNK"
+28 ;
+29 ;get pymts and adjs for bill
DO GETTRANS
+30 ;
+31 IF $DATA(BARY("SORT"))
DO CLINVIS
+32 IF '$TEST
DO ACCT
+33 ;
+34 SET BARHOLD=$GET(^TMP($JOB,"BAR-NEG",BARLOC))
+35 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC),U,2)=$PIECE(BARHOLD,U,2)+BARBILL
+36 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC),U,3)=$PIECE(BARHOLD,U,3)+BARTPAY
+37 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC),U,4)=$PIECE(BARHOLD,U,4)+BARTADJ
+38 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC),U,5)=$PIECE(BARHOLD,U,5)+BARBAL
+39 ;
+40 SET BARHOLD=$GET(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC))
+41 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC),U,2)=$PIECE(BARHOLD,U,2)+BARBILL
+42 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC),U,3)=$PIECE(BARHOLD,U,3)+BARTPAY
+43 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC),U,4)=$PIECE(BARHOLD,U,4)+BARTADJ
+44 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC),U,5)=$PIECE(BARHOLD,U,5)+BARBAL
+45 ;
+46 SET BARHOLD=$GET(^TMP($JOB,"BAR-NEG"))
+47 SET $PIECE(^TMP($JOB,"BAR-NEG"),U,2)=$PIECE(BARHOLD,U,2)+BARBILL
+48 SET $PIECE(^TMP($JOB,"BAR-NEG"),U,3)=$PIECE(BARHOLD,U,3)+BARTPAY
+49 SET $PIECE(^TMP($JOB,"BAR-NEG"),U,4)=$PIECE(BARHOLD,U,4)+BARTADJ
+50 SET $PIECE(^TMP($JOB,"BAR-NEG"),U,5)=$PIECE(BARHOLD,U,5)+BARBAL
+51 QUIT
GETTRANS ;
+1 SET (BARTPAY,BARTADJ)=0
+2 SET BARTIEN=0
+3 FOR
SET BARTIEN=$ORDER(^BARTR(DUZ(2),"AC",BAR,BARTIEN))
IF +BARTIEN=0
QUIT
Begin DoDot:1
+4 SET BARTTYP=$PIECE($GET(^BARTR(DUZ(2),BARTIEN,1)),U)
+5 ;payments and adjustments only
IF BARTTYP'=40&(BARTTYP'=43)
QUIT
+6 IF BARTTYP=40
SET BARTPAY=+$GET(BARTPAY)+$$GET1^DIQ(90050.03,BARTIEN,3.5)
+7 IF BARTTYP=43
SET BARTADJ=+$GET(BARTADJ)+$$GET1^DIQ(90050.03,BARTIEN,3.5)
End DoDot:1
+8 QUIT
ACCT ;
+1 ; Store data by AR Account
+2 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U)=BAR("D")
+3 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,2)=BARBILL
+4 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,3)=+$GET(BARTPAY)
+5 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,4)=+$GET(BARTADJ)
+6 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,5)=BARBAL
+7 ;
+8 SET BARHOLD=$GET(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT))
+9 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT),U)=$PIECE(BARHOLD,U)+BARBILL
+10 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,2)=$PIECE(BARHOLD,U,2)+BARBILL
+11 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,3)=$PIECE(BARHOLD,U,3)+BARTPAY
+12 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,4)=$PIECE(BARHOLD,U,4)+BARTADJ
+13 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,5)=$PIECE(BARHOLD,U,5)+BARBAL
+14 QUIT
CLINVIS ;
+1 ; Store data by Clinic/Visit Type
+2 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U)=BAR("D")
+3 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,2)=BARBILL
+4 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,3)=+$GET(BARTPAY)
+5 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,4)=+$GET(BARTADJ)
+6 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,5)=BARBAL
+7 ;
+8 SET BARHOLD=$GET(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT))
+9 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U)=BAR("D")
+10 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,2)=$PIECE(BARHOLD,U,2)+BARBILL
+11 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,3)=$PIECE(BARHOLD,U,3)+$GET(BARTPAY)
+12 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,4)=$PIECE(BARHOLD,U,4)+$GET(BARTADJ)
+13 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,5)=$PIECE(BARHOLD,U,5)+BARBAL
+14 ;
+15 SET BARHOLD=$GET(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2))
+16 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2),U)=BAR("D")
+17 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2),U,2)=$PIECE(BARHOLD,U,2)+BARBILL
+18 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2),U,3)=$PIECE(BARHOLD,U,3)+$GET(BARTPAY)
+19 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2),U,4)=$PIECE(BARHOLD,U,4)+$GET(BARTADJ)
+20 SET $PIECE(^TMP($JOB,"BAR-NEG",BARLOC,BARALLC,BAR2),U,5)=$PIECE(BARHOLD,U,5)+BARBAL
+21 QUIT
PRINT ;
+1 ; Print reports
+2 KILL BAR2,BARHOLD,BARBILL,BAR3P,BARACCT,BARLOC,BARDTB,BAR("D"),BAR("A")
+3 KILL BARBAL,BARAGE,BARALLC
+4 DO NEGB^BARRNEG2
+5 QUIT
+6 ; ********************************************************************
+7 ;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) BAR*1.8*23
+8 ;AND MAPS INSURER TYPE CODE TO CATEGORY (IE: W --> OTHER)
H ;;PRIVATE INSURANCE;;HMO
M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
D ;;MEDICAID;;MEDICAID FI
R ;;MEDICARE;;MEDICARE FI
P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
W ;;OTHER;;WORKMEN'S COMP
C ;;OTHER;;CHAMPUS
N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
I ;;OTHER;;INDIAN PATIENT
K ;;MEDICAID;;CHIP (KIDSCARE)
T ;;OTHER;;THIRD PARTY LIABILITY
G ;;OTHER;;GUARANTOR
MD ;;MEDICARE;;MCR PART D
MH ;;MEDICARE;;MEDICARE HMO
MMC ;;MEDICARE;;MCR MANAGED CARE
TSI ;;OTHER;;TRIBAL SELF INSURED
SEP ;;OTHER;;STATE EXCHANGE PLAN
FPL ;;MEDICAID;;FPL 133 PERCENT
MC ;;MEDICARE;;MCR PART C
F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
V ;;VETERAN;;VETERANS MEDICAL BENEFITS
+1 ;;***END OF TABLE**