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 ---[H[J[2J[HPRCXTST 300 printed Nov 22, 2024@17:30:34 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
