BARDMLP.m

BARDMLP ;IHS/OIT/FCJ - 1 OF 2 ;DEBT MANAGEMENT PRINT LETTERS

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,24,27**;OCT 26, 2005;Build 12

 ;vc; Version BARDMLP.INT/BAR.1  Date 31-Oct-17  By User  Location BAR$M

 ;vc; Component name INT.BARDMLP  Routine name: BARDMLP

 ;New routine 5-12-2011 for Debt Letter Management

 ; Routine to print letters

 ; IHS/SD/POTT HEAT91638 NOV 2012 fixed pat DOB - BAR*1.8*23

 ; IHS/SD/POTT HEAT ;JAN 2013 ADDED SORTING OPTION -BAR*1.8*23

 ; IHS/SD/POTT HEAT ;APR 2013 FIXED BARPOC (INCL ERR LETTERS) - BAR*1.8*23

 ; IHS/SD/POTT HEAT ;MAY 2013 CHK / SET STATUS 'PAID' - BAR*1.8*23

 ; IHS/SD/POTT HEAT ;JUN 2013 RESOLVED '??' - BAR*1.8*23

 ; IHS/SD/POTT HEAT118656 BELCOURT: SKIP UNDEF ENTRY IN ^BARBL - BAR*1.8*24

 ; IHS/SD/POTT HEAT143490 12/04/14 FIX ADDRESSE'THE GUARDIAN...' IF INS. - BAR*1.8*24

 ; IHS/SD/POTT HEAT152452 2/10/14 CHK IF PAR/SAT FILE CORECTLY SET UP - BAR*1.8*24

 ; IHS/DIT/CPC New Medicare Card Initiative CR09275 11/3/2017 - BAR*1.8*27

ST ;

 S BARRPT="L"

 W @IOF

 D TSTPRT

 Q:$G(BARQ)  ;P.OTT HEAT152452 2/10/2014

 G:$D(DUOUT) XIT

 D RRDT^BARDMU

 ;

101 K ^TMP("BARDME",$J)

 K ^TMP("BARDM",$J)

 K ^TMP("BARDMQN",$J)

 ;

 D ETST

 G:$G(BARQ) XIT2

 G:$D(DUOUT) XIT

 D VAR

 D LET

 D XIT

 Q

XIT ;

 I $D(IO("S")) S IOP="`"_IOS D ^%ZIS

 E  D ^%ZISC

XIT2 ;

 ;I DUZ=838 Q

 K ^TMP("BARDME",$J)

 K ^TMP("BARDM",$J)

 K ^TMP("BARDMQN",$J)  ;

 K ERRT,ERRCT,AGE

 Q

