PRCFFU13.m

PRCFFU13 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS CONT ;6/17/11  17:58

V ;;5.1;IFCAP;**158**;Oct 20, 2000;Build 1

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ; Allows FIscal to edit Cost Center and BOCs prior to 1358 obligation

1358 ; 1358 Correction

 N CCEDIT,BOCEDIT D PROMPT

 Q:'Y!($D(DIRUT))

 S ESIGCHK=$$VERIFY^PRCSC1(OB) I 'ESIGCHK W !!,"This 1358 Obligation has been tampered with.  Please notify IFCAP APPLICATION COORDINATOR." Q

 S (BOCEDIT,CCEDIT)=0

 S OLDCC=$P(TRNODE(3),U,3),OLDBOC=+$P(TRNODE(3),U,6)

 W !! K MSG S MSG="...now editing Cost Center and BOC information..." D EN^DDIOL(MSG) K MSG W !

 D OB^PRCS58OB(DA)

 S:+OLDCC'=+NEWCC CCEDIT=1 S:+OLDBOC'=+NEWBOC BOCEDIT=1

 I CCEDIT!(BOCEDIT) D   Q

 .S FISCEDIT=1,ESIGMSG="",ROUTINE=$T(+0)

 .D RECODE^PRCSC1(OB,.ESIGMSG)

 .I ESIGMSG<1 D

 ..S:'$D(ROUTINE) ROUTINE=$T(+0)

 ..W !!,$$ERROR(ROUTINE,ESIGMSG)

 ..W:ESIGMSG=0!(ESIGMSG=-3) !,"Notify IFCAP APPLICATION COORDINATOR!",$C(7)

 ..S DIR(0)="EAO",DIR("A")="Press RETURN to continue" D ^DIR K DIR

 ..Q

 .N X S X=$P($G(TRNODE(4)),U,5) D VER^PRCH58OB(.PRC,.X) I X]"" D

 ..S PO=POIEN K ^PRC(442,POIEN,22) S NODE=$G(^PRC(442,POIEN,22,0)) I NODE="" D

 ...S ^PRC(442,POIEN,22,0)="^"_$P(^DD(442,41,0),U,2)

 ...N DA S DIE=442,DA=POIEN,DR="3///^S X=+NEWBOC" D ^DIE K DIE,DR

 ...D MSG1,NODE22^PRCFFU5

 .Q

 D MSG6

 Q

PROMPT ; Prompt for user

 S DIR(0)="Y",DIR("A")="Should the Cost Center or BOC information be edited at this time",DIR("B")="NO"

 S DIR("?")="Enter 'NO' or 'N' or 'RETURN' if no editing is needed."

 S DIR("?",1)="Enter '^' to exit the option."

 S DIR("?",2)="Enter 'YES' or 'Y' to edit this information."

 W ! D ^DIR K DIR

 Q

 ; Message processing

MSG1 K MSG W !! S MSG="...now recalculating FMS accounting lines..." D EN^DDIOL(MSG) K MSG W !

 Q

 ;

MSG2 K MSG W !! S MSG(1)="...Cost Center is missing - cannot continue..."

MSG21 S MSG(2)=" ",MSG(3)="No further action is being taken on this obligation."

 D EN^DDIOL(.MSG) K MSG W !

 Q

 ;

MSG3 K MSG W !! S MSG="BOC "_+SA_" is not valid with Cost Center "_$P(PO(0),U,5)_"."

 D EN^DDIOL(MSG) K MSG W !

 Q

 ;

MSG4 W !! S DIR(0)="Y",DIR("A",1)="I will now enter BOC "_+SA_" on all line items.",DIR("A")="Is this OK",DIR("B")="YES"

 D ^DIR K DIR

 Q

 ;

MSG5 K MSG W !! S MSG="...now changing the BOCs on all line items..."

 D EN^DDIOL(MSG) K MSG W !

 Q

MSG6 I (CCEDIT=1)!(BOCEDIT=1) Q

 K MSG W !!

 S MSG(1)=" ",MSG(2)=" "

 S:CCEDIT=0 MSG(1)="Cost Center has not changed.",MSG(3)=" "

 S:BOCEDIT=0 MSG(2)="BOC has not changed.",MSG(4)=" "

 S MSG(5)="No further editing is being done on this obligation.",MSG(6)=" "

 S MSG(7)="Returning to the Obligation processing."

 D EN^DDIOL(.MSG) K MSG W !

 Q

