PRCFDSOD ;SSOI&TFO/LKG - Invoice Tracking Clerk Separation of Duties;11/26/10 13:25 ;12/2/10 16:00
;;5.1;IFCAP;**154**;Oct 20, 2000;Build 5
;;Per VHA Directive 2004-038, this routine should not be modified.
;Extrinsic function testing if user may certify invoice against 1358
;for payment
;
;Input variables:
;PRCIEN - Internal Entry Number of file #421.5 entry
;PRCDUZ - Internal Entry Number of current user in file #200
;Returns '1' if user not permitted to certify or error in call to function
;Returns '0' if user permitted to certify and no error in call
VIOLATE(PRCIEN,PRCDUZ) ;Checks if user certifying invoice would be violation
N PRCARR,PRCPO,PRCRES,PRCVAL,PRCVIOL
I $G(PRCIEN)'>0!($G(PRCDUZ)'>0) S PRCVIOL=1,PRCARR(1)="Call to function checking for violation not set up correctly.",PRCARR(1,"F")="!!?5",PRCARR(2)="Report error to IFCAP customer support.",PRCARR(2,"F")="!?5" D EN^DDIOL(.PRCARR) G VIOLX
S PRCVIOL=0
S PRCPO=$P($G(^PRCF(421.5,PRCIEN,0)),U,7)_","
I PRCPO="," D G VIOLX
. S PRCVIOL=1,PRCARR(1)="File #421.5 entry is missing pointer to file #442 and corrupt.",PRCARR(1,"F")="!!?5",PRCARR(2)="Invoice cannot be certified for payment without entry correction.",PRCARR(2,"F")="!?5"
. D EN^DDIOL(.PRCARR)
D GETS^DIQ(442,PRCPO,".01;.02","E","PRCVAL")
G VIOLX:$G(PRCVAL(442,PRCPO,.02,"E"))'["1358"
S PRCPO=$G(PRCVAL(442,PRCPO,.01,"E"))
D UOKCERT^PRCEMOA(.PRCRES,PRCPO,PRCDUZ)
S:'PRCRES PRCVIOL=1
I $P(PRCRES,U)="E" S PRCARR(1)="Error: "_$P(PRCRES,U,2),PRCARR(1,"F")="!!?2",PRCARR(2)="You cannot certify this invoice for payment without first addressing error.",PRCARR(2,"F")="!?2" D EN^DDIOL(.PRCARR)
I $P(PRCRES,U)=0 S PRCARR(1)=$P(PRCRES,U,2),PRCARR(1,"F")="!!?2",PRCARR(2)="Due to segregation of duties, you cannot also certify an invoice for payment.",PRCARR(2,"F")="!?2" D EN^DDIOL(.PRCARR)
VIOLX Q PRCVIOL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDSOD 1883 printed Dec 13, 2024@02:03:15 Page 2
PRCFDSOD ;SSOI&TFO/LKG - Invoice Tracking Clerk Separation of Duties;11/26/10 13:25 ;12/2/10 16:00
+1 ;;5.1;IFCAP;**154**;Oct 20, 2000;Build 5
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;Extrinsic function testing if user may certify invoice against 1358
+4 ;for payment
+5 ;
+6 ;Input variables:
+7 ;PRCIEN - Internal Entry Number of file #421.5 entry
+8 ;PRCDUZ - Internal Entry Number of current user in file #200
+9 ;Returns '1' if user not permitted to certify or error in call to function
+10 ;Returns '0' if user permitted to certify and no error in call
VIOLATE(PRCIEN,PRCDUZ) ;Checks if user certifying invoice would be violation
+1 NEW PRCARR,PRCPO,PRCRES,PRCVAL,PRCVIOL
+2 IF $GET(PRCIEN)'>0!($GET(PRCDUZ)'>0)
SET PRCVIOL=1
SET PRCARR(1)="Call to function checking for violation not set up correctly."
SET PRCARR(1,"F")="!!?5"
SET PRCARR(2)="Report error to IFCAP customer support."
SET PRCARR(2,"F")="!?5"
DO EN^DDIOL(.PRCARR)
GOTO VIOLX
+3 SET PRCVIOL=0
+4 SET PRCPO=$PIECE($GET(^PRCF(421.5,PRCIEN,0)),U,7)_","
+5 IF PRCPO=","
Begin DoDot:1
+6 SET PRCVIOL=1
SET PRCARR(1)="File #421.5 entry is missing pointer to file #442 and corrupt."
SET PRCARR(1,"F")="!!?5"
SET PRCARR(2)="Invoice cannot be certified for payment without entry correction."
SET PRCARR(2,"F")="!?5"
+7 DO EN^DDIOL(.PRCARR)
End DoDot:1
GOTO VIOLX
+8 DO GETS^DIQ(442,PRCPO,".01;.02","E","PRCVAL")
+9 if $GET(PRCVAL(442,PRCPO,.02,"E"))'["1358"
GOTO VIOLX
+10 SET PRCPO=$GET(PRCVAL(442,PRCPO,.01,"E"))
+11 DO UOKCERT^PRCEMOA(.PRCRES,PRCPO,PRCDUZ)
+12 if 'PRCRES
SET PRCVIOL=1
+13 IF $PIECE(PRCRES,U)="E"
SET PRCARR(1)="Error: "_$PIECE(PRCRES,U,2)
SET PRCARR(1,"F")="!!?2"
SET PRCARR(2)="You cannot certify this invoice for payment without first addressing error."
SET PRCARR(2,"F")="!?2"
DO EN^DDIOL(.PRCARR)
+14 IF $PIECE(PRCRES,U)=0
SET PRCARR(1)=$PIECE(PRCRES,U,2)
SET PRCARR(1,"F")="!!?2"
SET PRCARR(2)="Due to segregation of duties, you cannot also certify an invoice for payment."
SET PRCARR(2,"F")="!?2"
DO EN^DDIOL(.PRCARR)
VIOLX QUIT PRCVIOL
