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

BARUFER.m

Go to the documentation of this file. 
  1. BARUFER ; IHS/SD/TPF - UFMS ERROR RESOLUTION ; 10/24/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,7,8,23**;OCT 26, 2005
  1.  Q
  1.  ;
  1. LKUP ;EP - LOOK UP ERROR REPORTED BY UFMS
  1.  N SEARCH,TARGET,CHOICE,ITEM,MAX,LINE,ESC
  1.  D ERRHDR
  1.  S $P(LINE,"-",81)=""
  1.  K DIR,DIC,DIE,DR,DA
  1.  S DIR("?",1)="Enter an 'APPLY TO' value. This corresponds to the 3P invoice #,"
  1.  S DIR("?",2)="or Enter a partial 'APPLY TO' value,"
  1.  S DIR("?")="or enter a '*' to get a list of all 'APPLY TO' values on file"
  1.  S DIR("A")="Enter an 'APPLY TO' value: "
  1.  S DIR(0)="FO^1:20"
  1.  D ^DIR
  1.  Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(Y="")
  1.  ;
  1.  S TARGET=Y
  1.  K CHOICES
  1.  I Y="*" S SEARCH="",TARGET=""
  1.  E  S SEARCH=TARGET-1
  1.  S (MAX,ESC,CHOICE)=0
  1.  F ITEM=1:1 S SEARCH=$O(^BARSESS(DUZ(2),"E",SEARCH)) Q:SEARCH=""!($E(SEARCH,1,$L(TARGET))'=TARGET)!(ESC)!(CHOICE)  D  ;MRS:BAR*1.8*8 HEAT739
  1.  .;F ITEM=1:1 S SEARCH=$O(^BARSESS(DUZ(2),"E",SEARCH)) Q:SEARCH=""!(ESC)!(CHOICE)  D  ;MRS:BAR*1.8*8 HEAT739
  1.  .S CHOICES(ITEM)=SEARCH
  1.  .S MAX=MAX+1
  1.  .W !,ITEM_". "_CHOICES(ITEM)
  1.  .I '(ITEM#10)!('$O(^BARSESS(DUZ(2),"E",SEARCH))) K DIR S DIR(0)="NO^1:"_MAX W ! D ^DIR Q:Y=""  S ESC=$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q:ESC  S CHOICE=CHOICES(+Y)
  1.  I '$D(CHOICES) W "   ??" H 2 G LKUP
  1.  I ITEM=2,$D(CHOICES) D ARTRAN(CHOICES(1)) G LKUP
  1.  G:ESC!'(CHOICE) LKUP
  1.  D ARTRAN(CHOICE)
  1.  G LKUP
  1.  Q
  1.  ;
  1. ARTRAN(APPLYTO) ;EP - PULL TRANSACTION DATA
  1.  N TRDATE,EXDATE,BILL,BILLIEN,TPBIEN,TRANTYP,ADJCAT,ENTRYBY
  1.  S PAGE=0
  1.  D LKUPHDR(APPLYTO)
  1.  D TRDETAIL
  1.  S TRDATE="",ESC=0
  1.  F  S TRDATE=$O(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE)) Q:'TRDATE!(ESC)  D
  1.  .S CREDIT=$$GET1^DIQ(90050.03,TRDATE_",",2)
  1.  .S DEBIT=$$GET1^DIQ(90050.03,TRDATE_",",3)
  1.  .S BILL=$$GET1^DIQ(90050.03,TRDATE_",",4)
  1.  .S BLLIEN=$$GET1^DIQ(90050.03,TRDATE_",",4,"I")
  1.  .S ENTRYBY=$$GET1^DIQ(90050.03,TRDATE_",",13,"E")
  1.  .S TPBIEN=$$GET1^DIQ(90050.01,BLLIEN_",",17,"I")
  1.  .S TRANTYP=$$GET1^DIQ(90050.03,TRDATE_",",101,"E")
  1.  .S ADJCAT=$$GET1^DIQ(90050.03,TRDATE_",",102,"E")
  1.  .S SESSID=$O(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE,""))
  1.  .S UDUZ=$O(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE,SESSID,""))
  1.  .W !,BILL
  1.  .S Y=TRDATE X ^DD("DD") S EXDATE=Y
  1.  .W ?18,EXDATE
  1.  .W ?50,SESSID
  1.  .;W ?65,$E($P($G(^VA(200,DUZ,0)),U),1,15)  ;MRS;BAR*1.8*7
  1.  .W ?65,$E($P($G(^VA(200,UDUZ,0)),U),1,15)  ;MRS;BAR*1.8*7
  1.  .W !?10,ENTRYBY
  1.  .W ?30,$J(CREDIT,10,2)
  1.  .W ?40,$J(DEBIT,10,2)
  1.  .W ?52,$E(TRANTYP,1,15)
  1.  .W ?70,$E(ADJCAT,1,10)
  1.  .I $Y>(IOSL-4) W ! K DIR S DIR(0)="E" D ^DIR S ESC=$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q:ESC  D LKUPHDR(APPLYTO),TRDETAIL
  1.  .S DELSEND=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.08,"E")
  1.  .I DELSEND'="" D
  1.  ..W !?15,"FILE SENT IN DELAYED MODE:"
  1.  ..W !?20,DELSEND
  1.  .;SESSION TRANSMISSION DATES
  1.  .S TRANSDT=0  ;TRANSMISSION DATE
  1.  .F CNT=1:1 S TRANSDT=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,TRANSDT)) Q:'TRANSDT!ESC  D
  1.  ..S IENS=TRANSDT_","_SESSID_","_UDUZ_","
  1.  ..S EXTRANS=$$GET1^DIQ(90057.210101,IENS,.01,"E")
  1.  ..W:CNT=1 !?15,"SESSION TRANSMISSION DATE: ",EXTRANS
  1.  ..I $Y>(IOSL-4) W ! K DIR S DIR(0)="E" D ^DIR S ESC=$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q:ESC  D TRANSHDR
  1.  ..S FILENAME=$$GET1^DIQ(90057.210101,IENS,.02,"E")
  1.  ..S BY=$$GET1^DIQ(90057.210101,IENS,.03,"E")
  1.  ..W !?15,"IN FILE: ",FILENAME
  1.  ..W !?15,"     BY: ",BY
  1.  Q:ESC
  1.  K DIR
  1.  S DIR(0)="E"
  1.  W !
  1.  D ^DIR
  1.  Q
  1.  ;
  1. LKUPHDR(APPLYTO) ;
  1.  N PARENT,SATELITE
  1.  W @IOF
  1.  S PAGE=$G(PAGE)+1
  1.  S X="VIEWING TRANSACTIONS ASSOCIATED WITH 'APPLY TO'"
  1.  S X=$J("",IOM-$L(X)\2-$X)_X
  1.  W !,X
  1.  W ?70,"PAGE ",PAGE
  1.  W !
  1.  W $$CJ^XLFSTR("FIELD OF "_APPLYTO,IOM)
  1.  S PARENT=$E(APPLYTO,1,6)
  1.  S SATELITE=$E(APPLYTO,7,12)
  1.  K DIC,DIR,DIE,DA,DR
  1.  S DIC="^AUTTLOC("
  1.  S D="CTOO"
  1.  S DIC(0)=""
  1.  S X=PARENT
  1.  D IX^DIC
  1.  I Y<0 D
  1.  .S D="C"
  1.  .S DIC(0)=""
  1.  .S X=PARENT
  1.  .D IX^DIC
  1.  I Y<0 S PARENTNM="CAN'T BE FOUND"
  1.  E  S PARENTNM=$$GET1^DIQ(9999999.06,+Y_",",.01,"E")
  1.  K DIC,DIR,DIE,DA,DR
  1.  S DIC="^AUTTLOC("
  1.  S D="CTOO"
  1.  S DIC(0)=""
  1.  S X=SATELITE
  1.  D IX^DIC
  1.  I Y<0 D
  1.  .S D="C"
  1.  .S DIC(0)=""
  1.  .S X=SATELITE
  1.  .D IX^DIC
  1.  I Y<0 S SATNAME="CAN'T BE FOUND"
  1.  E  S SATNAME=$$GET1^DIQ(9999999.06,+Y_",",.01,"E")
  1.  K DIC,DIR,DIE,DA,DR
  1.  W $$CJ^XLFSTR("PARENT:   "_PARENTNM,IOM)
  1.  W $$CJ^XLFSTR("SATELLITE: "_SATNAME,IOM)
  1.  Q
  1.  ;
  1. TRDETAIL ;
  1.  W !!?3,"A/R BILL"
  1.  W ?18,"TRAN. DATE"
  1.  W ?50,"SESSION ID"
  1.  W ?65,"SENT BY"
  1.  W !?10,"ENTRY BY"
  1.  W ?35,"CREDIT"
  1.  W ?45,"DEBIT"
  1.  W ?52,"TRANTYPE"
  1.  W ?70,"ADJCAT"
  1.  W !,LINE
  1.  Q
  1.  ;
  1. ERRHDR ;EP - ERROR SCREEN HEADER
  1.  W @IOF
  1.  W !!,$$CJ^XLFSTR("TRANSACTION LOOKUP BY 'APPLY TO' FIELD",IOM)
  1.  W !
  1.  Q
  1.  ;
  1. TRANSHDR ;EP - TRANSMISSION HEADER
  1.  W @IOF
  1.  W !?15,"SESSION TRANSMISSION DATE: ",EXTRANS
  1.  Q