| 1 | PRCHFCY ;WISC/KMB/CR-ENTRY ACTION FOR FINAL CHARGE YES REPORT 6/09/98
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | N AA,J,ORIG,OUT,REM,STA,START,STR,STR1,TIMES,VALUE,XXZ,EN,END,FIN,I,COUNT
|
|---|
| 5 | S XXZ="",CCHECK="####"
|
|---|
| 6 | S (COUNT,I)=0 F S I=$O(^PRC(440.5,"C",DUZ,I)) Q:I="" D
|
|---|
| 7 | .Q:$P($G(^PRC(440.5,I,2)),U,2)="Y"
|
|---|
| 8 | .S COUNT=COUNT+1,STR=$P($G(^PRC(440.5,I,0)),"^",1),STR1=$P($G(^PRC(440.5,I,0)),"^",11)
|
|---|
| 9 | .S AA(DUZ,COUNT)=STR_"^"_STR1_"^"_I
|
|---|
| 10 | I COUNT=0 W !,"You are not a purchase card holder." QUIT
|
|---|
| 11 | S REM=COUNT#20,END=COUNT-REM,TIMES=END/20
|
|---|
| 12 | READ ;
|
|---|
| 13 | S VALUE=0 R !,"Enter Purchase Card Name: ",XXZ:200
|
|---|
| 14 | D LOOK1^PRCSPC
|
|---|
| 15 | I XXZ="^" QUIT
|
|---|
| 16 | I XXZ="" W !,"Invalid entry." G READ
|
|---|
| 17 | I +XXZ<1 W !,"Invalid entry." G READ
|
|---|
| 18 | I $G(AA(DUZ,XXZ))="" W !,"This card is not registered to you." G READ
|
|---|
| 19 | S CCHECK=$P(AA(DUZ,XXZ),"^") W " ",$P(AA(DUZ,XXZ),"^",2)
|
|---|
| 20 | ;
|
|---|
| 21 | QUIT
|
|---|
| 22 | ;
|
|---|
| 23 | ASK ;ask user if they wish to print data for all purchase cards,
|
|---|
| 24 | ;inactive cards, or active cards
|
|---|
| 25 | W !,"Please select the type of purchase cards you wish to display:",!!
|
|---|
| 26 | S DIR(0)="S^A:Active;I:Inactive;B:Both",DIR("A")="TYPE" D ^DIR K DIR Q:Y["^"
|
|---|
| 27 | S TYPE=Y QUIT
|
|---|
| 28 | ASK1 ;
|
|---|
| 29 | N SCREEN S SCREEN="I $P($G(^PRC(440.5,D0,2)),""^"",2)"
|
|---|
| 30 | S:TYPE="B" TYPE=SCREEN_"[""""" S:TYPE="I" TYPE=SCREEN_"=""Y""" S:TYPE="A" TYPE=SCREEN_"'=""Y"""
|
|---|
| 31 | S DIS(0)=TYPE
|
|---|
| 32 | QUIT
|
|---|
| 33 | ;
|
|---|
| 34 | OFFI ;get official or alternate for Unreconciled Austin Transactions
|
|---|
| 35 | ;Report
|
|---|
| 36 | W !! S DIC(0)="AEMQ",DIC="^VA(200," D ^DIC
|
|---|
| 37 | S ENTRY=+Y K Y,DIC QUIT
|
|---|
| 38 | ;
|
|---|
| 39 | FIND ;find PC official or alternate for card on CC record
|
|---|
| 40 | Q:'$D(D0)
|
|---|
| 41 | N SET1,SET2 S (SET3,SET4)=""
|
|---|
| 42 | S SET1=$P($G(^PRCH(440.6,D0,0)),"^",4) Q:SET1="" S SET2=$O(^PRC(440.5,"B",SET1,0))
|
|---|
| 43 | I $P($G(^PRC(440.5,+SET2,0)),"^",9)=ENTRY D Q
|
|---|
| 44 | .S SET3=$P($G(^PRC(440.5,+SET2,0)),"^",9),SET4=$P($G(^VA(200,SET3,0)),"^")
|
|---|
| 45 | I $P($G(^PRC(440.5,+SET2,0)),"^",10)=ENTRY D
|
|---|
| 46 | .S SET3=$P($G(^PRC(440.5,+SET2,0)),"^",10),SET4=$P($G(^VA(200,SET3,0)),"^")
|
|---|
| 47 | QUIT
|
|---|
