| 1 | PRCH1E ;WISC/PLT-IFCAP RETRIEVE UNREGISTERED PURCHASE CARD CHARGES ;10/15/97 14:26
|
|---|
| 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 | EN ;retrieve unregistered purchase card charges
|
|---|
| 7 | N PRCA,PRCB,PRCRI
|
|---|
| 8 | N A,B,C
|
|---|
| 9 | S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
|
|---|
| 10 | Q1 D YN^PRC0A(.X,.Y,"Ready to Retrieve Unregistered Purchase Card Charges","O","YES")
|
|---|
| 11 | I X["^"!(X="")!'Y G EXIT
|
|---|
| 12 | D EN^DDIOL("Start Retrieving:")
|
|---|
| 13 | S PRCRI=0,PRCTR=0
|
|---|
| 14 | F S PRCRI=$O(^PRCH(440.6,"ST","N~",PRCRI)) QUIT:'PRCRI D:$P(^PRCH(440.6,PRCRI,0),"^",17)="" K:$P(^PRCH(440.6,PRCRI,0),"^",17) ^PRCH(440.6,"ST","N~",PRCRI)
|
|---|
| 15 | . N A,B,C,X,Y
|
|---|
| 16 | . S A=^PRCH(440.6,PRCRI,0),B=$P(A,"^",4),PRCRI(440.5)=$O(^PRC(440.5,"B",B,0))
|
|---|
| 17 | . QUIT:'PRCRI(440.5)
|
|---|
| 18 | . S PRCRI(200)=$P(^PRC(440.5,PRCRI(440.5),0),"^",8) QUIT:PRCRI(200)=""
|
|---|
| 19 | . I $D(PRC("SITE")) Q:$P(^PRC(440.5,PRCRI(440.5),2),"^",3)'=PRC("SITE")
|
|---|
| 20 | . W "." D EDIT^PRC0B(.X,"440.6;^PRCH(440.6,;"_PRCRI,"16////"_PRCRI(200))
|
|---|
| 21 | . S PRCTR=$G(PRCTR)+1
|
|---|
| 22 | . QUIT
|
|---|
| 23 | ;
|
|---|
| 24 | I $G(PRCTR)>0 W !!?5,"Found "_PRCTR_" charge(s). Task completed !!" H 2
|
|---|
| 25 | I $G(PRCTR)=0 W !!?5,"No charges were found. Task completed !!" H 2
|
|---|
| 26 | K PRCTR
|
|---|
| 27 | EXIT QUIT
|
|---|
