BARDMLP1 ;IHS/OIT/FCJ - 2 OF 2 ;DEBT MANAGEMENT PRINT LETTERS
;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,24**;OCT 26, 2005;Build 69
;New routine 5-12-2011 for Debt Letter Management
;Routine to print letters
; IHS/SD/POTT JAN 2013 ADDED NEW PARAMETERS: BARPBDT and BARPDOB (SET IN BARDMU)- BAR*1.8*23
; IHS/SD/POTT SEP 2013 FIXED MISSING DATE- BAR*1.8*23
; IHS/SD/POTT HEAT143490 12/04/14 FIX ADDRESSE'THE GUARDIAN...' IF INS. - BAR*1.8*24
;
PRINT ;EP
W $$EN^BARVDF("IOF")
K ^UTILITY($J,"W")
S DIWL=BARMRGL,DIWR=75
S DIWF="W"
D HDR
S BARR=0 F S BARR=$O(^BAR(90052.03,BARPCP(CY),1,BARR)) Q:BARR'?1N.N D
.S X=^BAR(90052.03,BARPCP(CY),1,BARR,0)
.I X["TODAY" D DT Q
.I X["BARINS" D LTOP Q
.I X["BARFAC" D LFAC Q
.I X["BARSTF" D LBOT Q
.I X["BARSIG" D LSIG Q
.D ^DIWP
Q
HDR ;PRINT HEADER
F I1=1:1:BARMRGT S X="" D ^DIWP,^DIWW
S X=$P(^BAR(90052.03,BARPCP(CY),0),U,2) D ^DIWP,^DIWW
Q
DT ;OLD CODE HEAT158596 BAR*1.8*24
I BARRPT="R",BARDTP="",$G(BARBAT) D
. N Y
. S Y=+$G(^BARDMLG(DUZ(2),BARBAT,0))\1 I 'Y Q
. X ^DD("DD") S BARDTP=Y
I BARRPT="R" S X="Date: "_BARDTP
D ^DIWP
Q
;-------------------------------------------------
LTOP ;TOP OF LETTER
S X=BARDM("INS_NM") D ^DIWP,^DIWW
S X=BARDM("INS_STR") D ^DIWP,^DIWW
S X=BARDM("INS_CTY")_", "_$S(BARDM("INS_ST")'="":$P(^DIC(5,BARDM("INS_ST"),0),U,2),1:" ")_" "_BARDM("INS_ZP") D ^DIWP,^DIWW
I BARDACG="AUTNINS(" S X="TIN: "_BARDM("INS_TX") D ^DIWP
E S X="" D ^DIWP
S X="" D ^DIWP
I BARDACG="AUTNINS(" D
. S X="Re: Policy Holder: "_BARDM("POL_HOLDER")_BARLEN
. S X=$E(X,1,40)_" Policy #: "_BARDM("POL_NUM") D ^DIWP
. S X=" Patient: "_BARPAT_BARLEN
. S X=$E(X,1,40)_" Date of Service: "_BARDM("DOS") D ^DIWP
E S BARDACG="AUPNPAT(" S X="Re: Date of Service: "_BARDM("DOS") D ^DIWP
S X=" Bill Number: "_BARBILN_BARLEN S X=$E(X,1,40)_" Bill Amount: "_BARAMTO D ^DIWP
I BARPBDT S X=" Bill Date: "_$$SDT^BARDUTL($P($G(^BARBL(DUZ(2),BARBIEN,0)),U,18)) D ^DIWP ;P.OTT
S X=""
I BARPDOB D ;P.OTT - BAR*1.8*23
. S X=" Patient DOB: "_BARDOB_BARLEN D ^DIWP,^DIWW
S X=""
I BARPNPI="FACILITY" D
.S X=" Facility NPI: "_BARNPIF
I BARPNPI="PROVIDER" D
.S X=" Provider NPI: "_BARNPIP
I BARPNPI["BOTH" D
.S X=$S(BARNPIP>0:" Provider NPI: "_BARNPIP_BARLEN,1:" "_BARLEN)
.S X=$S(BARNPIF>0:$E(X,1,40)_" Facility NPI: "_BARNPIF,1:"")
I X'="" D ^DIWP
F I1=1:1:2 S X="" D ^DIWP
;begin old code - BAR*1.8*24
;I $G(BARL)="CYCLE 4" S X="Dear Area Claims Collection Officer:" D ^DIWP
;E I BARMIN=1 S X="Dear "_BARDM("INS_NM")_":" D ^DIWP
;E I BARMIN=0 S X="To the Guardian of "_BARDM("INS_NM")_":" D ^DIWP
I $G(BARL)="CYCLE 4" S X="Dear Area Claims Collection Officer:" D ^DIWP
I $G(BARL)'="CYCLE 4" I BARMIN=1 S X="Dear "_BARDM("INS_NM")_":" D ^DIWP
I $G(BARL)'="CYCLE 4" I BARMIN=0 S X="To the Guardian of "_BARDM("INS_NM")_":" D ^DIWP
I $G(BARL)'="CYCLE 4" I BARMIN=2 S X="To "_BARDM("INS_NM")_":" D ^DIWP ;- BAR*1.8*24
Q
LFAC ;FAC SET
S X=" "_BARFAC D ^DIWP
S X=" "_BARAD1 D ^DIWP
I BARAD2 S X=" "_BARAD2 D ^DIWP
S X=" "_BARCTY_", "_$P(^DIC(5,BARST,0),U,2)_" "_BARZP D ^DIWP
Q
LBOT ;BOTTOM OF LETTER
I $G(BARL)="CYCLE 4" S X=$P(X,"BARPH",1)_BARPH_"."
E S X=$P(X,"BARSTF",1)_BARSG_" at "_BARPH_"."
D ^DIWP,^DIWW
Q
LSIG ;SIGNATURE LINES
S SG=$P(X,"BARSIG")
S X=SG_BARSG D ^DIWP
I $D(BARSG1) S X=SG_BARSG1 D ^DIWP
I $D(BARSG2) S X=SG_BARSG2 D ^DIWP
D ^DIWW
Q ;------EOR-------------
BARDMLP1 ;IHS/OIT/FCJ - 2 OF 2 ;DEBT MANAGEMENT PRINT LETTERS
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,24**;OCT 26, 2005;Build 69
+2 ;New routine 5-12-2011 for Debt Letter Management
+3 ;Routine to print letters
+4 ; IHS/SD/POTT JAN 2013 ADDED NEW PARAMETERS: BARPBDT and BARPDOB (SET IN BARDMU)- BAR*1.8*23
+5 ; IHS/SD/POTT SEP 2013 FIXED MISSING DATE- BAR*1.8*23
+6 ; IHS/SD/POTT HEAT143490 12/04/14 FIX ADDRESSE'THE GUARDIAN...' IF INS. - BAR*1.8*24
+7 ;
PRINT ;EP
+1 WRITE $$EN^BARVDF("IOF")
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWL=BARMRGL
SET DIWR=75
+4 SET DIWF="W"
+5 DO HDR
+6 SET BARR=0
FOR
SET BARR=$ORDER(^BAR(90052.03,BARPCP(CY),1,BARR))
IF BARR'?1N.N
QUIT
Begin DoDot:1
+7 SET X=^BAR(90052.03,BARPCP(CY),1,BARR,0)
+8 IF X["TODAY"
DO DT
QUIT
+9 IF X["BARINS"
DO LTOP
QUIT
+10 IF X["BARFAC"
DO LFAC
QUIT
+11 IF X["BARSTF"
DO LBOT
QUIT
+12 IF X["BARSIG"
DO LSIG
QUIT
+13 DO ^DIWP
End DoDot:1
+14 QUIT
HDR ;PRINT HEADER
+1 FOR I1=1:1:BARMRGT
SET X=""
DO ^DIWP
DO ^DIWW
+2 SET X=$PIECE(^BAR(90052.03,BARPCP(CY),0),U,2)
DO ^DIWP
DO ^DIWW
+3 QUIT
DT ;OLD CODE HEAT158596 BAR*1.8*24
+1 IF BARRPT="R"
IF BARDTP=""
IF $GET(BARBAT)
Begin DoDot:1
+2 NEW Y
+3 SET Y=+$GET(^BARDMLG(DUZ(2),BARBAT,0))\1
IF 'Y
QUIT
+4 XECUTE ^DD("DD")
SET BARDTP=Y
End DoDot:1
+5 IF BARRPT="R"
SET X="Date: "_BARDTP
+6 DO ^DIWP
+7 QUIT
+8 ;-------------------------------------------------
LTOP ;TOP OF LETTER
+1 SET X=BARDM("INS_NM")
DO ^DIWP
DO ^DIWW
+2 SET X=BARDM("INS_STR")
DO ^DIWP
DO ^DIWW
+3 SET X=BARDM("INS_CTY")_", "_$SELECT(BARDM("INS_ST")'="":$PIECE(^DIC(5,BARDM("INS_ST"),0),U,2),1:" ")_" "_BARDM("INS_ZP")
DO ^DIWP
DO ^DIWW
+4 IF BARDACG="AUTNINS("
SET X="TIN: "_BARDM("INS_TX")
DO ^DIWP
+5 IF '$TEST
SET X=""
DO ^DIWP
+6 SET X=""
DO ^DIWP
+7 IF BARDACG="AUTNINS("
Begin DoDot:1
+8 SET X="Re: Policy Holder: "_BARDM("POL_HOLDER")_BARLEN
+9 SET X=$EXTRACT(X,1,40)_" Policy #: "_BARDM("POL_NUM")
DO ^DIWP
+10 SET X=" Patient: "_BARPAT_BARLEN
+11 SET X=$EXTRACT(X,1,40)_" Date of Service: "_BARDM("DOS")
DO ^DIWP
End DoDot:1
+12 IF '$TEST
SET BARDACG="AUPNPAT("
SET X="Re: Date of Service: "_BARDM("DOS")
DO ^DIWP
+13 SET X=" Bill Number: "_BARBILN_BARLEN
SET X=$EXTRACT(X,1,40)_" Bill Amount: "_BARAMTO
DO ^DIWP
+14 ;P.OTT
IF BARPBDT
SET X=" Bill Date: "_$$SDT^BARDUTL($PIECE($GET(^BARBL(DUZ(2),BARBIEN,0)),U,18))
DO ^DIWP
+15 SET X=""
+16 ;P.OTT - BAR*1.8*23
IF BARPDOB
Begin DoDot:1
+17 SET X=" Patient DOB: "_BARDOB_BARLEN
DO ^DIWP
DO ^DIWW
End DoDot:1
+18 SET X=""
+19 IF BARPNPI="FACILITY"
Begin DoDot:1
+20 SET X=" Facility NPI: "_BARNPIF
End DoDot:1
+21 IF BARPNPI="PROVIDER"
Begin DoDot:1
+22 SET X=" Provider NPI: "_BARNPIP
End DoDot:1
+23 IF BARPNPI["BOTH"
Begin DoDot:1
+24 SET X=$SELECT(BARNPIP>0:" Provider NPI: "_BARNPIP_BARLEN,1:" "_BARLEN)
+25 SET X=$SELECT(BARNPIF>0:$EXTRACT(X,1,40)_" Facility NPI: "_BARNPIF,1:"")
End DoDot:1
+26 IF X'=""
DO ^DIWP
+27 FOR I1=1:1:2
SET X=""
DO ^DIWP
+28 ;begin old code - BAR*1.8*24
+29 ;I $G(BARL)="CYCLE 4" S X="Dear Area Claims Collection Officer:" D ^DIWP
+30 ;E I BARMIN=1 S X="Dear "_BARDM("INS_NM")_":" D ^DIWP
+31 ;E I BARMIN=0 S X="To the Guardian of "_BARDM("INS_NM")_":" D ^DIWP
+32 IF $GET(BARL)="CYCLE 4"
SET X="Dear Area Claims Collection Officer:"
DO ^DIWP
+33 IF $GET(BARL)'="CYCLE 4"
IF BARMIN=1
SET X="Dear "_BARDM("INS_NM")_":"
DO ^DIWP
+34 IF $GET(BARL)'="CYCLE 4"
IF BARMIN=0
SET X="To the Guardian of "_BARDM("INS_NM")_":"
DO ^DIWP
+35 ;- BAR*1.8*24
IF $GET(BARL)'="CYCLE 4"
IF BARMIN=2
SET X="To "_BARDM("INS_NM")_":"
DO ^DIWP
+36 QUIT
LFAC ;FAC SET
+1 SET X=" "_BARFAC
DO ^DIWP
+2 SET X=" "_BARAD1
DO ^DIWP
+3 IF BARAD2
SET X=" "_BARAD2
DO ^DIWP
+4 SET X=" "_BARCTY_", "_$PIECE(^DIC(5,BARST,0),U,2)_" "_BARZP
DO ^DIWP
+5 QUIT
LBOT ;BOTTOM OF LETTER
+1 IF $GET(BARL)="CYCLE 4"
SET X=$PIECE(X,"BARPH",1)_BARPH_"."
+2 IF '$TEST
SET X=$PIECE(X,"BARSTF",1)_BARSG_" at "_BARPH_"."
+3 DO ^DIWP
DO ^DIWW
+4 QUIT
LSIG ;SIGNATURE LINES
+1 SET SG=$PIECE(X,"BARSIG")
+2 SET X=SG_BARSG
DO ^DIWP
+3 IF $DATA(BARSG1)
SET X=SG_BARSG1
DO ^DIWP
+4 IF $DATA(BARSG2)
SET X=SG_BARSG2
DO ^DIWP
+5 DO ^DIWW
+6 ;------EOR-------------
QUIT
