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

BARAWOR.m

Go to the documentation of this file. 
  1. BARAWOR ; IHS/SD/LSL - ADJUSTMENT AND REFUND REPORT RPT
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**10,23**;OCT 26, 2005
  1.  ; NEW ROUTINE BAR*1.8*10
  1.  ; JULY 2013 P.OTT ADDED NEW INS TYPES
  1.  ;************************************************************
  1. START ; EP
  1.  ; Collections report using FM print
  1.  ;
  1. S ;
  1.  N DIR
  1.  S DIR(0)="S^D:DETAIL;S:SUMMARY"
  1.  S DIR("A")="Select Report Type"
  1.  D ^DIR
  1.  S BARRDET=Y
  1.  K DIR
  1.  ;S DIR(0)="S^R:MEDICARE;D:MEDICAID;P:PRIVATE INS;H:HMO;M:MEDICARE SUPPL;W:WORKMEN'S COMP;C:CHAMPUS;F:FRATERNAL ORG;N:NON-INDIAN (NON-BEN);I:INDIAN (BENEFICIARY);K:SCHIP;T:TPL;MD:MEDICARE PART D;MH:MEDICARE HMO;A:ALL"
  1.  S DIR("A")="Select Type of Insurer"
  1.  S DIR(0)="SO^R:MEDICARE"
  1.  S DIR(0)=DIR(0)_";D:MEDICAID"
  1.  S DIR(0)=DIR(0)_";P:PRIVATE INSURANCE"
  1.  S DIR(0)=DIR(0)_";H:HMO"
  1.  S DIR(0)=DIR(0)_";M:MEDICARE SUPPL"
  1.  S DIR(0)=DIR(0)_";W:WORKMEN'S COMP"
  1.  S DIR(0)=DIR(0)_";C:CHAMPUS"
  1.  S DIR(0)=DIR(0)_";F:FRATERNAL ORG"
  1.  S DIR(0)=DIR(0)_";N:NON-BENEFICIARY PATIENTS"
  1.  S DIR(0)=DIR(0)_";I:BENEFICIARY PATIENTS"
  1.  S DIR(0)=DIR(0)_";T:TPL"
  1.  S DIR(0)=DIR(0)_";MD:MEDICARE PART D"
  1.  S DIR(0)=DIR(0)_";MH:MEDICARE HMO"
  1.  ;S DIR(0)=DIR(0)_";FPL:MEDICAID" ;FPL 133 PERCENT
  1.  S DIR(0)=DIR(0)_";K:CHIP"
  1.  S DIR(0)=DIR(0)_";V:VETERANS ADMINISTRATION"
  1.  S DIR(0)=DIR(0)_";A:ALL"
  1.  S DIR("A")="Select TYPE of BILLING ENTITY to Display"
  1.  S DIR("?")="Enter TYPE of BILLING ENTITY to display, or press <return> for ALL"
  1.  ; S BARY("TYP")=U_Y_U
  1.  ;S BARY("TYP","NM")=Y(0)
  1.  D ^DIR
  1.  K DIR
  1.  I Y<0!($D(DTOUT))!($D(DUOUT)) Q
  1.  S BAR("RPTYPE")=Y
  1.  D DATE
  1.  G:$D(BAREFLG) END
  1.  D DIPVAR
  1.  D PRINT
  1.  D EOP^BARUTL(1)
  1.  ;
  1. END ;
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DATE ; EP
  1.  ; Select Date Range - Transaction date/time
  1.  K BAREFLG
  1.  W !
  1.  S BAR("BDOS")=$$DATE^BARDUTL(1)
  1.  I Y<0 S BAREFLG=1 Q
  1.  S BAR("XBDOS")=$$MDT^BARDUTL(BAR("BDOS"))
  1.  S BAR("EDOS")=$$DATE^BARDUTL(2)
  1.  I Y<0 S BAREFLG=1 Q
  1.  S BAR("XEDOS")=$$MDT^BARDUTL(BAR("EDOS"))
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PRINT ;
  1.  ; Print
  1.  S BAR("SITE")=$P(^DIC(4,DUZ(2),0),U)
  1.  S DIC="90050.03"
  1.  S L=0
  1.  I BAR("RPTYPE")="P" S FR=BAR("BDOS")_",,PRIVATE,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,PRIVATE,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="R" S FR=BAR("BDOS")_",,MEDICARE FI,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MEDICARE FI,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="D" S FR=BAR("BDOS")_",,MEDICAID FI,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MEDICAID FI,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="H" S FR=BAR("BDOS")_",,HMO,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,HMO,,,"
  1.  I BAR("RPTYPE")="M" S FR=BAR("BDOS")_",,MEDICARE SUPPL,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MEDICARE SUPPL,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="W" S FR=BAR("BDOS")_",,WORKMEN'S COMP,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,WORKMEN'S COMP,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="C" S FR=BAR("BDOS")_",,CHAMPUS,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,CHAMPUS,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="F" S FR=BAR("BDOS")_",,FRATERNAL ORG,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,FRATERNAL ORG,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="N" S FR=BAR("BDOS")_",,NON-BEN (NON-INDIAN),,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,NON-BEN (NON-INDIAN),,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="I" S FR=BAR("BDOS")_",,INDIAN PATIENT,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,INDIAN PATIENT,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="K" S FR=BAR("BDOS")_",,CHIP (KIDSCARE),,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,CHIP (KIDSCARE),,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="T" S FR=BAR("BDOS")_",,3P LIABILITY,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,3P LIABILITY,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="MD" S FR=BAR("BDOS")_",,MCR PART D,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MCR PART D,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="MH" S FR=BAR("BDOS")_",,MEDICARE HMO,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MEDICARE HMO,,AUTO WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="V" S FR=BAR("BDOS")_",,VA,,WRITE-OFF 2000,",TO=BAR("EDOS")_",,VA,,WRITE-OFF 2007,"
  1.  I BAR("RPTYPE")="A" S FR=BAR("BDOS")_",,,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,,,AUTO WRITE-OFF 2007,"
  1.  ;S FR=BAR("BDOS")_",,,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,,,AUTO WRITE-OFF 2007,"
  1.  D EN1^DIP
  1.  ;
  1. DSP ; EP for VALM
  1.  D ^%ZISC,HOME^%ZIS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DIPVAR ;
  1.  ; Set up DIP variables and Header routine
  1.  Q:$D(BAREFLG)
  1.  S BY="@'.01,@101,6:1.08;""INSURER TYPE: "",102,+103;""REASON: "";L20,+6;""+"";S1;C1;"""
  1.  D:BARRDET="D" DETAIL
  1.  D:BARRDET="S" SUMMARY
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DETAIL ;
  1.  ;S DHD="[BAR ADAL HDR"
  1.  S DHD="AUTOMATIC WRITE OFF REPORT FOR "
  1.  S FLDS="NUMDATE4(#12);""TRANSACTION DATE"",!4;L18,4:102;""SERVICE DATE"",&3.7;R10;C65;D2;""ADJUSTMENT"""  ;Y2000
  1.  Q
  1.  ;
  1. SUMMARY ;
  1.  S FLDS="6!,&3.7;R10;C45;D2;""ADJUSTMENT"",&3.619;R9;D2""REFUND"",&3.5;R10;D2;""CREDIT/DEBIT"""  ;Print A/R ACCOUNT,ADJ, REF, CREDIT-DEBIT
  1.  ;S DHD="[BAR ADALS HDR]"
  1.  Q