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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFERI 1399 printed Dec 13, 2024@02:03:22 Page 2
PRCFFERI ;WISC/SJG-OBLIGATION ERROR PROCESSING INQUIRY ;7/24/00 23:19
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
+3 ; No top level entry
TYPE(X) NEW FMSNO,STATUS
+1 SET PRC("SITE")=$PIECE(X,U)
+2 IF ("^AR^MO^SO^"'[("^"_$PIECE(X,U,2)_"^"))
DO MSG1^PRCFFERM
DO OUT
QUIT
+3 SET STATUS=$GET(GECSDATA(2100.1,GECSDATA,3,"E"))
+4 DO MSG^PRCFFER1($EXTRACT(STATUS),.PRCFA)
+5 DO NUM^PRCFFERU
+6 DO GET^PRCFFERU(442,PONUM)
IF Y<0
DO MSG2^PRCFFERM
QUIT
+7 SET POIEN=+Y
+8 KILL MOP
SET MOP=$PIECE(Y(0),U,2)
IF MOP=""
DO MSG3^PRCFFERM
QUIT
+9 IF ("^1^2^3^4^7^8^26^"[("^"_MOP_"^"))
IF PRCFA("ERROR")
DO TPO
+10 IF MOP=21
IF PRCFA("ERROR")
DO T1358
+11 DO SCREEN
+12 QUIT
+13 ;
TPO ; Purchase Order Error Processing
+1 ; When MOP = Invoice/Rec Rep, Certified Invoice, Requisition
+2 IF $DATA(PRCFA("ERTYP"))
IF PRCFA("ERTYP")'="POREQ"
WRITE !!
DO MSG5^PRCFFERM
HANG 3
QUIT
+3 SET D0=+Y
DO STATR1^PRCFFERU(1)
DO ^PRCHDP1
+4 QUIT
T1358 ; 1358 Error Processing
+1 ; When MOP = MISC OBL(1358)
+2 IF $DATA(PRCFA("ERTYP"))
IF PRCFA("ERTYP")'="MISCOBL"
WRITE !!
DO MSG5^PRCFFERM
HANG 3
QUIT
+3 DO STATR1^PRCFFERU(1)
+4 SET PO(0)=Y(0)
+5 DO GENDIQ^PRCFFU7(442,+POIEN,".07","I","")
+6 SET DA=PRCTMP(442,+POIEN,.07,"I")
DO NODE^PRCS58OB(DA,.TRNODE)
+7 IF '$DATA(PRC("CP"))
SET PRC("CP")=$PIECE(TRNODE(0),"-",4)
+8 SET IOP="HOME"
DO ^%ZIS
DO ^PRCE58P0
+9 QUIT
OUT KILL GECSDATA,FMSNO,STATUS,DIC
+1 QUIT
SCREEN ; Control screen display
+1 IF $DATA(IOF)
WRITE @IOF
HDR ; Write Option Header
+1 IF $DATA(XQY0)
WRITE IOINHI,$PIECE(XQY0,U,2),IOINORM
+2 QUIT
