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

BARRPRP.m

Go to the documentation of this file. 
  1. BARRPRP ; IHS/SD/LSL - Payment Summary Report by Collection Batch ;08/20/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
  1.  ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892 
  1.  ; IHS/SD/LSL - 04/18/03 - V1.8
  1.  ;      Routine created
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EN ; EP
  1.  K BARY,BAR
  1.  D:'$D(BARUSR) INIT^BARUTL         ; Setup basic A/R variables
  1.  S BARP("RTN")="BARRPRP"           ; Routine used to get data
  1.  S BAR("PRIVACY")=1                ; Privacy act applies
  1.  S BAR("LOC")="BILLING"            ; Location is ALWAYS billing
  1.  D ^BARRSEL                        ; Select exclusion parameters
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
  1.  W !!," ============ Entry of COLLECTION BATCH OPEN DATE Range =============",!
  1.  D DATES
  1.  Q:+BARSTART<1                     ; Dates answered wrong
  1.  D ASKSORT^BARRSEL                 ; Ask sort by Clinic/Visit
  1.  D:BARASK SORT^BARRSEL             ; Ask Clinic/Visit
  1.  S BARQ("RC")="COMPUTE^BARRPRP"    ; Compute routine
  1.  S BARQ("RP")="PRINT^BARRPRP2"      ; 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.  ; *********************************************************************
  1.  ;
  1. DATES ;
  1.  ; Ask Collection Batch Open Date Range
  1.  S BARSTART=$$DATE^BARDUTL(1)
  1.  I BARSTART<1 Q
  1.  S BAREND=$$DATE^BARDUTL(2)
  1.  I BAREND<1 W ! G DATES
  1.  I BAREND<BARSTART D  G DATES
  1.  .W *7
  1.  .W !!,"The END date must not be before the START date.",!
  1.  S X1=BAREND
  1.  S X2=BARSTART
  1.  D ^%DTC
  1.  I X>31 D  G DATES
  1.  . W *7
  1.  . W !!,"The date range must not exceed 31 days.  Please try a different range.",!
  1.  S BARY("DT",1)=BARSTART
  1.  S BARY("DT",2)=BAREND
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. COMPUTE ; EP
  1.  ; Find bills matching criteria and store in ^TMP($J,"BAR-PRP")
  1.  K ^TMP($J,"BAR-PRP")
  1.  ; First loop Collection batch open dates
  1.  S BARDT=$O(^BARCOL(DUZ(2),"C",BARSTART),-1)
  1.  F  S BARDT=$O(^BARCOL(DUZ(2),"C",BARDT)) Q:((BARDT>BAREND)!(BARDT=""))  D BATCH
  1.  ;
  1.  ; Find Batched total for header
  1.  K BARBTOT
  1.  S BARBNAME=""
  1.  F  S BARBNAME=$O(BARB(BARBNAME)) Q:BARBNAME=""  D
  1.  . S $P(BARBTOT,U)=$P(BARB(BARBNAME),U)+$P($G(BARBTOT),U)
  1.  . S $P(BARBTOT,U,2)=$P(BARB(BARBNAME),U,2)+$P($G(BARBTOT),U,2)
  1.  . S $P(BARBTOT,U,3)=$P(BARB(BARBNAME),U,3)+$P($G(BARBTOT),U,3)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. BATCH ;
  1.  ; Loop batches opened on BARDT
  1.  S BARBATCH=0
  1.  F  S BARBATCH=$O(^BARCOL(DUZ(2),"C",BARDT,BARBATCH)) Q:'+BARBATCH  D DATA
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DATA ;
  1.  ; Collect data for report
  1.  Q:'$D(^BARCOL(DUZ(2),BARBATCH,0))              ; No data for col batch
  1.  Q:'$D(^BARTR(DUZ(2),"ACB",BARBATCH))         ; Batch not in TRANS file
  1.  S BARCB(0)=$G(^BARCOL(DUZ(2),BARBATCH,0))      ; 0 node for batch
  1.  I $D(BARY("COLPT")),BARY("COLPT")'=$P(BARCB(0),U,2) Q  ; Not col pt
  1.  S BARBNAME=$P(BARCB(0),U)                      ; Collection batch name
  1.  S BARBAMT=$$GET1^DIQ(90051.01,BARBATCH,15)     ; Batch amount
  1.  S BARBPST=$$GET1^DIQ(90051.01,BARBATCH,16)      ; Batch posted amount
  1.  S BARBUPST=$$GET1^DIQ(90051.01,BARBATCH,17)    ; Batch unposted amount
  1.  S BARITM=0
  1.  F  S BARITM=$O(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM)) Q:'+BARITM  D TRANS
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. TRANS ;
  1.  ; Loop payment transanctions on the batch
  1.  Q:'$D(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM,40))  ; No payments
  1.  S BARTR=0
  1.  F  S BARTR=$O(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM,40,BARTR)) Q:'+BARTR  D MORE
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. MORE ;
  1.  Q:'$D(^BARTR(DUZ(2),BARTR,0))                   ; No transaction data
  1.  S BARTR(0)=$G(^BARTR(DUZ(2),BARTR,0))
  1.  Q:'+$P(BARTR(0),U,4)                           ; No bill on transaction
  1.  S BARBL=$P(BARTR(0),U,4)                       ; A/R Bill IEN
  1.  Q:'$D(^BARBL(DUZ(2),BARBL,0))                  ; No bill data
  1.  S BAR(0)=$G(^BARBL(DUZ(2),BARBL,0))            ; O node A/R Bill file
  1.  S BAR(1)=$G(^BARBL(DUZ(2),BARBL,1))            ; 1 node A/R Bill file
  1.  S BARAC=$P(BAR(0),U,3)                         ; A/R Account IEN
  1.  S:+BARAC BARITYP=$$GET1^DIQ(90050.02,BARAC,1.08)  ; Insurer Type
  1.  I $D(BARY("ITYP")),$G(BARITYP)'=BARY("ITYP","NM") Q  ; Not chsn Ins Type
  1.  I $D(BARY("CLIN")),'$D(BARY("CLIN",$P(BAR(1),U,12))) Q  ;Not chsn clin
  1.  I $D(BARY("VTYP")),'$D(BARY("VTYP",$P(BAR(1),U,14))) Q  ;Not chsn vtyp
  1.  I $D(BARY("LOC")),BARY("LOC")'=$P(BAR(1),U,8) Q      ; Not chsn loc
  1.  S BARVIS=$$GET1^DIQ(90050.01,BARBL,108)        ; Visit Location
  1.  S:BARVIS="" BARVIS="No Visit Location"
  1.  S BARCLIN=$$GET1^DIQ(90050.01,BARBL,112)       ; Clinic
  1.  S:BARCLIN="" BARCLIN="No clinic"
  1.  S BARVTYP=$$GET1^DIQ(90050.01,BARBL,114)       ; Visit Type
  1.  S:BARVTYP="" BARVTYP="No Visit Type"
  1.  S BARBLAMT=$P(BAR(0),U,13)                     ; Bill Amount
  1.  S BARPAY=$$GET1^DIQ(90050.03,BARTR,3.6)        ; Payment
  1.  S BARDOS=$$GET1^DIQ(90050.01,BARBL,102,"I")    ; DOS Begin
  1.  S BARMDOS=$E(BARDOS,1,5)_"00"                  ; DOS Mon/yr
  1.  S BARB(BARBNAME)=BARBAMT_U_BARBPST_U_BARBUPST
  1.  I +BARASK D  Q
  1.  . I BARY("SORT")="C" S BARSORT=BARCLIN
  1.  . I BARY("SORT")="V"  S BARSORT=BARVTYP
  1.  . D CLINVIS
  1.  D DETAIL
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. CLINVIS ;
  1.  ; Data sorted by Clinic/Visit
  1.  S BARHOLD=$G(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS))
  1.  I $D(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS,BARBL)) D  Q
  1.  . S $P(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,3)=$P(BARHOLD,U,3)+BARPAY
  1.  S ^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS,BARBL)=""
  1.  S $P(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U)=$P(BARHOLD,U,1)+1
  1.  S $P(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,2)=$P(BARHOLD,U,2)+BARBLAMT
  1.  S $P(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,3)=$P(BARHOLD,U,3)+BARPAY
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DETAIL ;
  1.  ; Detail Report data
  1.  S BARHOLD=$G(^TMP($J,"BAR-PRP",BARVIS,BARMDOS))
  1.  I $D(^TMP($J,"BAR-PRP",BARVIS,BARMDOS,BARBL)) D  Q
  1.  . S $P(^TMP($J,"BAR-PRP",BARVIS,BARMDOS),U,3)=$P(BARHOLD,U,3)+BARPAY
  1.  S ^TMP($J,"BAR-PRP",BARVIS,BARMDOS,BARBL)=""
  1.  S $P(^TMP($J,"BAR-PRP",BARVIS,BARMDOS),U)=$P(BARHOLD,U)+1
  1.  S $P(^TMP($J,"BAR-PRP",BARVIS,BARMDOS),U,2)=$P(BARHOLD,U,2)+BARBLAMT
  1.  S $P(^TMP($J,"BAR-PRP",BARVIS,BARMDOS),U,3)=$P(BARHOLD,U,3)+BARPAY
  1.  Q