source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPDAPE.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1PRCPDAPE ;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 ;
7NONTYPE ; 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 ;
12ERROR(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 ;
19ORDER ; 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 ;
50ORDERROR(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
Note: See TracBrowser for help on using the repository browser.