source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH7PA4.m@ 1524

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1PRCH7PA4 ;Hines IOFO/RVD - RPC FOR 440.5 420 420.1 420.2 440 ;8/13/03 12:07
2 ;;5.1;IFCAP;**68**;Oct 20,2000
3 ;
4 ;This routine is use for RPC call to list all Purchase Card for a user.
5 ;DUZ - user
6 ;RESULTS - array of all Purchase Card available to a user whether
7 ;as a (Card Holder or Surrogate User)
8 ;RESULTS array contains the ff:
9 ;PURCHASE CARD NUMBER = pc1
10 ;FUND CONTROL POINT = pc2
11 ;COST CENTER NAME = pc3
12 ;COST CENTER 420.1IEN = pc4
13 ;BUDGET OBJECT CODE = pc5
14 ;PC USER SINGLE PURCHASE LIMIT = pc6
15 ;MONTHLY PURCHASE LIMIT = pc7
16 ;CARD HOLDER = pc8
17 ;APPROVING OFFICIAL = pc9
18 ;PURCHASE CARD NAME = pc10
19 ;INACTIVE CARD = pc11
20 ;STATION NUMBER = pc12
21 ;EXPIRATION DATE = pc13
22 ;
23 ;list all available Purchase card Number for a user.
24A1(DUZ,PRCSITE) G A2 ;entry point for roll and scroll
25 ;
26ENA(RESULTS,DUZ,PRCSITE) ;broker entry point
27 ;
28A2 ;
29 I DUZ="" S RESULTS(0)="User Is Undefined" G EXIT
30 I '$D(^PRC(411,PRCSITE,0)) S RESULTS(0)="IFCAP Station Not Defined in file # 411." G EXIT
31 ;new code
32 K PR S PRCNT=0
33 ;H x-ref is for Card Holder
34 F I=0:0 S I=$O(^PRC(440.5,"H",DUZ,I)) Q:I'>0 D
35 .D GETS^DIQ(440.5,I,".01;1;2;3;4;5;7;8;10;14;15;16","","PR")
36 .D SET
37 ;C x-ref is for Surrogate user.
38 F I=0:0 S I=$O(^PRC(440.5,"C",DUZ,I)) Q:I'>0 D
39 .D GETS^DIQ(440.5,I,".01;1;2;3;4;5;7;8;10;14;15;16","","PR")
40 .Q:$D(PRCCARD(I))
41 .D SET
42 ;
43EXIT ;common exit point
44 I '$D(RESULTS) S RESULTS(0)="NOTHING FOUND"
45 K PR,PRCNT,PRCCARD,I
46 Q
47SET ;
48 Q:$G(PR(440.5,I_",",15))'=PRCSITE
49 S RMPRFCP=$G(PR(440.5,I_",",1))
50 ;I '$D(^PRC(420,"C",DUZ,PRCSITE,RMPRFCP)) S RESULTS="1^You are not authorized for fund Control Point"_RMPRFCP_". Please resolve the problem and try again." Q
51 S PRCNT=PRCNT+1
52 S RESULTS(PRCNT)=PR(440.5,I_",",.01)_U
53 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",1))_U
54 S RMPRCIEN=$G(PR(440.5,I_",",2))
55 I RMPRCIEN="" S RESULTS(PRCNT)=RESULTS(PRCNT)_RMPRCIEN_U
56 E S RESULTS(PRCNT)=RESULTS(PRCNT)_$P(^PRCD(420.1,RMPRCIEN,0),U,1)_U
57 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",2))_U
58 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",3))_U
59 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",4))_U
60 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",5))_U
61 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",7))_U
62 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",8))_U
63 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",10))_U
64 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",14))_U
65 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",15))_U
66 S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",16))_U
67 S RESULTS(PRCNT)=RESULTS(PRCNT)_I
68 S PRCCARD(I)=""
69 Q
70 ;
71 ;Fund Control Point Check for a user.
72D1(DUZ,PRCSITE,PRCFCP) G D2 ;entry point for roll and scroll
73 ;
74END(RESULTS,DUZ,PRCSITE,PRCFCP) ;broker entry point
75 ;
76D2 S ^TMP("FCP",0)=DUZ_"^"_PRCSITE_"^"_PRCFCP
77 ;
78 S PRCFCP=+PRCFCP
79 I DUZ="" S RESULTS(0)="1^User Is Undefined" Q
80 I $D(^PRC(420,"C",DUZ,PRCSITE,PRCFCP)) S RESULTS(0)="0^FCP OK" Q
81 S RESULTS(0)="1^You are not set up for this fund control point "_PRCFCP_" check with your supervisor or Ficsal Service." Q
82 Q
83 ;END
Note: See TracBrowser for help on using the repository browser.