PRCFDCI ;WISC/CTB-CHECK IN DOCUMENTS FROM SERVICE ;7/19/95 14:30
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
DIE K %DT S X="T" D ^%DT S PRCFD("TODAY")=Y
S DIE="^PRCF(421.5,",DR="[PRCF CI CHECK-IN]",DA=PRCF("CIDA") D ^DIE
K PRCFD("AMT CERT"),PRCFD("CERT SHP"),PRCFD("INV AMT"),PRCFD("SHP AMT")
I $P(^PRCF(421.5,PRCF("CIDA"),1),"^",5) S %A="Do you wish to print the suspension letter at this time",%B="",%=1 D ^PRCFYN I %=1 D PRCFCHK,^PRCFDSUS
S %=0 D CHECK D
. I $G(PRCFNOPO)=1 S X=0 D STATUS^PRCFDE1 Q ;if there is no valid PO
. I '% S X=10 D STATUS^PRCFDE1 Q
I $G(PRCFNOPO)=1 S PRCFNOPO=0 Q
S %A="Is this document ready to go to accounting",%B="",%=1
D ^PRCFYN I %'=1 S X=10 D STATUS^PRCFDE1 Q
D SIG S X=$S(%:15,1:10) D STATUS^PRCFDE1
Q
OUT D OUT^PRCFDE Q
PRCFCHK ;CHECK FOR AMOUNT APPROVED FOR PAYMENT
I $P($G(^PRCF(421.5,PRCF("CIDA"),0)),U,15) S PRCF("CHECK")=1 Q
S %A(1)=" The Invoice Tracking record for this claim voucher does not show"
S %A(2)=" an amount approved for payment. Does this mean that the claim voucher"
S %A(3)=" has been disapproved and that no check will be issued",%=2,%A=" ",%B=""
D ^PRCFYN S PRCF("CHECK")=$S(%=1:0,1:1)
Q
CHECK ;CHECK THAT ALL INFO IS COMPLETE, ASK ES
F I=0,1,2 S P(I)=$G(^PRCF(421.5,DA,I))
S %=1,X=",,1,2,3,4,,6,,,,,,,13,,,,,,11.5,19,20"
I $P(P(0),U,8)="" W !,$P(^DD(421.5,6,0),U)_" is Blank.",$C(7),!,"You may enter a Vendor now.",! S PRCFD("PAY")=1 D VENED G CHECK
F I=3:1:6,15 I $P(P(0),"^",I)="" W !,$P(^DD(421.5,$P(X,",",I),0),"^")_" is Blank.",$C(7) S %=0
;I $D(P(1)),+P(1)=0 F I=2,9,21,22,23 I $P(P(0),"^",I)="" W !,$P(^DD(421.5,$P(X,",",I),0),"^")_" is Blank.",$C(7) S %=0
I $D(P(1)),+P(1)=0 F I=21 I $P(P(0),"^",I)="" W !,$P(^DD(421.5,$P(X,",",I),0),"^")_" is Blank.",$C(7) S %=0
I $P(P(0),"^",7)="",$P(P(1),"^",3)="" W !,"Both PURCHASE ORDER NUMBER and PURCHASE ORDER POINTER fields are blank.",$C(7) S %=0
K X
S X=0 F I=11,12,26 I $P(P(0),"^",I)]"" S X=1 Q
I 'X,$P(P(0),"^",13)'="X" S X=1
I X F I=11,12,13,26 I $P(P(0),"^",I)]"" Q:'% F J=12,13,26 I I+J'=37,J'>I,$P(P(0),"^",J)="" W !,"Discount Information is Incomplete.",$C(7) S %=0 G CK
I +$P(P(0),"^",11)'=0,+$P(P(0),"^",26)'=0 W !,$C(7),"You may not have both a Discount % and a Discount Amount." S %=0 K P
CK I % I $P($G(^PRCF(421.5,DA,0)),U,15)'>0 S X="No funds authorized for payment.*" D MSG^PRCFQ S %=1 K P Q
I % S X="Data appears OK for payment.*" D MSG^PRCFQ S %=1 K P Q
W !!,"No further action can be taken until document is corrected."
K P S ZX=%,%A="Do you wish to correct this information now",%B="",%=1
D ^PRCFYN I %'=1 S %=ZX K ZX Q
S DIE=421.5,DR="[PRCF CI VOUCHER AUDIT]",DA=PRCF("CIDA") D ^DIE
I $P(^PRCF(421.5,DA,0),U,8)']"" D VENED
K PRCF("VENDA"),PRCFD("DOI"),PRCFD("PODA"),PRCFD("DOP"),PRCFD("DIR")
K PRCFD("INV TYPE"),PRCF("PTR"),PRCF("DAYS"),PRCF("NAME"),PRCF("X")
K PRCF("PT"),PRCFD("DOD"),ZX
I $P($G(^PRCF(421.5,PRCF("CIDA"),0)),U,15)=""!($P($G(^(0)),U,21)="") D
. S DIE=421.5,DR="[PRCF CI CHECK-IN]",DA=PRCF("CIDA") D ^DIE K DIE,DR
. K PRCFD("AMT CERT"),PRCFD("CERT SHP"),PRCFD("INV AMT"),PRCFD("SHP AMT")
I $P(^PRCF(421.5,PRCF("CIDA"),1),"^",5) S %A="Do you wish to print the suspension letter at this time",%B="",%=1 D ^PRCFYN I %=1 D PRCFCHK,^PRCFDSUS
G CHECK
SIG K PRCFK D SIG^PRCFACX0 I $D(PRCFA("SIGFAIL")) K PRCFA("SIGFAIL") S X=" <No Further Action Taken.>" D MSG^PRCFQ S %=0 K P Q
S DA=PRCF("CIDA"),MESSAGE=""
D REMOVE^PRCFDES1(DA),ENCODE^PRCFDES1(DA,DUZ,.MESSAGE)
K MESSAGE,P S %=1
Q
VENED ;
S DIC=440,DIC(0)="AENMQ" S:$P($G(^PRC(411,PRC("SITE"),0)),U,20) DIC(0)=DIC(0)_"L",DLAYGO=440
S DIC("A")="Invoice's Vendor: " S:$G(PRCF("VENDA"))?1.N DIC("B")=$P($G(^PRC(440,PRCF("VENDA"),0)),U)
D ^DIC K DIC,DLAYGO,ORDER,PRCHOV3,STATE Q:+Y<1 S PRCF("VENDA")=+Y
I $P(Y,U,3) S PRCF("NUVEND")=1 D VENDOR^PRCFDE2
S DIE=421.5,DR="6////"_PRCF("VENDA"),DA=PRCF("CIDA") D ^DIE
K DIE,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDCI 4003 printed Dec 13, 2024@02:02:52 Page 2
PRCFDCI ;WISC/CTB-CHECK IN DOCUMENTS FROM SERVICE ;7/19/95 14:30
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
DIE KILL %DT
SET X="T"
DO ^%DT
SET PRCFD("TODAY")=Y
+1 SET DIE="^PRCF(421.5,"
SET DR="[PRCF CI CHECK-IN]"
SET DA=PRCF("CIDA")
DO ^DIE
+2 KILL PRCFD("AMT CERT"),PRCFD("CERT SHP"),PRCFD("INV AMT"),PRCFD("SHP AMT")
+3 IF $PIECE(^PRCF(421.5,PRCF("CIDA"),1),"^",5)
SET %A="Do you wish to print the suspension letter at this time"
SET %B=""
SET %=1
DO ^PRCFYN
IF %=1
DO PRCFCHK
DO ^PRCFDSUS
+4 SET %=0
DO CHECK
Begin DoDot:1
+5 ;if there is no valid PO
IF $GET(PRCFNOPO)=1
SET X=0
DO STATUS^PRCFDE1
QUIT
+6 IF '%
SET X=10
DO STATUS^PRCFDE1
QUIT
End DoDot:1
+7 IF $GET(PRCFNOPO)=1
SET PRCFNOPO=0
QUIT
+8 SET %A="Is this document ready to go to accounting"
SET %B=""
SET %=1
+9 DO ^PRCFYN
IF %'=1
SET X=10
DO STATUS^PRCFDE1
QUIT
+10 DO SIG
SET X=$SELECT(%:15,1:10)
DO STATUS^PRCFDE1
+11 QUIT
OUT DO OUT^PRCFDE
QUIT
PRCFCHK ;CHECK FOR AMOUNT APPROVED FOR PAYMENT
+1 IF $PIECE($GET(^PRCF(421.5,PRCF("CIDA"),0)),U,15)
SET PRCF("CHECK")=1
QUIT
+2 SET %A(1)=" The Invoice Tracking record for this claim voucher does not show"
+3 SET %A(2)=" an amount approved for payment. Does this mean that the claim voucher"
+4 SET %A(3)=" has been disapproved and that no check will be issued"
SET %=2
SET %A=" "
SET %B=""
+5 DO ^PRCFYN
SET PRCF("CHECK")=$SELECT(%=1:0,1:1)
+6 QUIT
CHECK ;CHECK THAT ALL INFO IS COMPLETE, ASK ES
+1 FOR I=0,1,2
SET P(I)=$GET(^PRCF(421.5,DA,I))
+2 SET %=1
SET X=",,1,2,3,4,,6,,,,,,,13,,,,,,11.5,19,20"
+3 IF $PIECE(P(0),U,8)=""
WRITE !,$PIECE(^DD(421.5,6,0),U)_" is Blank.",$CHAR(7),!,"You may enter a Vendor now.",!
SET PRCFD("PAY")=1
DO VENED
GOTO CHECK
+4 FOR I=3:1:6,15
IF $PIECE(P(0),"^",I)=""
WRITE !,$PIECE(^DD(421.5,$PIECE(X,",",I),0),"^")_" is Blank.",$CHAR(7)
SET %=0
+5 ;I $D(P(1)),+P(1)=0 F I=2,9,21,22,23 I $P(P(0),"^",I)="" W !,$P(^DD(421.5,$P(X,",",I),0),"^")_" is Blank.",$C(7) S %=0
+6 IF $DATA(P(1))
IF +P(1)=0
FOR I=21
IF $PIECE(P(0),"^",I)=""
WRITE !,$PIECE(^DD(421.5,$PIECE(X,",",I),0),"^")_" is Blank.",$CHAR(7)
SET %=0
+7 IF $PIECE(P(0),"^",7)=""
IF $PIECE(P(1),"^",3)=""
WRITE !,"Both PURCHASE ORDER NUMBER and PURCHASE ORDER POINTER fields are blank.",$CHAR(7)
SET %=0
+8 KILL X
+9 SET X=0
FOR I=11,12,26
IF $PIECE(P(0),"^",I)]""
SET X=1
QUIT
+10 IF 'X
IF $PIECE(P(0),"^",13)'="X"
SET X=1
+11 IF X
FOR I=11,12,13,26
IF $PIECE(P(0),"^",I)]""
if '%
QUIT
FOR J=12,13,26
IF I+J'=37
IF J'>I
IF $PIECE(P(0),"^",J)=""
WRITE !,"Discount Information is Incomplete.",$CHAR(7)
SET %=0
GOTO CK
+12 IF +$PIECE(P(0),"^",11)'=0
IF +$PIECE(P(0),"^",26)'=0
WRITE !,$CHAR(7),"You may not have both a Discount % and a Discount Amount."
SET %=0
KILL P
CK IF %
IF $PIECE($GET(^PRCF(421.5,DA,0)),U,15)'>0
SET X="No funds authorized for payment.*"
DO MSG^PRCFQ
SET %=1
KILL P
QUIT
+1 IF %
SET X="Data appears OK for payment.*"
DO MSG^PRCFQ
SET %=1
KILL P
QUIT
+2 WRITE !!,"No further action can be taken until document is corrected."
+3 KILL P
SET ZX=%
SET %A="Do you wish to correct this information now"
SET %B=""
SET %=1
+4 DO ^PRCFYN
IF %'=1
SET %=ZX
KILL ZX
QUIT
+5 SET DIE=421.5
SET DR="[PRCF CI VOUCHER AUDIT]"
SET DA=PRCF("CIDA")
DO ^DIE
+6 IF $PIECE(^PRCF(421.5,DA,0),U,8)']""
DO VENED
+7 KILL PRCF("VENDA"),PRCFD("DOI"),PRCFD("PODA"),PRCFD("DOP"),PRCFD("DIR")
+8 KILL PRCFD("INV TYPE"),PRCF("PTR"),PRCF("DAYS"),PRCF("NAME"),PRCF("X")
+9 KILL PRCF("PT"),PRCFD("DOD"),ZX
+10 IF $PIECE($GET(^PRCF(421.5,PRCF("CIDA"),0)),U,15)=""!($PIECE($GET(^(0)),U,21)="")
Begin DoDot:1
+11 SET DIE=421.5
SET DR="[PRCF CI CHECK-IN]"
SET DA=PRCF("CIDA")
DO ^DIE
KILL DIE,DR
+12 KILL PRCFD("AMT CERT"),PRCFD("CERT SHP"),PRCFD("INV AMT"),PRCFD("SHP AMT")
End DoDot:1
+13 IF $PIECE(^PRCF(421.5,PRCF("CIDA"),1),"^",5)
SET %A="Do you wish to print the suspension letter at this time"
SET %B=""
SET %=1
DO ^PRCFYN
IF %=1
DO PRCFCHK
DO ^PRCFDSUS
+14 GOTO CHECK
SIG KILL PRCFK
DO SIG^PRCFACX0
IF $DATA(PRCFA("SIGFAIL"))
KILL PRCFA("SIGFAIL")
SET X=" <No Further Action Taken.>"
DO MSG^PRCFQ
SET %=0
KILL P
QUIT
+1 SET DA=PRCF("CIDA")
SET MESSAGE=""
+2 DO REMOVE^PRCFDES1(DA)
DO ENCODE^PRCFDES1(DA,DUZ,.MESSAGE)
+3 KILL MESSAGE,P
SET %=1
+4 QUIT
VENED ;
+1 SET DIC=440
SET DIC(0)="AENMQ"
if $PIECE($GET(^PRC(411,PRC("SITE"),0)),U,20)
SET DIC(0)=DIC(0)_"L"
SET DLAYGO=440
+2 SET DIC("A")="Invoice's Vendor: "
if $GET(PRCF("VENDA"))?1.N
SET DIC("B")=$PIECE($GET(^PRC(440,PRCF("VENDA"),0)),U)
+3 DO ^DIC
KILL DIC,DLAYGO,ORDER,PRCHOV3,STATE
if +Y<1
QUIT
SET PRCF("VENDA")=+Y
+4 IF $PIECE(Y,U,3)
SET PRCF("NUVEND")=1
DO VENDOR^PRCFDE2
+5 SET DIE=421.5
SET DR="6////"_PRCF("VENDA")
SET DA=PRCF("CIDA")
DO ^DIE
+6 KILL DIE,DR
+7 QUIT
