source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFDCI.m@ 623

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRCFDCI ;WISC/CTB-CHECK IN DOCUMENTS FROM SERVICE ;7/19/95 14:30
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4DIE K %DT S X="T" D ^%DT S PRCFD("TODAY")=Y
5 S DIE="^PRCF(421.5,",DR="[PRCF CI CHECK-IN]",DA=PRCF("CIDA") D ^DIE
6 K PRCFD("AMT CERT"),PRCFD("CERT SHP"),PRCFD("INV AMT"),PRCFD("SHP AMT")
7 I $P(^PRCF(421.5,PRCF("CIDA"),1),"^",5) S %A="Do you wish to print the suspension letter at this time",%B="",%=1 D ^PRCFYN I %=1 D PRCFCHK,^PRCFDSUS
8 S %=0 D CHECK D
9 . I $G(PRCFNOPO)=1 S X=0 D STATUS^PRCFDE1 Q ;if there is no valid PO
10 . I '% S X=10 D STATUS^PRCFDE1 Q
11 I $G(PRCFNOPO)=1 S PRCFNOPO=0 Q
12 S %A="Is this document ready to go to accounting",%B="",%=1
13 D ^PRCFYN I %'=1 S X=10 D STATUS^PRCFDE1 Q
14 D SIG S X=$S(%:15,1:10) D STATUS^PRCFDE1
15 Q
16OUT D OUT^PRCFDE Q
17PRCFCHK ;CHECK FOR AMOUNT APPROVED FOR PAYMENT
18 I $P($G(^PRCF(421.5,PRCF("CIDA"),0)),U,15) S PRCF("CHECK")=1 Q
19 S %A(1)=" The Invoice Tracking record for this claim voucher does not show"
20 S %A(2)=" an amount approved for payment. Does this mean that the claim voucher"
21 S %A(3)=" has been disapproved and that no check will be issued",%=2,%A=" ",%B=""
22 D ^PRCFYN S PRCF("CHECK")=$S(%=1:0,1:1)
23 Q
24CHECK ;CHECK THAT ALL INFO IS COMPLETE, ASK ES
25 F I=0,1,2 S P(I)=$G(^PRCF(421.5,DA,I))
26 S %=1,X=",,1,2,3,4,,6,,,,,,,13,,,,,,11.5,19,20"
27 I $P(P(0),U,8)="" W !,$P(^DD(421.5,6,0),U)_" is Blank.",$C(7),!,"You may enter a Vendor now.",! S PRCFD("PAY")=1 D VENED G CHECK
28 F I=3:1:6,15 I $P(P(0),"^",I)="" W !,$P(^DD(421.5,$P(X,",",I),0),"^")_" is Blank.",$C(7) S %=0
29 ;I $D(P(1)),+P(1)=0 F I=2,9,21,22,23 I $P(P(0),"^",I)="" W !,$P(^DD(421.5,$P(X,",",I),0),"^")_" is Blank.",$C(7) S %=0
30 I $D(P(1)),+P(1)=0 F I=21 I $P(P(0),"^",I)="" W !,$P(^DD(421.5,$P(X,",",I),0),"^")_" is Blank.",$C(7) S %=0
31 I $P(P(0),"^",7)="",$P(P(1),"^",3)="" W !,"Both PURCHASE ORDER NUMBER and PURCHASE ORDER POINTER fields are blank.",$C(7) S %=0
32 K X
33 S X=0 F I=11,12,26 I $P(P(0),"^",I)]"" S X=1 Q
34 I 'X,$P(P(0),"^",13)'="X" S X=1
35 I X F I=11,12,13,26 I $P(P(0),"^",I)]"" Q:'% F J=12,13,26 I I+J'=37,J'>I,$P(P(0),"^",J)="" W !,"Discount Information is Incomplete.",$C(7) S %=0 G CK
36 I +$P(P(0),"^",11)'=0,+$P(P(0),"^",26)'=0 W !,$C(7),"You may not have both a Discount % and a Discount Amount." S %=0 K P
37CK I % I $P($G(^PRCF(421.5,DA,0)),U,15)'>0 S X="No funds authorized for payment.*" D MSG^PRCFQ S %=1 K P Q
38 I % S X="Data appears OK for payment.*" D MSG^PRCFQ S %=1 K P Q
39 W !!,"No further action can be taken until document is corrected."
40 K P S ZX=%,%A="Do you wish to correct this information now",%B="",%=1
41 D ^PRCFYN I %'=1 S %=ZX K ZX Q
42 S DIE=421.5,DR="[PRCF CI VOUCHER AUDIT]",DA=PRCF("CIDA") D ^DIE
43 I $P(^PRCF(421.5,DA,0),U,8)']"" D VENED
44 K PRCF("VENDA"),PRCFD("DOI"),PRCFD("PODA"),PRCFD("DOP"),PRCFD("DIR")
45 K PRCFD("INV TYPE"),PRCF("PTR"),PRCF("DAYS"),PRCF("NAME"),PRCF("X")
46 K PRCF("PT"),PRCFD("DOD"),ZX
47 I $P($G(^PRCF(421.5,PRCF("CIDA"),0)),U,15)=""!($P($G(^(0)),U,21)="") D
48 . S DIE=421.5,DR="[PRCF CI CHECK-IN]",DA=PRCF("CIDA") D ^DIE K DIE,DR
49 . K PRCFD("AMT CERT"),PRCFD("CERT SHP"),PRCFD("INV AMT"),PRCFD("SHP AMT")
50 I $P(^PRCF(421.5,PRCF("CIDA"),1),"^",5) S %A="Do you wish to print the suspension letter at this time",%B="",%=1 D ^PRCFYN I %=1 D PRCFCHK,^PRCFDSUS
51 G CHECK
52SIG K PRCFK D SIG^PRCFACX0 I $D(PRCFA("SIGFAIL")) K PRCFA("SIGFAIL") S X=" <No Further Action Taken.>" D MSG^PRCFQ S %=0 K P Q
53 S DA=PRCF("CIDA"),MESSAGE=""
54 D REMOVE^PRCFDES1(DA),ENCODE^PRCFDES1(DA,DUZ,.MESSAGE)
55 K MESSAGE,P S %=1
56 Q
57VENED ;
58 S DIC=440,DIC(0)="AENMQ" S:$P($G(^PRC(411,PRC("SITE"),0)),U,20) DIC(0)=DIC(0)_"L",DLAYGO=440
59 S DIC("A")="Invoice's Vendor: " S:$G(PRCF("VENDA"))?1.N DIC("B")=$P($G(^PRC(440,PRCF("VENDA"),0)),U)
60 D ^DIC K DIC,DLAYGO,ORDER,PRCHOV3,STATE Q:+Y<1 S PRCF("VENDA")=+Y
61 I $P(Y,U,3) S PRCF("NUVEND")=1 D VENDOR^PRCFDE2
62 S DIE=421.5,DR="6////"_PRCF("VENDA"),DA=PRCF("CIDA") D ^DIE
63 K DIE,DR
64 Q
Note: See TracBrowser for help on using the repository browser.