ERROR(ROUTINE,ERROR) ;

 I ROUTINE'="PRCUESIG" G NEXT

 I ERROR=-3 Q "NO SIGNATURE BLOCK IN FILE 200."

 I ERROR=-2 Q "TIME OUT OCCURRED DURING SIGNING PROCESS."

 I ERROR=-1 Q "USER CANCELLED SIGNING PROCESS."

 I ERROR=0 Q "INVALID SIGNATURE ENTERED."

 Q "PROBLEM WITH ELECTRONIC SIGNATURE.  ERROR= "_ERROR_" CALLING ROUTINE "_ROUTINE

NEXT I ERROR=-4 Q "CAN'T RE-SIGN RECORD."

 I ERROR=-3 Q "NO VALID USER NUMBER FOR FILING."

 I ERROR=-2 Q "NO SIGNATURE BLOCK IN FILE 200."

 I ERROR=-1 Q "A REQUIRED RECORD IS NULL."

 Q "PROBLEM WITH ELECTRONIC SIGNATURE.  ERROR= "_ERROR_" CALLING ROUTINE "_ROUTINE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFFU13   3359     printed  Mar 13, 2025@21:08:25                                                                                                                                                                                                    Page 2

PRCFFU13  ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS CONT ;6/17/11  17:58

V         ;;5.1;IFCAP;**158**;Oct 20, 2000;Build 1

 +1       ;Per VHA Directive 2004-038, this routine should not be modified.

 +2       ; Allows FIscal to edit Cost Center and BOCs prior to 1358 obligation

1358      ; 1358 Correction

 +1        NEW CCEDIT,BOCEDIT

           DO PROMPT

 +2        if 'Y!($DATA(DIRUT))

               QUIT 

 +3        SET ESIGCHK=$$VERIFY^PRCSC1(OB)

           IF 'ESIGCHK

               WRITE !!,"This 1358 Obligation has been tampered with.  Please notify IFCAP APPLICATION COORDINATOR."

               QUIT 

 +4        SET (BOCEDIT,CCEDIT)=0

 +5        SET OLDCC=$PIECE(TRNODE(3),U,3)

           SET OLDBOC=+$PIECE(TRNODE(3),U,6)

 +6        WRITE !!

           KILL MSG

           SET MSG="...now editing Cost Center and BOC information..."

           DO EN^DDIOL(MSG)

           KILL MSG

           WRITE !

 +7        DO OB^PRCS58OB(DA)

 +8        if +OLDCC'=+NEWCC

               SET CCEDIT=1

           if +OLDBOC'=+NEWBOC

               SET BOCEDIT=1

 +9        IF CCEDIT!(BOCEDIT)

               Begin DoDot:1

 +10               SET FISCEDIT=1

                   SET ESIGMSG=""

                   SET ROUTINE=$TEXT(+0)

 +11               DO RECODE^PRCSC1(OB,.ESIGMSG)

 +12               IF ESIGMSG<1

                       Begin DoDot:2

 +13                       if '$DATA(ROUTINE)

                               SET ROUTINE=$TEXT(+0)

 +14                       WRITE !!,$$ERROR(ROUTINE,ESIGMSG)

 +15                       if ESIGMSG=0!(ESIGMSG=-3)

                               WRITE !,"Notify IFCAP APPLICATION COORDINATOR!",$CHAR(7)

 +16                       SET DIR(0)="EAO"

                           SET DIR("A")="Press RETURN to continue"

                           DO ^DIR

                           KILL DIR

 +17                       QUIT 

                       End DoDot:2

 +18               NEW X

                   SET X=$PIECE($GET(TRNODE(4)),U,5)

                   DO VER^PRCH58OB(.PRC,.X)

                   IF X]""

                       Begin DoDot:2

 +19                       SET PO=POIEN

                           KILL ^PRC(442,POIEN,22)

                           SET NODE=$GET(^PRC(442,POIEN,22,0))

                           IF NODE=""

                               Begin DoDot:3

 +20                               SET ^PRC(442,POIEN,22,0)="^"_$PIECE(^DD(442,41,0),U,2)

 +21                               NEW DA

                                   SET DIE=442

                                   SET DA=POIEN

                                   SET DR="3///^S X=+NEWBOC"

                                   DO ^DIE

                                   KILL DIE,DR

 +22                               DO MSG1

                                   DO NODE22^PRCFFU5

                               End DoDot:3

                       End DoDot:2

 +23               QUIT 

               End DoDot:1

               QUIT 

 +24       DO MSG6

 +25       QUIT 

