PSABRKU5 ;BIR/DB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,67**; 10/24/97;Build 15
;This routine checks for correct X12 formating.
;
ORDER ; check order of code sheets
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
;
;adding next two lines for new format
I PSALAST="IT1",PSANEXT="PID" Q
I PSALAST="PO4",PSANEXT'="IT1",PSANEXT'="CTT"&(PSANEXT'="TDS") D ORDERROR("PO4",PSANEXT,"CTT") Q
;End of PSA*3*67 Changes
Q
;
ORDERROR(PSALAST,PSANEW,PSAEXPEC) ;Segments out of order
;ISA segment should be first
I PSALAST="" S PSASEG="ORDER1" D MSG^PSABRKU8 Q
;Segments other than ISA
S PSASEG="ORDER2" D MSG^PSABRKU8
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSABRKU5 1169 printed Dec 13, 2024@01:48:56 Page 2
PSABRKU5 ;BIR/DB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,67**; 10/24/97;Build 15
+2 ;This routine checks for correct X12 formating.
+3 ;
ORDER ; check order of code sheets
+1 SET PSANEXT=$PIECE(PSADATA,"^")
+2 ;
+3 IF PSALAST="GE"
IF PSANEXT="GS"
QUIT
+4 IF PSALAST="GE"
IF PSANEXT'="IEA"
DO ORDERROR("GE",PSANEXT,"IEA")
QUIT
+5 ;
+6 IF PSALAST="ISA"
IF PSANEXT'="GS"
DO ORDERROR("ISA",PSANEXT,"GS")
QUIT
+7 ;
+8 IF PSALAST="SE"
IF PSANEXT="ST"
QUIT
+9 IF PSALAST="SE"
IF PSANEXT'="GE"
DO ORDERROR("SE",PSANEXT,"GE")
QUIT
+10 ;
+11 IF PSALAST="GS"
IF PSANEXT'="ST"
DO ORDERROR("GS",PSANEXT,"ST")
QUIT
+12 ;
+13 IF PSALAST="CTT"
IF PSANEXT'="SE"
DO ORDERROR("CTT",PSANEXT,"SE")
QUIT
+14 ;
+15 IF PSALAST="ST"
IF PSANEXT'="BIG"
DO ORDERROR("ST",PSANEXT,"BIG")
QUIT
+16 ;
+17 ;adding next two lines for new format
+18 IF PSALAST="IT1"
IF PSANEXT="PID"
QUIT
+19 IF PSALAST="PO4"
IF PSANEXT'="IT1"
IF PSANEXT'="CTT"&(PSANEXT'="TDS")
DO ORDERROR("PO4",PSANEXT,"CTT")
QUIT
+20 ;End of PSA*3*67 Changes
+21 QUIT
+22 ;
ORDERROR(PSALAST,PSANEW,PSAEXPEC) ;Segments out of order
+1 ;ISA segment should be first
+2 IF PSALAST=""
SET PSASEG="ORDER1"
DO MSG^PSABRKU8
QUIT
+3 ;Segments other than ISA
+4 SET PSASEG="ORDER2"
DO MSG^PSABRKU8
+5 QUIT
