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
Q
;
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
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
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
Q
OUT K GECSDATA,FMSTYPE,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[HPRCFDPVI 1822 printed Nov 22, 2024@17:13:15 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
