| 1 | PRCFDPVT ;WISC/LEM/BGJ-PAYMENT ERROR PROCESSING REBUILD/RETRANSMIT ;10/3/95 17:14
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | TYPE(X) N FMSNO,STATUS,STATTXT1,FMSTYPE
|
|---|
| 5 | S PRC("SITE")=$P(X,U),FMSTYPE=$P(X,U,2)
|
|---|
| 6 | I ("^PV^MO^SO^"'[("^"_FMSTYPE_"^")) D MSG1^PRCFDPVM,OUT Q
|
|---|
| 7 | D STAT I $D(DIRUT)!$D(DIROUT)!$D(DUOUT)!$D(DTOUT) G EX
|
|---|
| 8 | I 'PRCFA("ERROR"),'$G(PRCFA("TRANS")) G EX
|
|---|
| 9 | D NUM^PRCFDPVU W !,"**PONUM=",PONUM,! D GET^PRCFDPVU(421.5,PONUM) I Y<0 D MSG2^PRCFDPVM Q
|
|---|
| 10 | L:+Y>0 +^PRCF(421.5,+Y):5 E W !,"This Payment Voucher is being edited by someone else, please try later!" R !,"Hit <RETURN> to continue.",Y:DTIME G EX
|
|---|
| 11 | D TPO
|
|---|
| 12 | EX D SCREEN K DIRUT,DIROUT,DUOUT,DTOUT,VAR
|
|---|
| 13 | QUIT
|
|---|
| 14 | ;
|
|---|
| 15 | STAT S STATUS=GECSDATA(2100.1,GECSDATA,3,"E") D
|
|---|
| 16 | .I $E(STATUS,1)="T" D STATT^PRCFDPV2 Q
|
|---|
| 17 | .I $E(STATUS,1)="Q" D STATQ^PRCFDPV2 Q
|
|---|
| 18 | .I $E(STATUS,1)="M" D STATM^PRCFDPV2 Q
|
|---|
| 19 | .I $E(STATUS,1)="E" D STATE^PRCFDPV2 Q
|
|---|
| 20 | .I $E(STATUS,1)="A" D STATA^PRCFDPV2 Q
|
|---|
| 21 | .I $E(STATUS,1)="R" D STATR^PRCFDPV2 Q
|
|---|
| 22 | Q
|
|---|
| 23 | TPO ; Payment Voucher Error Processing when MOP = Invoice/Rec Rep,CI,Req
|
|---|
| 24 | S (D0,PRCF("CIDA"))=+Y D STATR1^PRCFDPV2
|
|---|
| 25 | S GO=$P($G(RESP),U) I GO D
|
|---|
| 26 | . S DIC=421.5
|
|---|
| 27 | . S (FR,TO)=PRCF("CIDA"),L=0,BY="@.01;",FLDS="[CAPTIONED]",IOP="HOME"
|
|---|
| 28 | . S PRCF("VIEW")="" D WAIT^PRCFYN,EN1^DIP
|
|---|
| 29 | . K PRCF("VIEW"),RECORD,RECORD1,DIC,DK
|
|---|
| 30 | . D PAUSE^PRCFDPVU
|
|---|
| 31 | . Q
|
|---|
| 32 | W ! S RETRAN=$$RETRANS^PRCFDPVU
|
|---|
| 33 | K GO S GO=$P($G(RETRAN),U)
|
|---|
| 34 | I 'GO D MSG4^PRCFDPVM L -^PRCF(421.5,PRCF("CIDA")) D OUT H 3 Q
|
|---|
| 35 | I GO D
|
|---|
| 36 | . S PRCFA("RETRAN")=1
|
|---|
| 37 | . D EN^PRCFDA3(PRCF("CIDA")),PAUSE^PRCFDPVU
|
|---|
| 38 | . Q
|
|---|
| 39 | Q
|
|---|
| 40 | T1358 ; 1358 Error Processing when MOP = MISC OBL(1358)
|
|---|
| 41 | D STATR1^PRCFDPV2
|
|---|
| 42 | D GENDIQ^PRCFFU7(442,+POIEN,".07","I","")
|
|---|
| 43 | S (OB,DA)=$G(PRCTMP(442,+POIEN,".07","I"))
|
|---|
| 44 | D NODE^PRCS58OB(DA,.TRNODE)
|
|---|
| 45 | I '$D(PRC("CP")) S PRC("CP")=$P(TRNODE(0),"-",4)
|
|---|
| 46 | S GO=$P($G(RESP),U) I GO D
|
|---|
| 47 | .D PAUSE1^PRCFDPVU
|
|---|
| 48 | .S IOP="HOME" D ^%ZIS,^PRCE58P0
|
|---|
| 49 | .Q
|
|---|
| 50 | W ! S RETRAN=$$RETRANS^PRCFDPVU
|
|---|
| 51 | K GO S GO=$P($G(RETRAN),U) I 'GO D MSG4^PRCFDPVM,OUT H 3 Q
|
|---|
| 52 | I GO D
|
|---|
| 53 | .S PRCFA("RETRAN")=1,DA=OB
|
|---|
| 54 | .S PRCF("X")="F" D ^PRCFSITE
|
|---|
| 55 | .D SC^PRCESOE
|
|---|
| 56 | Q
|
|---|
| 57 | OUT K GECSDATA,FMSTYPE,FMSNO,STATUS,DIC
|
|---|
| 58 | Q
|
|---|
| 59 | SCREEN ; Control screen display
|
|---|
| 60 | I $D(IOF) W @IOF
|
|---|
| 61 | HDR ; Write Option Header
|
|---|
| 62 | I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM
|
|---|
| 63 | Q
|
|---|