ETST ;ERROR TEST

 ;

 S BAR2PRT=0 ;P.OTT SELECTION MOVED UP - BEFORE CALLING BARDMRE JULY 2013

 S DIR(0)="SO^1:Print only letters w/o errors;2:Print only letters with errors;3:Print Both type of letters;4:Exit without printing"

 S DIR("A")="Select letters to print: "

 D ^DIR

 K DIR

 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BARQ=1 Q

 I X="" G ETST1

 I (X[U)!(X=4) S BARQ=1 Q

 S BAR2PRT=+Y

 ;

 S BARERRCT=0 ;#OF ER ENTRIES IN ^TMP('BARDME' (MULTIPLE REASONS FOR 1 LETTER!)

 D CALC^BARDMRE(2) ;P.OTT : COUNT ONLY DUE PRINT ERR LETTERS

 I BARERRCT>0 D PRINT^BARDMRE ;BARCT=#OF ERR LETTERS

 Q:$G(BARQ)

 Q:BARERRCT=0

ETST1 W !

 Q

TSTPRT ;EP

 D PAR^BARDMU ;GET PARAMETERS (INCL. BARPSRT)

 Q:$G(BARQ)  ;P.OTT HEAT152452 2/10/2014 BAR*1.8*24

 S Y=$$DIR^XBDIR("Y","Do you wish to print a test letter","N")

 Q:+Y<1

 D ^%ZIS

 Q:$D(DUOUT)

 Q:POP

 U IO

 D VAR,VARSET

 S BARMIN=2 ;NOT PAT 4/25/2014 BAR*1.8*24 FIX ADDRESSE'THE GUARDIAN...'

 S CY=1,BARDACG="AUTNINS(",BARL="CYCLE 1"

 S BARDM("INS_NM")="TEST INSURANCE"

 S BARDM("INS_STR")="1234 STREET"

 S BARDM("INS_CTY")="Portland"

 S BARDM("INS_ST")=38

 S BARDM("INS_ZP")=97204

 S BARPAT="TEST PATIENT",BARBILN=1234,BARAMTO=0

 S BARDM("DOS")=""

 S BARPBDT="N"

 S BARRPT="L"

 S BARDTP=DT

 S BARDOB="",BARNPIF="1234567890",BARNPIP="0987654321"

 D PRINT^BARDMLP1

 D ^%ZISC

 G TSTPRT

 Q

VAR ;SET LET VARIABLES

 S BARLEN="" F I=1:1:30 S BARLEN=BARLEN_" "

 S BARPAR1=^BAR(90052.06,BARPIEN,DUZ(2),18)

 S BARAD1=$P(BARPAR1,U),BARAD2=$P(BARPAR1,U,2),BARCTY=$P(BARPAR1,U,3),BARST=$P(BARPAR1,U,4),BARZP=$P(BARPAR1,U,5),BARPH=$P(BARPAR1,U,6)

 S BARPMX=$P(BARPAR1,U,8),BARMRGT=$P(BARPAR1,U,9),BARMRGL=$P(BARPAR1,U,10)

 S BARSG=$P(BARPAR,U,13),BARSG1=$P(BARPAR,U,14),BARSG2=$P(BARPAR,U,15)

 S C=1 F I=5:2:11 S BARPCP(C)=$P(BARPAR,U,I),C=C+1

 S BARNPI=$P(BARPAR,3),BARLDOB=$P(BARPAR,4)

 S:BARMRGT="" BARMRGT=5

 S:BARMRGL="" BARMRGL=3

 S BARFAC=$$VAL^XBDIQ1(9999999.06,DUZ(2),.01)

 K BARPAR,BARPAR1

 Q

VARSET ;RESET VARS

 S BARMIN=0 ;BAR*1.8*24

 S (BARDM("INS"),BARDM("MEMBER"),BARDM("POL_HOLDER_IEN"),BARDM("POL_HOLDER"),BARDM("POL_NUM"),BARDM("POL_DOB"),BARDM("INS_TX"))=""

 Q

LET ;

 ;

 K ^TMP($J,"BARDM")

 NEW BARSORT,BAROK1,BAROK2,BARNOK1,BARNOK2

 S CY=0,BARCT=0,BARQ=0

 S BARTOT=0  ;

 S BAROK1=0,BARNOK1=0 ;P.OTT (TOT)

 S BAROK2=0,BARNOK2=0 ;P.OTT (ACTUAL COUNTS LIMITED BY MAX PRT#)

 F BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D  Q:BARQ

 . S CY=CY+1

 . S BARDM=0 F  S BARDM=$O(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM)) Q:BARDM'?1N.N  D  Q:BARQ

 .. Q:$P(^BARDM(DUZ(2),BARDM,0),U,2)'="A"

 .. I BAR2PRT=1 I $D(^TMP("BARDME",$J,BARDM)) Q   ;PRINT OK ONLY and this is an ERR letter

 .. I BAR2PRT=2 I '$D(^TMP("BARDME",$J,BARDM)) Q  ;PRINT ERR ONLY and this is not an ERR letter

 .. S BARDMC=0,BARDM("DOS")=""

 .. F  S BARDMC=$O(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM,BARDMC)) Q:BARDMC'?1N.N  D  Q:BARQ

 ... I CY'=1 D CYDAY^BARDMRU I BARLQ=0 QUIT

 ... S X=$P(^BARDM(DUZ(2),BARDM,100,BARDMC,0),U,6),X2="2$" D COMMA^%DTC S BARAMTO="$"_$P(X,"$",2)

 ... S BARBIEN=$P(^BARDM(DUZ(2),BARDM,0),U)

 ... I '$D(^BARBL(DUZ(2),BARBIEN,0)) D  Q  ;HEAT118656 BELCOURT P.OTT

 .... I $P($G(^VA(200,DUZ,0)),U,4)'="@" Q

 .... W !,"MISSING DATA IN ^BARBL(",DUZ(2),",",BARBIEN

 ... S BARBILN=$$VAL^XBDIQ1(90053.05,BARDM,.01)

 ... S BARDAC=$P(^BARBL(DUZ(2),BARBIEN,0),U,3),BARDBDT=$P(^(0),U,7),BARD3P=$P(^(0),U,17)

 ... S BARD3PD=$P($G(^BARBL(DUZ(2),BARBIEN,0)),U,22)

 ... I '$D(^ABMDBILL(BARD3PD,BARD3P)) QUIT  ;DUPLICATE BILL / NONEX CLAIM #

 ... S BARDMINS=$P($G(^ABMDBILL(BARD3PD,BARD3P,0)),U,8)

 ... S BARDM("DOS")=$$VAL^XBDIQ1(90050.01,BARBIEN,102)

 ... S BARNPIF=$P($$NPI^XUSNPI("Organization_ID",DUZ(2)),U)

 ... S BARNPIP=$S(+$$GET1^DIQ(90050.01,BARBIEN,113,"I")'=0:$P($$NPI^XUSNPI("Individual_ID",$$GET1^DIQ(90050.01,BARBIEN,113,"I")),U),1:"")

 ... I $P(^BARBL(DUZ(2),BARBIEN,0),U,15)'>0 D  Q  ;P.OTT

 .... W !,"Bill status of ",$P(^BARBL(DUZ(2),BARBIEN,0),U,1)," changed. Flagging DL as PAID."

 .... D PAID(BARDM,BARDMC) Q

 ... D INSTYP^BARDMU

 ... S BARDI=$$VAL^XBDIQ1(90050.02,BARDAC,.01)

 ... I '$D(BARDINS(BARDI))&'$D(BARDINS(BARDITY)) D  Q  ;not insurer type or insurer we are looking for

  ... D POLCHK

 ... S BARTOT=BARTOT+1

 ... I $D(^TMP("BARDME",$J,BARDM)) S BARNOK1=BARNOK1+1

 ... I '$D(^TMP("BARDME",$J,BARDM)) S BAROK1=BAROK1+1

 ... I BARCT<BARPMX D  ;?????DO WE NEED THIS??

 .... I $D(^TMP("BARDME",$J,BARDM)) S BARNOK2=BARNOK2+1

 .... I '$D(^TMP("BARDME",$J,BARDM)) S BAROK2=BAROK2+1

 .... S BARCT=BARCT+1

 .... I BARPSRT="" S ^TMP("BARDM",$J,"PRT",BARCYCLE,BARDMINS,BARDM,BARDMC)=""

 .... I $E(BARPSRT)="P" D  ;POLICYHOLDER,CYCLE,INS

 ..... S BARSORT=BARDM("POL_HOLDER") I BARSORT="" S BARSORT=" "

 ..... S ^TMP("BARDM",$J,"POLHNAME",BARSORT,BARCYCLE,BARDMINS,BARDM,BARDMC)=""

 .... I $E(BARPSRT)="I" D  ;INSNAME,CYCLE

 ..... S BARSORT=BARDM("INS_NM") I BARSORT="" S BARSORT=" "

 ..... S ^TMP("BARDM",$J,"INSNAME",BARSORT,BARCYCLE,BARDMINS,BARDM,BARDMC)=""

 .... I $E(BARPSRT)="C" D  ;CYCLE;INS,POLICYHOLDER

 ..... S BARSORT1=BARDM("INS_NM") I BARSORT1="" S BARSORT1=" "

 ..... S BARSORT2=BARDM("POL_HOLDER") I BARSORT2="" S BARSORT2=" "

 ..... S ^TMP("BARDM",$J,"CYCLE",BARCYCLE,BARSORT1,BARDMINS,BARSORT2,BARDM,BARDMC)=""

 .... S ^TMP("BARDMQN",$J,BARCYCLE,BARDM,BARDMC)=BARDMINS ;for BARDMRQN report (after printing)  ;

 D SUMMARY

 I BARQ QUIT  ;DISPLAY SUMMARY OF LETTERS TO BE PRINTED ;

 D ^%ZIS ;--->SELECT PRINTER

 Q:POP

 U IO

 ;SORT BY: <NIL> P(OLICY HOLDER) I(INSURANCE NAME)

 IF BARPSRT="" D SORT0

 IF $E(BARPSRT)="P" D SORT1

 IF $E(BARPSRT)="I" D SORT2

 IF $E(BARPSRT)="C" D SORT3

 D ^%ZISC  ;CLOSE PRINTER

 ;--------TERMINAL IO ----------------------

 D  Q:Y<1

 . S Y=$$DIR^XBDIR("Y","Do you wish to display the print report","Y")

 . I +Y<1 Q

 . D ^BARDMRQN ;DISPLAY PRINT REPORT

 . K DIR S (X,Y)=""

 . S DIR(0)="E"

 . S DIR("A")="Hit ENTER to continue"

 . D ^DIR

 . K DIR

 Q

SORT0 S CY=0

 F BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D

 . S CY=CY+1,BARDMINS="" F  S BARDMINS=$O(^TMP("BARDM",$J,"PRT",BARCYCLE,BARDMINS)) Q:'BARDMINS  D

 . . S BARDM=0 F  S BARDM=$O(^TMP("BARDM",$J,"PRT",BARCYCLE,BARDMINS,BARDM)) Q:'BARDM  D

 . . .S BARDMC=0 F  S BARDMC=$O(^TMP("BARDM",$J,"PRT",BARCYCLE,BARDMINS,BARDM,BARDMC)) Q:'BARDMC  D ONEDM

 Q

SORT1 ;

 S BARSORT="" F  S BARSORT=$O(^TMP("BARDM",$J,"POLHNAME",BARSORT)) Q:BARSORT=""  D

 . S CY=0 F BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D

 . . S CY=CY+1,BARDMINS="" F  S BARDMINS=$O(^TMP("BARDM",$J,"POLHNAME",BARSORT,BARCYCLE,BARDMINS)) Q:'BARDMINS  D

 . . . S BARDM=0 F  S BARDM=$O(^TMP("BARDM",$J,"POLHNAME",BARSORT,BARCYCLE,BARDMINS,BARDM)) Q:'BARDM  D

 . . . . S BARDMC=0 F  S BARDMC=$O(^TMP("BARDM",$J,"POLHNAME",BARSORT,BARCYCLE,BARDMINS,BARDM,BARDMC)) Q:'BARDMC  D ONEDM

 Q

SORT2 ;

 S BARSORT="" F  S BARSORT=$O(^TMP("BARDM",$J,"INSNAME",BARSORT)) Q:BARSORT=""  D

 . S CY=0 F BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D

 . . S CY=CY+1,BARDMINS="" F  S BARDMINS=$O(^TMP("BARDM",$J,"INSNAME",BARSORT,BARCYCLE,BARDMINS)) Q:'BARDMINS  D

 . . . S BARDM=0 F  S BARDM=$O(^TMP("BARDM",$J,"INSNAME",BARSORT,BARCYCLE,BARDMINS,BARDM)) Q:'BARDM  D

 . . . . S BARDMC=0 F  S BARDMC=$O(^TMP("BARDM",$J,"INSNAME",BARSORT,BARCYCLE,BARDMINS,BARDM,BARDMC)) Q:'BARDMC  D ONEDM

 Q

SORT3 S CY=0

 F BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D

 . S CY=CY+1,BARSORT1="" F  S BARSORT1=$O(^TMP("BARDM",$J,"CYCLE",BARCYCLE,BARSORT1)) Q:BARSORT1=""  D

 . . S BARDMINS="" F  S BARDMINS=$O(^TMP("BARDM",$J,"CYCLE",BARCYCLE,BARSORT1,BARDMINS)) Q:'BARDMINS  D

 . . . S BARSORT2="" F  S BARSORT2=$O(^TMP("BARDM",$J,"CYCLE",BARCYCLE,BARSORT1,BARDMINS,BARSORT2)) Q:BARSORT2=""  D

 . . . . S BARDM=0 F  S BARDM=$O(^TMP("BARDM",$J,"CYCLE",BARCYCLE,BARSORT1,BARDMINS,BARSORT2,BARDM)) Q:'BARDM  D

 . . . . . S BARDMC=0 F  S BARDMC=$O(^TMP("BARDM",$J,"CYCLE",BARCYCLE,BARSORT1,BARDMINS,BARSORT2,BARDM,BARDMC)) Q:'BARDMC  D ONEDM

 Q

ONEDM ;

 S BARDM("DOS")=""

 S X=$P(^BARDM(DUZ(2),BARDM,100,BARDMC,0),U,6),X2="2$" D COMMA^%DTC S BARAMTO="$"_$P(X,"$",2)

 S BARBIEN=$P(^BARDM(DUZ(2),BARDM,0),U)

 S BARBILN=$$VAL^XBDIQ1(90053.05,BARDM,.01)

 S BARDAC=$P(^BARBL(DUZ(2),BARBIEN,0),U,3),BARDBDT=$P(^(0),U,7),BARD3P=$P(^(0),U,17)

 S BARD3PD=$P($G(^BARBL(DUZ(2),BARBIEN,0)),U,22)

 S BARDM("DOS")=$$VAL^XBDIQ1(90050.01,BARBIEN,102)

 S BARDOB=$$GET1^DIQ(2,BARDM("PAT_IEN"),".03","E") ;P.OTT

 S BARNPIF=$P($$NPI^XUSNPI("Organization_ID",DUZ(2)),U)

 S BARNPIP=$S(+$$GET1^DIQ(90050.01,BARBIEN,113,"I")'=0:$P($$NPI^XUSNPI("Individual_ID",$$GET1^DIQ(90050.01,BARBIEN,113,"I")),U),1:"")

 D INSTYP^BARDMU

 S BARDI=$$VAL^XBDIQ1(90050.02,BARDAC,.01)

 I $P(^BARBL(DUZ(2),BARBIEN,0),U,15)'>0 Q

 D POLCHK

 D PRINT^BARDMLP1

 D CYUP

 D LGUP

 Q

POLCHK ;TEST FOR POLICY NO, POLICY HOLDER AND POLICY HOLDER DOB

 S BARMIN=0 ;BAR*1.8*24

 I BARDACG'="VA(" D

 . S BARDM("PAT_IEN")=$P(^BARBL(DUZ(2),BARBIEN,1),U)

 . S BARHRN=$P($G(^AUPNPAT(BARDM("PAT_IEN"),41,DUZ(2),0)),U,2)

 . S BARPAT=$P(^DPT(BARDM("PAT_IEN"),0),U)

 . S BARDOB=$$GET1^DIQ(2,BARDM("PAT_IEN"),".03","E")

 D VARSET

 ;I BARDACG="AUTNINS(" D INSCHK ;OLD CODE

 I BARDACG="AUTNINS(" D INSCHK S BARMIN=2 ;NOT A PAT 12/04/2013

 I BARDACG="AUPNPAT(" D PATCHK

 I BARDACG="VA(" D PERCHK

 Q

INSCHK ;

 S BARDM("INS")=^AUTNINS(BARDACI,0)

 S BARDM("INS_NM")=$P(BARDM("INS"),U),BARDM("INS_STR")=$P(BARDM("INS"),U,2)

 S BARDM("INS_CTY")=$P(BARDM("INS"),U,3),BARDM("INS_ST")=$P(BARDM("INS"),U,4)

 S BARDM("INS_ZP")=$P(BARDM("INS"),U,5)

 S BARDM("INS_TX")=$P(BARDM("INS"),U,11)

 S BARTST=0

 I $D(^ABMDBILL(BARD3PD,BARD3P,13,"B",BARDACI)) D

 .S BARL="",BARL=$O(^ABMDBILL(BARD3PD,BARD3P,13,"B",BARDACI,BARL))

 .D INSCHK1

 Q:BARTST=1

 S BARL=0 F  S BARL=$O(^ABMDBILL(BARD3PD,BARD3P,13,BARL)) Q:BARL'?1N.N  D  Q:BARTST=1

 .I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,11)=BARDACI D INSCHK1

 ;end new code

 Q

INSCHK1 ;

 I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,4)'="" D MCR^BARDMRE Q  ;MCR^BARDMRE UPDATED FOR NMCI P27 IHS/DIT/CPC - 20171031

 I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,5)'="" D RR^BARDMRE Q   ;RR^BARDMRE UPDATED FOR NMCI P27 IHS/DIT/CPC - 20171031

 I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,7)'="" D MCD^BARDMRE Q

 I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,8)'="" D PRVT^BARDMRE Q

 ;end new code

 Q

