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 ---[H[J[2J[HPRCUFC0E 1159 printed Dec 13, 2024@02:19:37 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;"
