PRCUFC0E.m

PRCUFC0E ;WISC/SJG-OBLIGATION CONVERSION ERROR ROUTINE ;7/22/94  9:35 AM

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

EN(IEN,ERR) ;

 ; IEN = Internal record number from 442

 ; ERR = Error from Obligation conversion routines

 N TAG

 S TRANS=$S($D(PRCFA("CONVG")):"GPF",$D(PRCFA("CONVS")):"SFF")

 S TAG=ERR D @TAG

 Q

ERR1 ;STATION NUMBER NOT FOUND IN 411

 ;N DIC,DIE,DA,DR,FIELD

 ;D NEXT S DR=DR_"6///^S X=1" D ^DIE Q

 Q

ERR2 ;

 ;N DIC,DIE,DA,DR,FIELD

 ;D NEXT S DR=DR_"6///^S X=2" D ^DIE Q

 Q

ERR3 ;

 ;N DIC,DIE,DA,DR,FIELD

 ;D NEXT S DR=DR_"6///^S X=3" D ^DIE Q

 Q

ERR4 ; Purchase Order Receipts and Purchase Status do not match

 N DIC,DIE,DA,DR,FIELD

 D NEXT S DR=DR_"6///^S X=8" D ^DIE Q

 ;

ERR5 ; 'Dummy' GPF Fund Control point is missing

 N DIC,DIE,DA,DR

 D NEXT S DR=DR_"6///^S X=9" D ^DIE Q

 ;

NEXT ;GET THE NEXT FREE ENTRY IN FILE 411.3

 N NEXT,DLAYGO

 S NEXT=$P($G(^PRC(411.3,0)),U,4) F  S NEXT=NEXT+1 Q:$G(^PRC(411.3,NEXT,0))=""

 K DD,DO S DIC="^PRC(411.3,",DIC(0)="L",DLAYGO=411.3,X=NEXT D FILE^DICN Q:+Y'>0  S DA=+Y,DIE=DIC,DR="9///^S X=TRANS;12///^S X=IEN;"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCUFC0E   1159     printed  Apr 09, 2024@21:13:22                                                                                                                                                                                                    Page 2

PRCUFC0E  ;WISC/SJG-OBLIGATION CONVERSION ERROR ROUTINE ;7/22/94  9:35 AM

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;

EN(IEN,ERR) ;

 +1       ; IEN = Internal record number from 442

 +2       ; ERR = Error from Obligation conversion routines

 +3        NEW TAG

 +4        SET TRANS=$SELECT($DATA(PRCFA("CONVG")):"GPF",$DATA(PRCFA("CONVS")):"SFF")

 +5        SET TAG=ERR

           DO @TAG

 +6        QUIT 

ERR1      ;STATION NUMBER NOT FOUND IN 411

 +1       ;N DIC,DIE,DA,DR,FIELD

 +2       ;D NEXT S DR=DR_"6///^S X=1" D ^DIE Q

 +3        QUIT 

ERR2      ;

 +1       ;N DIC,DIE,DA,DR,FIELD

 +2       ;D NEXT S DR=DR_"6///^S X=2" D ^DIE Q

 +3        QUIT 

ERR3      ;

 +1       ;N DIC,DIE,DA,DR,FIELD

 +2       ;D NEXT S DR=DR_"6///^S X=3" D ^DIE Q

 +3        QUIT 

ERR4      ; Purchase Order Receipts and Purchase Status do not match

 +1        NEW DIC,DIE,DA,DR,FIELD

 +2        DO NEXT

           SET DR=DR_"6///^S X=8"

           DO ^DIE

           QUIT 

 +3       ;

ERR5      ; 'Dummy' GPF Fund Control point is missing

 +1        NEW DIC,DIE,DA,DR

 +2        DO NEXT

           SET DR=DR_"6///^S X=9"

           DO ^DIE

           QUIT 

 +3       ;

NEXT      ;GET THE NEXT FREE ENTRY IN FILE 411.3

 +1        NEW NEXT,DLAYGO

 +2        SET NEXT=$PIECE($GET(^PRC(411.3,0)),U,4)

           FOR 

               SET NEXT=NEXT+1

               if $GET(^PRC(411.3,NEXT,0))=""

                   QUIT 

 +3        KILL DD,DO

           SET DIC="^PRC(411.3,"

           SET DIC(0)="L"

           SET DLAYGO=411.3

           SET X=NEXT

           DO FILE^DICN

           if +Y'>0

               QUIT 

           SET DA=+Y

           SET DIE=DIC

           SET DR="9///^S X=TRANS;12///^S X=IEN;"