PATCHK ;

 S BARDM("INS_NM")=$P(BARPAT,",",2)_" "_$P(BARPAT,",",1)_" "_$P(BARPAT,",",3)

 S BARDM("INS_STR")=$$VAL^XBDIQ1(2,BARDM("PAT_IEN"),.111)

 S BARDM("INS_CTY")=$$VAL^XBDIQ1(2,BARDM("PAT_IEN"),.114)

 ;S BARDM("INS_ST")=$P(^DPT(BARDM("PAT_IEN"),.11),U,5)

 S BARDM("INS_ST")=$P($G(^DPT(BARDM("PAT_IEN"),.11)),U,5)

 S BARDM("INS_ZP")=$$VAL^XBDIQ1(2,BARDM("PAT_IEN"),.116)

 ;**CHECK AND SET BARMIN FOR MINOR OR NOT

 S X1=$$VALI^XBDIQ1(90050.01,BARBIEN,102)

 S X2=$$VALI^XBDIQ1(2,BARDM("PAT_IEN"),.03)

 D ^%DTC S AGE=X\365.25 S:AGE>17 BARMIN=1

 Q

PERCHK ;

 S BARPAT=$$VAL^XBDIQ1(200,BARDACI,.01)

 S BARDM("INS_NM")=$P(BARPAT,",",2)_" "_$P(BARPAT,",",1)_" "_$P(BARPAT,",",3)

 S BARDM("INS_STR")=$$VAL^XBDIQ1(200,BARDACI,.111)

 S BARDM("INS_CTY")=$$VAL^XBDIQ1(200,BARDACI,.114)

 S BARDM("INS_ST")=$$VAL^XBDIQ1(200,BARDACI,.115)

 S BARDM("INS_ZP")=$$VAL^XBDIQ1(200,BARDACI,.116)

 Q

