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

BARRNEGB.m

Go to the documentation of this file. 
  1. BARRNEGB ; IHS/SD/LSL - Print Synch Reports ;08/20/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,7,23,24**;OCT 26, 2005;Build 69
  1.  ;
  1.  ; IHS/SD/SDR - v1.8 p6 - DD 4.1.3
  1.  ;   New Negative Balance report
  1.  ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
  1.  ; IHS/SD/POT MAR 2013 ADDED NEW VA billing BAR*1.8*23
  1.  ; IHS/SD/POT HEAT159172 04/03/2014 BAR*1.8*24 FIXED <UNDEFINED>ASKAGAIN+3^BARRSEL *BARP("RTN")     
  1.  ; *********************************************************************
  1. NB ;EP - negative balance
  1.  S BAR("LOC")="BILLING"
  1.  S BARP("RTN")="BARRNEGB"     ; LINE MOVED BEFORE CALLING BARRSEL 4/3/2014 BAR*1.8*24 HEAT159172
  1.  D ^BARRSEL
  1.  I $D(BARY("ALL")) S BARY("ALL")=$$CONVERT^BARRSL2(BARY("ALL"))
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
  1.  S BAR("HD",0)=BARMENU
  1.  D ^BARRHD                         ; Report header
  1.  S BARQ("RC")="COMPUTE^BARRNEGB"    ; Compute routine
  1.  S BARQ("RP")="PRINT^BARRNEGB"      ; Print routine
  1.  S BARQ("NS")="BAR"                ; Namespace for variables
  1.  S BARQ("RX")="POUT^BARRUTL"       ; Clean-up routine
  1.  D ^BARDBQUE                       ; Double queuing
  1.  D PAZ^BARRUTL
  1.  Q
  1. COMPUTE ;
  1.  ;
  1.  S BAR("SUBR")="BAR-NEG"
  1.  K ^TMP($J,"BAR-NEG")
  1.  S BARP("RTN")="BARRNEGB"     ; Routine used to get data if no parameters
  1.  I BAR("LOC")="BILLING" D LOOP^BARRUTL Q
  1.  S BARDUZ2=DUZ(2)
  1.  S DUZ(2)=0
  1.  F  S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2)  D LOOP^BARRUTL
  1.  S DUZ(2)=BARDUZ2
  1.  Q
  1. DATA ;
  1.  S BARBAL=$$GET1^DIQ(90050.01,BAR,15)
  1.  Q:BARBAL'<0
  1.  S BARP("HIT")=0
  1.  D BILL^BARRCHK
  1.  Q:'BARP("HIT")
  1.  S BARLOC=""
  1.  S:BAR("L")]"" BARLOC=$$GET1^DIQ(4,BAR("L"),.01)
  1.  S:BARLOC="" BARLOC="No Visit Location"       ; Visit Location Name
  1.  S BARACCT=""
  1.  S:BAR("I")]"" BARACCT=$$GET1^DIQ(90050.02,BAR("I"),.01)
  1.  S:BARACCT="" BARACCT="No A/R Account"        ; A/R Account Name
  1.  S:'+BAR("A") BAR("A")=9999999
  1.  I $G(BARY("SORT"))="C" D
  1.  . S BAR2=BAR("C")
  1.  . I BAR2]"",BAR2'=99999 S BAR2=$$GET1^DIQ(40.7,BAR2,.01)
  1.  . S:BAR2=""!(BAR2=99999) BAR2="No Clinic Type"
  1.  I $G(BARY("SORT"))="V" D
  1.  . S BAR2=BAR("V")
  1.  . I BAR2]"",BAR2'=99999 S BAR2=$$GET1^DIQ(9002274.8,BAR2,.01)
  1.  . S:BAR2=""!(BAR2=99999) BAR2="No Visit Type"
  1.  S BARBILL=$P(BAR(0),U,13)
  1.  S BARBL=$P(BAR(0),U)
  1.  ;
  1.  S D0=BAR("I")
  1.  S BARALLC=$$VALI^BARVPM(8)  ;insurer type CODE
  1.  S BARALLC=$P($T(@BARALLC),";;",2)
  1.  I BARALLC="" S BARALLC="UNK" ;P.OTT
  1.  ;
  1.  D GETTRANS  ;get pymts and adjs for bill
  1.  ;
  1.  I $D(BARY("SORT")) D CLINVIS
  1.  E  D ACCT
  1.  ;
  1.  S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC))
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC),U,2)=$P(BARHOLD,U,2)+BARBILL
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC),U,3)=$P(BARHOLD,U,3)+BARTPAY
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC),U,4)=$P(BARHOLD,U,4)+BARTADJ
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC),U,5)=$P(BARHOLD,U,5)+BARBAL
  1.  ;
  1.  S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC,BARALLC))
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC),U,2)=$P(BARHOLD,U,2)+BARBILL
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC),U,3)=$P(BARHOLD,U,3)+BARTPAY
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC),U,4)=$P(BARHOLD,U,4)+BARTADJ
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC),U,5)=$P(BARHOLD,U,5)+BARBAL
  1.  ;
  1.  S BARHOLD=$G(^TMP($J,"BAR-NEG"))
  1.  S $P(^TMP($J,"BAR-NEG"),U,2)=$P(BARHOLD,U,2)+BARBILL
  1.  S $P(^TMP($J,"BAR-NEG"),U,3)=$P(BARHOLD,U,3)+BARTPAY
  1.  S $P(^TMP($J,"BAR-NEG"),U,4)=$P(BARHOLD,U,4)+BARTADJ
  1.  S $P(^TMP($J,"BAR-NEG"),U,5)=$P(BARHOLD,U,5)+BARBAL
  1.  Q
  1. GETTRANS ;
  1.  S (BARTPAY,BARTADJ)=0
  1.  S BARTIEN=0
  1.  F  S BARTIEN=$O(^BARTR(DUZ(2),"AC",BAR,BARTIEN)) Q:+BARTIEN=0  D
  1.  .S BARTTYP=$P($G(^BARTR(DUZ(2),BARTIEN,1)),U)
  1.  .Q:BARTTYP'=40&(BARTTYP'=43)  ;payments and adjustments only
  1.  .I BARTTYP=40 S BARTPAY=+$G(BARTPAY)+$$GET1^DIQ(90050.03,BARTIEN,3.5)
  1.  .I BARTTYP=43 S BARTADJ=+$G(BARTADJ)+$$GET1^DIQ(90050.03,BARTIEN,3.5)
  1.  Q
  1. ACCT ;
  1.  ; Store data by AR Account
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U)=BAR("D")
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,2)=BARBILL
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,3)=+$G(BARTPAY)
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,4)=+$G(BARTADJ)
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT,BAR("A"),BARBL),U,5)=BARBAL
  1.  ;
  1.  S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT))
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U)=$P(BARHOLD,U)+BARBILL
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,2)=$P(BARHOLD,U,2)+BARBILL
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,3)=$P(BARHOLD,U,3)+BARTPAY
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,4)=$P(BARHOLD,U,4)+BARTADJ
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BARACCT),U,5)=$P(BARHOLD,U,5)+BARBAL
  1.  Q
  1. CLINVIS ;
  1.  ; Store data by Clinic/Visit Type
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U)=BAR("D")
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,2)=BARBILL
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,3)=+$G(BARTPAY)
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,4)=+$G(BARTADJ)
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT,BAR("A"),BARBL),U,5)=BARBAL
  1.  ;
  1.  S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT))
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U)=BAR("D")
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,2)=$P(BARHOLD,U,2)+BARBILL
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,3)=$P(BARHOLD,U,3)+$G(BARTPAY)
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,4)=$P(BARHOLD,U,4)+$G(BARTADJ)
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2,BARACCT),U,5)=$P(BARHOLD,U,5)+BARBAL
  1.  ;
  1.  S BARHOLD=$G(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2))
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U)=BAR("D")
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U,2)=$P(BARHOLD,U,2)+BARBILL
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U,3)=$P(BARHOLD,U,3)+$G(BARTPAY)
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U,4)=$P(BARHOLD,U,4)+$G(BARTADJ)
  1.  S $P(^TMP($J,"BAR-NEG",BARLOC,BARALLC,BAR2),U,5)=$P(BARHOLD,U,5)+BARBAL
  1.  Q
  1. PRINT ;
  1.  ; Print reports
  1.  K BAR2,BARHOLD,BARBILL,BAR3P,BARACCT,BARLOC,BARDTB,BAR("D"),BAR("A")
  1.  K BARBAL,BARAGE,BARALLC
  1.  D NEGB^BARRNEG2
  1.  Q
  1.  ; ********************************************************************
  1.  ;THIS TABLE REPLICATES ^AUTTINTY INSURER TYPE (21 ENTRIES) BAR*1.8*23
  1.  ;AND MAPS INSURER TYPE CODE TO CATEGORY (IE: W --> OTHER)
  1. H ;;PRIVATE INSURANCE;;HMO
  1. M ;;PRIVATE INSURANCE;;MEDICARE SUPPL.
  1. D ;;MEDICAID;;MEDICAID FI
  1. R ;;MEDICARE;;MEDICARE FI
  1. P ;;PRIVATE INSURANCE;;PRIVATE INSURANCE
  1. W ;;OTHER;;WORKMEN'S COMP
  1. C ;;OTHER;;CHAMPUS
  1. N ;;OTHER;;NON-BENEFICIARY (NON-INDIAN)
  1. I ;;OTHER;;INDIAN PATIENT
  1. K ;;MEDICAID;;CHIP (KIDSCARE)
  1. T ;;OTHER;;THIRD PARTY LIABILITY 
  1. G ;;OTHER;;GUARANTOR
  1. MD ;;MEDICARE;;MCR PART D
  1. MH ;;MEDICARE;;MEDICARE HMO
  1. MMC ;;MEDICARE;;MCR MANAGED CARE
  1. TSI ;;OTHER;;TRIBAL SELF INSURED
  1. SEP ;;OTHER;;STATE EXCHANGE PLAN
  1. FPL ;;MEDICAID;;FPL 133 PERCENT
  1. MC ;;MEDICARE;;MCR PART C
  1. F ;;PRIVATE INSURANCE;;FRATERNAL ORGANIZATION
  1. V ;;VETERAN;;VETERANS MEDICAL BENEFITS
  1.   ;;***END OF TABLE**