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

BARUFEX3.m

Go to the documentation of this file. 
  1. BARUFEX3 ; IHS/SD/TPF - CONTINUATION OF EXPORT TO PROCESS PAYMENTS ;10/31/08
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,6,7,8,23**;OCT 26, 2005
  1.  ;NEW ROUTINE ;ITEM 1 OF SCR58 1/2/2008
  1.  ;BAR*1.8*4 DD ITEM 4.1.1
  1.  ;
  1. REVERSAL() ;EP; CHECK REVERSAL DATES AND FIX IF POSSIBLE
  1.  ;          RETURNS ORIGINAL SCHEDULE NUMBER IF REVERSAL
  1.  ;
  1.  ; FIX ANY TRANSACTION HAS A 0 REVERSAL DATE
  1.  I $P($G(^BARTR(DUZ(2),TRDATE,1)),U,10)=0 D DEPOP  ;CLEAN BAD DATA
  1.  ;
  1.  ; FIX TRANTYPE NOT = PAYMENT WITH A REVERSAL DATE
  1.  I TRANTYPE='"PAYMENT",($P($G(^BARTR(DUZ(2),TRDATE,1)),U,10)) D  Q ""
  1.  .D DEPOP
  1.  ;
  1.  ; FIX TRANTYPE = PAYMENT WITH A REVERSAL DATE AND A POSITIVE AMT
  1.  I (ARCRDEB>0!(ARCRDEB=0)),$P($G(^BARTR(DUZ(2),TRDATE,1)),U,10) D  Q ""
  1.  .D DEPOP
  1.  ;
  1.  ; ONLY LOOK AT PAYMENTS
  1.  I TRANTYPE'="PAYMENT" Q ""
  1.  ;
  1.  ; CHECK FOR BATCH
  1.  I ARCOLITM=""!(ARCOLIN="") D  Q ""                ;NOT OK
  1. ERR23 .D ERR^BARUFEXU(23)                               ;NO BATCH IN TX
  1.  .S ARBILL=""
  1.  ;
  1.  ; CHECK BOB FOR CODES
  1.  N SCHED,BARFLG,BARZ0
  1.  S BARZ0=$G(^BARBOB("BARZ",BARDUZ,DUZ(2),ARCOLIN,ARCOLITM,TRDATE))
  1.  S BARFLG=$P(BARZ0,U,5)             ;PAIR OR -ERROR FLAG
  1.  S SCHED=$$IPAC^BARUFEX4(ARCOLIN,ARCOLITM,TRDATE_",")
  1.  I '$$CKIPAC(SCHED) Q ""   ;BAD IPAC ERROR 5
  1. IGNORE I BARFLG="-I" D  Q ""     ;PERMANENTLY IGNORABLE PAIR
  1.  .D SETI
  1.  .D ERR^BARUFEXU("I")
  1.  .S ARBILL=""
  1.  I BARFLG=1 D POP Q SCHED     ;ORIGINAL NOT IN BILL, BUT PAIRED IN BATCH/ITEM
  1.  I BARFLG=2 D POP Q SCHED     ;SIMPLE REVERSAL ALREADY PAIRED
  1. ERRNEG I $E(BARFLG)="-" D  Q ""     ;ONE OF THE MINUS CODES
  1.  .D ERR^BARUFEXU(-BARFLG)
  1.  .S ARBILL=""
  1.  ;
  1.  ;CHECK +DOLLAR PAYMENTS FOR REVERSALS THEN QUIT
  1.  I ARCRDEB>0 D  Q SCHED
  1.  .S BAROK=$$COLCK^BARUFEX4(BARDUZ)  ;BATCH/ITEM CHECK
  1.  .I 'BAROK S (ARBILL,SCHED)=""      ;DIDN'T FIND MATCH
  1.  ;
  1. DIAG ;NOTHING SHOULD REACH THIS POINT AFTER NEW CODING
  1. DIAG1 W !!,"*** ERROR **** ENTERING CHECK FOR ERA OR MANUAL REVERSALS "
  1.  W !?5,UDUZ,"  ",TRDATE,"  ",ARBILLIN,"  ",BARZ0
  1.  S ARBILL=""
  1.  Q ""
  1.  ;
  1. POP ;POPULATE THE REVERSAL FIELDS
  1.  S SCHED=$P(BARZ0,U,2)              ;GET MATCHED TDN/IPAC
  1.  S DA=TRDATE
  1.  S DIE="^BARTR("_DUZ(2)_","
  1.  ;S DR="110////"_$P($P(BARZ0,U,8),".",1)         ;MRS:BAR*1.8*6 IM29571
  1.  S DR="110////"_$P(BARZ0,U,11)                   ;MRS:BAR*1.8*6 IM29571
  1.  S DR=DR_";111////"_SCHED
  1.  D ^DIE
  1.  K DIR,DR,DIC,DA,DIE
  1.  Q
  1. SETI ;POPULATE THE IGNORE TRANSACTION FIELD
  1.  S DA=TRDATE
  1.  S DIE="^BARTR("_DUZ(2)_","
  1.  S DR="112////I"
  1.  D ^DIE
  1.  K DIR,DR,DIC,DA,DIE
  1.  Q
  1. DEPOP ;EP - DE POPULATE IF REVERSAL DATES NOT FOUND
  1.  ;ONLY FOR BETA SITES
  1.  K DIR,DIE,DIC,DA,DR
  1.  S DA=TRDATE
  1.  S DR="110///@;111///@"
  1.  S DIE="^BARTR("_DUZ(2)_","
  1.  D ^DIE
  1.  K DIR,DIE,DIC,DA,DR
  1.  Q
  1.  ;
  1. GOODIPAC(X) ;EP - INPUT TRANSFORM FOR TREASURY SCHEDULE NUMBER/IPAC
  1.  N Z
  1.  I X="NONPAYMENT" Q 1
  1.  I X="PRE-UFMS_COLLECTIONS" Q 1
  1.  S Z=$$UPC^BARUTL(X)
  1.  S Z=$TR(Z,"-,")
  1.  I Z["NON" Q 0                  ;CHECK FOR NON IN ANY FORM
  1.  I $L(X)>5,$L(X)<21,X?.UN Q 1   ;MIN/MAX MIXED ALPHA/NUMERIC ;MRS:BAR*1.8*7 IM30201
  1.  I $L(X)<6!($L(X)>20) Q 0       ;MIN/MAX CHECK ;MRS:BAR*1.8*7 IM30201
  1.  ;RE-WRITTEN TO ALLOW FY# PREFIX ;MRS:BAR*1.8*8 D150
  1.  ;I $E(X,1,2)?1U1"-",$E(X,3,20)?.UN Q 1   ;IPAC WITH DASH AND MIXED ALPHA/NUMERIC ;MRS:BAR*1.8*7 IM30201;MRS:BAR*1.8*8
  1.  N ZZ
  1.  S ZZ=X
  1.  I $E(Z,1,2)="FY" S ZZ=$E(X,4,20)  ;ALLOW FY# PREFIX ;MRS:BAR*1.8*8 D150
  1.  I $E(ZZ,1,2)?1U1"-",$E(ZZ,3,20)?.UN Q 1  ;MRS:BAR*1.8*8 D150
  1.  I X?.UN Q 1                    ;STRAIGHT MIXED ALPHA/NUMERIC ;MRS:BAR*1.8*7 IM30201
  1.  Q 0
  1.  ;
  1. FINDREV ;EP - FIND REVERSALS ON THE SYSTEM - THIS IS FOR TESTING ONLY
  1.  N TEMPDUZ2,TRDATE,REVDATE,SCHEDNUM,ARCOL,ARITEM,SOURCE
  1.  N TRANTYPE,CREDDEB
  1.  S TEMPDUZ2=DUZ(2)
  1.  S DUZ(2)=1
  1.  F  S DUZ(2)=$O(^BARTR(DUZ(2)))  Q:'DUZ(2)  D
  1.  . Q:'$$IHS^BARUFUT(DUZ(2))
  1.  . ;;;Q:'$$IHSERA^BARUFUT(DUZ(2)) ;P.OTT
  1.  .S FACILITY=$$GET1^DIQ(9999999.06,DUZ(2)_",",.01,"E")
  1.  .S TRDATE=0
  1.  .F  S TRDATE=$O(^BARTR(DUZ(2),TRDATE)) Q:'TRDATE  D
  1.  ..S REVDATE=$$GET1^DIQ(90050.03,TRDATE_",",110)
  1.  ..S SCHEDNUM=$$GET1^DIQ(90050.03,TRDATE_",",111)
  1.  ..Q:SCHEDNUM=""&(REVDATE="")
  1.  ..S SOURCE=$$GET1^DIQ(90050.03,TRDATE_",",106)
  1.  ..S ARBILL=$$GET1^DIQ(90050.03,TRDATE_",",4)
  1.  ..S TRANTYPE=$$GET1^DIQ(90050.03,TRDATE_",",101)
  1.  ..S ARCOL=$$GET1^DIQ(90050.03,TRDATE_",",14)
  1.  ..S ARITEM=$$GET1^DIQ(90050.03,TRDATE_",",15)
  1.  ..S ARCRDEB=$$GET1^DIQ(90050.03,TRDATE,3.5,"E")
  1.  ..W !!!,"FACILITY: ",FACILITY
  1.  ..W !,"BILL: ",ARBILL
  1.  ..W !,"TRDATE: ",TRDATE
  1.  ..W !,"TRANTYPE: ",TRANTYPE
  1.  ..W !,"REVDATE: ",REVDATE
  1.  ..W !,"SCHEDNUM: ",SCHEDNUM
  1.  ..W !,"ARCOL: ",ARCOL
  1.  ..W !,"ARITEM: ",ARITEM
  1.  ..W !,"SOURCE: ",SOURCE
  1.  ..W !,"CREDIT-DEBIT: ",ARCRDEB
  1.  S DUZ(2)=TEMPDUZ2
  1.  Q
  1. CKIPAC(X) ;
  1.  ;ENTERS WITH  X = SCHEDULE NUMBER
  1.  ;
  1.  I '$$GOODIPAC(X) D  Q 0   ;STILL NOT AN ACCEPTABLE SCHEDULE # FORMAT
  1. ERR5 .D ERR^BARUFEXU(5)            ;Bad schedule number
  1.  .S ARBILL=""
  1.  Q 1