PRCXTST.m

PRCXTST ;Routine to create "AB" entries for split off 2237s ;8/24/95  08:31

 ;;5.0;IFCAP;**23**;4/21/95

 N N

 S N=0 F  S N=$O(^PRCS(410,N)) Q:'N  I $P($G(^(N,0)),U,4)'=1&('$D(^PRCS(410,N,"IT","AB"))) D

 .S DA(1)=N,DIK="^PRCS(410,"_DA(1)_",""IT"",",DIK(1)=".01^AB"

 .D ENALL^DIK K DA,DIK

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCXTST   300     printed  Mar 13, 2025@21:25:17                                                                                                                                                                                                      Page 2

PRCXTST   ;Routine to create "AB" entries for split off 2237s ;8/24/95  08:31

 +1       ;;5.0;IFCAP;**23**;4/21/95

 +2        NEW N

 +3        SET N=0

           FOR 

               SET N=$ORDER(^PRCS(410,N))

               if 'N

                   QUIT 

               IF $PIECE($GET(^(N,0)),U,4)'=1&('$DATA(^PRCS(410,N,"IT","AB")))

                   Begin DoDot:1

 +4                    SET DA(1)=N

                       SET DIK="^PRCS(410,"_DA(1)_",""IT"","

                       SET DIK(1)=".01^AB"

 +5                    DO ENALL^DIK

                       KILL DA,DIK

                   End DoDot:1

 +6        QUIT