Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARDMU

BARDMU.m

Go to the documentation of this file. 
  1. BARDMU ;IHS/OIT/FCJ - DEBT MANAGEMENT UTILITY ROUTINE ; 26 May 2011  8:33 AM
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,24**;OCT 26, 2005;Build 69
  1.  ;New routine 5-12-2011 for Debt Letter Management
  1.  ;IHS/SD/POT JAN  2013 ADDED SORTING PARAMETER, PRT BILL DATE (TO SITE PARAMETERS) - BAR*1.8*.23
  1.  ;IHS/SD/POT FEB  2013 CHANGED PTR TO INSURER TYPE - BAR*1.8*.23
  1.  ;IHS/SD/POT JUL 2013 HEAT118656 BELCOURT: SKIP UNDEF ENTRY IN ^BARBL - BAR*1.8*.24
  1.  ;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP  - BAR*1.8*.24
  1. PAR ;EP;SET LETTER PARAMETERS
  1.  S BARPIEN="",BARPNM=""
  1.  S BARPIEN=$P($G(^BAR(90052.05,DUZ(2),DUZ(2),0)),U,3) ;- BAR*1.8*.24
  1.  I BARPIEN="" D  Q
  1.  . W !!!,$P(^DIC(4,DUZ(2),0),U)," IS NOT REGIONALLY SETUP"
  1.  . W !,"CONTACT YOUR A/R MANAGER",*7
  1.  . S BARQ=1
  1.  . D EOP
  1.  ;END OF NEW CODE
  1.  S BARPNM=$P(^AUTTLOC(BARPIEN,0),U,2)
  1.  S BARPAR=^BAR(90052.06,BARPIEN,DUZ(2),17)
  1.  S BARPAR1=^BAR(90052.06,BARPIEN,DUZ(2),18)  ;bar*1.8*22 SDR
  1.  S (BARPSDI,Y)=$P(BARPAR,U)
  1.  I Y D DD^%DT S BARPSDX=Y
  1.  S BARPWO=$P(BARPAR,U,2),BARPNPI=$$VAL^XBDIQ1(90052.06,DUZ(2),1703)
  1.  S BARPDOB=$$VALI^XBDIQ1(90052.06,DUZ(2),1704)="Y"
  1.  S BARPBDT=$$VALI^XBDIQ1(90052.06,DUZ(2),1901)="Y" ;BILL DATE ;- BAR*1.8*.23
  1.  S BARPSRT=$$VALI^XBDIQ1(90052.06,DUZ(2),1902) ;SORT BY <NIL>,P(OLICY HOLDER), I(INSURANCE NAME)
  1.  ;CYCLE LETTER AND PERIOD
  1.  S C=1
  1.  F I=1:2:8 S BARPCL(C)=$$VAL^XBDIQ1(90052.06,DUZ(2),1704+I),C=C+1
  1.  S C=1
  1.  F I=1:2:8 S BARPCD(C)=$$VAL^XBDIQ1(90052.06,DUZ(2),1705+I),C=C+1
  1.  ;LAST RUN DATE FOR BILL SEARCH
  1.  S BARDRDT=$P($G(^BAR(90052.06,BARPIEN,DUZ(2),18)),U,7)
  1.  S BARPMX=$P($G(^BAR(90052.06,BARPIEN,DUZ(2),18)),U,8)
  1.  Q
  1.  ;
  1. INS ;EP;BAR DL SITE PARAM ACCOUNT OPTION
  1.  ;ADD INSURER TYPES TO BE TESTED TO PRINT LETTERS
  1.  D PAR
  1.  S BARQ=0,BARCT=0
  1.  I $D(^BAR(90052.06,BARPIEN,DUZ(2),19)) S BARB=0 F  S BARB=$O(^BAR(90052.06,BARPIEN,DUZ(2),19,BARB)) Q:BARB'?1N.N  D
  1.  .S BARB1=$P(^BAR(90052.06,BARPIEN,DUZ(2),19,BARB,0),U)
  1.  .S BARI(BARB1)=$P(^BAR(90053.03,BARB1,0),U,2),BARCT=BARCT+1
  1.  ;
  1.  I '$D(^BAR(90052.06,BARPIEN,DUZ(2),19,0)) S ^(0)="^90052.0603P^^0"
  1.  S DIE="^BAR(90052.06,"_BARPIEN_",",DA=DUZ(2),DR=1900
  1.  W ! D ^DIE
  1.  I $D(^BAR(90052.06,BARPIEN,DUZ(2),19)) S BARB=0 F  S BARB=$O(^BAR(90052.06,BARPIEN,DUZ(2),19,BARB)) Q:BARB'?1N.N  D
  1.  .I $D(BARI($P(^BAR(90052.06,BARPIEN,DUZ(2),19,BARB,0),U))) K BARI($P(^BAR(90052.06,BARPIEN,DUZ(2),19,BARB,0),U)) S BARCT=BARCT-1
  1.  I BARCT>0 D DEL
  1.  K BARQ,BARI,DIE,DR,DA
  1.  ;
  1. ACC ;ACCOUNT SELECTION
  1.  ;ADD ACCOUNTS TO BE TESTED TO PRINT LETTERS
  1.  S BARQ=0
  1.  S (DIE,DIC)="^BARAC("_DUZ(2)_",",DIC(0)="AEQZ",DR=7
  1.  F  D  Q:BARQ
  1.  .W ! D ^DIC
  1.  .I $D(Y),+Y<0 S BARQ=1 Q
  1.  .I $D(Y),+Y>0 S DA=+Y D ^DIE S $P(^BAR(90052.06,BARPIEN,DUZ(2),18,0),U,7)=0 I %="NO" S BARI(DA)=DA
  1.  D:$D(BARI) DELA
  1.  K BARQ,DIE,DIC,DA,DR
  1.  Q
  1.  ;
  1. DEL ;DELETE ENTRIES FROM BILL FILE IF LETTERS HAVE NOT BEEN PRINTED
  1.  W !,"Deleting entries from Bill file if letters do not exist for deleted Insurer type."
  1.  S BARB=0 F  S BARB=$O(^BARDM(DUZ(2),"S","Q","CYCLE 1",BARB)) Q:BARB'?1N.N  D
  1.  . S BARBIEN=$P(^BARDM(DUZ(2),BARB,0),U)
  1.  . I '$D(^BARBL(DUZ(2),BARBIEN,0)) D  Q  ;HEAT118656 BELCOURT P.OTT
  1.  .. I $P($G(^VA(200,DUZ,0)),U,4)'="@" Q
  1.  .. W !,"MISSING DATA IN ^BARBL(",DUZ(2),",",BARBIEN
  1.  .. Q
  1.  .S BARDAC=$P(^BARBL(DUZ(2),BARBIEN,0),U,3)
  1.  .D INSTYP
  1.  .S BARB1=0 F  S BARB1=$O(BARI(BARB1)) Q:BARB1'?1N.N  I BARI(BARB1)=BARDITY S DIK="^BARDM("_DUZ(2)_",",DA=BARB D ^DIK  ;bar*1.8*22 SDR
  1.  .K DIK
  1.  Q
  1.  ;
  1. DELA ;DELETE ACCOUNTS
  1.  W !,"Deleting entries from Bill file if letters do not exist for deleted Account."
  1.  S BARB=0 F  S BARB=$O(^BARDM(DUZ(2),"S","Q","CYCLE 1",BARB)) Q:BARB'?1N.N  D
  1.  .S BARBIEN=$P(^BARDM(DUZ(2),BARB,0),U)
  1.  . I '$D(^BARBL(DUZ(2),BARBIEN,0)) D  Q  ;HEAT118656 BELCOURT P.OTT - BAR*1.8*.24
  1.  .. I $P($G(^VA(200,DUZ,0)),U,4)'="@" Q
  1.  .. W !,"MISSING DATA IN ^BARBL(",DUZ(2),",",BARBIEN
  1.  .. Q
  1.  . S BARDAC=$P(^BARBL(DUZ(2),BARBIEN,0),U,3) I BARDAC=168 W !,BARB
  1.  . I $D(BARI(BARDAC)) S DIK="^BARDM("_DUZ(2)_",",DA=BARB D ^DIK
  1.  . K DIK
  1.  Q
  1.  ;
  1. INSTYP ;EP
  1.  ;$$GET1^DIQ(9999999.18,BARIIEN,.211,"I")=21
  1.  ;$$GET1^DIQ(9999999.18,BARIIEN,.211,"E")="VETERANS ADMINISTRATION"
  1.  ;$$GET1^DIQ(9999999.18,BARIIEN,.211)="VETERANS ADMINISTRATION"
  1.  S BARDACI=0 ;ACCT .01 VAR POINTER
  1.  S BARDACG=0  ;ACCT .01 VAR GLB
  1.  S BARDITY=""
  1.  S BARDACI=$P($P(^BARAC(DUZ(2),BARDAC,0),U),";")
  1.  S BARDACG=$P($P(^BARAC(DUZ(2),BARDAC,0),U),";",2)
  1.  S BARDITY=$$GET1^DIQ(90050.02,BARDAC,"1.08","E")  ;bar*1.8*22 SDR (=>MEDICARE FI)
  1.  I BARDACG="AUTNINS(" S BARDIT=$$VAL^XBDIQ1(9999999.18,BARDACI,.211) Q  ;(=>MEDICARE FI)
  1.  S BARDIT=$S(BARDACG="VA(":"NEW PERSON",BARDACG="AUPNPAT(":"PATIENT","AUTTVNDR(":"VENDOR",1:"OTHER")
  1.  Q
  1.  ;
  1. ZIS ;EP;
  1.  W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
  1.  I $D(DIRUT) S BARQUIT="" Q
  1.  S BAROPT=Y
  1.  Q
  1. RRDT ;EP;REPORT RUN DATE
  1.  D BARPSAT^BARUTL0
  1.  S Y=DT
  1.  D DD^%DT S BARRDT=Y
  1.  S BARPG=0  ;bar*1.8*22 SDR
  1.  Q
  1. RTRN ;EP - ask usr to press RET
  1.  S BARDLQ=0
  1.  I IOST["C-",'$D(IO("S")) W ! S Y=$$DIR^XBDIR("E","Press RETURN To Continue ^ to Cancel...","","","",1) X ^%ZOSF("TRMRD") I Y=0!(Y=27)!(X=U) S BARDLQ=1
  1.  Q
  1. SEL ;EP;SELECT BILL
  1.  S (BARQ,BARREQ)=0
  1.  S (DIE,DIC)="^BARDM("_DUZ(2)_","
  1.  S DIC("A")="Enter the Debt Management Bill: "
  1.  S DIC(0)="AEQ"
  1.  D ^DIC
  1.  I +Y<1 S BARQ=1 Q
  1.  S BARDM=+Y
  1.  Q
  1. EOP ;EP
  1.  Q:$G(IOT)'["TRM"
  1.  Q:$E($G(IOST))'="C"
  1.  Q:$D(IO("S"))
  1.  Q:$D(ZTQUEUED)
  1.  K DIR
  1.  S DIR(0)="E"
  1.  S DIR("A")="Enter RETURN to continue"
  1.  D ^DIR
  1.  K DIR
  1.  Q