| 1 | PRCH3A ;WISC/PLT-IFCAP INACTIVATE EXPIRED PURCHASE CARDS ;8/28/98 11:49
|
|---|
| 2 | V ;;5.1;IFCAP;**8**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT ;invalid entry
|
|---|
| 5 | ;
|
|---|
| 6 | ;ZTQPARAM="REGULAR" if from schedule option, ="RMNB" if from ROCKY BANK schedule
|
|---|
| 7 | EN ;inactivate charge cards
|
|---|
| 8 | N PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRC,PRCDES,PTCTD
|
|---|
| 9 | N A,B,C
|
|---|
| 10 | S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
|
|---|
| 11 | I $D(ZTQUEUED) G SCHED
|
|---|
| 12 | Q1 ;inactivate all charge cards with expired date before t
|
|---|
| 13 | S PRCTD=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
|
|---|
| 14 | D YN^PRC0A(.X,.Y,"Ready to inactivate expired charge cards before "_PRCTD,"O","NO")
|
|---|
| 15 | I X["^"!(X="")!'Y G EXIT
|
|---|
| 16 | D NOW^%DTC S ZTDTH=%
|
|---|
| 17 | S %ZIS("B")="Q",ZTIO=""
|
|---|
| 18 | S ZTRTN="SCHED^PRCH3A",ZTDESC="IFCAP INACTIVATION OF EXPIRED CHARGE CARDS",ZTSAVE("*")=""
|
|---|
| 19 | D ^%ZTLOAD
|
|---|
| 20 | W !! D EN^DDIOL(" IFCAP INACTIVATION OF EXPIRED CHARGE CARDS WAS SCHEDULED WITH TASK # "_ZTSK)
|
|---|
| 21 | D HOME^%ZIS
|
|---|
| 22 | EXIT QUIT
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | D EDIT^PRC0B(.X,PRCDI,"4;5;6")
|
|---|
| 26 | ;
|
|---|
| 27 | SCHED ;inactivate expired charge card with date before zdt (today)
|
|---|
| 28 | N PRCRI,PRCA,PRCB,PRCC
|
|---|
| 29 | S PRCRI=0
|
|---|
| 30 | F S PRCRI=$O(^PRC(440.5,PRCRI)) QUIT:PRCRI'?1N.N!'PRCRI S PRCA=$G(^(PRCRI,0)),PRCB=$G(^(2)) D:$P(PRCB,"^",2)'="Y"
|
|---|
| 31 | . I $D(PRC("SITE")) Q:$P($G(PRCB),"^",3)'=PRC("SITE")
|
|---|
| 32 | . S PRCC=""
|
|---|
| 33 | . I PRCA?1"4716".E S PRCC="Y"
|
|---|
| 34 | . I PRCC="",$P(PRCB,"^",4),$P(PRCB,"^",4)<DT S PRCC="Y"
|
|---|
| 35 | . I PRCC="Y" S X="" D EDIT^PRC0B(.X,"440.5;^PRC(440.5,;"_PRCRI,"14///^S X=""Y""")
|
|---|
| 36 | . QUIT
|
|---|
| 37 | QUIT
|
|---|
