source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHSWCH.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1PRCHSWCH ;WISC/AKS-Check switches ;7/13/2001 08:00
2 ;;5.1;IFCAP;**37**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5CHECK ;check switches
6 ;
7 ; processing is controlled by PRCHOBL
8 ; PRCHOBL=0 do nothing PRCHOBL=1 obligate immediately without Fiscal
9 ; PRCHOBL=2 call PRCOEDI to generate PHA transactions
10 I FILE'=442&(FILE'=443.6) W !,"Improper file." Q
11 N EDICHK,EDIVEN S EDICHK="N",EDIVEN=$P($G(^PRC(FILE,PRCHPO,1)),U) S:EDIVEN'="" EDICHK=$P($G(^PRC(440,EDIVEN,3)),U,2)
12 K PRCHOBL
13 N PRCHFUND
14 S PRCHOBL=0,PRCHFUND=""
15 S PRCHFUND=$P(^PRC(FILE,PRCHPO,0),U,3) Q:PRCHFUND="" S PRCHFUND=+$P(PRCHFUND," ")
16 I $P($G(^PRC(442,PRCHPO,23)),U,11)="D" S PRCHOBL=1 D
17 . I $P($G(^PRC(420,PRC("SITE"),3)),U,2)="",$P($G(^PRC(420,PRC("SITE"),1,PRCHFUND,6)),U,2)="" S PRCHOBL=0
18 . I $P(^PRC(FILE,PRCHPO,0),U,2)=26 S PRCHOBL=1
19 I '$G(PRCHOBL) D
20 . I $P($G(^PRC(420,PRC("SITE"),3)),U,2)="A",$P($G(^PRC(420,PRC("SITE"),1,PRCHFUND,6)),U,2)'="D" S PRCHOBL=1
21 . I $P($G(^PRC(420,PRC("SITE"),3)),U,2)="D",$P($G(^PRC(420,PRC("SITE"),1,PRCHFUND,6)),U,2)="A" S PRCHOBL=1
22 . I $P($G(^PRC(420,PRC("SITE"),3)),U,2)="",$P($G(^PRC(420,PRC("SITE"),1,PRCHFUND,6)),U,2)="A" S PRCHOBL=1
23 I '$G(PRCHOBL) D
24 . I $P($G(^PRC(420,PRC("SITE"),3)),U)="Y",EDICHK="Y" S PRCHOBL=1
25 . I $P($G(^PRC(420,PRC("SITE"),1,PRCHFUND,6)),U)="N" S PRCHOBL=0
26 . ; PRC*5.1*37, Added a missing check for EDI vendor at FCP level
27 . I $P($G(^PRC(420,PRC("SITE"),1,PRCHFUND,6)),U)="Y",EDICHK="Y" S PRCHOBL=1
28 ; if a certified invoice, set flag to 0 so that Fiscal must process
29 I $P($G(^PRC(FILE,PRCHPO,0)),"^",2)=2 S PRCHOBL=0
30 K FILE
31 QUIT
32POST ;post init for PRC*5*113
33 N ZP,ZIP,CNTR
34 S ZP="" F S ZP=$O(^PRC(442,"F",25,ZP)) Q:ZP="" D
35 .S ZIP=$P($G(^PRC(442,+ZP,23)),"^",13) Q:ZIP="" Q:ZIP[";"
36 .S $P(^PRC(442,ZP,23),"^",13)=$P(^PRC(442,ZP,23),"^",13)_";PRCS(410.7,"
37 S ZP="" F S ZP=$O(^PRC(442,"F",25,ZP)) Q:ZP="" D CONV
38 S ZP="" F S ZP=$O(^PRC(442,"F",26,ZP)) Q:ZP="" D CONV
39 QUIT
40CONV ;
41 Q:+$P($G(^PRC(442,ZP,1)),"^")=0
42 S DA=ZP,DIK(1)="5^D",DIK="^PRC(442," D EN^DIK
43 S VALUE=$P($G(^PRC(442,ZP,23)),"^",14) Q:+VALUE=0
44 S VVAL=$P($G(^PRC(440,VALUE,0)),"^") Q:VVAL=""
45 S VVAL=$E(VVAL,1,30) K ^PRC(442,"D",VVAL,ZP)
46 K DA,DIK,VALUE,VVAL
47 QUIT
Note: See TracBrowser for help on using the repository browser.