- 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
