Routine: PRCFDPVI

PRCFDPVI ;WISC/LEM-PAYMENT ERROR PROCESSING INQUIRY ;6/13/94  10:34 AM

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

V ;

 QUIT

 ; No top level entry

TYPE(X) N FMSNO,STATUS,STATTXT1,FMSTYPE

 S PRC("SITE")=$P(X,U),FMSTYPE=$P(X,U,2)

 I ("^PV^MO^SO^"'[("^"_FMSTYPE_"^")) D MSG1^PRCFDPVM,OUT Q

 D STAT,NUM^PRCFDPVU,GET^PRCFDPVU(421.5,PONUM) I Y<0 D MSG2^PRCFDPVM Q

 ;STOP HERE TO CHECK VARIABLES

 S PRCF("CIDA")=+Y

 ;K MOP S MOP=$P(Y(0),U,2) I MOP="" D MSG3^PRCFDPVM Q

 ;I MOP=1!(MOP=2)!(MOP=8) I PRCFA("ERROR") D TPO

 ;I MOP=21 I PRCFA("ERROR") D T1358

 I PRCFA("ERROR") D TPO

 D SCREEN

STAT S STATUS=GECSDATA(2100.1,GECSDATA,3,"E") D

 .I $E(STATUS,1)="T" D STATT^PRCFDPV1 Q

 .I $E(STATUS,1)="Q" D STATQ^PRCFDPV1 Q

 .I $E(STATUS,1)="M" D STATM^PRCFDPV1 Q

 .I $E(STATUS,1)="E" D STATE^PRCFDPV1 Q

 .I $E(STATUS,1)="A" D STATA^PRCFDPV1 Q

 .I $E(STATUS,1)="R" D STATR^PRCFDPV1 Q

TPO ; Payment Voucher Error Processing

 ; When MOP = Invoice/Rec Rep, Certified Invoice, Requisition

 S D0=+Y D STATR1^PRCFDPV1 D  ;,VIEW^PRCFDCI1 ;^PRCHDP1

 . S DIC=421.5 ;,DIC(0)="AEMNZ" D ^DIC G OUTV:Y<0

 . S (FR,TO)=$P(Y,"^",2),L=0,BY="@.01;",FLDS="[CAPTIONED]",IOP="HOME"

 . S PRCF("VIEW")="" D WAIT^PRCFYN,EN1^DIP ;,OUTV G VIEW

 . D PAUSE^PRCFDPVU

. Q

OUTV ;K DIC,DA,DR,PRCF,X,Y Q

T1358 ; 1358 Error Processing

 ; When MOP = MISC OBL(1358)

 D STATR1^PRCFDPV1

 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

OUT K GECSDATA,FMSTYPE,FMSNO,STATUS,DIC

SCREEN ; Control screen display

 I $D(IOF) W @IOF

HDR ; Write Option Header

 I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDPVI   1822     printed  Mar 13, 2025@21:07:57                                                                                                                                                                                                    Page 2

PRCFDPVI  ;WISC/LEM-PAYMENT ERROR PROCESSING INQUIRY ;6/13/94  10:34 AM

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

V         ;

 +1        QUIT

 +2       ; No top level entry

TYPE(X)    NEW FMSNO,STATUS,STATTXT1,FMSTYPE

 +1        SET PRC("SITE")=$PIECE(X,U)

           SET FMSTYPE=$PIECE(X,U,2)

 +2        IF ("^PV^MO^SO^"'[("^"_FMSTYPE_"^"))

               DO MSG1^PRCFDPVM

               DO OUT

               QUIT

 +3        DO STAT

           DO NUM^PRCFDPVU

           DO GET^PRCFDPVU(421.5,PONUM)

           IF Y<0

               DO MSG2^PRCFDPVM

               QUIT

 +4       ;STOP HERE TO CHECK VARIABLES

 +5        SET PRCF("CIDA")=+Y

 +6       ;K MOP S MOP=$P(Y(0),U,2) I MOP="" D MSG3^PRCFDPVM Q

 +7       ;I MOP=1!(MOP=2)!(MOP=8) I PRCFA("ERROR") D TPO

 +8       ;I MOP=21 I PRCFA("ERROR") D T1358

 +9        IF PRCFA("ERROR")

               DO TPO

 +10       DO SCREEN

 +11       QUIT

 +12      ;

STAT       SET STATUS=GECSDATA(2100.1,GECSDATA,3,"E")

           Begin DoDot:1

 +1            IF $EXTRACT(STATUS,1)="T"

                   DO STATT^PRCFDPV1

                   QUIT

 +2            IF $EXTRACT(STATUS,1)="Q"

                   DO STATQ^PRCFDPV1

                   QUIT

 +3            IF $EXTRACT(STATUS,1)="M"

                   DO STATM^PRCFDPV1

                   QUIT

 +4            IF $EXTRACT(STATUS,1)="E"

                   DO STATE^PRCFDPV1

                   QUIT

 +5            IF $EXTRACT(STATUS,1)="A"

                   DO STATA^PRCFDPV1

                   QUIT

 +6            IF $EXTRACT(STATUS,1)="R"

                   DO STATR^PRCFDPV1

                   QUIT

           End DoDot:1

 +7        QUIT

 +8       ;

TPO       ; Payment Voucher Error Processing

 +1       ; When MOP = Invoice/Rec Rep, Certified Invoice, Requisition

 +2       ;,VIEW^PRCFDCI1 ;^PRCHDP1

           SET D0=+Y

           DO STATR1^PRCFDPV1

           Begin DoDot:1

 +3       ;,DIC(0)="AEMNZ" D ^DIC G OUTV:Y<0

               SET DIC=421.5

 +4            SET (FR,TO)=$PIECE(Y,"^",2)

               SET L=0

               SET BY="@.01;"

               SET FLDS="[CAPTIONED]"

               SET IOP="HOME"

 +5       ;,OUTV G VIEW

               SET PRCF("VIEW")=""

               DO WAIT^PRCFYN

               DO EN1^DIP

 +6            DO PAUSE^PRCFDPVU

 +7            QUIT

           End DoDot:1

OUTV      ;K DIC,DA,DR,PRCF,X,Y Q

 +1        QUIT

T1358     ; 1358 Error Processing

 +1       ; When MOP = MISC OBL(1358)

 +2        DO STATR1^PRCFDPV1

 +3        SET PO(0)=Y(0)

 +4        DO GENDIQ^PRCFFU7(442,+POIEN,".07","I","")

 +5        SET DA=PRCTMP(442,+POIEN,.07,"I")

           DO NODE^PRCS58OB(DA,.TRNODE)

 +6        IF '$DATA(PRC("CP"))

               SET PRC("CP")=$PIECE(TRNODE(0),"-",4)

 +7        SET IOP="HOME"

           DO ^%ZIS

           DO ^PRCE58P0

 +8        QUIT

OUT        KILL GECSDATA,FMSTYPE,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

PRCFDPVI.m