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 ---[H[J[2J[HPRCFFU13 3359 printed Nov 22, 2024@17:13:43 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
