56 lines
1.7 KiB
Mathematica
56 lines
1.7 KiB
Mathematica
PRCUFCD ;WISC/SJG-CONVERSION PROCESSING ;4/30/93 3:02 PM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; Routine is modification of PRCFAC02 for conversion processing
|
|
;
|
|
S PRCFA("MOP")=$P(^PRC(442,PRCFA("PODA"),0),"^",2) I 12348'[PRCFA("MOP") Q
|
|
I PRCFA("MOP") D @PRCFA("MOP")
|
|
D OBD Q
|
|
1 ;INVOICE/RR
|
|
D OBL Q
|
|
Q
|
|
2 ;CERTIFIED INVOICE
|
|
D TC Q
|
|
3 ;PAYMENT IN ADVANCE
|
|
D TC Q
|
|
8 ;REQUISITION
|
|
D OBL Q
|
|
4 ;GUARANTEED DELIVERY
|
|
D TC Q
|
|
Q
|
|
OBL ;MARK AS "OBLIGATED"
|
|
Q:SCP=1!(SCP=2)
|
|
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="" D G OUT
|
|
. N A
|
|
. S A=$P($G(^PRC(442,PRCFA("PODA"),1)),"^",15) QUIT:A=""
|
|
. S A=$$DATE^PRC0C(A,"I")
|
|
. S A=+PO(0)_"^"_$P(PO(0),"^",3)_"^"_$E(A,3,4)_"^"_$P(A,"^",2)_"^"_AMT
|
|
. D EBAL^PRCSEZ(A,"C"),EBAL^PRCSEZ(A,"O")
|
|
. QUIT
|
|
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
|
|
OUT K CSDA,PODA,AMT,CS,PO(0),DEL,TRDA,DA,TIME
|
|
Q
|