| 1 | PRCFAC02 ;WISC@ALTOONA/CTB/BGJ-CONTINUATION OF PRCFAC01 ;11/17/94 09:37
|
|---|
| 2 | V ;;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
|
|---|
| 8 | 1 ;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 | ;
|
|---|
| 20 | 2 ;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
|
|---|
| 24 | 3 ;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
|
|---|
| 29 | 7 ;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
|
|---|
| 33 | 8 ;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
|
|---|
| 37 | 4 ;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
|
|---|
| 43 | OBL ;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
|
|---|
| 46 | TC ;MARK PO AS "TRANSACTION COMPLETE"
|
|---|
| 47 | S X=40,DA=PRCFA("PODA") D ENF^PRCHSTAT Q
|
|---|
| 48 | OAI ;MARK AS "OBLIGATED - AWAITING INVOICE"
|
|---|
| 49 | S X=42,DA=PRCFA("PODA") D ENF^PRCHSTAT Q
|
|---|
| 50 | OBD ;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
|
|---|
| 69 | PRINT ;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),"^")=%
|
|---|
| 72 | P1 ;
|
|---|
| 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
|
|---|
| 77 | OUT 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
|
|---|
