source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHFCY.m@ 1078

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PRCHFCY ;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
12READ ;
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 ;
23ASK ;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
28ASK1 ;
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 ;
34OFFI ;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 ;
39FIND ;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
Note: See TracBrowser for help on using the repository browser.