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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCUFCD 1805 printed Dec 13, 2024@02:19:42 Page 2
PRCUFCD ;WISC/SJG-CONVERSION PROCESSING ;4/30/93 3:02 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ; Routine is modification of PRCFAC02 for conversion processing
+4 ;
+5 SET PRCFA("MOP")=$PIECE(^PRC(442,PRCFA("PODA"),0),"^",2)
IF 12348'[PRCFA("MOP")
QUIT
+6 IF PRCFA("MOP")
DO @PRCFA("MOP")
+7 DO OBD
QUIT
1 ;INVOICE/RR
+1 DO OBL
QUIT
+2 QUIT
2 ;CERTIFIED INVOICE
+1 DO TC
QUIT
3 ;PAYMENT IN ADVANCE
+1 DO TC
QUIT
8 ;REQUISITION
+1 DO OBL
QUIT
4 ;GUARANTEED DELIVERY
+1 DO TC
QUIT
+2 QUIT
OBL ;MARK AS "OBLIGATED"
+1 if SCP=1!(SCP=2)
QUIT
+2 SET FSO=$PIECE(^PRC(442,PRCFA("PODA"),7),U,1)
if FSO=""
SET FSO=10
SET FSO=$PIECE(^PRCD(442.3,FSO,0),"^",3)+15
SET X=FSO
SET DA=PRCFA("PODA")
DO ENF^PRCHSTAT
+3 KILL FSO
QUIT
TC ;MARK PO AS "TRANSACTION COMPLETE"
+1 SET X=40
SET DA=PRCFA("PODA")
DO ENF^PRCHSTAT
QUIT
OAI ;MARK AS "OBLIGATED - AWAITING INVOICE"
+1 SET X=42
SET DA=PRCFA("PODA")
DO ENF^PRCHSTAT
QUIT
OBD ;PASS OBLIGATION DATA TO CPA MODULE AND PO
+1 KILL PODA
IF $SELECT('$DATA(PRCFA("PODA")):1,'$DATA(^PRC(442,PRCFA("PODA"),0)):1,1:0)
DO OUT
QUIT
+2 SET PODA=PRCFA("PODA")
SET PO(0)=^PRC(442,PODA,0)
+3 SET AMT=+$SELECT($PIECE(PRCFMO,"^",12)="N":$PIECE(PO(0),"^",16),1:$PIECE(PO(0),"^",15))
+4 SET DEL=$PIECE(PO(0),"^",10)
SET TRDA=$PIECE(PO(0),"^",12)
DO NOW^%DTC
SET TIME=X
+5 IF TRDA=""
Begin DoDot:1
+6 NEW A
+7 SET A=$PIECE($GET(^PRC(442,PRCFA("PODA"),1)),"^",15)
if A=""
QUIT
+8 SET A=$$DATE^PRC0C(A,"I")
+9 SET A=+PO(0)_"^"_$PIECE(PO(0),"^",3)_"^"_$EXTRACT(A,3,4)_"^"_$PIECE(A,"^",2)_"^"_AMT
+10 DO EBAL^PRCSEZ(A,"C")
DO EBAL^PRCSEZ(A,"O")
+11 QUIT
End DoDot:1
GOTO OUT
+12 IF '$DATA(^PRCS(410,TRDA,4))
DO OUT
QUIT
+13 SET X=$PIECE(^PRCS(410,TRDA,4),"^",8)
SET DA=TRDA
DO TRANK^PRCSES
+14 SET $PIECE(^PRCS(410,TRDA,9),"^",2)=DEL
+15 SET X=(^PRCS(410,TRDA,4))
+16 SET $PIECE(X,"^",3,4)=AMT_"^"_TIME
+17 SET $PIECE(X,"^",8)=AMT
+18 SET (^PRCS(410,TRDA,4))=X
+19 SET MESSAGE=""
+20 DO ENCODE^PRCSC2(DA,DUZ,.MESSAGE)
+21 KILL MESSAGE
+22 SET X=AMT
+23 DO TRANS1^PRCSES
DO TRANS^PRCSES
OUT KILL CSDA,PODA,AMT,CS,PO(0),DEL,TRDA,DA,TIME
+1 QUIT
