PRCFFERI ;WISC/SJG-OBLIGATION ERROR PROCESSING INQUIRY ;7/24/00  23:19
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 QUIT
 ; No top level entry
TYPE(X) N FMSNO,STATUS
 S PRC("SITE")=$P(X,U)
 I ("^AR^MO^SO^"'[("^"_$P(X,U,2)_"^")) D MSG1^PRCFFERM,OUT Q
 S STATUS=$G(GECSDATA(2100.1,GECSDATA,3,"E"))
 D MSG^PRCFFER1($E(STATUS),.PRCFA)
 D NUM^PRCFFERU
 D GET^PRCFFERU(442,PONUM) I Y<0 D MSG2^PRCFFERM Q
 S POIEN=+Y
 K MOP S MOP=$P(Y(0),U,2) I MOP="" D MSG3^PRCFFERM Q
 I ("^1^2^3^4^7^8^26^"[("^"_MOP_"^")) I PRCFA("ERROR") D TPO
 I MOP=21 I PRCFA("ERROR") D T1358
 D SCREEN
 Q
 ;
TPO ; Purchase Order Error Processing
 ; When MOP = Invoice/Rec Rep, Certified Invoice, Requisition
 I $D(PRCFA("ERTYP")),PRCFA("ERTYP")'="POREQ" W !! D MSG5^PRCFFERM H 3 Q
 S D0=+Y D STATR1^PRCFFERU(1),^PRCHDP1
 Q
T1358 ; 1358 Error Processing 
 ; When MOP = MISC OBL(1358)
 I $D(PRCFA("ERTYP")),PRCFA("ERTYP")'="MISCOBL" W !! D MSG5^PRCFFERM H 3 Q
 D STATR1^PRCFFERU(1)
 S PO(0)=Y(0)
 D GENDIQ^PRCFFU7(442,+POIEN,".07","I","")
 S DA=PRCTMP(442,+POIEN,.07,"I") D NODE^PRCS58OB(DA,.TRNODE)
 I '$D(PRC("CP")) S PRC("CP")=$P(TRNODE(0),"-",4)
 S IOP="HOME" D ^%ZIS,^PRCE58P0
 Q
OUT K GECSDATA,FMSNO,STATUS,DIC
 Q
SCREEN ; Control screen display
 I $D(IOF) W @IOF
HDR ; Write Option Header
 I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM
 Q