source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFERI.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1PRCFFERI ;WISC/SJG-OBLIGATION ERROR PROCESSING INQUIRY ;7/24/00 23:19
2V ;;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
6TYPE(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 ;
20TPO ; 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
25T1358 ; 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
35OUT K GECSDATA,FMSNO,STATUS,DIC
36 Q
37SCREEN ; Control screen display
38 I $D(IOF) W @IOF
39HDR ; Write Option Header
40 I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM
41 Q
Note: See TracBrowser for help on using the repository browser.