PRCFDSOD.m

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 ---PRCFDSOD   1883     printed  Apr 09, 2024@21:16:37                                                                                                                                                                                                    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