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