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

BAREDP09.m

Go to the documentation of this file. 
  1. BAREDP09 ; IHS/SD/LSL - FIND ERA CHECKS AND MATCH TO RPMS ;07/08/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20,21,22,23,24**;OCT 26,2005;Build 69
  1.  ;IHS/SD/POT HEAT#82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS)- BAR*1.8*.23
  1.  ;IHS/SD/POT            MAR 2013 EXCLUDED COL BATCHES OLDER THAN 365 DAYS- BAR*1.8*.23
  1.  ;IHS/SD/POT HEAT152930 02/12/2014 CONVERTED BATCHEIN AND BATCHDATE TO EXTERNALS - BAR*1.8*.24
  1.  Q
  1. CHECK(IMPDA) ; EP
  1.  N BARCNT,BARCNT2,BARTMP,BARCHK
  1.  D ERACHECK  ;find all chks on ERA
  1.  I '+BARCNT D  Q 0  ;TPF 11/21/2005 BAR*1.8*1 IM19058,IM17965,IM19546  
  1.  . W !,"I'm sorry, it seems ERA file ",IMPDA," does not contain "
  1.  . W !,"a Check/EFT Trace Number.  The file cannot be posted."
  1.  . K DIC,DIE,DR,DA
  1.  . S DA=IMPDA
  1.  . S DIE="^BAREDI(""I"",DUZ(2),"
  1.  . S DR=".08////T"  ;UP-Missing Chk#
  1.  . D ^DIE
  1.  . D EOP^BARUTL(1)
  1.  D BATCHECK  ;Find ERA chks in Coll Batch
  1.  D MATCH  ;Match ERA to RPMS Batch/Item
  1.  D CONT  ;Matching complete, cont?
  1.  Q:'+Y 0  ;NOT REPORTED BAR*1.8*1
  1.  ;start new bar*1.8*20 REQ3
  1.  D STORE
  1.  W $$EN^BARVDF("IOF")
  1.  D DISPLAY
  1.  W !!?1,"IMPORT FILE SUMMARY:"
  1.  W !?7,"TOTAL SEGMENTS PROCESSED........:",$J($P($G(^BAREDI("I",DUZ(2),IMPDA,15,0)),U,3),12)
  1.  W !?7,"TOTAL AMOUNT PROCESSED..........$",$J($FN((+$G(BARMAMT)+$G(BARNAMT)),",",2),12)
  1.  I +$G(BARNAMT)'=0 W !!?1,"PLEASE REVIEW THE BPR 'NOT FOUND' REPORT AND CREATE A BATCH FOR THE BPR SEGMENT 'NOT FOUND'."
  1.  I +$G(BARPLB)>0 W !!?1,"* - Indicates a PLB segment has been located.",!?5,"Collection item balance may not match check balance!"
  1.  D EOP^BARUTL(1)
  1.  ;end new REQ3
  1.  Q BARCKIEN
  1. ERACHECK ;
  1.  ;First find all chks for file (ERA) selected ( I=IEN for chk entry)
  1.  N BARCHECK,BARITEM,BARBATCH
  1.  S BARCNT=0
  1.  S I=0
  1.  F  S I=$O(^BAREDI("I",DUZ(2),IMPDA,5,I)) Q:'I  D
  1.  . ;end new REQ3
  1.  . S BARCNT=BARCNT+1  ;# chks on ERA
  1.  . S IENS=I_","_IMPDA_","
  1.  . S ($P(BARCHK(I),U),BARI)=$$GET1^DIQ(90056.02011,IENS,.01)
  1.  . S $P(BARCHK(I),U,2)=0
  1.  . D EXIST
  1.  Q
  1. EXIST ;
  1.  ;See if ERA chk already in A/R EDI Chk file & matched to AR
  1.  I '$D(^BARECHK("B",BARI)) Q
  1.  S BARMTCH=0
  1.  S BARCKIEN=0
  1.  F  S BARCKIEN=$O(^BARECHK("B",BARI,BARCKIEN)) Q:'+BARCKIEN  D  Q:+BARMTCH
  1.  . Q:$P($G(^BARECHK(BARCKIEN,0)),U,2)'=IMPDA
  1.  . S BARMTCH=1
  1.  . S $P(BARCHK(I),U,5)=BARCKIEN
  1.  I 'BARMTCH Q
  1.  S BARBATCH=$P($G(^BARECHK(BARCKIEN,0)),U,3)
  1.  S BARITEM=$P($G(^BARECHK(BARCKIEN,0)),U,4)
  1.  I +BARBATCH,+BARITEM D
  1.  . S $P(BARCHK(I),U,3)=BARBATCH
  1.  . S $P(BARCHK(I),U,4)=BARITEM
  1.  . ;end new REQ3
  1.  Q
  1. BATCHECK ;
  1.  ;Now loop to find occurrence of ERA chks in A/R Coll. Batch
  1.  N BARBATCH,BATITEM,BARCHECK,BARXCHK,BARTODAY,%H
  1.  S X=DT D H^%DTC ;GET $H-FORMAT ;- BAR*1.8*.23
  1.  S BARTODAY=%H
  1.  S BARCHECK="" F  S BARCHECK=$O(BARCHK(BARCHECK)) Q:BARCHECK=""  D
  1.  . S BARCHKN=$P(BARCHK(BARCHECK),U)
  1.  . S BARXCHK=$$BARXCHK^BAREDP09(BARCHKN) ;- BAR*1.8*.24
  1.  . I $P(BARCHK(BARCHECK),U,3),$P(BARCHK(BARCHECK),U,4) D  Q
  1.  . . S BARBATCH=$P(BARCHK(BARCHECK),U,3)
  1.  . . S BARITEM=$P(BARCHK(BARCHECK),U,4)
  1.  . . S BARCNT2=1
  1.  . . S $P(BARCHK(BARCHECK),U,2)=BARCNT2
  1.  . . D BTCHDATA
  1.  . . I $G(BARTMP)<BARCNT2 S BARTMP=BARCNT2
  1.  . S BARCNT2=0
  1.  . I '$D(^BARCOL(DUZ(2),"D",BARXCHK)) S $P(BARCHK(BARCHECK),U,2)=0,BARTMP=0 Q  ;- BAR*1.8*.23
  1.  . I $D(^BARCOL(DUZ(2),"D",BARXCHK)) D
  1.  . . S BARBATCH=0 F  S BARBATCH=$O(^BARCOL(DUZ(2),"D",BARXCHK,BARBATCH)) Q:'+BARBATCH  D  ;Collection Batch IEN - BAR*1.8*.23
  1.  . . . NEW X,BARCBDT ;- BAR*1.8*.23
  1.  . . . S X=$$GET1^DIQ(90051.01,BARBATCH_",",4,"I")
  1.  . . . D H^%DTC ;GET $H-FORMAT
  1.  . . . S BARCBDT=%H
  1.  . . . IF BARTODAY-BARCBDT>365 D  Q  ;- BAR*1.8*.23
  1.  . . . . S $P(BARCHK(BARCHECK),U,2)=0,BARTMP=0
  1.  . . . . W !!,"A/R Collection batch found is older than 365 days. Checks will NOT be"
  1.  . . . . W !,"matched in the ERA file AND will not be posted to the Collection Batch"
  1.  . . . . ;old code W !," CHK:",BARXCHK," BATCH: ",BARBATCH," BATCH DATE: ",BARCBDT
  1.  . . . . W !," CHK:",BARXCHK," BATCH: ",$$GET1^DIQ(90051.01,BARBATCH,.01)," BATCH DATE: ",$P($$GET1^DIQ(90051.01,BARBATCH_",",4,"I"),"@",1) ;HEAT152930 - BAR*1.8*.24
  1.  . . . . D EOP^BARUTL(1)
  1.  . . . S BARITEM=0  ;Item#
  1.  . . . F  S BARITEM=$O(^BARCOL(DUZ(2),"D",BARXCHK,BARBATCH,BARITEM)) Q:'+BARITEM  D
  1.  . . . . S BARCNT2=BARCNT2+1
  1.  . . . . D BTCHDATA
  1.  . S $P(BARCHK(BARCHECK),U,2)=BARCNT2
  1.  . I $G(BARTMP)<BARCNT2 S BARTMP=BARCNT2
  1.  Q
  1. BTCHDATA ;
  1.  ;Gather data for coll. batch
  1.  K BARIENS
  1.  S BARIENS=BARITEM_","_BARBATCH_","
  1.  S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U)=$$GET1^DIQ(90051.01,BARBATCH,.01)  ;NAME
  1.  S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,2)=$$GET1^DIQ(90051.1101,BARIENS,7)  ;A/R ACCT
  1.  S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,3)=$$GET1^DIQ(90051.1101,BARIENS,101)  ;CREDIT
  1.  S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,4)=$$GET1^DIQ(90051.1101,BARIENS,19)  ;ITEM POSTING BALANCE
  1.  S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,5)=$$GET1^DIQ(90051.1101,BARIENS,17)
  1.  I (U_"ROLLED UP"_U_"CANCELED"_U)[(U_$P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,5)_U) K BARCHK(BARCHECK,BARBATCH,BARITEM) S BARCNT=BARCNT-1
  1.  Q
  1. MATCH ;
  1.  ; Loop chks & tell user matched status
  1.  N BARCHECK,BAREITM,BAREBTCH,BARBATCH,BARITEM
  1.  S BARCHECK=""
  1.  F  S BARCHECK=$O(BARCHK(BARCHECK)) Q:BARCHECK=""  D
  1.  . S IENS=BARCHECK_","_IMPDA_","
  1.  . W !!,"#"_BARCHECK_"  BPR02: ",$FN($$GET1^DIQ(90056.02011,IENS,.03),",",2)
  1.  . W !?4,"TRN02: ",$$GET1^DIQ(90056.02011,IENS,.01)
  1.  . W ?40,"Matching...  "
  1.  . ; chk if prev. matched
  1.  . S BAREBTCH=$P($G(BARCHK(BARCHECK)),U,3)
  1.  . S BAREITM=$P($G(BARCHK(BARCHECK)),U,4)  ;bar*2.8*20 REQ3
  1.  . I $P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCHECK,0)),U,7)'="" D PREVIOUS Q
  1.  . I $P(BARCHK(BARCHECK),U,2)=0 D NONE Q
  1.  . I $P(BARCHK(BARCHECK),U,2)=1 D ONLYONE Q
  1.  . D MANY
  1.  Q
  1. PREVIOUS ;
  1.  ; This ERA chk previously matched to coll. batch
  1.  W "  Previously matched"
  1.  W !,"Matched to batch ",$P(BARCHK(BARCHECK,BAREBTCH,BAREITM),U),?50," ITEM: ",BAREITM
  1.  I $$GET1^DIQ(90051.01,BAREBTCH_",",28)'="" W !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.01,BAREBTCH_",",28)
  1.  E  W !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.1101,BAREITM_","_BAREBTCH_",",20)
  1.  S BARMCNT=+$G(BARMCNT)+1
  1.  S BARMAMT=+$G(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
  1.  Q
  1. NONE ;
  1.  ; No coll. batch/item for this chk#
  1.  W "not done!"
  1.  W !,"Match to:  COLLECTION BATCH/ITEM NOT FOUND.  PLACING ON NOT FOUND REPORT!"
  1.  S BARNCNT=+$G(BARNCNT)+1
  1.  S BARNAMT=+$G(BARNAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
  1.  S (BARBATCH,BARITEM)=""
  1.  D UPDCHECK
  1.  Q
  1. ONLYONE ;
  1.  ; This ERA chk only matches 1 coll. batch/item
  1.  S BARBATCH=$O(BARCHK(BARCHECK,""))
  1.  S BARITEM=$O(BARCHK(BARCHECK,BARBATCH,""))
  1.  S BARCHKN=$P(BARCHK(BARCHECK),U)
  1.  W "done!"
  1.  W !,"Match to: ",$P(BARCHK(BARCHECK,BARBATCH,BARITEM),U),?50," ITEM: ",BARITEM
  1.  S $P(BARCHK(BARCHECK),U,3)=BARBATCH,$P(BARCHK(BARCHECK),U,4)=BARITEM
  1.  I $$GET1^DIQ(90051.01,BARBATCH_",",28)'="" W !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.01,BARBATCH_",",28)
  1.  E  W !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.1101,BARITEM_","_BARBATCH_",",20)  ;TPF 3/24/2008 BAR*1.8*5 FY08-SRS-90
  1.  D UPDCHECK
  1.  S BARMCNT=+$G(BARMCNT)+1
  1.  S BARMAMT=+$G(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
  1.  Q
  1. MANY ;
  1.  ;This ERA chk matches >1 coll. batch/item.  Ask user to choose
  1.  W !!,"Chk/EFT # ",BARCHECK," matches more than one collection batch and item."
  1.  W !,"Please select one:"
  1.  D LISTCHK
  1.  D ASK
  1.  I '+BARANS D  Q
  1.  . W !!,"A collection batch/item has NOT been selected for this ERA Chk/EFT #"
  1.  S BARBATCH=$P(BARTMP(BARANS),U)
  1.  S BARITEM=$P(BARTMP(BARANS),U,2)
  1.  S $P(BARCHK(BARCHECK),U,3)=BARBATCH,$P(BARCHK(BARCHECK),U,4)=BARITEM
  1.  S BARCHKN=$P(BARCHK(BARCHECK),U)  ;IHS/SD/TPF BAR*1.8*21 HEAT43451
  1.  W !!,"Updating A/R EDI CHECKS file with Collection Batch Data..."  ;bar*1.8*22
  1.  D UPDCHECK
  1.  W "   ... Done!"
  1.  S BARMCNT=+$G(BARMCNT)+1
  1.  S BARMAMT=+$G(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
  1.  ;end new REQ3
  1.  Q
  1. LISTCHK ;
  1.  ; List possible batches for ERA chk so user can choose
  1.  W !!,$$EN^BARVDF("ULN"),"LINE",?11,"BATCH",?35,"ITEM",?42,"A/R ACCOUNT",?57,"$ BATCHED",?70,"BALANCE",$$EN^BARVDF("ULF")
  1.  K BARTMP
  1.  S (BARBATCH,BARCNT)=0
  1.  F  S BARBATCH=$O(BARCHK(BARCHECK,BARBATCH)) Q:'+BARBATCH  D
  1.  . S BARITEM=0
  1.  . F  S BARITEM=$O(BARCHK(BARCHECK,BARBATCH,BARITEM)) Q:'+BARITEM  D
  1.  . . S BARCNT=BARCNT+1
  1.  . . W !,$J(BARCNT,3)
  1.  . . W ?5,$E($P(BARCHK(BARCHECK,BARBATCH,BARITEM),U),1,31)
  1.  . . W ?36,$J(BARITEM,3)
  1.  . . W ?40,$E($P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,2),1,15)
  1.  . . W ?56,$J($FN($P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,3),",",2),10)
  1.  . . W ?67,$J($FN($P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,4),",",2),10)
  1.  . . S BARTMP(BARCNT)=BARBATCH_U_BARITEM
  1.  Q
  1. ASK ;
  1.  ;Ask user to choose batch/item
  1.  W !
  1.  S BARANS=0
  1.  K DIR
  1.  S DIR(0)="NAO^1:"_BARCNT
  1.  S DIR("A")="Please enter the LINE # of the collection batch/item that matches this ERA: "
  1.  S DIR("?")="Enter a number between 1 and "_BARCNT
  1.  S DIR("??")="^D LISTCHK^BAREDPA1"
  1.  D ^DIR
  1.  S BARANS=Y
  1.  Q
  1. UPDCHECK ; EP
  1.  ;Populate A/R EDI Checks File
  1.  ;I '$D(^BARECHK("B",BARCHECK)) D  Q
  1.  I '$D(^BARECHK("B",BARCHKN)) D  Q
  1.  . D ADD
  1.  . Q:'+BARCKIEN
  1.  . D UPD
  1.  S BARMTCH=0
  1.  S BARCKIEN=0
  1.  F  S BARCKIEN=$O(^BARECHK("B",BARCHKN,BARCKIEN)) Q:'+BARCKIEN  D  Q:+BARMTCH
  1.  . Q:$P($G(^BARECHK(BARCKIEN,0)),U,2)'=IMPDA
  1.  . S BARMTCH=1
  1.  I 'BARMTCH D ADD
  1.  Q:'+BARCKIEN
  1.  D UPD
  1.  Q
  1. ADD ;
  1.  ;Add new entry to A/R EDI Check
  1.  K DIC,DA,DR
  1.  S DIC="^BARECHK("
  1.  S DIC(0)="XZ"
  1.  S X=BARCHKN
  1.  K DO,DD D FILE^DICN
  1.  I +Y<1 D  Q
  1.  . S BARCKIEN=0
  1.  S BARCKIEN=+Y
  1.  Q
  1. UPD ;
  1.  ;Update entry in A/R EDI Check
  1.  K DIE,DIC,DA,DR,X,Y
  1.  S DIE="^BARECHK("
  1.  S DA=BARCKIEN
  1.  S DR=".02////^S X=IMPDA"  ;RLT - IM13516
  1.  I BARBATCH'="" S DR=DR_";.03////^S X=BARBATCH"
  1.  I BARITEM'="" S DR=DR_";.04///^S X=BARITEM"
  1.  D ^DIE
  1.  Q
  1. CONT ;
  1.  W !!
  1.  I +$G(BARMCNT)>0 D
  1.  . W !?2,BARMCNT_" "_$S(+$G(BARMCNT)=1:"ENTRY HAS ",1:"ENTRIES HAVE ")_"BEEN MATCHED.....................$",?50,$J($FN(BARMAMT,",",2),12)
  1.  I +$G(BARNCNT)>0 D
  1.  . W !?2,BARNCNT_" "_$S(+$G(BARNCNT)=1:"ENTRY HAS ",1:"ENTRIES HAVE ")_"NOT BEEN MATCHED.................$",?50,$J($FN(BARNAMT,",",2),12)
  1.  W !,?40,"TOTAL.....$",$J($FN((+$G(BARMAMT)+$G(BARNAMT)),",",2),12)
  1.  D EOP^BARUTL(1)
  1.  Q
  1. STORE ;
  1.  S BARI=0
  1.  F  S BARI=$O(BARCHK(BARI)) Q:'BARI  D
  1.  . Q:$P(BARCHK(BARI),U,3)=""  ;no batch
  1.  . D ^XBFMK
  1.  . S DA(1)=IMPDA
  1.  . S DA=BARI
  1.  . S DIE="^BAREDI(""I"","_DUZ(2)_","_DA(1)_",5,"
  1.  . S DR=".07////"_$P(BARCHK(BARI),U,3)_";.08////"_$P(BARCHK(BARI),U,4)_";.11///MPN"
  1.  . D ^DIE
  1.  Q
  1. DISPLAY ;
  1.  S BAR("PG")=0
  1.  S $P(BARDASH,"-",81)=""
  1.  D SETHDR
  1.  D HDB
  1.  S BARI=0
  1.  F  S BARI=$O(^BAREDI("I",DUZ(2),IMPDA,5,BARI)) Q:'BARI  D
  1.  . S BARREC=$G(^BAREDI("I",DUZ(2),IMPDA,5,BARI,0))
  1.  . S BARST=$P(BARREC,U,2)
  1.  . W !?1,$E(BARST,($L(BARST)-3),$L(BARST))
  1.  . I $P(BARREC,U,9) W "*" S BARPLB=1  ;PLB on chk
  1.  . W ?10,$J($FN($P(BARREC,U,3),",",2),12),?24,$P(BARREC,U)
  1.  . I $P(BARREC,U,7)="" W ?47,"NOT FOUND"
  1.  . I $P(BARREC,U,7)'="" D
  1.  . . S IENS=BARI_","_IMPDA_","
  1.  . . W ?47,$$GET1^DIQ(90056.02011,IENS,.07)_"  "_$P(BARREC,U,8)
  1.  Q
  1. SETHDR ;
  1.  ;Set up Rpt Hdr
  1.  K BARPCIEN,BARPC,BARIIEN,BARAIEN
  1.  K IMP
  1.  D ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")
  1.  S BAR("HD",0)="ERA/RPMS CHECK MATCHING REPORT"
  1.  S BAR("HD",1)="LOCATION: "_$$GET1^DIQ(4,DUZ(2),.01)
  1.  S BAR("HD",2)="FOR RPMS FILE: "_IMP(.01)
  1.  Q
  1. HDB ;EP
  1.  S BAR("COL")="W !,""ST"",?12,""AMOUNT"",?32,""CHECK#"",?50,""COLL. BATCH/ITEM FOUND"""
  1.  S BAR("PG")=BAR("PG")+1
  1.  I BAR("PG")>1 S BAR("LVL")=4
  1.  D WHD^BARRHD
  1.  X BAR("COL")
  1.  W !,BARDASH,!
  1.  Q
  1. BARXCHK(X) ;
  1.  I $D(^BARCOL(DUZ(2),"D",X)) Q X  ;CHECK # AS SEND IN ERA FILE
  1.  I $D(^BARCOL(DUZ(2),"D",+X)) Q +X  ;;CHECK # W/O LEADING ZEROES
  1.  Q X  ;NOT FOUND - DON'T CHANGE
  1.  ;-----EOR-----