PRCHQ6B ;(WASH IRMFO)/LKG-RFQ SERVER UNPACKING VENDOR QUOTE ;9/11/96  15:41
 ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
ITEM S PRCIENS="+1,"_PRC("D1")_","_PRC("D0")_",",PRCAR(444.026,PRCIENS,.01)=+$P(PRCX,U,2)
 D UPDATE^DIE("E","PRCAR","PRCENUM") D:$D(^TMP("DIERR",$J)) ERRCOPY^PRCHQ6A
 I $G(PRCENUM(1))'?1.N S PRCERR=16 G ERR
 S PRC("D2")=PRCENUM(1),PRCIENS=PRC("D2")_","_PRC("D1")_","_PRC("D0")_","
 K PRCAR,PRCENUM S PRCITEMS=PRCITEMS+1
 S PRCY=$P(PRCX,U,3) S:$L(PRCY)>4 PRCAR(444.026,PRCIENS,5)=PRCY
 S PRCAR(444.026,PRCIENS,4)=$P(PRCY,"-")
 S PRCY=$P(PRCX,U,5) S:PRCY]"" PRCAR(444.026,PRCIENS,1)=PRCY
 S PRCY=$P(PRCX,U,6) S:PRCY]"" PRCAR(444.026,PRCIENS,8)=PRCY
 S PRCY=$P(PRCX,U,7) S:PRCY]"" PRCAR(444.026,PRCIENS,7)=PRCY
 S PRCAR(444.026,PRCIENS,2)=$P(PRCX,U,8)/100
 S PRCAR(444.026,PRCIENS,3)=$P(PRCX,U,9)
 S PRCAR(444.026,PRCIENS,13)=$P(PRCX,U,10)/10000
 S PRCY=$P(PRCX,U,12)
 I PRCY]"" D
 . S PRCY="."_PRCY*100
 . S PRCAR(444.026,PRCIENS,14)=PRCY
 S PRCY=$P(PRCX,U,13) S:PRCY]"" PRCAR(444.026,PRCIENS,15)=PRCY/100
 S PRCY=$P(PRCX,U,19) S:PRCY]"" PRCAR(444.026,PRCIENS,16)=PRCY
 S PRCY=$P(PRCX,U,23) S:PRCY]"" PRCAR(444.026,PRCIENS,9)=PRCY
 S PRCY=$P(PRCX,U,24) S:PRCY]"" PRCAR(444.026,PRCIENS,10)=PRCY
 S PRCY=$P(PRCX,U,22) S:PRCY]""&(PRCY'="000000") PRCAR(444.026,PRCIENS,6)=$S($D(^PRC(444.2,PRCY,0)):$P(^(0),U),1:PRCY)
 S PRCY=$P(PRCX,U,25) S:PRCY]"" PRCAR(444.026,PRCIENS,12)=$S(PRCY="HM":"HAZARDOUS MATERIAL",1:PRCY)
 S PRCY=$P(PRCX,U,26) S:PRCY]"" PRCAR(444.026,PRCIENS,11)=$S(PRCY="O":"ORIGIN",PRCY="D":"DESTINATION",1:PRCY)
 S PRCAR(444.026,PRCIENS,18)=$FN($G(PRCAR(444.026,PRCIENS,13))*$G(PRCAR(444.026,PRCIENS,2)),"",2)
 S X=$S($G(PRCAR(444.026,PRCIENS,14))>0:PRCAR(444.026,PRCIENS,18)*PRCAR(444.026,PRCIENS,14)/100,1:$G(PRCAR(444.026,PRCIENS,15)))
 S:X>0 PRCAR(444.026,PRCIENS,18)=$FN(PRCAR(444.026,PRCIENS,18)-X,"",2) K X
 D FILE^DIE("E","PRCAR") K PRCAR D:$D(^TMP("DIERR",$J)) ERRCOPY^PRCHQ6A
 K ^TMP($J,"DE") S PRCJ=0
 F  S PRCI=$O(^PRCF(423.6,PRCDA,1,PRCI)) Q:PRCI=""  S PRCX=$G(^(PRCI,0)) Q:$P(PRCX,U)'="DE"  D
 . S PRCJ=PRCJ+1,^TMP($J,"DE",PRCJ,0)=$P(PRCX,U,4)
 D:PRCJ>0 WP^DIE(444.026,PRCIENS,1.5,"","^TMP($J,""DE"")")
 D:$D(^TMP("DIERR",$J)) ERRCOPY^PRCHQ6A
 K ^TMP($J,"DE")
 G EX:PRCI="",EX:$P(PRCX,U)="$",ITEM:$P(PRCX,U)="IT"
 I $P(PRCX,U)'="SC" S PRCERR=12 G ERR
