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