79 lines
2.8 KiB
Mathematica
79 lines
2.8 KiB
Mathematica
PRCFAC02 ;WISC@ALTOONA/CTB/BGJ-CONTINUATION OF PRCFAC01 ;11/17/94 09:37
|
|
V ;;5.1;IFCAP;**14**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
S PRCFA("MOP")=$P(^PRC(442,PRCFA("PODA"),0),"^",2) I 123478'[PRCFA("MOP") Q
|
|
I PRCFA("MOP") D @PRCFA("MOP")
|
|
I $D(PRCHDELV) D:$P($G(^PRC(442,PRCFA("PODA"),0)),U,19)'=2 PRINT Q
|
|
D OBD K COPY Q
|
|
1 ;INVOICE/RR
|
|
D OBL
|
|
I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)'=2 D
|
|
.S COPY=1,PRCF("DEST")="S8"
|
|
.S DIR("A")="Do you wish to queue this order to another printer"
|
|
.S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR
|
|
.I Y<0!($D(DIRUT)) S PRCFA("XTRA")=0
|
|
.I Y=1 S PRCFA("XTRA")=1
|
|
.D PRINT
|
|
.Q
|
|
Q
|
|
;
|
|
2 ;CERTIFIED INVOICE
|
|
D TC
|
|
I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
|
|
S COPY=1,PRCF("DEST")="S8" D PRINT Q
|
|
3 ;PAYMENT IN ADVANCE
|
|
D TC
|
|
I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
|
|
S COPY=1,PRCF("DEST")="S8" D PRINT
|
|
S COPY=3,PRCF("DEST")="F" D P1 Q
|
|
7 ;IMPREST FUND
|
|
D OBL
|
|
I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
|
|
S COPY=1,PRCF("DEST")="S8" D PRINT Q
|
|
8 ;REQUISITION
|
|
D OBL
|
|
I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
|
|
S COPY=1,PRCF("DEST")="S" D PRINT Q
|
|
4 ;GUARANTEED DELIVERY
|
|
D TC,^PRCHPOO
|
|
I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
|
|
S COPY=1,PRCF("DEST")="S8" D PRINT Q
|
|
;
|
|
S X="Unable to print Fiscal Copy. Use reprint option if copy is required.*" D MSG^PRCFQ Q
|
|
OBL ;MARK AS "OBLIGATED"
|
|
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
|
|
K FSO Q
|
|
TC ;MARK PO AS "TRANSACTION COMPLETE"
|
|
S X=40,DA=PRCFA("PODA") D ENF^PRCHSTAT Q
|
|
OAI ;MARK AS "OBLIGATED - AWAITING INVOICE"
|
|
S X=42,DA=PRCFA("PODA") D ENF^PRCHSTAT Q
|
|
OBD ;PASS OBLIGATION DATA TO CPA MODULE AND PO
|
|
K PODA I $S('$D(PRCFA("PODA")):1,'$D(^PRC(442,PRCFA("PODA"),0)):1,1:0) D OUT Q
|
|
S PODA=PRCFA("PODA"),PO(0)=^PRC(442,PODA,0)
|
|
S AMT=+$S($P(PRCFMO,"^",12)="N":$P(PO(0),"^",16),1:$P(PO(0),"^",15))
|
|
S DEL=$P(PO(0),"^",10),TRDA=$P(PO(0),"^",12) D NOW^%DTC S TIME=X
|
|
I TRDA="" G:$P($G(^PRC(442,PRCFA("PODA"),0)),U,19)'=2 PRINT Q
|
|
I '$D(^PRCS(410,TRDA,4)) D OUT Q
|
|
S X=$P(^PRCS(410,TRDA,4),"^",8),DA=TRDA D TRANK^PRCSES
|
|
S $P(^PRCS(410,TRDA,9),"^",2)=DEL
|
|
S X=(^PRCS(410,TRDA,4))
|
|
S $P(X,"^",3,4)=AMT_"^"_TIME
|
|
S $P(X,"^",8)=AMT
|
|
S (^PRCS(410,TRDA,4))=X
|
|
S MESSAGE=""
|
|
D ENCODE^PRCSC2(DA,DUZ,.MESSAGE)
|
|
K MESSAGE
|
|
S X=AMT
|
|
D TRANS1^PRCSES,TRANS^PRCSES
|
|
I $P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2 Q
|
|
PRINT ;PRINT PO
|
|
I $D(^PRC(442,PRCFA("PODA"),12)),$P(^(12),"^")]"" Q
|
|
D NOW^PRCFQ K %X,X,Y S $P(^PRC(442,PRCFA("PODA"),12),"^")=%
|
|
P1 ;
|
|
F PRCFI=1:1:COPY S PRCHQ("DEST")=PRCF("DEST"),D0=PRCFA("PODA"),PRCHQ="^PRCHFPNT" D ^PRCHQUE
|
|
I $D(PRCFA("XTRA")),PRCFA("XTRA")=1 S PRCHQ="^PRCHFPNT",D0=PRCFA("PODA") D ^PRCHQUE
|
|
S PRC("BBFY")=PRCFA("BBFY")
|
|
Q
|
|
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
|
|
Q
|