PRCFDCI.m

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 ---PRCFDCI   4003     printed  Mar 13, 2025@21:07:41                                                                                                                                                                                                     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