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

BAREDBPR.m

Go to the documentation of this file. 
  1. BAREDBPR ; IHS/SD/SDR - AR ERA Batch/Item matching ; 01/30/2009
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**20,21**;OCT 26,2005
  1.  Q
  1. EN ;
  1.  I $G(DUZ(2))="" D  Q
  1.  . W !!,"Check your DUZ setup."
  1.  . D EOP^BARUTL(1)
  1.  W !,"Matching ERA 835 to A/R Collection Batch & Items..."
  1.  D SELFL^BAREDP00
  1.  I Y'>0 Q
  1.  ;IHS/SD/TPF 8/22/2001 BAR*1.8*21 5010
  1.  I TRNAME[("5010") D EN^BAR50BPR Q
  1.  ;END BAR*1.8*21
  1.  W !,"I will begin matching the following items:"
  1.  H 1
  1.  I TRNAME["HIPAA" D  Q:'+BARCKIEN
  1.  . S BARCKIEN=$$CHECK^BAREDP09(IMPDA)
  1.  ;IHS/SD/TPF BAR*1.8*21 ADD PLB LISTING TO BPR OPTION PER PAGE 10 5010 SPECS
  1.  S $P(DASH,"=",81)=""
  1.  N BARNOW
  1.  D NOW^%DTC
  1.  S Y=% X ^DD("DD")
  1.  S BARNOW=Y
  1.  D SEP^BAR50PA1(IMPDA)
  1.  S PAGENO=0
  1.  D PLBHDR
  1.  S GRANDTOT=0   ;GRAND TOTAL
  1.  S DATETOT=0    ;TOTAL BY FY DATE
  1.  S LSTDATE=""
  1.  S SEGDA=0
  1.  F  S SEGDA=$O(^BAREDI("I",DUZ(2),IMPDA,20,SEGDA)) Q:'SEGDA  D
  1.  .Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,20,SEGDA,1)),E)'="PLB"
  1.  .S PLBDATA=$G(^BAREDI("I",DUZ(2),IMPDA,20,SEGDA,1))
  1.  .S NPI=$P($G(^BAREDI("I",DUZ(2),IMPDA,20,SEGDA,1)),E,2)
  1.  .S FYDATE=$P($G(^BAREDI("I",DUZ(2),IMPDA,20,SEGDA,1)),E,3)
  1.  .I FYDATE'=LSTDATE S DATETOT=0
  1.  .S LSTDATE=FYDATE
  1.  .S X=FYDATE D DT^BAR50P02 S FYDATE=X
  1.  .;W !,$G(^BAREDI("I",DUZ(2),IMPDA,20,SEGDA,1))
  1.  .W !!?3,NPI
  1.  .W ?20,FYDATE
  1.  .;PLB SEPARATOR - WILL BE THE SUB-ELEMENT SEPARATOR OR VARIABLE SE
  1.  .S LENGTH=$L($G(^BAREDI("I",DUZ(2),IMPDA,20,SEGDA,1)),E)
  1.  .;GET ALL THE CODES IN THE PLB SEGMENT
  1.  .S COUNT=1
  1.  .F PIECE=4:2:LENGTH  D
  1.  ..S PLBCODE=$P($G(^BAREDI("I",DUZ(2),IMPDA,20,SEGDA,1)),E,PIECE,PIECE+1)
  1.  ..;W !,PLBCODE
  1.  ..S CD=$P(PLBCODE,SE)
  1.  ..I CD[E S CD=$P(CD,E)
  1.  ..S CDAMT=$P(PLBCODE,E,2)
  1.  ..S PLBREFID=$P($P(PLBCODE,E),SE,2)
  1.  ..W !,COUNT
  1.  ..W ?14,$J($FN(CDAMT,",",2),10)
  1.  ..W ?26,CD
  1.  ..S DESC=$$DESC(CD)
  1.  ..W ?30,DESC
  1.  ..W ?50,PLBREFID
  1.  ..S DATETOT=DATETOT+CDAMT
  1.  ..S GRANDTOT=GRANDTOT+CDAMT
  1.  ..S COUNT=COUNT+1
  1.  .W !?10,"---------------"
  1.  .W !?14,$J($FN(DATETOT,",",2),10)
  1.  .S DATETOT=0
  1.  .;I $Y>20 D EOP^BARUTL(1)
  1.  W !?10,"---------------"
  1.  W !?14,$J($FN(GRANDTOT,",",2),10)
  1.  D EOP^BARUTL(1)
  1.  D CLNUP
  1.  Q
  1. DESC(CD) ;EP - GET DESCRIPTION OF CODE
  1.  S TBLIEN=$O(^BARETBL("B","Adjustment Reason Code",""))
  1.  S CODEIEN=$O(^BARETBL(TBLIEN,1,"B",CD,""))
  1.  S CD=$P(^BARETBL(TBLIEN,1,CODEIEN,0),U,2)
  1.  Q CD
  1.  ;END BAR*1.8*21
  1.  ;
  1. PLBHDR ;EP - PLB REPORT HEADER
  1.  S PAGENO=PAGENO+1
  1.  ;W @IOF  ;ADRIAN WANTED FF TAKEN OUT
  1.  W !!
  1.  W DASH
  1.  W "PLB DETAIL REPORT"
  1.  W ?45,BARNOW
  1.  W ?70,"PAGE ",PAGENO
  1.  W !,$G(BAR("HD",1))
  1.  W !,$G(BAR("HD",2))
  1.  W !,DASH
  1.  ;PRINT COLUMNS
  1.  W !?5,"NPI",?20,"FY DATE"
  1.  W !,"NO",?10,"AMOUNT",?24,"CD",?30,"DESCRIPTION",?45,"REFERENCE ID"
  1.  W !,DASH
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. CLNUP ; Cleanup variables
  1.  I $G(IMPDA) L -^BAREDI("I",IMPDA)  ;BAR*1.8*5 SRS-80 IHS/SD/TPF
  1.  K XBDIR,X,Y,HSTFILE,ANS,IMPDA,TRDA,DATM,SEQ,TNAME
  1.  K HSTIME,BARCOL,BARITM
  1.  Q