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