CYUP ;CYCLE UPDATE - SET LETTER STATUS AND QUE

 S (DIC,DIE)="^BARDM(DUZ(2),"_BARDM_",100,",DA(1)=BARDM,DA=BARDMC

 ;S DR=".03///P;.04///"_DUZ_";.05///"_DT ;OLD CODE

 S DR=".03////P;.04////"_DUZ_";.05////"_DT ;P.OTT FIX FOR YAKAMA '??'

 D ^DIE

 I CY=4 K DIE,DIC,DA,DR Q

 ;SET NEW LETTER STATUS AND QUE

 S DIC(0)="L",X="CYCLE "_(CY+1)

 D ^DIC

 Q:+Y<0

 S DA=+Y

 S DR=".02///"_BARPCP(CY+1)_";.03///Q"_";.06///"_$P(^BARBL(DUZ(2),BARBIEN,0),U,15)

 D ^DIE

 K DIE,DIC,DA,DR

 Q

LGADD ;ENTRY TO LOG FILE

 D NOW^%DTC

 S DIC(0)="L",DIC="^BARDMLG("_DUZ(2)_","

 S X=%

 D ^DIC

 S BARLG=+Y

 K DA

 Q

LGCYL ;ADD CYCLE TO LOG FILE

 S DA(1)=BARLG

 S DIC(0)="L",DIC="^BARDMLG("_DUZ(2)_","_BARLG_",100,"

 S DIC("P")=$P(^DD(90053.08,100,0),U,2)

 S X=BARCYCLE

 D ^DIC

 S BARLGC=+Y

 K DA

 Q

