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