PSAUP3 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
;This routine checks for correct X12 formating.
;
ORDER ; check order of code sheets
; isa <--------------+
; gs <----------+ |
; st <------+ | |
; | big | | |
; | it1 <--+ | | |
; | ... | | | |--repeats
; | it1 <--+ | | |
; | ctt | | |
; se <------+ | |
; ge <----------+ |
; iea <--------------+
S PSANEXT=$P(PSADATA,"^")
;
I PSALAST="GE",PSANEXT="GS" Q
I PSALAST="GE",PSANEXT'="IEA" D ORDERROR("GE",PSANEXT,"IEA") Q
;
I PSALAST="ISA",PSANEXT'="GS" D ORDERROR("ISA",PSANEXT,"GS") Q
;
I PSALAST="SE",PSANEXT="ST" Q
I PSALAST="SE",PSANEXT'="GE" D ORDERROR("SE",PSANEXT,"GE") Q
;
I PSALAST="GS",PSANEXT'="ST" D ORDERROR("GS",PSANEXT,"ST") Q
;
I PSALAST="CTT",PSANEXT'="SE" D ORDERROR("CTT",PSANEXT,"SE") Q
;
I PSALAST="ST",PSANEXT'="BIG" D ORDERROR("ST",PSANEXT,"BIG") Q
;
I PSALAST="IT1",PSANEXT="IT1" Q
I PSALAST="IT1",PSANEXT'="CTT"&(PSANEXT'="TDS") D ORDERROR("IT1",PSANEXT,"CTT") Q
Q
;
ORDERROR(PSALAST,PSANEW,PSAEXPEC) ;Segments out of order
;ISA segment should be first
I PSALAST="" S PSASEG="ORDER1" D MSG^PSAUTL2 Q
;Segments other than ISA
S PSASEG="ORDER2" D MSG^PSAUTL2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAUP3 1383 printed Dec 13, 2024@01:50:48 Page 2
PSAUP3 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
+2 ;This routine checks for correct X12 formating.
+3 ;
ORDER ; check order of code sheets
+1 ; isa <--------------+
+2 ; gs <----------+ |
+3 ; st <------+ | |
+4 ; | big | | |
+5 ; | it1 <--+ | | |
+6 ; | ... | | | |--repeats
+7 ; | it1 <--+ | | |
+8 ; | ctt | | |
+9 ; se <------+ | |
+10 ; ge <----------+ |
+11 ; iea <--------------+
+12 SET PSANEXT=$PIECE(PSADATA,"^")
+13 ;
+14 IF PSALAST="GE"
IF PSANEXT="GS"
QUIT
+15 IF PSALAST="GE"
IF PSANEXT'="IEA"
DO ORDERROR("GE",PSANEXT,"IEA")
QUIT
+16 ;
+17 IF PSALAST="ISA"
IF PSANEXT'="GS"
DO ORDERROR("ISA",PSANEXT,"GS")
QUIT
+18 ;
+19 IF PSALAST="SE"
IF PSANEXT="ST"
QUIT
+20 IF PSALAST="SE"
IF PSANEXT'="GE"
DO ORDERROR("SE",PSANEXT,"GE")
QUIT
+21 ;
+22 IF PSALAST="GS"
IF PSANEXT'="ST"
DO ORDERROR("GS",PSANEXT,"ST")
QUIT
+23 ;
+24 IF PSALAST="CTT"
IF PSANEXT'="SE"
DO ORDERROR("CTT",PSANEXT,"SE")
QUIT
+25 ;
+26 IF PSALAST="ST"
IF PSANEXT'="BIG"
DO ORDERROR("ST",PSANEXT,"BIG")
QUIT
+27 ;
+28 IF PSALAST="IT1"
IF PSANEXT="IT1"
QUIT
+29 IF PSALAST="IT1"
IF PSANEXT'="CTT"&(PSANEXT'="TDS")
DO ORDERROR("IT1",PSANEXT,"CTT")
QUIT
+30 QUIT
+31 ;
ORDERROR(PSALAST,PSANEW,PSAEXPEC) ;Segments out of order
+1 ;ISA segment should be first
+2 IF PSALAST=""
SET PSASEG="ORDER1"
DO MSG^PSAUTL2
QUIT
+3 ;Segments other than ISA
+4 SET PSASEG="ORDER2"
DO MSG^PSAUTL2
+5 QUIT
