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

BARPNP2.m

Go to the documentation of this file. 
  1. BARPNP2 ; IHS/SD/LSL - POSTING PATIENT LOOKUP ; 05/02/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,23**;OCT 26, 2005
  1.  ;
  1.  ; IHS/SD/LSL - 11/08/02 - V1.7 - NOIS CNA-1102-110028
  1.  ;       If when looping through ABC x-ref, there is no data for the bill,
  1.  ;       k the x-ref and q
  1.  ;
  1.  ; ********************************************************************
  1.  ;
  1.  ; verify Status of Bill,
  1.  ;  If the bill was 'CLOSED' not displayed - no 3P bill found
  1.  ;  If the bill was 'CANCELED' and Current bill amount is 0  not displayed - has already been worked
  1.  ;** patient a/r lookup based on from/thru dos
  1.  ;** called from ^BARPST
  1.  ;** BARPASS = PATDFN^BEGDOS^ENDDOS
  1.  ;** builds an array that includes all entries from a/r that meet the
  1.  ;   criteria.
  1.  ;HEAT93190 DEC 2012 P.OTTIS NOHEAT MARK DUPLICATE BILLS
  1.  ; *********************************************************************
  1.  ;
  1. EN(BARPASS)        ;EP - pat/bills lookup
  1.  N DIC,DIQ,DR,BARBLV,BARDT,BARPAT,BARBEG,BAREND,BARHIT,BARCNT
  1.  K ^BARTMP($J)
  1.  S BARCNT=0
  1.  I (+$G(BARPASS)=0) Q 0
  1.  S BARPAT=+BARPASS
  1.  S BARBEG=$P(BARPASS,U,2)
  1.  S BAREND=$P(BARPASS,U,3)
  1.  S X1=BARBEG
  1.  S X2=-1
  1.  D C^%DTC
  1.  S BARDT=X
  1.  S DIC="^BARBL(DUZ(2),"
  1.  S DR=".01;3;13;15;16"
  1.  S DIQ="BARBLV("
  1.  S BARCNT=0
  1.  F  S BARDT=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDT)) Q:'BARDT!(BARDT>BAREND)  DO
  1.  . S BARBDA=0
  1.  . F  S BARBDA=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA)) Q:'BARBDA  DO
  1.  .. I '$D(^BARBL(DUZ(2),BARBDA)) K ^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA) Q
  1.  .. S DA=BARBDA D EN^XBDIQ1
  1.  .. S BARCNT=BARCNT+1
  1.  .. I BARBLV(16)'="CLOSED" D
  1.  ... S ^BARTMP($J,BARBDA,BARCNT)=BARDT_U_BARBLV(.01)_U_BARBLV(13)_U_BARBLV(3)_U_BARBLV(15)_U_U_U_BARBLV(16)
  1.  ... S ^BARTMP($J,"B",BARCNT,BARBDA)=""
  1.  .. I (BARBLV(16)="3P CANCELLED")&(BARBLV(15)=0) D
  1.  ... K ^BARTMP($J,BARBDA,BARCNT)
  1.  ... K ^BARTMP($J,"B",BARCNT,BARBDA)
  1.  ... S BARCNT=BARCNT-1
  1.  .. I BARBLV(16)="CLOSED" S BARCNT=BARCNT-1
  1.  .. K BARBLV
  1.  Q BARCNT
  1.  ; *********************************************************************
  1.  ;
  1. HIT(BARPASS) ;EP - ** display a/r bills found
  1.  N BARBDA,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
  1.  S (BARBDA,BARPG,BARSTOP)=0
  1.  D HEAD
  1.  F  S BARBDA=$O(^BARTMP($J,BARBDA)) Q:'BARBDA  DO  Q:BARSTOP
  1.  . S BARLIN=$O(^BARTMP($J,BARBDA,""))
  1.  . S BARREC=^BARTMP($J,BARBDA,BARLIN)
  1.  . S BARBLO=$P(BARREC,U,2) I $D(^BARTR(DUZ(2),"AM4",+BARBLO)) S BARBLO="m"_BARBLO
  1.  . S BARSTOP=$$CHKLINE(0) Q:BARSTOP
  1.  . S BARCMSG="      "
  1.  . S:$P(BARREC,U,8)="3P CANCELLED" BARCMSG="3P CAN"
  1.  . S BARTMP=$$DUPLBILL($P(BARREC,U,2)) I BARTMP>0 D  ;-------->P.OTT MARK DUPLICATE BILLS
  1.  . . S BAREIN1=$P(BARTMP,"^",2)
  1.  . . S BAREIN2=$P(BARTMP,"^",3)
  1.  . . S BARDPTR=$P(BARTMP,"^",4)
  1.  . . I BARDPTR=3 S BARBLO="?"_BARBLO Q
  1.  . . I BARBDA=BAREIN1,BARDPTR=1 S BARBLO="!"_BARBLO Q  ;! = ORPHANT (NO DATA IN 3PB)
  1.  . . I BARBDA=BAREIN2,BARDPTR=2 S BARBLO="!"_BARBLO Q  ;d = DUPLICATE (CORRECT ONE)
  1.  . . I BARBDA=BAREIN1 S BARBLO="d"_BARBLO Q
  1.  . . I BARBDA=BAREIN2 S BARBLO="d"_BARBLO Q
  1.  . ;---------------------------------------------------------< P.OTT
  1.  . ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
  1.  . S BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARBDA)
  1.  . S:$G(BARTPB)'="" BARSTAT=$P($G(^ABMDBILL($P(BARTPB,","),$P(BARTPB,",",2),0)),U,4)
  1.  . ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
  1.  . W !,BARLIN
  1.  . W ?6,$$SDT^BARDUTL($P(BARREC,U,1))
  1.  . W ?18,BARBLO
  1.  . W:($G(BARSTAT)="X") "*"  ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
  1.  . W ?25,BARCMSG
  1.  . W ?32,$J($P(BARREC,U,3),8,2)
  1.  . W ?44,$E($P(BARREC,U,4),1,23)
  1.  . W ?70,$J($P(BARREC,U,5),8,2)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1.  W $$EN^BARVDF("IOF"),!
  1.  N BARPTNAM
  1.  Q:'+$G(BARPASS)
  1.  S BARPG=BARPG+1
  1.  S BARPTNAM=$P(^DPT(+BARPASS,0),U,1)
  1.  I $D(^BARTR(DUZ(2),"AM5",+BARPASS)) S BARPTNAM="(msg) "_BARPTNAM
  1.  W "Claims for "_BARPTNAM_"  from "_$$SDT^BARDUTL($P(BARPASS,U,2))_" to "_$$SDT^BARDUTL($P(BARPASS,U,3))
  1.  W ?(IOM-15),"Page: "_BARPG
  1.  W !!
  1.  W ?32,"Billed",?70,"Current"
  1.  W !
  1.  W "Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
  1.  S BARDSH="",$P(BARDSH,"-",IOM)=""
  1.  W !,BARDSH
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HIT1(BARPASS) ;EP - ** display a/r bills found
  1.  N BARHIT,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
  1.  S (BARTPAY,BARTADJ,BARHIT,BARPG,BARSTOP)=0
  1.  D HEAD1
  1.  F  S BARHIT=$O(^BARTMP($J,BARHIT)) Q:'BARHIT  D  Q:BARSTOP
  1.  .S BARLIN=$O(^BARTMP($J,BARHIT,""))
  1.  .S BARREC=^BARTMP($J,BARHIT,BARLIN)
  1.  .S BARBLO=$P(BARREC,U,2)
  1.  .I $D(^BARTR(DUZ(2),"AM4",+BARBLO)) S BARBLO="m"_BARBLO
  1.  .S BARTPAY=BARTPAY+$P(BARREC,U,6)
  1.  .S BARTADJ=BARTADJ+$P(BARREC,U,7)
  1.  .S BARSTOP=$$CHKLINE(1) Q:BARSTOP
  1.  .S BARCMSG="      "
  1.  .S:$P(BARREC,U,8)="3P CANCELLED" BARCMSG="3P CAN"
  1.  . S BARTMP=$$DUPLBILL($P(BARREC,U,2)) I BARTMP>0 D  ;-------->P.OTT MARK DUPLICATE BILLS
  1.  . . S BAREIN1=$P(BARTMP,"^",2)
  1.  . . S BAREIN2=$P(BARTMP,"^",3)
  1.  . . S BARDPTR=$P(BARTMP,"^",4)
  1.  . . I BARDPTR=3 S BARBLO="?"_BARBLO Q
  1.  . . I BARHIT=BAREIN1,BARDPTR=1 S BARBLO="!"_BARBLO Q  ;! = ORPHANT (NO DATA IN 3PB)
  1.  . . I BARHIT=BAREIN2,BARDPTR=2 S BARBLO="!"_BARBLO Q  ;d = DUPLICATE (CORRECT ONE)
  1.  . . I BARHIT=BAREIN1 S BARBLO="d"_BARBLO Q
  1.  . . I BARHIT=BAREIN2 S BARBLO="d"_BARBLO Q
  1.  . ;---------------------------------------------------------< P.OTT
  1.  .;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
  1.  .S BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARHIT)
  1.  .S:$G(BARTPB)'="" BARSTAT=$P($G(^ABMDBILL($P(BARTPB,","),$P(BARTPB,",",2),0)),U,4)
  1.  .;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
  1.  .W !,BARLIN
  1.  .W ?6,$$SDT^BARDUTL($P(BARREC,U,1))
  1.  .W ?18,BARBLO
  1.  .W:($G(BARSTAT)="X") "*"  ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
  1.  .W ?25,BARCMSG
  1.  .W ?32,$J($P(BARREC,U,3),8,2)
  1.  .W ?44,$J($P(BARREC,U,6),8,2)
  1.  .W ?56,$J($P(BARREC,U,7),8,2)
  1.  .W ?70,$J($P(BARREC,U,5),8,2)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HEAD1 ;
  1.  W $$EN^BARVDF("IOF"),!
  1.  N BARPTNAM
  1.  S BARPG=BARPG+1
  1.  S BARPTNAM=$P(^DPT(+BARPASS,0),U,1)
  1.  I $D(^BARTR(DUZ(2),"AM5",+BARPASS)) S BARPTNAM="(msg) "_BARPTNAM
  1.  W "Claims for "_BARPTNAM_"  from "_$$SDT^BARDUTL($P(BARPASS,U,2))_" to "_$$SDT^BARDUTL($P(BARPASS,U,3))
  1.  W ?(IOM-15),"Page: "_BARPG
  1.  W !!?32,"Billed",?44,"Current",?56,"Current",?70,"Current"
  1.  W !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Payments",?56,"Adjust.",?70,"Balance"
  1.  S BARDSH=""
  1.  S $P(BARDSH,"-",IOM)=""
  1.  W !,BARDSH
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. CHKLINE(BARHD) ;EP
  1.  ; Q 0 = CONTINUE
  1.  ; Q 1 = STOP
  1.  N X
  1.  I ($Y+5)<IOSL Q 0
  1.  W !?(IOM-15),"continued==>"
  1.  D EOP^BARUTL(0)
  1.  I 'Y Q 1
  1.  I BARHD=0 D HEAD
  1.  I BARHD=1 D HEAD1
  1.  Q 0
  1. DUPLBILL(BARBN) ;CHECK FOR DUPLICATE BILLS
  1.  ; IF THE BILL# IS A DUPLICATE RETURNS: 1^EIN1^EIN2^PTR (PTR POINTS TO THE 'ORPHANT' EIN1 or EIN2)
  1.  ;NEW BAREIN1,BAREIN2,BAR3PEIN,BARDUZ3P,BARAPP1,BARAPP2,BARRET
  1.  S BAREIN1=$O(^BARBL(DUZ(2),"B",BARBN,"")) I BAREIN1="" Q -1 ;0  ;NO DATA - WE DON'T CARE
  1.  S BAREIN2=$O(^BARBL(DUZ(2),"B",BARBN,BAREIN1)) I BAREIN2="" Q -2 ;0 ;ONLY 1 BILL - NO DUPS
  1.  ;TAKE 1ST OF THE PAIR
  1.  S BARRET="1^"_BAREIN1_"^"_BAREIN2_"^"
  1.  S BAR3PEIN=$P($G(^BARBL(DUZ(2),BAREIN1,0)),"^",17)
  1.  S BARDUZ3P=$P($G(^BARBL(DUZ(2),BAREIN1,0)),"^",22)
  1.  I BAR3PEIN="" Q -3 ;0  ;NO DATA
  1.  I BARDUZ3P="" Q -4 ;0  ;NO DATA
  1.  ;
  1.  S BARAPP1=0 I '$D(^ABMDBILL(BARDUZ3P,BAR3PEIN,0)) S BARAPP1=1 ;OK
  1.  ;TAKE 2ND OF THE PAIR
  1.  S BAR3PEIN=$P($G(^BARBL(DUZ(2),BAREIN2,0)),"^",17)
  1.  S BARDUZ3P=$P($G(^BARBL(DUZ(2),BAREIN2,0)),"^",22)
  1.  I BAR3PEIN="" Q -5  ; 0  ;NO DATA
  1.  I BARDUZ3P="" Q -6   ;0  ;NO DATA
  1.  ;
  1.  S BARAPP2=0 I '$D(^ABMDBILL(BARDUZ3P,BAR3PEIN,0)) S BARAPP2=1 ;OK
  1.  I BARAPP1+BARAPP2=1 D  Q BARRET
  1.  . I BARAPP1=1 S BARRET=BARRET_1
  1.  . I BARAPP2=1 S BARRET=BARRET_2
  1.  Q BARRET_3 ;IF BOTH BILLS NOT FOUND IN 3PB