PROMPT    ; Prompt for user

 +1        SET DIR(0)="Y"

           SET DIR("A")="Should the Cost Center or BOC information be edited at this time"

           SET DIR("B")="NO"

 +2        SET DIR("?")="Enter 'NO' or 'N' or 'RETURN' if no editing is needed."

 +3        SET DIR("?",1)="Enter '^' to exit the option."

 +4        SET DIR("?",2)="Enter 'YES' or 'Y' to edit this information."

 +5        WRITE !

           DO ^DIR

           KILL DIR

 +6        QUIT 

 +7       ; Message processing

MSG1       KILL MSG

           WRITE !!

           SET MSG="...now recalculating FMS accounting lines..."

           DO EN^DDIOL(MSG)

           KILL MSG

           WRITE !

 +1        QUIT 

 +2       ;

MSG2       KILL MSG

           WRITE !!

           SET MSG(1)="...Cost Center is missing - cannot continue..."

MSG21      SET MSG(2)=" "

           SET MSG(3)="No further action is being taken on this obligation."

 +1        DO EN^DDIOL(.MSG)

           KILL MSG

           WRITE !

 +2        QUIT 

 +3       ;

MSG3       KILL MSG

           WRITE !!

           SET MSG="BOC "_+SA_" is not valid with Cost Center "_$PIECE(PO(0),U,5)_"."

 +1        DO EN^DDIOL(MSG)

           KILL MSG

           WRITE !

 +2        QUIT 

 +3       ;

MSG4       WRITE !!

           SET DIR(0)="Y"

           SET DIR("A",1)="I will now enter BOC "_+SA_" on all line items."

           SET DIR("A")="Is this OK"

           SET DIR("B")="YES"

 +1        DO ^DIR

           KILL DIR

 +2        QUIT 

 +3       ;

MSG5       KILL MSG

           WRITE !!

           SET MSG="...now changing the BOCs on all line items..."

 +1        DO EN^DDIOL(MSG)

           KILL MSG

           WRITE !

 +2        QUIT 

MSG6       IF (CCEDIT=1)!(BOCEDIT=1)

               QUIT 

 +1        KILL MSG

           WRITE !!

 +2        SET MSG(1)=" "

           SET MSG(2)=" "

 +3        if CCEDIT=0

               SET MSG(1)="Cost Center has not changed."

               SET MSG(3)=" "

 +4        if BOCEDIT=0

               SET MSG(2)="BOC has not changed."

               SET MSG(4)=" "

 +5        SET MSG(5)="No further editing is being done on this obligation."

           SET MSG(6)=" "

 +6        SET MSG(7)="Returning to the Obligation processing."

 +7        DO EN^DDIOL(.MSG)

           KILL MSG

           WRITE !

 +8        QUIT 

ERROR(ROUTINE,ERROR) ;

 +1        IF ROUTINE'="PRCUESIG"

               GOTO NEXT

 +2        IF ERROR=-3

               QUIT "NO SIGNATURE BLOCK IN FILE 200."

 +3        IF ERROR=-2

               QUIT "TIME OUT OCCURRED DURING SIGNING PROCESS."

 +4        IF ERROR=-1

               QUIT "USER CANCELLED SIGNING PROCESS."

 +5        IF ERROR=0

               QUIT "INVALID SIGNATURE ENTERED."

 +6        QUIT "PROBLEM WITH ELECTRONIC SIGNATURE.  ERROR= "_ERROR_" CALLING ROUTINE "_ROUTINE

NEXT       IF ERROR=-4

               QUIT "CAN'T RE-SIGN RECORD."

 +1        IF ERROR=-3

               QUIT "NO VALID USER NUMBER FOR FILING."

 +2        IF ERROR=-2

               QUIT "NO SIGNATURE BLOCK IN FILE 200."

 +3        IF ERROR=-1

               QUIT "A REQUIRED RECORD IS NULL."

 +4        QUIT "PROBLEM WITH ELECTRONIC SIGNATURE.  ERROR= "_ERROR_" CALLING ROUTINE "_ROUTINE

 +5        QUIT