PRCH3A ;WISC/PLT-IFCAP INACTIVATE OLD/EXPIRED PURCHASE CARDS - CITIBANK ;8/28/98 11:49
V ;;5.1;IFCAP;**8,125,129**;Oct 20, 2000;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
QUIT ;invalid entry
;
;ZTQPARAM="REGULAR" if from schedule option, ="CITI" if from CITIBANK schedule
EN ;inactivate charge cards
N PRCA,PRCB,PRCRI,PRCDI,PRC,PRCTD
I $D(ZTQUEUED) G SCHED
S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
Q1 ;inactivate all CITI charge cards with expired date before t
S PRCTD=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
D YN^PRC0A(.X,.Y,"Ready to inactivate old Citibank & expired US Bank charge cards before "_PRCTD,"O","NO")
I X["^"!(X="")!'Y G EXIT
D NOW^%DTC S ZTDTH=%
S %ZIS("B")="Q",ZTIO=""
S ZTRTN="SCHED^PRCH3A",ZTDESC="IFCAP INACTIVATION OF OLD CITIBANK/EXPIRED US BANK CHARGE CARDS",ZTSAVE("*")=""
D ^%ZTLOAD
W !! D EN^DDIOL(" IFCAP INACTIVATION OF OLD CITIBANK/EXPIRED US BANK CHARGE CARDS WAS SCHEDULED WITH TASK # "_ZTSK)
R X:4
D HOME^%ZIS
EXIT QUIT
;
;
D EDIT^PRC0B(.X,PRCDI,"4;5;6")
;
SCHED ;inactivate old Citibank/expired US Bank charge card with date before run date
D NOW^%DTC I %<3081129.0500 Q
N PRCRI,PRCA,PRCB,PRCC S DT=X
S PRCRI=0,U="^"
F S PRCRI=$O(^PRC(440.5,PRCRI)) QUIT:PRCRI'?1N.N!'PRCRI S PRCA=$G(^(PRCRI,0)),PRCB=$G(^(2)) D:$P(PRCB,U,2)'="Y"
. I $D(PRC("SITE")) Q:$P($G(PRCB),"^",3)'=PRC("SITE")
. S PRCC=""
. I PRCA?1"4486".E S PRCC="Y"
. I PRCC="",$P(PRCB,U,4),$P(PRCB,U,4)<DT S PRCC="Y"
. I PRCC="Y" S X="" D EDIT^PRC0B(.X,"440.5;^PRC(440.5,;"_PRCRI,"14///^S X=""Y""")
. QUIT
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCH3A 1631 printed Dec 13, 2024@02:05:11 Page 2
PRCH3A ;WISC/PLT-IFCAP INACTIVATE OLD/EXPIRED PURCHASE CARDS - CITIBANK ;8/28/98 11:49
V ;;5.1;IFCAP;**8,125,129**;Oct 20, 2000;Build 5
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;invalid entry
QUIT
+3 ;
+4 ;ZTQPARAM="REGULAR" if from schedule option, ="CITI" if from CITIBANK schedule
EN ;inactivate charge cards
+1 NEW PRCA,PRCB,PRCRI,PRCDI,PRC,PRCTD
+2 IF $DATA(ZTQUEUED)
GOTO SCHED
+3 SET PRCF("X")="S"
DO ^PRCFSITE
if '$DATA(PRC("SITE"))
QUIT
if $GET(X)="^"
QUIT
Q1 ;inactivate all CITI charge cards with expired date before t
+1 SET PRCTD=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+2 DO YN^PRC0A(.X,.Y,"Ready to inactivate old Citibank & expired US Bank charge cards before "_PRCTD,"O","NO")
+3 IF X["^"!(X="")!'Y
GOTO EXIT
+4 DO NOW^%DTC
SET ZTDTH=%
+5 SET %ZIS("B")="Q"
SET ZTIO=""
+6 SET ZTRTN="SCHED^PRCH3A"
SET ZTDESC="IFCAP INACTIVATION OF OLD CITIBANK/EXPIRED US BANK CHARGE CARDS"
SET ZTSAVE("*")=""
+7 DO ^%ZTLOAD
+8 WRITE !!
DO EN^DDIOL(" IFCAP INACTIVATION OF OLD CITIBANK/EXPIRED US BANK CHARGE CARDS WAS SCHEDULED WITH TASK # "_ZTSK)
+9 READ X:4
+10 DO HOME^%ZIS
EXIT QUIT
+1 ;
+2 ;
+3 DO EDIT^PRC0B(.X,PRCDI,"4;5;6")
+4 ;
SCHED ;inactivate old Citibank/expired US Bank charge card with date before run date
+1 DO NOW^%DTC
IF %<3081129.0500
QUIT
+2 NEW PRCRI,PRCA,PRCB,PRCC
SET DT=X
+3 SET PRCRI=0
SET U="^"
+4 FOR
SET PRCRI=$ORDER(^PRC(440.5,PRCRI))
if PRCRI'?1N.N!'PRCRI
QUIT
SET PRCA=$GET(^(PRCRI,0))
SET PRCB=$GET(^(2))
if $PIECE(PRCB,U,2)'="Y"
Begin DoDot:1
+5 IF $DATA(PRC("SITE"))
if $PIECE($GET(PRCB),"^",3)'=PRC("SITE")
QUIT
+6 SET PRCC=""
+7 IF PRCA?1"4486".E
SET PRCC="Y"
+8 IF PRCC=""
IF $PIECE(PRCB,U,4)
IF $PIECE(PRCB,U,4)<DT
SET PRCC="Y"
+9 IF PRCC="Y"
SET X=""
DO EDIT^PRC0B(.X,"440.5;^PRC(440.5,;"_PRCRI,"14///^S X=""Y""")
+10 QUIT
End DoDot:1
+11 QUIT
