55 lines
1.7 KiB
Mathematica
55 lines
1.7 KiB
Mathematica
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
|