PRCFFERI.m

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 ---PRCFFERI   1399     printed  Apr 09, 2024@21:19:40                                                                                                                                                                                                    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