PRCFDE2 ;WISC/LKG-ENTER/EDIT CERTIFIED INVOICE ;7/19/95 14:32
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
VENDOR ;Edit Vendor information
N PRCFERR,I
I '$G(PRCF("VENDA")) S X="Incomplete Vendor Information on PO/1358. Unable to Edit Vendor Data.*" D MSG^PRCFQ Q
S (PRCFA("VEND"),DA)=PRCF("VENDA")
G:$G(PRCF("NUVEND")) A
D HILO^PRCFQ,INFO^PRCFAC3
K IOINHI,IOINLOW,IOINORM,PRCTMP D EDIT^PRCFAC31
I 'Y!($D(DIRUT)) W !!,"No further action is being taken on this Vendor.",! G VENDX
A L +(^PRC(440.3,DA),^PRC(440,DA)):5 E W !,"Vendor information being edited by another user",! G VENDX
K ^PRC(440.3,DA) S %X="^PRC(440,DA,",%Y="^PRC(440.3,DA," D %XY^%RCR
A1 S DIE=440,DR=$S($P($G(^PRC(411,PRC("SITE"),0)),U,20):$S($D(^XUSEC("PRCFA VENDOR EDIT",DUZ)):"[PRCF FMS VENEDIT2B]",1:"[PRCF FMS VENEDIT2]"),1:$S($D(^XUSEC("PRCFA VENDOR EDIT",DUZ)):"[PRCF FMS VENEDIT1B]",1:"[PRCF FMS VENEDIT1]"))
D ^DIE K DIE,DR,ORDER
G:'$D(DA) A2
S X=$G(^PRC(440,DA,7)),PRCFERR=0
F I=3,7,8,9 I $P(X,U,I)="" S PRCFERR=1 Q
I $G(PRCFERR) D G:Y=1 A1
. W !!,"Warning - Payment Information for this Vendor is Incomplete."
. W !,"Payment information will have to be re-edited, if vendor is to be paid."
. S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you wish to re-edit the payment information now"
. D ^DIR K DIR
I '$G(PRCFERR) W ! D VEDIT^PRCHE1A(PRCFA("VEND"),PRC("SITE"))
A2 L -^PRC(440.3,PRCF("VENDA")),-^PRC(440,PRCF("VENDA"))
VENDX K DA,PRCFA("VEND"),DIRUT,DIROUT,DTOUT,DUOUT,%X,%Y
S X="Returning to Payments Module.*" D MSG^PRCFQ
Q
CLSD1358(PODA,MSG) ;Determine if 1358, status Transaction Complete or
;Canceled, Totally Liquidated
N PRCFX,PRCFY,PRCFZ
Q:PODA'?1.N 0 Q:'$D(^PRC(442,PODA,0)) 0
S PRCFX=$O(^PRCD(442.5,"C",1358,"")) Q:PRCFX="" 0
I $P(^PRC(442,PODA,0),U,2)'=PRCFX Q 0
S PRCFX=$P($G(^PRC(442,PODA,7)),U),PRCFZ=$P($P($G(^PRC(442,PODA,0)),U,3)," ")
I PRCFX]"",";40;105;"[(";"_$P($G(^PRCD(442.3,PRCFX,0)),U,3)_";") D Q 1
. W:MSG !,"Warning - This 1358 has been closed."
. W:MSG !,"In order for this invoice to be paid, the ",PRCFZ," FCP Official will have ",!," to reopen this 1358 and maybe adjust its obligation amount."
S PRCFY=$G(^PRC(442,PODA,8))
I $P(PRCFY,U)-$P(PRCFY,U,2)'>0 D Q 1
. W:MSG !,"Warning - This 1358 has already been totally liquidated."
. W:MSG !,"In order for this invoice to be paid, the ",PRCFZ," FCP official must first do",!," an Increase Adjustment."
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDE2 2493 printed Oct 16, 2024@18:03:43 Page 2
PRCFDE2 ;WISC/LKG-ENTER/EDIT CERTIFIED INVOICE ;7/19/95 14:32
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
VENDOR ;Edit Vendor information
+1 NEW PRCFERR,I
+2 IF '$GET(PRCF("VENDA"))
SET X="Incomplete Vendor Information on PO/1358. Unable to Edit Vendor Data.*"
DO MSG^PRCFQ
QUIT
+3 SET (PRCFA("VEND"),DA)=PRCF("VENDA")
+4 if $GET(PRCF("NUVEND"))
GOTO A
+5 DO HILO^PRCFQ
DO INFO^PRCFAC3
+6 KILL IOINHI,IOINLOW,IOINORM,PRCTMP
DO EDIT^PRCFAC31
+7 IF 'Y!($DATA(DIRUT))
WRITE !!,"No further action is being taken on this Vendor.",!
GOTO VENDX
A LOCK +(^PRC(440.3,DA),^PRC(440,DA)):5
IF '$TEST
WRITE !,"Vendor information being edited by another user",!
GOTO VENDX
+1 KILL ^PRC(440.3,DA)
SET %X="^PRC(440,DA,"
SET %Y="^PRC(440.3,DA,"
DO %XY^%RCR
A1 SET DIE=440
SET DR=$SELECT($PIECE($GET(^PRC(411,PRC("SITE"),0)),U,20):$SELECT($DATA(^XUSEC("PRCFA VENDOR EDIT",DUZ)):"[PRCF FMS VENEDIT2B]",1:"[PRCF FMS VENEDIT2]"),1:$SELECT($DATA(^XUSEC("PRCFA VENDOR EDIT",DUZ)):"[PRCF FMS VENEDIT1B]",1:"[PRCF FMS VENEDI
T1]"))
+1 DO ^DIE
KILL DIE,DR,ORDER
+2 if '$DATA(DA)
GOTO A2
+3 SET X=$GET(^PRC(440,DA,7))
SET PRCFERR=0
+4 FOR I=3,7,8,9
IF $PIECE(X,U,I)=""
SET PRCFERR=1
QUIT
+5 IF $GET(PRCFERR)
Begin DoDot:1
+6 WRITE !!,"Warning - Payment Information for this Vendor is Incomplete."
+7 WRITE !,"Payment information will have to be re-edited, if vendor is to be paid."
+8 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Do you wish to re-edit the payment information now"
+9 DO ^DIR
KILL DIR
End DoDot:1
if Y=1
GOTO A1
+10 IF '$GET(PRCFERR)
WRITE !
DO VEDIT^PRCHE1A(PRCFA("VEND"),PRC("SITE"))
A2 LOCK -^PRC(440.3,PRCF("VENDA")),-^PRC(440,PRCF("VENDA"))
VENDX KILL DA,PRCFA("VEND"),DIRUT,DIROUT,DTOUT,DUOUT,%X,%Y
+1 SET X="Returning to Payments Module.*"
DO MSG^PRCFQ
+2 QUIT
CLSD1358(PODA,MSG) ;Determine if 1358, status Transaction Complete or
+1 ;Canceled, Totally Liquidated
+2 NEW PRCFX,PRCFY,PRCFZ
+3 if PODA'?1.N
QUIT 0
if '$DATA(^PRC(442,PODA,0))
QUIT 0
+4 SET PRCFX=$ORDER(^PRCD(442.5,"C",1358,""))
if PRCFX=""
QUIT 0
+5 IF $PIECE(^PRC(442,PODA,0),U,2)'=PRCFX
QUIT 0
+6 SET PRCFX=$PIECE($GET(^PRC(442,PODA,7)),U)
SET PRCFZ=$PIECE($PIECE($GET(^PRC(442,PODA,0)),U,3)," ")
+7 IF PRCFX]""
IF ";40;105;"[(";"_$PIECE($GET(^PRCD(442.3,PRCFX,0)),U,3)_";")
Begin DoDot:1
+8 if MSG
WRITE !,"Warning - This 1358 has been closed."
+9 if MSG
WRITE !,"In order for this invoice to be paid, the ",PRCFZ," FCP Official will have ",!," to reopen this 1358 and maybe adjust its obligation amount."
End DoDot:1
QUIT 1
+10 SET PRCFY=$GET(^PRC(442,PODA,8))
+11 IF $PIECE(PRCFY,U)-$PIECE(PRCFY,U,2)'>0
Begin DoDot:1
+12 if MSG
WRITE !,"Warning - This 1358 has already been totally liquidated."
+13 if MSG
WRITE !,"In order for this invoice to be paid, the ",PRCFZ," FCP official must first do",!," an Increase Adjustment."
End DoDot:1
QUIT 1
+14 QUIT 0
