PSABRKU5.m

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 ---PSABRKU5   1169     printed  Feb 18, 2025@23:15:19                                                                                                                                                                                                    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