source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFDPVT.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PRCFDPVT ;WISC/LEM/BGJ-PAYMENT ERROR PROCESSING REBUILD/RETRANSMIT ;10/3/95 17:14
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4TYPE(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
12EX D SCREEN K DIRUT,DIROUT,DUOUT,DTOUT,VAR
13 QUIT
14 ;
15STAT 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
23TPO ; 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
40T1358 ; 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
57OUT K GECSDATA,FMSTYPE,FMSNO,STATUS,DIC
58 Q
59SCREEN ; Control screen display
60 I $D(IOF) W @IOF
61HDR ; Write Option Header
62 I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM
63 Q
Note: See TracBrowser for help on using the repository browser.