BARPUC2 ; IHS/SD/LSL - UNALLOCATED PATIENT LOOKUP ; 01/26/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**17,23**;OCT 26, 2005
;
;** patient a/r lookup based on from/thru dos
;** called from ^BARPST
;** BARPASS = PATDFN^BEGDOS^ENDDOS
;** builds an array that includes all entries from a/r that meet the
; criteria.
;HEAT93190 DEC 2012 P.OTTIS NOHEAT MARK DUPLICATE BILLS
;MAR 2013 P.OTTIS ADDED NEW VA billing
; *********************************************************************
;
EN(BARPASS) ;EP
N DIC,DIQ,DR,BARBLV,BARDT,BARPAT,BARBEG,BAREND,BARHIT,BARCNT
K ^BARTMP($J)
Q:+BARPASS=0
S BARPAT=+BARPASS
S BARBEG=$P(BARPASS,U,2)
S BAREND=$P(BARPASS,U,3)
S X1=BARBEG
S X2=-1
D C^%DTC
S BARDT=X
S DIC="^BARBL(DUZ(2),"
S DR=".01;3;13;15"
S DIQ="BARBLV("
S BARCNT=0
F S BARDT=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDT)) Q:'BARDT!(BARDT>BAREND) D
. S BARBDA=0
. F S BARBDA=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA)) Q:'BARBDA D
.. S DA=BARBDA
.. D EN^XBDIQ1
.. S BARCNT=BARCNT+1
.. S ^BARTMP($J,BARBDA,BARCNT)=BARDT_U_BARBLV(.01)_U_BARBLV(13)_U_BARBLV(3)_U_BARBLV(15)
.. S ^BARTMP($J,"B",BARCNT,BARBDA)=""
.. K BARBLV
Q BARCNT
; *********************************************************************
;
HIT(BARPASS) ;
; ** display a/r bills found
N BARBDA,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
S (BARBDA,BARPG,BARSTOP)=0
D HEAD
F S BARBDA=$O(^BARTMP($J,BARBDA)) Q:'BARBDA D Q:BARSTOP
. S BARLIN=$O(^BARTMP($J,BARBDA,""))
. S BARREC=^BARTMP($J,BARBDA,BARLIN)
. S BARBLO=$P(BARREC,U,2)
. I $D(^BARTR(DUZ(2),"AM4",+BARBLO)) S BARBLO="m"_BARBLO
. S BARSTOP=$$CHKLINE(0) Q:BARSTOP
. S BARTMP=$$DUPLBILL^BARPNP2($P(BARREC,U,2)) I BARTMP>0 D ;-------->P.OTT MARK DUPLICATE BILLS
. . S BAREIN1=$P(BARTMP,"^",2)
. . S BAREIN2=$P(BARTMP,"^",3)
. . S BARDPTR=$P(BARTMP,"^",4)
. . I BARDPTR=3 S BARBLO="?"_BARBLO Q
. . I BARBDA=BAREIN1,BARDPTR=1 S BARBLO="!"_BARBLO Q ;! = ORPHANT (NO DATA IN 3PB)
. . I BARBDA=BAREIN2,BARDPTR=2 S BARBLO="!"_BARBLO Q ;d = DUPLICATE (CORRECT ONE)
. . I BARBDA=BAREIN1 S BARBLO="d"_BARBLO Q
. . I BARBDA=BAREIN2 S BARBLO="d"_BARBLO Q
. ;---------------------------------------------------------< P.OTT
. W !,BARLIN
. W ?6,$$SDT^BARDUTL($P(BARREC,U,1))
. W ?18,BARBLO
. W ?32,$J($P(BARREC,U,3),8,2)
. W ?44,$E($P(BARREC,U,4),1,23)
. W ?70,$J($P(BARREC,U,5),8,2)
Q
; *********************************************************************
;
HEAD ;
W $$EN^BARVDF("IOF"),!
N BARPTNAM
S BARPG=BARPG+1
S BARPTNAM=$P(^DPT(+BARPASS,0),U,1)
I $D(^BARTR(DUZ(2),"AM5",+BARPASS)) S BARPTNAM="(msg) "_BARPTNAM
W "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($P(BARPASS,U,2))_" to "_$$SDT^BARDUTL($P(BARPASS,U,3))
W ?(IOM-15),"Page: "_BARPG
W !!?32,"Billed",?70,"Current"
W !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
S BARDSH=""
S $P(BARDSH,"-",IOM)=""
W !,BARDSH
Q
; *********************************************************************
;
HIT1(BARPASS) ; EP
; ** display a/r bills found
N BARHIT,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
S (BARTPAY,BARTADJ,BARHIT,BARPG,BARSTOP)=0
D HEAD1
F S BARHIT=$O(^BARTMP($J,BARHIT)) Q:'BARHIT D Q:BARSTOP
. S BARLIN=$O(^BARTMP($J,BARHIT,""))
. S BARREC=^BARTMP($J,BARHIT,BARLIN)
. S BARBLO=$P(BARREC,U,2)
. I $D(^BARTR(DUZ(2),"AM4",+BARBLO)) S BARBLO="m"_BARBLO
. S BARTMP=$$DUPLBILL^BARPNP2($P(BARREC,U,2)) I BARTMP>0 D ;-------->P.OTT MARK DUPLICATE BILLS
. . S BAREIN1=$P(BARTMP,"^",2)
. . S BAREIN2=$P(BARTMP,"^",3)
. . S BARDPTR=$P(BARTMP,"^",4)
. . I BARDPTR=3 S BARBLO="?"_BARBLO Q
. . I BARHIT=BAREIN1,BARDPTR=1 S BARBLO="!"_BARBLO Q ;! = ORPHANT (NO DATA IN 3PB)
. . I BARHIT=BAREIN2,BARDPTR=2 S BARBLO="!"_BARBLO Q ;d = DUPLICATE (CORRECT ONE)
. . I BARHIT=BAREIN1 S BARBLO="d"_BARBLO Q
. . I BARHIT=BAREIN2 S BARBLO="d"_BARBLO Q
. ;---------------------------------------------------------< P.OTT
. S BARTPAY=BARTPAY+$P(BARREC,U,6)
. S BARTADJ=BARTADJ+$P(BARREC,U,7)
. S BARSTOP=$$CHKLINE(1) Q:BARSTOP
. W !,BARLIN
. W ?6,$$SDT^BARDUTL($P(BARREC,U,1))
. W ?18,BARBLO
. W ?32,$J($P(BARREC,U,3),8,2)
. W ?44,$J($P(BARREC,U,6),8,2)
. W ?56,$J($P(BARREC,U,7),8,2)
. W ?70,$J($P(BARREC,U,5),8,2)
Q
; *********************************************************************
;
HEAD1 ;
W $$EN^BARVDF("IOF"),!
N BARPTNAM
S BARPG=BARPG+1
S BARPTNAM=$P(^DPT(+BARPASS,0),U,1)
I $D(^BARTR(DUZ(2),"AM5",+BARPASS)) S BARPTNAM="(msg) "_BARPTNAM
W "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($P(BARPASS,U,2))_" to "_$$SDT^BARDUTL($P(BARPASS,U,3))
W ?(IOM-15),"Page: "_BARPG
W !!?32,"Billed",?44,"Current",?56,"Current",?70,"Current"
W !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Payments",?56,"Adjust.",?70,"Balance"
S BARDSH=""
S $P(BARDSH,"-",IOM)=""
W !,BARDSH
Q
; *********************************************************************
;
CHKLINE(BARHD) ;
; Q 0 = CONTINUE
; Q 1 = STOP
N X
I ($Y+5)<IOSL Q 0
W !?(IOM-15),"continued==>"
D EOP^BARUTL(0)
I 'Y Q 1
I BARHD=0 D HEAD
I BARHD=1 D HEAD1
Q 0
; Begin new code BAR*1.8*17 ADD COMMENTS ENTRY TO PUC ITEMS
; - per Adrian 2/12/10 PKD:BAR*1.8.17 2/12/10
ITMSG ;
;BAR1.8*17 PKD 2/24/2010
W !!!,"Create a New Message for: "
W !!,"Credit",?10,"Account",?42,"Batch",?71,"Item"
W !?8,"TRANS DATE",?32,"ALLOW CAT",?46,"TDN",?68,"STATUS"
W !
S BARDSH=""
S $P(BARDSH,"-",80)="" W BARDSH
;
W $J(BARTX(2),8,2)
W ?10,$E(BARTX(6),1,30),?42,BARTX(14)
W ?71,BARTX(15) ;coll. item
S D0=BARTX(6,"I")
I D0']"" D Q ;MRS:BAR*1.8*7 IM30586
. W !,"** ERROR--MISSING ALLOCATION INFO "
. D EOP^BARUTL(1)
S BARALLC=$$VALI^BARVPM(8) ;CODE
I BARALLC="" D Q ;MRS:BAR*1.8*7 IM30586
. W !,"** ERROR--MISSING ALLOCATION INFO "
. D EOP^BARUTL(1)
S Y=$P(BARTX("ID"),":") D DD^%DT
W !?8,Y,?32,$E($TR($P($T(@BARALLC),";;",3)," ",""),1,12) ;P.OTT SHOW BOTH FIELDS
W ?46
W $S($G(BARTX(17))'="":BARTX(17),$$GET1^DIQ(90051.1101,BARTX(15,"I")_","_BARTX(14,"I")_",",20,"E")'="":$$GET1^DIQ(90051.1101,BARTX(15,"I")_","_BARTX(14,"I")_",",20,"E"),1:"<NO TDN>")
W ?68,$S($O(^BAR(90052,"D",BARTX(14),0))'="":"LETTER",1:"")
;
K DIE,DIC,DA,DIR
S DA(1)=BARTX(14,"I"),DA=BARTX(15,"I")
S DR=107 ; SubFile ITEMS in A/R Collect Batch - Question #107: PUC comments
S DIE="^BARCOL("_DUZ(2)_","_DA(1)_",1,"
D ^DIE
Q
;
PRTQ ; Ask whether to print comments on Letters to Finance 1.8.17 2/25/10 PKD
Q:$G(^BARCOL(DUZ(2),BARTX(14,"I"),1,BARTX(15,"I"),7,0))=""
K DIR
W !!,?31,"**Messages Exist**",!
S DIR("A")="Do you want them to print on the letter? ",DIR("B")="YES",DIR(0)="YOA"
D ^DIR
I Y=1 S BARPRTQ=1
Q
; ********************************************************************
;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) P.OTT 4/12/2013
;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**
BARPUC2 ; IHS/SD/LSL - UNALLOCATED PATIENT LOOKUP ; 01/26/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**17,23**;OCT 26, 2005
+2 ;
+3 ;** patient a/r lookup based on from/thru dos
+4 ;** called from ^BARPST
+5 ;** BARPASS = PATDFN^BEGDOS^ENDDOS
+6 ;** builds an array that includes all entries from a/r that meet the
+7 ; criteria.
+8 ;HEAT93190 DEC 2012 P.OTTIS NOHEAT MARK DUPLICATE BILLS
+9 ;MAR 2013 P.OTTIS ADDED NEW VA billing
+10 ; *********************************************************************
+11 ;
EN(BARPASS) ;EP
+1 NEW DIC,DIQ,DR,BARBLV,BARDT,BARPAT,BARBEG,BAREND,BARHIT,BARCNT
+2 KILL ^BARTMP($JOB)
+3 IF +BARPASS=0
QUIT
+4 SET BARPAT=+BARPASS
+5 SET BARBEG=$PIECE(BARPASS,U,2)
+6 SET BAREND=$PIECE(BARPASS,U,3)
+7 SET X1=BARBEG
+8 SET X2=-1
+9 DO C^%DTC
+10 SET BARDT=X
+11 SET DIC="^BARBL(DUZ(2),"
+12 SET DR=".01;3;13;15"
+13 SET DIQ="BARBLV("
+14 SET BARCNT=0
+15 FOR
SET BARDT=$ORDER(^BARBL(DUZ(2),"ABC",BARPAT,BARDT))
IF 'BARDT!(BARDT>BAREND)
QUIT
Begin DoDot:1
+16 SET BARBDA=0
+17 FOR
SET BARBDA=$ORDER(^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA))
IF 'BARBDA
QUIT
Begin DoDot:2
+18 SET DA=BARBDA
+19 DO EN^XBDIQ1
+20 SET BARCNT=BARCNT+1
+21 SET ^BARTMP($JOB,BARBDA,BARCNT)=BARDT_U_BARBLV(.01)_U_BARBLV(13)_U_BARBLV(3)_U_BARBLV(15)
+22 SET ^BARTMP($JOB,"B",BARCNT,BARBDA)=""
+23 KILL BARBLV
End DoDot:2
End DoDot:1
+24 QUIT BARCNT
+25 ; *********************************************************************
+26 ;
HIT(BARPASS) ;
+1 ; ** display a/r bills found
+2 NEW BARBDA,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
+3 SET (BARBDA,BARPG,BARSTOP)=0
+4 DO HEAD
+5 FOR
SET BARBDA=$ORDER(^BARTMP($JOB,BARBDA))
IF 'BARBDA
QUIT
Begin DoDot:1
+6 SET BARLIN=$ORDER(^BARTMP($JOB,BARBDA,""))
+7 SET BARREC=^BARTMP($JOB,BARBDA,BARLIN)
+8 SET BARBLO=$PIECE(BARREC,U,2)
+9 IF $DATA(^BARTR(DUZ(2),"AM4",+BARBLO))
SET BARBLO="m"_BARBLO
+10 SET BARSTOP=$$CHKLINE(0)
IF BARSTOP
QUIT
+11 ;-------->P.OTT MARK DUPLICATE BILLS
SET BARTMP=$$DUPLBILL^BARPNP2($PIECE(BARREC,U,2))
IF BARTMP>0
Begin DoDot:2
+12 SET BAREIN1=$PIECE(BARTMP,"^",2)
+13 SET BAREIN2=$PIECE(BARTMP,"^",3)
+14 SET BARDPTR=$PIECE(BARTMP,"^",4)
+15 IF BARDPTR=3
SET BARBLO="?"_BARBLO
QUIT
+16 ;! = ORPHANT (NO DATA IN 3PB)
IF BARBDA=BAREIN1
IF BARDPTR=1
SET BARBLO="!"_BARBLO
QUIT
+17 ;d = DUPLICATE (CORRECT ONE)
IF BARBDA=BAREIN2
IF BARDPTR=2
SET BARBLO="!"_BARBLO
QUIT
+18 IF BARBDA=BAREIN1
SET BARBLO="d"_BARBLO
QUIT
+19 IF BARBDA=BAREIN2
SET BARBLO="d"_BARBLO
QUIT
End DoDot:2
+20 ;---------------------------------------------------------< P.OTT
+21 WRITE !,BARLIN
+22 WRITE ?6,$$SDT^BARDUTL($PIECE(BARREC,U,1))
+23 WRITE ?18,BARBLO
+24 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
+25 WRITE ?44,$EXTRACT($PIECE(BARREC,U,4),1,23)
+26 WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5),8,2)
End DoDot:1
IF BARSTOP
QUIT
+27 QUIT
+28 ; *********************************************************************
+29 ;
HEAD ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 NEW BARPTNAM
+3 SET BARPG=BARPG+1
+4 SET BARPTNAM=$PIECE(^DPT(+BARPASS,0),U,1)
+5 IF $DATA(^BARTR(DUZ(2),"AM5",+BARPASS))
SET BARPTNAM="(msg) "_BARPTNAM
+6 WRITE "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($PIECE(BARPASS,U,2))_" to "_$$SDT^BARDUTL($PIECE(BARPASS,U,3))
+7 WRITE ?(IOM-15),"Page: "_BARPG
+8 WRITE !!?32,"Billed",?70,"Current"
+9 WRITE !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
+10 SET BARDSH=""
+11 SET $PIECE(BARDSH,"-",IOM)=""
+12 WRITE !,BARDSH
+13 QUIT
+14 ; *********************************************************************
+15 ;
HIT1(BARPASS) ; EP
+1 ; ** display a/r bills found
+2 NEW BARHIT,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
+3 SET (BARTPAY,BARTADJ,BARHIT,BARPG,BARSTOP)=0
+4 DO HEAD1
+5 FOR
SET BARHIT=$ORDER(^BARTMP($JOB,BARHIT))
IF 'BARHIT
QUIT
Begin DoDot:1
+6 SET BARLIN=$ORDER(^BARTMP($JOB,BARHIT,""))
+7 SET BARREC=^BARTMP($JOB,BARHIT,BARLIN)
+8 SET BARBLO=$PIECE(BARREC,U,2)
+9 IF $DATA(^BARTR(DUZ(2),"AM4",+BARBLO))
SET BARBLO="m"_BARBLO
+10 ;-------->P.OTT MARK DUPLICATE BILLS
SET BARTMP=$$DUPLBILL^BARPNP2($PIECE(BARREC,U,2))
IF BARTMP>0
Begin DoDot:2
+11 SET BAREIN1=$PIECE(BARTMP,"^",2)
+12 SET BAREIN2=$PIECE(BARTMP,"^",3)
+13 SET BARDPTR=$PIECE(BARTMP,"^",4)
+14 IF BARDPTR=3
SET BARBLO="?"_BARBLO
QUIT
+15 ;! = ORPHANT (NO DATA IN 3PB)
IF BARHIT=BAREIN1
IF BARDPTR=1
SET BARBLO="!"_BARBLO
QUIT
+16 ;d = DUPLICATE (CORRECT ONE)
IF BARHIT=BAREIN2
IF BARDPTR=2
SET BARBLO="!"_BARBLO
QUIT
+17 IF BARHIT=BAREIN1
SET BARBLO="d"_BARBLO
QUIT
+18 IF BARHIT=BAREIN2
SET BARBLO="d"_BARBLO
QUIT
End DoDot:2
+19 ;---------------------------------------------------------< P.OTT
+20 SET BARTPAY=BARTPAY+$PIECE(BARREC,U,6)
+21 SET BARTADJ=BARTADJ+$PIECE(BARREC,U,7)
+22 SET BARSTOP=$$CHKLINE(1)
IF BARSTOP
QUIT
+23 WRITE !,BARLIN
+24 WRITE ?6,$$SDT^BARDUTL($PIECE(BARREC,U,1))
+25 WRITE ?18,BARBLO
+26 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
+27 WRITE ?44,$JUSTIFY($PIECE(BARREC,U,6),8,2)
+28 WRITE ?56,$JUSTIFY($PIECE(BARREC,U,7),8,2)
+29 WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5),8,2)
End DoDot:1
IF BARSTOP
QUIT
+30 QUIT
+31 ; *********************************************************************
+32 ;
HEAD1 ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 NEW BARPTNAM
+3 SET BARPG=BARPG+1
+4 SET BARPTNAM=$PIECE(^DPT(+BARPASS,0),U,1)
+5 IF $DATA(^BARTR(DUZ(2),"AM5",+BARPASS))
SET BARPTNAM="(msg) "_BARPTNAM
+6 WRITE "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($PIECE(BARPASS,U,2))_" to "_$$SDT^BARDUTL($PIECE(BARPASS,U,3))
+7 WRITE ?(IOM-15),"Page: "_BARPG
+8 WRITE !!?32,"Billed",?44,"Current",?56,"Current",?70,"Current"
+9 WRITE !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Payments",?56,"Adjust.",?70,"Balance"
+10 SET BARDSH=""
+11 SET $PIECE(BARDSH,"-",IOM)=""
+12 WRITE !,BARDSH
+13 QUIT
+14 ; *********************************************************************
+15 ;
CHKLINE(BARHD) ;
+1 ; Q 0 = CONTINUE
+2 ; Q 1 = STOP
+3 NEW X
+4 IF ($Y+5)<IOSL
QUIT 0
+5 WRITE !?(IOM-15),"continued==>"
+6 DO EOP^BARUTL(0)
+7 IF 'Y
QUIT 1
+8 IF BARHD=0
DO HEAD
+9 IF BARHD=1
DO HEAD1
+10 QUIT 0
+11 ; Begin new code BAR*1.8*17 ADD COMMENTS ENTRY TO PUC ITEMS
+12 ; - per Adrian 2/12/10 PKD:BAR*1.8.17 2/12/10
ITMSG ;
+1 ;BAR1.8*17 PKD 2/24/2010
+2 WRITE !!!,"Create a New Message for: "
+3 WRITE !!,"Credit",?10,"Account",?42,"Batch",?71,"Item"
+4 WRITE !?8,"TRANS DATE",?32,"ALLOW CAT",?46,"TDN",?68,"STATUS"
+5 WRITE !
+6 SET BARDSH=""
+7 SET $PIECE(BARDSH,"-",80)=""
WRITE BARDSH
+8 ;
+9 WRITE $JUSTIFY(BARTX(2),8,2)
+10 WRITE ?10,$EXTRACT(BARTX(6),1,30),?42,BARTX(14)
+11 ;coll. item
WRITE ?71,BARTX(15)
+12 SET D0=BARTX(6,"I")
+13 ;MRS:BAR*1.8*7 IM30586
IF D0']""
Begin DoDot:1
+14 WRITE !,"** ERROR--MISSING ALLOCATION INFO "
+15 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+16 ;CODE
SET BARALLC=$$VALI^BARVPM(8)
+17 ;MRS:BAR*1.8*7 IM30586
IF BARALLC=""
Begin DoDot:1
+18 WRITE !,"** ERROR--MISSING ALLOCATION INFO "
+19 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+20 SET Y=$PIECE(BARTX("ID"),":")
DO DD^%DT
+21 ;P.OTT SHOW BOTH FIELDS
WRITE !?8,Y,?32,$EXTRACT($TRANSLATE($PIECE($TEXT(@BARALLC),";;",3)," ",""),1,12)
+22 WRITE ?46
+23 WRITE $SELECT($GET(BARTX(17))'="":BARTX(17),$$GET1^DIQ(90051.1101,BARTX(15,"I")_","_BARTX(14,"I")_",",20,"E")'="":$$GET1^DIQ(90051.1101,BARTX(15,"I")_","_BARTX(14,"I")_",",20,"E"),1:"<NO TDN>")
+24 WRITE ?68,$SELECT($ORDER(^BAR(90052,"D",BARTX(14),0))'="":"LETTER",1:"")
+25 ;
+26 KILL DIE,DIC,DA,DIR
+27 SET DA(1)=BARTX(14,"I")
SET DA=BARTX(15,"I")
+28 ; SubFile ITEMS in A/R Collect Batch - Question #107: PUC comments
SET DR=107
+29 SET DIE="^BARCOL("_DUZ(2)_","_DA(1)_",1,"
+30 DO ^DIE
+31 QUIT
+32 ;
PRTQ ; Ask whether to print comments on Letters to Finance 1.8.17 2/25/10 PKD
+1 IF $GET(^BARCOL(DUZ(2),BARTX(14,"I"),1,BARTX(15,"I"),7,0))=""
QUIT
+2 KILL DIR
+3 WRITE !!,?31,"**Messages Exist**",!
+4 SET DIR("A")="Do you want them to print on the letter? "
SET DIR("B")="YES"
SET DIR(0)="YOA"
+5 DO ^DIR
+6 IF Y=1
SET BARPRTQ=1
+7 QUIT
+8 ; ********************************************************************
+9 ;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) P.OTT 4/12/2013
+10 ;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**
