| 1 | PSAUTL2 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data Utility ;9/19/97
 | 
|---|
| 2 |  ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
 | 
|---|
| 3 |  ;This routine is a utility that writes X12 errors to the screen. It is
 | 
|---|
| 4 |  ;used during the uploading of prime vendor invoices. It is called by
 | 
|---|
| 5 |  ;PSAUP2 and PSAUP3.
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | ERROR ;Writes X12 error messages.
 | 
|---|
| 8 |  S PSASLN="",$P(PSASLN,"-",80)=""
 | 
|---|
| 9 |  W @IOF,!,"The format of the invoice file is incorrect."
 | 
|---|
| 10 |  W !,"Call your IRM staff and relay the error messages listed below."
 | 
|---|
| 11 |  W !!,"ERROR MESSAGES:",!,PSASLN S PSAOUT=1
 | 
|---|
| 12 |  S PSACTRL2="" F  S PSACTRL2=$O(PSAERR(PSACTRL2)) Q:PSACTRL2=""  W !!,"Control# "_PSACTRL2_":" D
 | 
|---|
| 13 |  .S PSASEG="" F  S PSASEG=$O(PSAERR(PSACTRL2,PSASEG)) Q:PSASEG=""  W !,PSAERR(PSACTRL2,PSASEG)
 | 
|---|
| 14 |  S PSAS=22-$Y F PSASS=1:1:PSAS W !
 | 
|---|
| 15 |  S DIR(0)="E",DIR("A")="Press ESC, answer Yes to the ""EXIT SCRIPT?"" question, then press RETURN." D ^DIR K DIR
 | 
|---|
| 16 |  Q
 | 
|---|
| 17 | MSG S:$G(PSACTRL)="" PSACTRL="UNKNOWN"
 | 
|---|
| 18 |  I PSASEG="ISA" S PSAERR(PSACTRL,PSASEG)="The ISA control# (piece 14) should be 9 characters in length." Q
 | 
|---|
| 19 |  I PSASEG="IEA" S PSAERR(PSACTRL,PSASEG)="The IEA control# (piece 3) should equal the ISA control# (piece 14 = "_$P($G(PSAISA),"^",14)_")" Q
 | 
|---|
| 20 |  I PSASEG="GS" S PSAERR(PSACTRL,PSASEG)="GS piece "_%_" should equal ISA's piece "_$G(PSAPC)_" ("_$TR($P($G(PSAISA),"^",$G(PSAPC))," ")_")." Q
 | 
|---|
| 21 |  I PSASEG="GE" S PSAERR(PSACTRL,PSASEG)="The GE control# (piece 3) should equal GS's control# piece 7 ("_$P($G(PSAGS),"^",7)_")." Q
 | 
|---|
| 22 |  I PSASEG="ST" S PSAERR(PSACTRL,PSASEG)="The ST control# (piece 3) should be 4 to 9 characters in length." Q
 | 
|---|
| 23 |  I $E(PSASEG,1,2)="SE" D  Q
 | 
|---|
| 24 |  .I PSASEG="SE1" S PSAERR(PSACTRL,PSASEG)="The SE control# (piece 3) should be equal to ST's control# (piece 3 = "_PSACTRL_")" Q
 | 
|---|
| 25 |  .I PSASEG="SE2" S PSAERR(PSACTRL,PSASEG)="SE's count of segments (piece 2) should equal the number of segments ("_$G(PSASTCNT)_")."
 | 
|---|
| 26 |  I PSASEG="N1" S PSAERR(PSACTRL,PSASEG)="N1's piece 2 should equal 'BY', 'DS' OR 'ST'."
 | 
|---|
| 27 |  I PSASEG="NONTYPE" S PSAERR(PSACTRL,PSASEG)="The identifier segment 'N1' needs to come before the '"_$P($G(PSADATA),"^")_"' segment." Q
 | 
|---|
| 28 |  I PSASEG="CTT" S PSAERR(PSACTRL,PSASEG)="CTT's line item count (piece 2) should equal the number of line items ("_$G(PSAITCNT)_")."
 | 
|---|
| 29 |  I $E(PSASEG,1,3)="IT1" D  Q
 | 
|---|
| 30 |  .I PSASEG="IT1-1" S PSAERR(PSACTRL,PSASEG)="The IT1 invoice line number "_$G(PSAITEM)_" (piece 2) is not defined." Q
 | 
|---|
| 31 |  .I PSASEG="IT1-2" S PSAERR(PSACTRL,PSASEG)="The IT1 unit price code (piece 6) should equal 'DS' for discount." Q
 | 
|---|
| 32 |  .I PSASEG="IT1-3" S PSAERR(PSACTRL,PSASEG)="The IT1 does not contain a NDC (piece 8) or an UPC (piece 12)."
 | 
|---|
| 33 |  I PSASEG="ORDER1" S PSAERR(PSACTRL,PSASEG)="Segments are out of order. The starting segment should be 'ISA', not '"_$G(PSANEW)_"'." Q
 | 
|---|
| 34 |  I PSASEG="ORDER2" S PSAERR(PSACTRL,PSASEG)="Segments are out of order. The segment following '"_$G(PSALAST)_"' should be '"_$G(PSAEXPEC)_"', not '"_$G(PSANEW)_"'."
 | 
|---|
| 35 |  Q
 | 
|---|
| 36 | NONTYPE ;
 | 
|---|
| 37 |  I PSANTYPE="" S PSASEG="NONTYPE" D ERROR
 | 
|---|
| 38 |  Q
 | 
|---|