source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFAC02.m@ 1535

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PRCFAC02 ;WISC@ALTOONA/CTB/BGJ-CONTINUATION OF PRCFAC01 ;11/17/94 09:37
2V ;;5.1;IFCAP;**14**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 S PRCFA("MOP")=$P(^PRC(442,PRCFA("PODA"),0),"^",2) I 123478'[PRCFA("MOP") Q
5 I PRCFA("MOP") D @PRCFA("MOP")
6 I $D(PRCHDELV) D:$P($G(^PRC(442,PRCFA("PODA"),0)),U,19)'=2 PRINT Q
7 D OBD K COPY Q
81 ;INVOICE/RR
9 D OBL
10 I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)'=2 D
11 .S COPY=1,PRCF("DEST")="S8"
12 .S DIR("A")="Do you wish to queue this order to another printer"
13 .S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR
14 .I Y<0!($D(DIRUT)) S PRCFA("XTRA")=0
15 .I Y=1 S PRCFA("XTRA")=1
16 .D PRINT
17 .Q
18 Q
19 ;
202 ;CERTIFIED INVOICE
21 D TC
22 I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
23 S COPY=1,PRCF("DEST")="S8" D PRINT Q
243 ;PAYMENT IN ADVANCE
25 D TC
26 I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
27 S COPY=1,PRCF("DEST")="S8" D PRINT
28 S COPY=3,PRCF("DEST")="F" D P1 Q
297 ;IMPREST FUND
30 D OBL
31 I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
32 S COPY=1,PRCF("DEST")="S8" D PRINT Q
338 ;REQUISITION
34 D OBL
35 I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
36 S COPY=1,PRCF("DEST")="S" D PRINT Q
374 ;GUARANTEED DELIVERY
38 D TC,^PRCHPOO
39 I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
40 S COPY=1,PRCF("DEST")="S8" D PRINT Q
41 ;
42 S X="Unable to print Fiscal Copy. Use reprint option if copy is required.*" D MSG^PRCFQ Q
43OBL ;MARK AS "OBLIGATED"
44 S FSO=$P(^PRC(442,PRCFA("PODA"),7),U,1) S:FSO="" FSO=10 S FSO=$P(^PRCD(442.3,FSO,0),"^",3)+15,X=FSO,DA=PRCFA("PODA") D ENF^PRCHSTAT
45 K FSO Q
46TC ;MARK PO AS "TRANSACTION COMPLETE"
47 S X=40,DA=PRCFA("PODA") D ENF^PRCHSTAT Q
48OAI ;MARK AS "OBLIGATED - AWAITING INVOICE"
49 S X=42,DA=PRCFA("PODA") D ENF^PRCHSTAT Q
50OBD ;PASS OBLIGATION DATA TO CPA MODULE AND PO
51 K PODA I $S('$D(PRCFA("PODA")):1,'$D(^PRC(442,PRCFA("PODA"),0)):1,1:0) D OUT Q
52 S PODA=PRCFA("PODA"),PO(0)=^PRC(442,PODA,0)
53 S AMT=+$S($P(PRCFMO,"^",12)="N":$P(PO(0),"^",16),1:$P(PO(0),"^",15))
54 S DEL=$P(PO(0),"^",10),TRDA=$P(PO(0),"^",12) D NOW^%DTC S TIME=X
55 I TRDA="" G:$P($G(^PRC(442,PRCFA("PODA"),0)),U,19)'=2 PRINT Q
56 I '$D(^PRCS(410,TRDA,4)) D OUT Q
57 S X=$P(^PRCS(410,TRDA,4),"^",8),DA=TRDA D TRANK^PRCSES
58 S $P(^PRCS(410,TRDA,9),"^",2)=DEL
59 S X=(^PRCS(410,TRDA,4))
60 S $P(X,"^",3,4)=AMT_"^"_TIME
61 S $P(X,"^",8)=AMT
62 S (^PRCS(410,TRDA,4))=X
63 S MESSAGE=""
64 D ENCODE^PRCSC2(DA,DUZ,.MESSAGE)
65 K MESSAGE
66 S X=AMT
67 D TRANS1^PRCSES,TRANS^PRCSES
68 I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
69PRINT ;PRINT PO
70 I $D(^PRC(442,PRCFA("PODA"),12)),$P(^(12),"^")]"" Q
71 D NOW^PRCFQ K %X,X,Y S $P(^PRC(442,PRCFA("PODA"),12),"^")=%
72P1 ;
73 F PRCFI=1:1:COPY S PRCHQ("DEST")=PRCF("DEST"),D0=PRCFA("PODA"),PRCHQ="^PRCHFPNT" D ^PRCHQUE
74 I $D(PRCFA("XTRA")),PRCFA("XTRA")=1 S PRCHQ="^PRCHFPNT",D0=PRCFA("PODA") D ^PRCHQUE
75 S PRC("BBFY")=PRCFA("BBFY")
76 Q
77OUT K CSDA,PODA,AMT,CS,PO(0),DEL,TRDA,DA,TIME S X="No data posted to Control Point Files*" D MSG^PRCFQ Q
78 Q
Note: See TracBrowser for help on using the repository browser.