LGUP ;ADD BILL TO LOG FILE

 I '$D(BARLG) D LGADD ;GET NEW BATCH IEN

 I $D(^BARDMLG(DUZ(2),BARLG,100,"B",BARCYCLE)) S BARLGC=$O(^BARDMLG(DUZ(2),BARLG,100,"B",BARCYCLE,"")) ;P.OTT 9/18/2013

 I '$D(^BARDMLG(DUZ(2),BARLG,100,"B",BARCYCLE)) D LGCYL ;;GET NEW SUBFILE IEN

 K DIC,DIE,DIR,X,Y,DA,DR

 S DA(2)=BARLG

 S DA(1)=BARLGC

 S DIC(0)="L"

 S DIC="^BARDMLG("_DUZ(2)_","_BARLG_",100,"_BARLGC_",10,"

 S DIC("P")=$P(^DD(90053.09,10,0),U,2)

 S X=BARBILN

 D ^DIC

 S $P(^BARDMLG(DUZ(2),BARLG,100,BARLGC,0),U,2)=$P(^BARDMLG(DUZ(2),BARLG,100,BARLGC,0),U,2)+1

 Q

SUMMARY ;

 S BARQ=0

 D UNDL

 W !,"            # of letters in queue : ",$J(BARTOT,6)

 I BAR2PRT=2 W " with errors."

 I BAR2PRT>2 W " incl. ",BARNOK1," letter(s) with errors."

 I BARTOT W !,"# of letters that will be printed : ",$J(BAROK2+BARNOK2,6)

 I BARTOT>BARPMX W !,"NOTE: According to the parameter setup only ",BARPMX," letters will be printed."

 D UNDL

 ;

 K DIR S (X,Y)=""

 S DIR(0)="E"

 I 'BARTOT S DIR("A")="There is nothing to print. Hit ENTER to quit"

 I BARTOT S DIR("A")="Hit ENTER to continue printing, or ^ to quit (no printing)"

 D ^DIR

 K DIR

 I X="^" S BARQ=1

 I 'BARTOT S BARQ=1

 QUIT

