source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH1E.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PRCH1E ;WISC/PLT-IFCAP RETRIEVE UNREGISTERED PURCHASE CARD CHARGES ;10/15/97 14:26
2V ;;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 ;
6EN ;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)="^"
10Q1 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
27EXIT QUIT
Note: See TracBrowser for help on using the repository browser.