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

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