UNDL ;

 NEW BARTMP

 W ! F BARTMP=1:1:78 W "-"

 Q

PAID(BARDM,BARDMC) ;SET THE PRINT QUEUED STATUS TO NOT QUEUED AND BILL STATUS TO PAID ;P.OTT

 S DIE="^BARDM("_DUZ(2)_","_BARDM_",100,",DA(1)=BARDM,DA=BARDMC

 S DR=".03///N"

 D ^DIE

 K DIE,DA,DR

 S DIE="^BARDM("_DUZ(2)_",",DA=BARDM,DR=".02///P"

 D ^DIE

 K DIE,DA,DR

 Q  ;EOR--

BARDMLP   ;IHS/OIT/FCJ - 1 OF 2 ;DEBT MANAGEMENT PRINT LETTERS

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,24,27**;OCT 26, 2005;Build 12

 +2       ;vc; Version BARDMLP.INT/BAR.1  Date 31-Oct-17  By User  Location BAR$M

 +3       ;vc; Component name INT.BARDMLP  Routine name: BARDMLP

 +4       ;New routine 5-12-2011 for Debt Letter Management

 +5       ; Routine to print letters

 +6       ; IHS/SD/POTT HEAT91638 NOV 2012 fixed pat DOB - BAR*1.8*23

 +7       ; IHS/SD/POTT HEAT ;JAN 2013 ADDED SORTING OPTION -BAR*1.8*23

 +8       ; IHS/SD/POTT HEAT ;APR 2013 FIXED BARPOC (INCL ERR LETTERS) - BAR*1.8*23

 +9       ; IHS/SD/POTT HEAT ;MAY 2013 CHK / SET STATUS 'PAID' - BAR*1.8*23

 +10      ; IHS/SD/POTT HEAT ;JUN 2013 RESOLVED '??' - BAR*1.8*23

 +11      ; IHS/SD/POTT HEAT118656 BELCOURT: SKIP UNDEF ENTRY IN ^BARBL - BAR*1.8*24

 +12      ; IHS/SD/POTT HEAT143490 12/04/14 FIX ADDRESSE'THE GUARDIAN...' IF INS. - BAR*1.8*24

 +13      ; IHS/SD/POTT HEAT152452 2/10/14 CHK IF PAR/SAT FILE CORECTLY SET UP - BAR*1.8*24

 +14      ; IHS/DIT/CPC New Medicare Card Initiative CR09275 11/3/2017 - BAR*1.8*27

