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

BAREDI01.m

Go to the documentation of this file. 
  1. BAREDI01 ; IHS/SD/LSL - EDI TRANSPORT ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
  1.  ;;
  1.  ; IHS/SD/LSL - 12/24/2002 - V1.7 - XJG-1202-160021
  1.  ;       Allow user to pick new adjust categories 21 and 22
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. SELTRAN() ;EP SELECT TRANSPORT
  1.  N DIC,Y
  1.  S DIC=90056.01
  1.  S DIC(0)="AQEML"
  1.  S DLAYGO=90056
  1.  K DD,DO
  1.  D ^DIC
  1.  Q +Y
  1.  ; *********************************************************************
  1.  ;
  1. SELSEG(X)          ;EP SELECT SEGMENT GIVEN TRANSPORT
  1.  N DA,DIC,Y
  1.  S DA(1)=X
  1.  W @IOF,!,"Transport: ",$$VAL^XBDIQ1(90056.01,X,.01)
  1.  S DIC=$$DIC^XBDIQ1(90056.0101)
  1.  S DIC(0)="AEQM"
  1.  S DLAYGO=90056
  1.  K DD,DO
  1.  D ^DIC
  1.  Q +Y
  1.  ; *********************************************************************
  1.  ;
  1. SELTAB(X)          ;EP SELECT TABLE GIVEN SEGMENT
  1.  N DA,DIC,Y
  1.  S DA(1)=X
  1.  W @IOF,!,"Transport: ",$$VAL^XBDIQ1(90056.01,X,.01)
  1.  S DIC=$$DIC^XBDIQ1(90056.0105)
  1.  S DIC(0)="AEQM"
  1.  S DLAYGO=90056
  1.  K DD,DO
  1.  D ^DIC
  1.  Q +Y
  1.  ; *********************************************************************
  1.  ;
  1. DEMOG ;EP EDIT DEMOGRAPHICS OF TRANSPORT
  1.  N X1
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . S DA=X1
  1.  . S DIE=$$DIC^XBDIQ1(90056.01)
  1.  . S DR=".01:.06"
  1.  . D ^DIE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PRTVARS ;EP PRINT VARIABLES LOCATED IN THE TRANPORT
  1.  N X1
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . S TRDA=X1
  1.  . D VARPRT
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDTELEM ;EP EDIT ELEMENTS
  1.  N X1,X2
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . F  S X2=$$SELSEG(X1) Q:X2'>0  D
  1.  .. S DA=X2
  1.  .. S DA(1)=X1
  1.  .. S DR="[BAR ELEMENTS EDIT]"
  1.  .. S DDSFILE=90056.01
  1.  .. S DDSFILE(1)=90056.0101
  1.  ..D ^DDS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDTTAB ;EP EDIT Entries of a Table
  1.  N X1,X2
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . F  S X2=$$SELTAB(X1) Q:X2'>0  D
  1.  .. S DA=X2
  1.  .. S DA(1)=X1
  1.  .. S DR="[BAR EDI TABLE ID EDIT]"
  1.  .. S DDSFILE=90056.01
  1.  .. S DDSFILE(1)=90056.0105
  1.  ..D ^DDS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDTCLAIM ;EP EDIT CLAIM LEVEL CODES
  1.  N X1
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . S DA=X1
  1.  . S DDSFILE=90056.01
  1.  . S DR="[BAR CLAIM LEVEL CODES EDIT]"
  1.  . D ^DDS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDTLINE ;EP EDIT LINE LEVEL CODES
  1.  N X1
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . S DA=X1
  1.  . S DDSFILE=90056.01
  1.  . S DR="[BAR LINE LEVEL CODES EDIT]"
  1.  . D ^DDS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDTPROV ;EP EDIT PROVIDER LEVEL CODES
  1.  N X1
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . S DA=X1
  1.  . S DDSFILE=90056.01
  1.  . S DR="[BAR PROVIDER LEVEL CODES EDIT]"
  1.  . D ^DDS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDTVROU ;EP EDIT VARIABLE ROUTINES
  1.  N X1
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . S DA=X1
  1.  . S DDSFILE=90056.01
  1.  . S DR="[BAR PROCESS VARIABLE EDIT]"
  1.  . D ^DDS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDTDATA ;EP EDIT  DATA TYPES & CONVERSIONS
  1.  N X1
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . S DA=X1,DDSFILE=90056.01,DR="[BAR EDIT DATA TYPES]" D ^DDS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EDTSEG ;EP EDIT SEGMENTS
  1.  N X1
  1.  F  S X1=$$SELTRAN() Q:X1'>0  D
  1.  . S DA=X1
  1.  . S DDSFILE=90056.01
  1.  . S DR="[BAR EDIT SEGMENTS OF TRANSPORT]"
  1.  . D ^DDS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. TABNM() ;EP RETURN A TABLE NAME FOR TABLE ELEMENT DATA TYPES
  1.  ;MADE UP OF SEGMENT-ELEMENT
  1.  N X
  1.  S X=$$VAL^XBDIQ1(90056.0101,"D0,D1",.01)
  1.  S X=X_$$VAL^XBDIQ1(90056.0102,"D0,D1,D2",.01)
  1.  Q X
  1.  ; *********************************************************************
  1.  ;
  1. GENTAB ;EP SCAN ELEMENTS AND GENERATE TABLE NAMES 
  1.  S Y=$$SELTRAN
  1.  Q:Y'>0
  1.  S TRANDA=+Y
  1.  S TABID=$$VAL^XBDIQ1(90056.01,TRANDA,.03)
  1.  I '$L(TABID) D  Q
  1.  . W !,"TABLE ID NOT SET - EXITING",!
  1.  . H 2
  1.  W @IOF
  1.  W !,$$VAL^XBDIQ1(90056.01,TRANDA,01),!
  1.  I '$D(^BAREDI("1T",TRANDA,10,0)) D  Q
  1.  . W !,"NO SEGMENTS - EXITING",!
  1.  . H 2
  1.  I $D(^BAREDI("1T",TRANDA,30)) D  Q
  1.  . W !,"TABLES ALREADY EXIST - EXITING",!
  1.  . H 2
  1.   W !,"HM .. CHECK FAILED"
  1.   Q
  1.  ; *********************************************************************
  1.  ;
  1. SETTAB ;EP  Set Table names of data types that are tables to SEG_"-"_ELEMENT
  1.  ; ie field #1 of element & add forward & backward pointer values
  1.  S ELEMDA=0
  1.  F  S ELEMDA=$O(ELEM(ELEMDA)) Q:ELEMDA'>0  D
  1.  . K DIC,DA,DR
  1.  . S DIC=$$DIC^XBDIQ1(90056.0105)
  1.  . S DIC(0)="XMLE"
  1.  . S DLAYGO=90056
  1.  . S DIC("P")="90056.0105A"
  1.  . S DA(1)=TRANDA
  1.  . S X=ELEM(ELEMDA,1)
  1.  . W !,?10,X
  1.  . K DD,DO
  1.  . D ^DIC
  1.  . S (DA,TABDA)=+Y
  1.  . S VAL=TRANDA_","_SEGDA_","_ELEMDA
  1.  . S DIE=DIC
  1.  . S DR=".02///^S X=VAL"
  1.  . D ^DIE
  1.  . K DIC,DA,DIE,DR
  1.  . S DIE=$$DIC^XBDIQ1(90056.0102)
  1.  . S DA=ELEMDA
  1.  . S DA(1)=SEGDA
  1.  . S DA(2)=TRANDA
  1.  . S DR=".07////"_TRANDA_","_TABDA
  1.  . D ^DIE
  1.  . K TABDA,DA,DIC,DIE,DR
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DICSTYP ;EP Set DIC("S") for selection of postable CATEGORY/TYPE  tables
  1.  S DIC("S")="I (Y=3)!(Y=4)!(Y=13)!(Y=14)!(Y=15)!(Y=16)!(Y=20)!(Y=21)!(Y=22)"
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DICSREA ;EP Set DIC("S") for selection of reasons based on the Posting CATEGORY/TYPE selected
  1.  S DIC("S")="N Z S Z=$P(^(0),U,2) I Z=+$G(^BAREDI(""1T"",DA(1),40,DA,2))"
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. VARPRT ;EP XBLM CALL FOR VARPRT
  1.  ;
  1. PRT ;EP
  1.  ; GET DEVICE (QUEUEING ALLOWED)
  1.  S Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)
  1.  K DA
  1.  Q:$D(DIRUT)
  1.  I Y="B" D  Q
  1.  . S XBFLD("BROWSE")=1
  1.  . S BARIOSL=IOSL
  1.  . S IOSL=600
  1.  . D VIEWR^XBLM("PRTVARS^BAREDIUT(TRDA)")
  1.  . D FULL^VALM1
  1.  . W $$EN^BARVDF("IOF")
  1.  .D CLEAR^VALM1  ;clears out all list man stuff
  1.  .K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF
  1.  .K VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP
  1.  .K VALMY,XQORS,XQORSPEW,VALMCOFF
  1.  .;
  1. DEVE .;
  1.  .S IOSL=BARIOSL
  1.  .K BARIOSL
  1.  .Q
  1.  S XBRP="PRTVARS^BAREDIUT(TRDA)"
  1.  S XBNS="TRDA"
  1.  S XBRX="EXIT^BAREDP07"
  1.  D ^XBDBQUE
  1.  K DIR
  1.  S DIR(0)="E"
  1.  S DIR("A")="<CR> - Continue"
  1.  D ^DIR
  1.  K DIR
  1.  ;
  1. ENDJOB ;
  1.  Q