PRCFDE ;WISC/CTB/CLH/BGJ-ENTER/EDIT CERTIFIED INVOICE ; 9/28/99 11:30am
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
DE I '$D(PRC("SITE")) S PRCF("X")="AS" D ^PRCFSITE Q:'$D(PRC("SITE"))
S DIC=421.5,DIC("S")="I $P(^(2),U)=0",DIC(0)="AEMNQ"
S DIC("A")="Select CERTIFIED INVOICE: "
D ^DIC K DIC Q:+Y<0 S PRCF("CIDA")=+Y
S %A="Are you SURE you want to delete this record",%B="",%=2
D ^PRCFYN I %'=1 S X=" <Nothing deleted.>*" D MSG^PRCFQ,OUT Q
DEL ;DELETE INDIVIDUAL CERTIFIED INVOICE RECORD
S DA=PRCF("CIDA"),DIK="^PRCF(421.5," D ^DIK K DIK
S X="Certified Invoice Record Deleted*" D MSG^PRCFQ
OUT ;EXIT LINE
K %,C,DA,DIC,DIE,DLAYGO,DR,F,J,N,PRCF,PRCFD,PRCFCK,PRCHPO,X,X1,Y,Z,D0
Q
OUT1 D NA^PRCFDE1 S X=0 D STATUS^PRCFDE1,OUT Q
CREATE ;ASSIGN NEXT NUMBER
S X=$P(^PRCF(421.5,0),"^",3) F Y=X+1:1 L +^PRCF(421.5,Y):0 Q:$T&('$D(^PRCF(421.5,Y))) L -^PRCF(421.5,Y)
S X=Y,DIC=421.5,DLAYGO=421.5,DIC(0)="ELZN",D="B" D IX^DIC K DLAYGO Q:Y<0
S X=+Y L -^PRCF(421.5,X)
Q
QUES W $C(7),!,"You may:",!,"1. Scan a Certified Invoice Barcode Label or,",!,"2. Enter 'NEW' or 'NEXT' for auto assignment.",!!
Q
PT K PRCF("PODA"),PRCF("VENDA")
N PRCFVEN
S PRCFVEN=$P(^PRCF(421.5,PRCF("CIDA"),0),U,8) I $G(PRCFVEN)]"" D
. K ^PRCF(421.5,"C",PRCFVEN,PRCF("CIDA"))
. S $P(^PRCF(421.5,PRCF("CIDA"),0),U,8)=""
S DIE="^PRCF(421.5,",DR="4.5Select PAT Number: ",DA=PRCF("CIDA")
D ^DIE
Q
NEW ;ENTER NEW CERTIFIED INVOICE
S PRCFNOPO=0
S PRCF("X")="AS" D ^PRCFSITE Q:'%
N1 S (PRCFD("NEW"),PRCFD("PAY"))="",Y=0
R !,"Enter Invoice Tracking Number: ",X:DTIME
G:'$T!(X["^")!(X="") OUT I $E(X)=" " W $C(7) G NEW
I X["?" D QUES G N1
S A="~NEW~New~new~NEXT~Next~next",Z="~"_X I X'?1.9N,A'[Z W $C(7)," Incorrect format." S X="Correct Format is 1 to 9 numbers or the words NEW or NEXT*" D MSG^PRCFQ D QUES G N1
I A[Z D CREATE G:Y<0 NEW
K Z,A I Y=0 S DIC=421.5,DLAYGO=421.5,DIC(0)="XZL" D ^DIC K DLAYGO I Y<0 S X="Unable to add "_X_" to the file. Try again.*" D MSG^PRCFQ W $C(7),$C(7),$C(7),$C(7) G NEW
S X="Adding "_X_" to Invoice Tracking File.*" D MSG^PRCFQ
N2 K DIC,DLAYGO I Y<0 K X,Y G OUT
I '$P(Y,"^",3) S X="This is not a new Invoice Tracking Number. Use EDIT INCOMPLETE INVOICE Option if you wish to edit it.*" D MSG^PRCFQ G NEW
S DA=+Y,PRCF("CIDA")=+Y,$P(^PRCF(421.5,DA,1),"^",2)=PRC("SITE")
;D ^PRCFDLN S $P(^PRCF(421.5,PRCF("CIDA"),0),"^",2)=PRCFDLN K PRCFDLN
K PRCFX,DIC
D PAT G:$D(PRCFD("^")) OUT
S %A="Do you wish to enter another invoice",%B="",%=1 D ^PRCFYN
G:%'=1 OUT D OUT G NEW
PAT D PT I $D(Y) S %A="OK to Delete",%B="",%=1 D ^PRCFYN G:%=2 PAT D DEL Q
S Y(0)=^PRCF(421.5,DA,0),Y(1)=$G(^(1))
I $P(Y(1),"^",3)="" S X="PAT Number is REQUIRED.*" D MSG^PRCFQ
I $P(Y(0),"^",7)="" S X="Purchase Order data will not be available for this payment.*" D MSG^PRCFQ S PRCFNOPO=1 G DIE
S (PRCF("PODA"),D0)=$P(^PRCF(421.5,DA,0),"^",7)
I $$CLSD1358^PRCFDE2(PRCF("PODA"),1) R !,"Hit <CR> to continue",X:DTIME
D ^PRCFDSC1 S PRCF("VENDA")=$P($G(^PRCF(421.5,PRCF("CIDA"),0)),U,8)
I $D(^PRC(442,PRCF("PODA"),1)),+^(1)>0 S PRCF("VENDA")=+^(1)
S $P(^PRCF(421.5,PRCF("CIDA"),0),"^",7)=PRCF("PODA")
I PRCF("VENDA")?1.N D
. S DA=PRCF("CIDA"),DIE=421.5,DR="6////"_PRCF("VENDA")
. D ^DIE K DA,DIE,DR
S (X,PRCF("PO"))=$P(^PRC(442,PRCF("PODA"),0),"^")
S $P(^PRCF(421.5,PRCF("CIDA"),2),"^",3)=X,$P(^(1),"^",3)=X
D
. S DIC=421.9,DIC(0)="Z",X=PRCF("PO") D ^DIC
. I Y'<0,$P(Y(0),"^",2)>949 D W !! D MSG^PRCFQ W $C(7),$C(7),$C(7),$C(7)
. . I $P(Y(0),"^",2)<974 S X="WARNING: This PO currently has "_$P(Y(0),"^",2)_" partials and is approaching the limit of 974 permitted by the system." Q
. . I $P(Y(0),"^",2)=974 S X="WARNING: This PO currently has 974 partials, which is the limit permitted by the system. The addition of further partials will result in errors." D Q
. . . S X=X_" If you proceed with the processing of this invoice in IFCAP, the PV document will have to be created on-line in FMS."
. . S X="WARNING: This PO currently has "_$P(Y(0),"^",2)_" partials and has exceeded the limit of 974 permitted by the system. Corrective action must be taken." D Q
. . . S X=X_" If you proceed with the processing of this invoice in IFCAP, the PV document will have to be created on-line in FMS."
. K DIC,Y
W !,$C(7) S %=2,%A="Do you need to view the entire PO",%B=""
D ^PRCFYN I %<0 D OUT1 Q
S D0=PRCF("PODA") I %=1 D ^PRCHDP1,^PRCFDSC1 W !,$C(7) K PRCHPO
S %=1,%A="Is this the correct Purchase Order for this Invoice",%B=""
D ^PRCFYN G PAT:%=2 I %<0 D OUT1 Q
S %A="Do you want to review other Invoices for this Purchase Order"
S %B="",%=2 D ^PRCFYN I %<0 D OUT1 Q
D:%=1 PO^PRCFDIC
VEN ;
D
. S X=$O(^PRC(442,PRCF("PODA"),5,0)) Q:X=""
. S X1=$G(^PRC(442,PRCF("PODA"),5,X,0))
. S PRCF("%")=$P(X1,"^"),PRCF("DAYS")=$P(X1,"^",2)
. S:+X1>0 $P(^PRCF(421.5,PRCF("CIDA"),0),"^",11,12)=PRCF("%")_"^"_PRCF("DAYS")
. S:$E(X1,1,3)="NET" $P(^PRCF(421.5,PRCF("CIDA"),1),"^",10)=PRCF("DAYS")
. Q
S $P(^PRCF(421.5,PRCF("CIDA"),0),U,6)=$P($G(^PRC(442,PRCF("PODA"),12)),U,15)
I +$P($G(^PRC(442,PRCF("PODA"),1)),U) D I %'=1 D VENED^PRCFDCI
. S %A="Is this the correct Vendor for this Invoice",%B="",%=1
. D ^PRCFYN
I '$P($G(^PRC(442,PRCF("PODA"),1)),U) D I PRCF("VENDA")'?1.N W !,"Terminating Edit." D OUT Q
. 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: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 DA,DR,DIE
I +$G(PRCF("VENDA")),'$G(PRCF("NUVEND")) S %A="Do you want to edit this Vendor's information",%B="",%=2 D ^PRCFYN G OUT:%<1 D:%=1 VENDOR^PRCFDE2
VL ;
S %A="Do you want to review other Invoices for this VENDOR"
S %B="",%=2 D ^PRCFYN I %<0 D OUT1 Q
D:%=1 VENDOR^PRCFDIC
DIE G ^PRCFDE1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDE 6064 printed Dec 13, 2024@02:02:55 Page 2
PRCFDE ;WISC/CTB/CLH/BGJ-ENTER/EDIT CERTIFIED INVOICE ; 9/28/99 11:30am
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
DE IF '$DATA(PRC("SITE"))
SET PRCF("X")="AS"
DO ^PRCFSITE
if '$DATA(PRC("SITE"))
QUIT
+1 SET DIC=421.5
SET DIC("S")="I $P(^(2),U)=0"
SET DIC(0)="AEMNQ"
+2 SET DIC("A")="Select CERTIFIED INVOICE: "
+3 DO ^DIC
KILL DIC
if +Y<0
QUIT
SET PRCF("CIDA")=+Y
+4 SET %A="Are you SURE you want to delete this record"
SET %B=""
SET %=2
+5 DO ^PRCFYN
IF %'=1
SET X=" <Nothing deleted.>*"
DO MSG^PRCFQ
DO OUT
QUIT
DEL ;DELETE INDIVIDUAL CERTIFIED INVOICE RECORD
+1 SET DA=PRCF("CIDA")
SET DIK="^PRCF(421.5,"
DO ^DIK
KILL DIK
+2 SET X="Certified Invoice Record Deleted*"
DO MSG^PRCFQ
OUT ;EXIT LINE
+1 KILL %,C,DA,DIC,DIE,DLAYGO,DR,F,J,N,PRCF,PRCFD,PRCFCK,PRCHPO,X,X1,Y,Z,D0
+2 QUIT
OUT1 DO NA^PRCFDE1
SET X=0
DO STATUS^PRCFDE1
DO OUT
QUIT
CREATE ;ASSIGN NEXT NUMBER
+1 SET X=$PIECE(^PRCF(421.5,0),"^",3)
FOR Y=X+1:1
LOCK +^PRCF(421.5,Y):0
if $TEST&('$DATA(^PRCF(421.5,Y)))
QUIT
LOCK -^PRCF(421.5,Y)
+2 SET X=Y
SET DIC=421.5
SET DLAYGO=421.5
SET DIC(0)="ELZN"
SET D="B"
DO IX^DIC
KILL DLAYGO
if Y<0
QUIT
+3 SET X=+Y
LOCK -^PRCF(421.5,X)
+4 QUIT
QUES WRITE $CHAR(7),!,"You may:",!,"1. Scan a Certified Invoice Barcode Label or,",!,"2. Enter 'NEW' or 'NEXT' for auto assignment.",!!
+1 QUIT
PT KILL PRCF("PODA"),PRCF("VENDA")
+1 NEW PRCFVEN
+2 SET PRCFVEN=$PIECE(^PRCF(421.5,PRCF("CIDA"),0),U,8)
IF $GET(PRCFVEN)]""
Begin DoDot:1
+3 KILL ^PRCF(421.5,"C",PRCFVEN,PRCF("CIDA"))
+4 SET $PIECE(^PRCF(421.5,PRCF("CIDA"),0),U,8)=""
End DoDot:1
+5 SET DIE="^PRCF(421.5,"
SET DR="4.5Select PAT Number: "
SET DA=PRCF("CIDA")
+6 DO ^DIE
+7 QUIT
NEW ;ENTER NEW CERTIFIED INVOICE
+1 SET PRCFNOPO=0
+2 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
N1 SET (PRCFD("NEW"),PRCFD("PAY"))=""
SET Y=0
+1 READ !,"Enter Invoice Tracking Number: ",X:DTIME
+2 if '$TEST!(X["^")!(X="")
GOTO OUT
IF $EXTRACT(X)=" "
WRITE $CHAR(7)
GOTO NEW
+3 IF X["?"
DO QUES
GOTO N1
+4 SET A="~NEW~New~new~NEXT~Next~next"
SET Z="~"_X
IF X'?1.9N
IF A'[Z
WRITE $CHAR(7)," Incorrect format."
SET X="Correct Format is 1 to 9 numbers or the words NEW or NEXT*"
DO MSG^PRCFQ
DO QUES
GOTO N1
+5 IF A[Z
DO CREATE
if Y<0
GOTO NEW
+6 KILL Z,A
IF Y=0
SET DIC=421.5
SET DLAYGO=421.5
SET DIC(0)="XZL"
DO ^DIC
KILL DLAYGO
IF Y<0
SET X="Unable to add "_X_" to the file. Try again.*"
DO MSG^PRCFQ
WRITE $CHAR(7),$CHAR(7),$CHAR(7),$CHAR(7)
GOTO NEW
+7 SET X="Adding "_X_" to Invoice Tracking File.*"
DO MSG^PRCFQ
N2 KILL DIC,DLAYGO
IF Y<0
KILL X,Y
GOTO OUT
+1 IF '$PIECE(Y,"^",3)
SET X="This is not a new Invoice Tracking Number. Use EDIT INCOMPLETE INVOICE Option if you wish to edit it.*"
DO MSG^PRCFQ
GOTO NEW
+2 SET DA=+Y
SET PRCF("CIDA")=+Y
SET $PIECE(^PRCF(421.5,DA,1),"^",2)=PRC("SITE")
+3 ;D ^PRCFDLN S $P(^PRCF(421.5,PRCF("CIDA"),0),"^",2)=PRCFDLN K PRCFDLN
+4 KILL PRCFX,DIC
+5 DO PAT
if $DATA(PRCFD("^"))
GOTO OUT
+6 SET %A="Do you wish to enter another invoice"
SET %B=""
SET %=1
DO ^PRCFYN
+7 if %'=1
GOTO OUT
DO OUT
GOTO NEW
PAT DO PT
IF $DATA(Y)
SET %A="OK to Delete"
SET %B=""
SET %=1
DO ^PRCFYN
if %=2
GOTO PAT
DO DEL
QUIT
+1 SET Y(0)=^PRCF(421.5,DA,0)
SET Y(1)=$GET(^(1))
+2 IF $PIECE(Y(1),"^",3)=""
SET X="PAT Number is REQUIRED.*"
DO MSG^PRCFQ
+3 IF $PIECE(Y(0),"^",7)=""
SET X="Purchase Order data will not be available for this payment.*"
DO MSG^PRCFQ
SET PRCFNOPO=1
GOTO DIE
+4 SET (PRCF("PODA"),D0)=$PIECE(^PRCF(421.5,DA,0),"^",7)
+5 IF $$CLSD1358^PRCFDE2(PRCF("PODA"),1)
READ !,"Hit <CR> to continue",X:DTIME
+6 DO ^PRCFDSC1
SET PRCF("VENDA")=$PIECE($GET(^PRCF(421.5,PRCF("CIDA"),0)),U,8)
+7 IF $DATA(^PRC(442,PRCF("PODA"),1))
IF +^(1)>0
SET PRCF("VENDA")=+^(1)
+8 SET $PIECE(^PRCF(421.5,PRCF("CIDA"),0),"^",7)=PRCF("PODA")
+9 IF PRCF("VENDA")?1.N
Begin DoDot:1
+10 SET DA=PRCF("CIDA")
SET DIE=421.5
SET DR="6////"_PRCF("VENDA")
+11 DO ^DIE
KILL DA,DIE,DR
End DoDot:1
+12 SET (X,PRCF("PO"))=$PIECE(^PRC(442,PRCF("PODA"),0),"^")
+13 SET $PIECE(^PRCF(421.5,PRCF("CIDA"),2),"^",3)=X
SET $PIECE(^(1),"^",3)=X
+14 Begin DoDot:1
+15 SET DIC=421.9
SET DIC(0)="Z"
SET X=PRCF("PO")
DO ^DIC
+16 IF Y'<0
IF $PIECE(Y(0),"^",2)>949
Begin DoDot:2
+17 IF $PIECE(Y(0),"^",2)<974
SET X="WARNING: This PO currently has "_$PIECE(Y(0),"^",2)_" partials and is approaching the limit of 974 permitted by the system."
QUIT
+18 IF $PIECE(Y(0),"^",2)=974
SET X="WARNING: This PO currently has 974 partials, which is the limit permitted by the system. The addition of further partials will result in errors."
Begin DoDot:3
+19 SET X=X_" If you proceed with the processing of this invoice in IFCAP, the PV document will have to be created on-line in FMS."
End DoDot:3
QUIT
+20 SET X="WARNING: This PO currently has "_$PIECE(Y(0),"^",2)_" partials and has exceeded the limit of 974 permitted by the system. Corrective action must be taken."
Begin DoDot:3
+21 SET X=X_" If you proceed with the processing of this invoice in IFCAP, the PV document will have to be created on-line in FMS."
End DoDot:3
QUIT
End DoDot:2
WRITE !!
DO MSG^PRCFQ
WRITE $CHAR(7),$CHAR(7),$CHAR(7),$CHAR(7)
+22 KILL DIC,Y
End DoDot:1
+23 WRITE !,$CHAR(7)
SET %=2
SET %A="Do you need to view the entire PO"
SET %B=""
+24 DO ^PRCFYN
IF %<0
DO OUT1
QUIT
+25 SET D0=PRCF("PODA")
IF %=1
DO ^PRCHDP1
DO ^PRCFDSC1
WRITE !,$CHAR(7)
KILL PRCHPO
+26 SET %=1
SET %A="Is this the correct Purchase Order for this Invoice"
SET %B=""
+27 DO ^PRCFYN
if %=2
GOTO PAT
IF %<0
DO OUT1
QUIT
+28 SET %A="Do you want to review other Invoices for this Purchase Order"
+29 SET %B=""
SET %=2
DO ^PRCFYN
IF %<0
DO OUT1
QUIT
+30 if %=1
DO PO^PRCFDIC
VEN ;
+1 Begin DoDot:1
+2 SET X=$ORDER(^PRC(442,PRCF("PODA"),5,0))
if X=""
QUIT
+3 SET X1=$GET(^PRC(442,PRCF("PODA"),5,X,0))
+4 SET PRCF("%")=$PIECE(X1,"^")
SET PRCF("DAYS")=$PIECE(X1,"^",2)
+5 if +X1>0
SET $PIECE(^PRCF(421.5,PRCF("CIDA"),0),"^",11,12)=PRCF("%")_"^"_PRCF("DAYS")
+6 if $EXTRACT(X1,1,3)="NET"
SET $PIECE(^PRCF(421.5,PRCF("CIDA"),1),"^",10)=PRCF("DAYS")
+7 QUIT
End DoDot:1
+8 SET $PIECE(^PRCF(421.5,PRCF("CIDA"),0),U,6)=$PIECE($GET(^PRC(442,PRCF("PODA"),12)),U,15)
+9 IF +$PIECE($GET(^PRC(442,PRCF("PODA"),1)),U)
Begin DoDot:1
+10 SET %A="Is this the correct Vendor for this Invoice"
SET %B=""
SET %=1
+11 DO ^PRCFYN
End DoDot:1
IF %'=1
DO VENED^PRCFDCI
+12 IF '$PIECE($GET(^PRC(442,PRCF("PODA"),1)),U)
Begin DoDot:1
+13 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
+14 SET DIC("A")="Invoice's Vendor: "
if PRCF("VENDA")?1.N
SET DIC("B")=$PIECE($GET(^PRC(440,PRCF("VENDA"),0)),U)
+15 DO ^DIC
KILL DIC,DLAYGO,ORDER,PRCHOV3,STATE
if +Y<1
QUIT
SET PRCF("VENDA")=+Y
+16 IF $PIECE(Y,U,3)
SET PRCF("NUVEND")=1
DO VENDOR^PRCFDE2
+17 SET DIE=421.5
SET DR="6////"_PRCF("VENDA")
SET DA=PRCF("CIDA")
DO ^DIE
+18 KILL DA,DR,DIE
End DoDot:1
IF PRCF("VENDA")'?1.N
WRITE !,"Terminating Edit."
DO OUT
QUIT
+19 IF +$GET(PRCF("VENDA"))
IF '$GET(PRCF("NUVEND"))
SET %A="Do you want to edit this Vendor's information"
SET %B=""
SET %=2
DO ^PRCFYN
if %<1
GOTO OUT
if %=1
DO VENDOR^PRCFDE2
VL ;
+1 SET %A="Do you want to review other Invoices for this VENDOR"
+2 SET %B=""
SET %=2
DO ^PRCFYN
IF %<0
DO OUT1
QUIT
+3 if %=1
DO VENDOR^PRCFDIC
DIE GOTO ^PRCFDE1
