PRCOSRV8.m

PRCOSRV8 ;WISC/DJM-FILE 423.5 FIELD .01 UPDATE ;7/13/94  9:58 AM

V ;;5.0;IFCAP;;4/21/95

UPDATE ;ALL ENTRIES WITHOUT A '-' IN FILE 423.5 WILL BE CHANGED TO INCLUDE 'IFC-'BEFORE THE TRANSACTION CODE.  THE "B" X-REF WILL ALSO BE UPDATED.

 N A,X

 K ^PRCF(423.5,"B") S X=0

 F  S X=$O(^PRCF(423.5,X)) Q:X'>0  D

 .S A=^PRCF(423.5,X,0)

 .D:A'["-"

 ..S A="IFC-"_A,^PRCF(423.5,X,0)=A

 ..Q

 .S ^PRCF(423.5,"B",$P(A,"^"),X)=""

 .Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCOSRV8   435     printed  Nov 22, 2024@17:22:15                                                                                                                                                                                                     Page 2

PRCOSRV8  ;WISC/DJM-FILE 423.5 FIELD .01 UPDATE ;7/13/94  9:58 AM

V         ;;5.0;IFCAP;;4/21/95

UPDATE    ;ALL ENTRIES WITHOUT A '-' IN FILE 423.5 WILL BE CHANGED TO INCLUDE 'IFC-'BEFORE THE TRANSACTION CODE.  THE "B" X-REF WILL ALSO BE UPDATED.

 +1        NEW A,X

 +2        KILL ^PRCF(423.5,"B")

           SET X=0

 +3        FOR 

               SET X=$ORDER(^PRCF(423.5,X))

               if X'>0

                   QUIT 

               Begin DoDot:1

 +4                SET A=^PRCF(423.5,X,0)

 +5                if A'["-"

                       Begin DoDot:2

 +6                        SET A="IFC-"_A

                           SET ^PRCF(423.5,X,0)=A

 +7                        QUIT 

                       End DoDot:2

 +8                SET ^PRCF(423.5,"B",$PIECE(A,"^"),X)=""

 +9                QUIT 

               End DoDot:1

 +10       QUIT