ST        ;

 +1        SET BARRPT="L"

 +2        WRITE @IOF

 +3        DO TSTPRT

 +4       ;P.OTT HEAT152452 2/10/2014

           IF $GET(BARQ)

               QUIT 

 +5        IF $DATA(DUOUT)

               GOTO XIT

 +6        DO RRDT^BARDMU

 +7       ;

101        KILL ^TMP("BARDME",$JOB)

 +1        KILL ^TMP("BARDM",$JOB)

 +2        KILL ^TMP("BARDMQN",$JOB)

 +3       ;

 +4        DO ETST

 +5        IF $GET(BARQ)

               GOTO XIT2

 +6        IF $DATA(DUOUT)

               GOTO XIT

 +7        DO VAR

 +8        DO LET

 +9        DO XIT

 +10       QUIT 

XIT       ;

 +1        IF $DATA(IO("S"))

               SET IOP="`"_IOS

               DO ^%ZIS

 +2       IF '$TEST

               DO ^%ZISC

XIT2      ;

 +1       ;I DUZ=838 Q

 +2        KILL ^TMP("BARDME",$JOB)

 +3        KILL ^TMP("BARDM",$JOB)

 +4       ;

           KILL ^TMP("BARDMQN",$JOB)

 +5        KILL ERRT,ERRCT,AGE

 +6        QUIT 

