- PSABRKU8 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data Utility ;9/19/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26**; 10/24/97
- ;This routine is a utility that writes X12 errors to the screen. It is
- ;used during the uploading of prime vendor invoices. It is called by
- ;PSAUP2 and PSAUP3.
- ;
- ERROR ;Writes X12 error messages.
- S PSASLN="",$P(PSASLN,"-",80)=""
- S X12="The format of the invoice file is incorrect." D SETMSG
- S X12="Call your IRM staff and relay the error messages listed below." D SETMSG
- S X12=" " D SETMSG S X12="ERROR MESSAGES:" D SETMSG S X12=PSASLN D SETMSG
- S PSACTRL2="" F S PSACTRL2=$O(PSAERR(PSACTRL2)) Q:PSACTRL2="" S X12="Control# "_PSACTRL2_":" D SETMSG D
- .S PSASEG="" F S PSASEG=$O(PSAERR(PSACTRL2,PSASEG)) Q:PSASEG="" S X12=PSAERR(PSACTRL2,PSASEG) D SETMSG
- Q
- MSG S:$G(PSACTRL)="" PSACTRL="UNKNOWN"
- I PSASEG="ISA" S PSAERR(PSACTRL,PSASEG)="The ISA control# (piece 14) should be 9 characters in length." Q
- I PSASEG="IEA" S PSAERR(PSACTRL,PSASEG)="The IEA control# (piece 3) should equal the ISA control# (piece 14 = "_$P($G(PSAISA),"^",14)_")" Q
- I PSASEG="GS" S PSAERR(PSACTRL,PSASEG)="GS piece "_%_" should equal ISA's piece "_$G(PSAPC)_" ("_$TR($P($G(PSAISA),"^",$G(PSAPC))," ")_")." Q
- I PSASEG="GE" S PSAERR(PSACTRL,PSASEG)="The GE control# (piece 3) should equal GS's control# piece 7 ("_$P($G(PSAGS),"^",7)_")." Q
- I PSASEG="ST" S PSAERR(PSACTRL,PSASEG)="The ST control# (piece 3) should be 4 to 9 characters in length." Q
- I $E(PSASEG,1,2)="SE" D Q
- .I PSASEG="SE1" S PSAERR(PSACTRL,PSASEG)="The SE control# (piece 3) should be equal to ST's control# (piece 3 = "_PSACTRL_")" Q
- .I PSASEG="SE2" S PSAERR(PSACTRL,PSASEG)="SE's count of segments (piece 2) should equal the number of segments ("_$G(PSASTCNT)_")."
- I PSASEG="N1" S PSAERR(PSACTRL,PSASEG)="N1's piece 2 should equal 'BY', 'DS' OR 'ST'."
- I PSASEG="NONTYPE" S PSAERR(PSACTRL,PSASEG)="The identifier segment 'N1' needs to come before the '"_$P($G(PSADATA),"^")_"' segment." Q
- I PSASEG="CTT" S PSAERR(PSACTRL,PSASEG)="CTT's line item count (piece 2) should equal the number of line items ("_$G(PSAITCNT)_")."
- I $E(PSASEG,1,3)="IT1" D Q
- .I PSASEG="IT1-1" S PSAERR(PSACTRL,PSASEG)="The IT1 invoice line number "_$G(PSAITEM)_" (piece 2) is not defined." Q
- .I PSASEG="IT1-2" S PSAERR(PSACTRL,PSASEG)="The IT1 unit price code (piece 6) should equal 'DS' for discount." Q
- .I PSASEG="IT1-3" S PSAERR(PSACTRL,PSASEG)="The IT1 does not contain a NDC (piece 8) or an UPC (piece 12)."
- I PSASEG="ORDER1" S PSAERR(PSACTRL,PSASEG)="Segments are out of order. The starting segment should be 'ISA', not '"_$G(PSANEW)_"'." Q
- I PSASEG="ORDER2" S PSAERR(PSACTRL,PSASEG)="Segments are out of order. The segment following '"_$G(PSALAST)_"' should be '"_$G(PSAEXPEC)_"', not '"_$G(PSANEW)_"'."
- Q
- NONTYPE ;
- I PSANTYPE="" S PSASEG="NONTYPE" D ERROR
- Q
- SETMSG S PSAMCNT=$G(PSAMCNT)+1,^TMP($J,"PSA UPLOAD",PSAMCNT,0)=$G(X12) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSABRKU8 2972 printed Jan 18, 2025@02:50:12 Page 2
- PSABRKU8 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data Utility ;9/19/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26**; 10/24/97
- +2 ;This routine is a utility that writes X12 errors to the screen. It is
- +3 ;used during the uploading of prime vendor invoices. It is called by
- +4 ;PSAUP2 and PSAUP3.
- +5 ;
- ERROR ;Writes X12 error messages.
- +1 SET PSASLN=""
- SET $PIECE(PSASLN,"-",80)=""
- +2 SET X12="The format of the invoice file is incorrect."
- DO SETMSG
- +3 SET X12="Call your IRM staff and relay the error messages listed below."
- DO SETMSG
- +4 SET X12=" "
- DO SETMSG
- SET X12="ERROR MESSAGES:"
- DO SETMSG
- SET X12=PSASLN
- DO SETMSG
- +5 SET PSACTRL2=""
- FOR
- SET PSACTRL2=$ORDER(PSAERR(PSACTRL2))
- if PSACTRL2=""
- QUIT
- SET X12="Control# "_PSACTRL2_":"
- DO SETMSG
- Begin DoDot:1
- +6 SET PSASEG=""
- FOR
- SET PSASEG=$ORDER(PSAERR(PSACTRL2,PSASEG))
- if PSASEG=""
- QUIT
- SET X12=PSAERR(PSACTRL2,PSASEG)
- DO SETMSG
- End DoDot:1
- +7 QUIT
- MSG if $GET(PSACTRL)=""
- SET PSACTRL="UNKNOWN"
- +1 IF PSASEG="ISA"
- SET PSAERR(PSACTRL,PSASEG)="The ISA control# (piece 14) should be 9 characters in length."
- QUIT
- +2 IF PSASEG="IEA"
- SET PSAERR(PSACTRL,PSASEG)="The IEA control# (piece 3) should equal the ISA control# (piece 14 = "_$PIECE($GET(PSAISA),"^",14)_")"
- QUIT
- +3 IF PSASEG="GS"
- SET PSAERR(PSACTRL,PSASEG)="GS piece "_%_" should equal ISA's piece "_$GET(PSAPC)_" ("_$TRANSLATE($PIECE($GET(PSAISA),"^",$GET(PSAPC))," ")_")."
- QUIT
- +4 IF PSASEG="GE"
- SET PSAERR(PSACTRL,PSASEG)="The GE control# (piece 3) should equal GS's control# piece 7 ("_$PIECE($GET(PSAGS),"^",7)_")."
- QUIT
- +5 IF PSASEG="ST"
- SET PSAERR(PSACTRL,PSASEG)="The ST control# (piece 3) should be 4 to 9 characters in length."
- QUIT
- +6 IF $EXTRACT(PSASEG,1,2)="SE"
- Begin DoDot:1
- +7 IF PSASEG="SE1"
- SET PSAERR(PSACTRL,PSASEG)="The SE control# (piece 3) should be equal to ST's control# (piece 3 = "_PSACTRL_")"
- QUIT
- +8 IF PSASEG="SE2"
- SET PSAERR(PSACTRL,PSASEG)="SE's count of segments (piece 2) should equal the number of segments ("_$GET(PSASTCNT)_")."
- End DoDot:1
- QUIT
- +9 IF PSASEG="N1"
- SET PSAERR(PSACTRL,PSASEG)="N1's piece 2 should equal 'BY', 'DS' OR 'ST'."
- +10 IF PSASEG="NONTYPE"
- SET PSAERR(PSACTRL,PSASEG)="The identifier segment 'N1' needs to come before the '"_$PIECE($GET(PSADATA),"^")_"' segment."
- QUIT
- +11 IF PSASEG="CTT"
- SET PSAERR(PSACTRL,PSASEG)="CTT's line item count (piece 2) should equal the number of line items ("_$GET(PSAITCNT)_")."
- +12 IF $EXTRACT(PSASEG,1,3)="IT1"
- Begin DoDot:1
- +13 IF PSASEG="IT1-1"
- SET PSAERR(PSACTRL,PSASEG)="The IT1 invoice line number "_$GET(PSAITEM)_" (piece 2) is not defined."
- QUIT
- +14 IF PSASEG="IT1-2"
- SET PSAERR(PSACTRL,PSASEG)="The IT1 unit price code (piece 6) should equal 'DS' for discount."
- QUIT
- +15 IF PSASEG="IT1-3"
- SET PSAERR(PSACTRL,PSASEG)="The IT1 does not contain a NDC (piece 8) or an UPC (piece 12)."
- End DoDot:1
- QUIT
- +16 IF PSASEG="ORDER1"
- SET PSAERR(PSACTRL,PSASEG)="Segments are out of order. The starting segment should be 'ISA', not '"_$GET(PSANEW)_"'."
- QUIT
- +17 IF PSASEG="ORDER2"
- SET PSAERR(PSACTRL,PSASEG)="Segments are out of order. The segment following '"_$GET(PSALAST)_"' should be '"_$GET(PSAEXPEC)_"', not '"_$GET(PSANEW)_"'."
- +18 QUIT
- NONTYPE ;
- +1 IF PSANTYPE=""
- SET PSASEG="NONTYPE"
- DO ERROR
- +2 QUIT
- SETMSG SET PSAMCNT=$GET(PSAMCNT)+1
- SET ^TMP($JOB,"PSA UPLOAD",PSAMCNT,0)=$GET(X12)
- QUIT