DELSCHED ;Delivery Schedule Loop
 S PRCIENS="+1,"_PRC("D2")_","_PRC("D1")_","_PRC("D0")_","
 S PRCAR(444.027,PRCIENS,.01)=+$P(PRCX,U,3)
 D UPDATE^DIE("E","PRCAR","PRCENUM") D:$D(^TMP("DIERR",$J)) ERRCOPY^PRCHQ6A
 I $G(PRCENUM(1))'?1.N S PRCERR=17 G ERR
 S PRC("D3")=PRCENUM(1)
 S PRCIENS=PRC("D3")_","_PRC("D2")_","_PRC("D1")_","_PRC("D0")_","
 K PRCAR,PRCENUM
 S PRCAR(444.027,PRCIENS,2)=$P(PRCX,U,4)/100
 S PRCAR(444.027,PRCIENS,3)=$P(PRCX,U,5)
 S X=$$JD2FMD^PRCHQ7($P(PRCX,U,6)),X=+$E(X,4,5)_"/"_(+$E(X,6,7))_"/"_($E(X,1,3)+1700)
 S PRCAR(444.027,PRCIENS,1)=X K X
 D FILE^DIE("E","PRCAR") K PRCAR D:$D(^TMP("DIERR",$J)) ERRCOPY^PRCHQ6A
 S PRCI=$O(^PRCF(423.6,PRCDA,1,PRCI)) G:PRCI="" EX
 S PRCX=$G(^PRCF(423.6,PRCDA,1,PRCI,0))
 G DELSCHED:$P(PRCX,U)="SC",ITEM:$P(PRCX,U)="IT"
 I $P(PRCX,U)'="$",$P(PRCX,U)'="~" S PRCERR=13 G ERR
EX ;
 I $D(PRC("D0")),$D(PRC("D1")) D QUOTETOT^PRCHQ1B(PRC("D0"),PRC("D1"))
 I $G(PRCITEMS)'=$G(PRCICNT) S PRCERR=14 G ERR
 I $D(^TMP($J,"PRCERR")) G ERR
EX1 L:$D(PRC("D0")) -^PRC(444,PRC("D0"))
 K PRC,PRCAR,PRCDA,PRCDB,PRCDBI,PRCEFFDT,PRCENUM,PRCERR,PRCI,PRCICNT,PRCITEMS
 K PRCIENS,PRCJ,PRCNUM,PRCRCVDT,PRCREF,PRCRFQ,PRCVCN,PRCVCP,PRCVDA,PRCVEN
 K PRCX,PRCY,X,Y,PRCVNM
 S:$D(ZTQUEUED) ZTREQ="@"
 Q
ERR ;
 K ^TMP($J,"MSG")
 S ^TMP($J,"MSG",1,0)="During the filing of an 843 Transaction (Vendor's Quote) from vendor"
 S ^TMP($J,"MSG",2,0)=$G(PRCDB)_" for RFQ # "_$G(PRCRFQ)_", the following errors"
 S ^TMP($J,"MSG",3,0)="occurred: ",PRCJ=3
 S:$D(PRCERR) PRCJ=PRCJ+1,^TMP($J,"MSG",PRCJ,0)=$P($T(TXT+PRCERR),";;",2)
 I $D(^TMP($J,"PRCERR")) D
 . S PRCX=0
 . F  S PRCX=$O(^TMP($J,"PRCERR",PRCX)) Q:PRCX'?1.N  D
 . . S:$D(^TMP($J,"PRCERR",PRCX)) PRCJ=PRCJ+1,^TMP($J,"MSG",PRCJ,0)=^(PRCX)
 S XMTEXT="^TMP($J,""MSG"","
 I $D(PRC("D0")) S X=$P($G(^PRC(444,PRC("D0"),0)),U,4) S:X?1.N XMY(X)=""
 S XMY("G.PRCHQ RFQ")="" ;,XMDUZ="843 Vendor Quote Filer"
 S XMSUB="Error filing Quote for RFQ #: "_$G(PRCRFQ)
 D ^XMD K XMZ,^TMP($J,"MSG"),^TMP($J,"PRCERR"),XMY,XMTEXT,XMSUB
 G EX1
TXT ;Error Messages
 ;;No segments to process in the File #423.6 entry.
 ;;Initial segment not 'ISM' for 843 Transaction (Vendor's Quote).
 ;;No 'HE' segment.
 ;;Referenced RFQ not found in REQUEST FOR QUOTATION File (#444).
 ;;Unable to lock RFQ entry - timed out.
 ;;No 'VE' Segment.
 ;;Unable to add submitting vendor to RFQ VENDOR File (#444.1).
 ;;Unable to add entry to QUOTES multiple of File (#444).
 ;;Unable to lock QUOTES entry - timed out.
 ;;No 'AC' segment.
 ;;No 'IT' segment.
 ;;Segment type 'SC' expected but not found.
 ;;Inappropriate segment type following 'SC' segment.
 ;;Number of Items Processed does not equal Number of Items
 ;;Unable to add Prompt Pay Terms
 ;;Unable to add entry to ITEM multiple
 ;;Unable to add entry to DELIVERY SCHEDULE multiple