- 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 Mar 13, 2025@21:10 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
