Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCH7PA4

PRCH7PA4.m

Go to the documentation of this file.
  1. PRCH7PA4 ;Hines IOFO/RVD - RPC FOR 440.5 420 420.1 420.2 440 ;8/13/03 12:07
  1. ;;5.1;IFCAP;**68**;Oct 20,2000
  1. ;
  1. ;This routine is use for RPC call to list all Purchase Card for a user.
  1. ;DUZ - user
  1. ;RESULTS - array of all Purchase Card available to a user whether
  1. ;as a (Card Holder or Surrogate User)
  1. ;RESULTS array contains the ff:
  1. ;PURCHASE CARD NUMBER = pc1
  1. ;FUND CONTROL POINT = pc2
  1. ;COST CENTER NAME = pc3
  1. ;COST CENTER 420.1IEN = pc4
  1. ;BUDGET OBJECT CODE = pc5
  1. ;PC USER SINGLE PURCHASE LIMIT = pc6
  1. ;MONTHLY PURCHASE LIMIT = pc7
  1. ;CARD HOLDER = pc8
  1. ;APPROVING OFFICIAL = pc9
  1. ;PURCHASE CARD NAME = pc10
  1. ;INACTIVE CARD = pc11
  1. ;STATION NUMBER = pc12
  1. ;EXPIRATION DATE = pc13
  1. ;
  1. ;list all available Purchase card Number for a user.
  1. A1(DUZ,PRCSITE) G A2 ;entry point for roll and scroll
  1. ;
  1. ENA(RESULTS,DUZ,PRCSITE) ;broker entry point
  1. ;
  1. A2 ;
  1. I DUZ="" S RESULTS(0)="User Is Undefined" G EXIT
  1. I '$D(^PRC(411,PRCSITE,0)) S RESULTS(0)="IFCAP Station Not Defined in file # 411." G EXIT
  1. ;new code
  1. K PR S PRCNT=0
  1. ;H x-ref is for Card Holder
  1. F I=0:0 S I=$O(^PRC(440.5,"H",DUZ,I)) Q:I'>0 D
  1. .D GETS^DIQ(440.5,I,".01;1;2;3;4;5;7;8;10;14;15;16","","PR")
  1. .D SET
  1. ;C x-ref is for Surrogate user.
  1. F I=0:0 S I=$O(^PRC(440.5,"C",DUZ,I)) Q:I'>0 D
  1. .D GETS^DIQ(440.5,I,".01;1;2;3;4;5;7;8;10;14;15;16","","PR")
  1. .Q:$D(PRCCARD(I))
  1. .D SET
  1. ;
  1. EXIT ;common exit point
  1. I '$D(RESULTS) S RESULTS(0)="NOTHING FOUND"
  1. K PR,PRCNT,PRCCARD,I
  1. Q
  1. SET ;
  1. Q:$G(PR(440.5,I_",",15))'=PRCSITE
  1. S RMPRFCP=$G(PR(440.5,I_",",1))
  1. ;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
  1. S PRCNT=PRCNT+1
  1. S RESULTS(PRCNT)=PR(440.5,I_",",.01)_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",1))_U
  1. S RMPRCIEN=$G(PR(440.5,I_",",2))
  1. I RMPRCIEN="" S RESULTS(PRCNT)=RESULTS(PRCNT)_RMPRCIEN_U
  1. E S RESULTS(PRCNT)=RESULTS(PRCNT)_$P(^PRCD(420.1,RMPRCIEN,0),U,1)_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",2))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",3))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",4))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",5))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",7))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",8))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",10))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",14))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",15))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_$G(PR(440.5,I_",",16))_U
  1. S RESULTS(PRCNT)=RESULTS(PRCNT)_I
  1. S PRCCARD(I)=""
  1. Q
  1. ;
  1. ;Fund Control Point Check for a user.
  1. D1(DUZ,PRCSITE,PRCFCP) G D2 ;entry point for roll and scroll
  1. ;
  1. END(RESULTS,DUZ,PRCSITE,PRCFCP) ;broker entry point
  1. ;
  1. D2 S ^TMP("FCP",0)=DUZ_"^"_PRCSITE_"^"_PRCFCP
  1. ;
  1. S PRCFCP=+PRCFCP
  1. I DUZ="" S RESULTS(0)="1^User Is Undefined" Q
  1. I $D(^PRC(420,"C",DUZ,PRCSITE,PRCFCP)) S RESULTS(0)="0^FCP OK" Q
  1. S RESULTS(0)="1^You are not set up for this fund control point "_PRCFCP_" check with your supervisor or Ficsal Service." Q
  1. Q
  1. ;END