| 1 | PRCPDAPE ;WISC/RFJ-drug accountability/prime vendor (errors) ;15 Mar 94
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | NONTYPE ; check for order of buyer, seller, ship
|
|---|
| 8 | I NTYPE="" D ERROR("THE IDENTIFIER SEGMENT 'N1' NEEDS TO COME BEFORE THE '"_$P(DATA,"^")_"' SEGMENT")
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | ERROR(MSG) ; show error
|
|---|
| 13 | W !,DATA
|
|---|
| 14 | K X S X(1)=MSG D DISPLAY^PRCPUX2(1,79,.X)
|
|---|
| 15 | S PRCPFLAG=1
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | ;
|
|---|
| 19 | ORDER ; check order of code sheets
|
|---|
| 20 | ; isa <--------------+
|
|---|
| 21 | ; gs <----------+ |
|
|---|
| 22 | ; st <------+ | |
|
|---|
| 23 | ; | big | | |
|
|---|
| 24 | ; | it1 <--+ | | |
|
|---|
| 25 | ; | ... | | | |--repeats
|
|---|
| 26 | ; | it1 <--+ | | |
|
|---|
| 27 | ; | ctt | | |
|
|---|
| 28 | ; se <------+ | |
|
|---|
| 29 | ; ge <----------+ |
|
|---|
| 30 | ; iea <--------------+
|
|---|
| 31 | S NEXTSEG=$P(DATA,"^")
|
|---|
| 32 | I LASTSEG="",NEXTSEG'="ISA" D ORDERROR("",NEXTSEG,"ISA") Q
|
|---|
| 33 | I LASTSEG="GE",NEXTSEG="GS" Q
|
|---|
| 34 | I LASTSEG="GE",NEXTSEG'="IEA" D ORDERROR("GE",NEXTSEG,"IEA") Q
|
|---|
| 35 | ;
|
|---|
| 36 | I LASTSEG="ISA",NEXTSEG'="GS" D ORDERROR("ISA",NEXTSEG,"GS") Q
|
|---|
| 37 | I LASTSEG="SE",NEXTSEG="ST" Q
|
|---|
| 38 | I LASTSEG="SE",NEXTSEG'="GE" D ORDERROR("SE",NEXTSEG,"GE") Q
|
|---|
| 39 | ;
|
|---|
| 40 | I LASTSEG="GS",NEXTSEG'="ST" D ORDERROR("GS",NEXTSEG,"ST") Q
|
|---|
| 41 | I LASTSEG="CTT",NEXTSEG'="SE" D ORDERROR("CTT",NEXTSEG,"SE") Q
|
|---|
| 42 | ;
|
|---|
| 43 | I LASTSEG="ST",NEXTSEG'="BIG" D ORDERROR("ST",NEXTSEG,"BIG") Q
|
|---|
| 44 | ;
|
|---|
| 45 | I LASTSEG="IT1",NEXTSEG="IT1" Q
|
|---|
| 46 | I LASTSEG="IT1",NEXTSEG'="CTT" D ORDERROR("IT1",NEXTSEG,"CTT") Q
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | ;
|
|---|
| 50 | ORDERROR(LAST,NEW,EXPECT) ; segments out of order
|
|---|
| 51 | ; isa segment should be first
|
|---|
| 52 | I LAST="" D ERROR("SEGMENTS OUT OF ORDER, THE STARTING SEGMENT SHOULD BE 'ISA', NOT '"_NEW_"'") Q
|
|---|
| 53 | ; segments other than isa
|
|---|
| 54 | D ERROR("SEGMENTS OUT OF ORDER, THE SEGMENT FOLLOWING '"_LAST_"' SHOULD BE '"_EXPECT_"', NOT '"_NEW_"'") Q
|
|---|
| 55 | Q
|
|---|