ETST      ;ERROR TEST

 +1       ;

 +2       ;P.OTT SELECTION MOVED UP - BEFORE CALLING BARDMRE JULY 2013

           SET BAR2PRT=0

 +3        SET DIR(0)="SO^1:Print only letters w/o errors;2:Print only letters with errors;3:Print Both type of letters;4:Exit without printing"

 +4        SET DIR("A")="Select letters to print: "

 +5        DO ^DIR

 +6        KILL DIR

 +7        IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               SET BARQ=1

               QUIT 

 +8        IF X=""

               GOTO ETST1

 +9        IF (X[U)!(X=4)

               SET BARQ=1

               QUIT 

 +10       SET BAR2PRT=+Y

 +11      ;

 +12      ;#OF ER ENTRIES IN ^TMP('BARDME' (MULTIPLE REASONS FOR 1 LETTER!)

           SET BARERRCT=0

 +13      ;P.OTT : COUNT ONLY DUE PRINT ERR LETTERS

           DO CALC^BARDMRE(2)

 +14      ;BARCT=#OF ERR LETTERS

           IF BARERRCT>0

               DO PRINT^BARDMRE

 +15       IF $GET(BARQ)

               QUIT 

 +16       IF BARERRCT=0

               QUIT 

ETST1      WRITE !

 +1        QUIT 

TSTPRT    ;EP

 +1       ;GET PARAMETERS (INCL. BARPSRT)

           DO PAR^BARDMU

 +2       ;P.OTT HEAT152452 2/10/2014 BAR*1.8*24

           IF $GET(BARQ)

               QUIT 

 +3        SET Y=$$DIR^XBDIR("Y","Do you wish to print a test letter","N")

 +4        IF +Y<1

               QUIT 

 +5        DO ^%ZIS

 +6        IF $DATA(DUOUT)

               QUIT 

 +7        IF POP

               QUIT 

 +8        USE IO

 +9        DO VAR

           DO VARSET

 +10      ;NOT PAT 4/25/2014 BAR*1.8*24 FIX ADDRESSE'THE GUARDIAN...'

           SET BARMIN=2

 +11       SET CY=1

           SET BARDACG="AUTNINS("

           SET BARL="CYCLE 1"

 +12       SET BARDM("INS_NM")="TEST INSURANCE"

 +13       SET BARDM("INS_STR")="1234 STREET"

 +14       SET BARDM("INS_CTY")="Portland"

 +15       SET BARDM("INS_ST")=38

 +16       SET BARDM("INS_ZP")=97204

 +17       SET BARPAT="TEST PATIENT"

           SET BARBILN=1234

           SET BARAMTO=0

 +18       SET BARDM("DOS")=""

 +19       SET BARPBDT="N"

 +20       SET BARRPT="L"

 +21       SET BARDTP=DT

 +22       SET BARDOB=""

           SET BARNPIF="1234567890"

           SET BARNPIP="0987654321"

 +23       DO PRINT^BARDMLP1

 +24       DO ^%ZISC

 +25       GOTO TSTPRT

 +26       QUIT 

VAR       ;SET LET VARIABLES

 +1        SET BARLEN=""

           FOR I=1:1:30

               SET BARLEN=BARLEN_" "

 +2        SET BARPAR1=^BAR(90052.06,BARPIEN,DUZ(2),18)

 +3        SET BARAD1=$PIECE(BARPAR1,U)

           SET BARAD2=$PIECE(BARPAR1,U,2)

           SET BARCTY=$PIECE(BARPAR1,U,3)

           SET BARST=$PIECE(BARPAR1,U,4)

           SET BARZP=$PIECE(BARPAR1,U,5)

           SET BARPH=$PIECE(BARPAR1,U,6)

 +4        SET BARPMX=$PIECE(BARPAR1,U,8)

           SET BARMRGT=$PIECE(BARPAR1,U,9)

           SET BARMRGL=$PIECE(BARPAR1,U,10)

 +5        SET BARSG=$PIECE(BARPAR,U,13)

           SET BARSG1=$PIECE(BARPAR,U,14)

           SET BARSG2=$PIECE(BARPAR,U,15)

 +6        SET C=1

           FOR I=5:2:11

               SET BARPCP(C)=$PIECE(BARPAR,U,I)

               SET C=C+1

 +7        SET BARNPI=$PIECE(BARPAR,3)

           SET BARLDOB=$PIECE(BARPAR,4)

 +8        IF BARMRGT=""

               SET BARMRGT=5

 +9        IF BARMRGL=""

               SET BARMRGL=3

 +10       SET BARFAC=$$VAL^XBDIQ1(9999999.06,DUZ(2),.01)

 +11       KILL BARPAR,BARPAR1

 +12       QUIT 

VARSET    ;RESET VARS

 +1       ;BAR*1.8*24

           SET BARMIN=0

 +2        SET (BARDM("INS"),BARDM("MEMBER"),BARDM("POL_HOLDER_IEN"),BARDM("POL_HOLDER"),BARDM("POL_NUM"),BARDM("POL_DOB"),BARDM("INS_TX"))=""

 +3        QUIT 

LET       ;

 +1       ;

 +2        KILL ^TMP($JOB,"BARDM")

 +3        NEW BARSORT,BAROK1,BAROK2,BARNOK1,BARNOK2

 +4        SET CY=0

           SET BARCT=0

           SET BARQ=0

 +5       ;

           SET BARTOT=0

 +6       ;P.OTT (TOT)

           SET BAROK1=0

           SET BARNOK1=0

 +7       ;P.OTT (ACTUAL COUNTS LIMITED BY MAX PRT#)

           SET BAROK2=0

           SET BARNOK2=0

 +8        FOR BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4"

               Begin DoDot:1

 +9                SET CY=CY+1

 +10               SET BARDM=0

                   FOR 

                       SET BARDM=$ORDER(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM))

                       IF BARDM'?1N.N

                           QUIT 

                       Begin DoDot:2

 +11                       IF $PIECE(^BARDM(DUZ(2),BARDM,0),U,2)'="A"

                               QUIT 

 +12      ;PRINT OK ONLY and this is an ERR letter

                           IF BAR2PRT=1

                               IF $DATA(^TMP("BARDME",$JOB,BARDM))

                                   QUIT 

 +13      ;PRINT ERR ONLY and this is not an ERR letter

                           IF BAR2PRT=2

                               IF '$DATA(^TMP("BARDME",$JOB,BARDM))

                                   QUIT 

 +14                       SET BARDMC=0

                           SET BARDM("DOS")=""

 +15                       FOR 

                               SET BARDMC=$ORDER(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM,BARDMC))

                               IF BARDMC'?1N.N

                                   QUIT 

                               Begin DoDot:3

 +16                               IF CY'=1

                                       DO CYDAY^BARDMRU

                                       IF BARLQ=0

                                           QUIT 

 +17                               SET X=$PIECE(^BARDM(DUZ(2),BARDM,100,BARDMC,0),U,6)

                                   SET X2="2$"

                                   DO COMMA^%DTC

                                   SET BARAMTO="$"_$PIECE(X,"$",2)

 +18                               SET BARBIEN=$PIECE(^BARDM(DUZ(2),BARDM,0),U)

 +19      ;HEAT118656 BELCOURT P.OTT

                                   IF '$DATA(^BARBL(DUZ(2),BARBIEN,0))

                                       Begin DoDot:4

 +20                                       IF $PIECE($GET(^VA(200,DUZ,0)),U,4)'="@"

                                               QUIT 

 +21                                       WRITE !,"MISSING DATA IN ^BARBL(",DUZ(2),",",BARBIEN

                                       End DoDot:4