DIT2 ;SFISC/GFT-TRANSFER TEMPLATES ;10/16/90 9:37 AM
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
TEM F Z=0:0 W "." S Z=$O(^UTILITY("DITR",$J,DIK,Z)) Q:Z="" F V=V:1 I $O(@(%Y_"0)"))="" D %XY S ^(0)=$P(@(%Y_"0)"),U,1,3)_U_DDT(0)_U_$P(^(0),U,5,99) K ^("ROU"),^("ROUOLD") K:DIK="^DIBT(" ^DIBT(V,1) Q
Q
%XY ;
S %Z=0,%A="",%C(-1)=0,%E=""
S S %B=-1
N S @("%B=$O("_%X_%A_"%B))") S:%B="" %B=-1 S %C(%Z)=%C(%Z-1),%D=$S($D(L(%B)):L(%B),1:%B)
I %B=-1 Q:'%Z S @("%B="_$P(%A,",",%Z+%C(%Z-2),%Z+%C(%Z-1))),%Z=%Z-1,%A=$P(%A,",",1,%Z+%C(%Z-1))_$E(",",%Z>0),%E=$P(%E,",",1,%Z+%C(%Z-1))_$E(",",%Z>0) G N
I $D(@(%X_%A_"%B)"))#2 S W=^(%B) X A D Y^DIT1 X E S @(%Y_%E_"%D)=W") I %A="""DCL""," S ^(%B#1+DHIT_U_$P(%B,U,2))=^(%B) K ^(%B) G N
I @("$D("_%X_%A_"%B))<9") G N
S:+%B'=%B %B=""""_%B_"""" S:+%D'=%D %D=""""_%D_""""
S %A=%A_%B_",",%Z=%Z+1,%E=%E_%D_"," G S
;
DCL ;S ^(%B#1+DHIT_U_$P(%B,U,2))=^(%B) K ^(%B) G N
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIT2 1186 printed Nov 22, 2024@18:04:02 Page 2
DIT2 ;SFISC/GFT-TRANSFER TEMPLATES ;10/16/90 9:37 AM
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
TEM FOR Z=0:0
WRITE "."
SET Z=$ORDER(^UTILITY("DITR",$JOB,DIK,Z))
if Z=""
QUIT
FOR V=V:1
IF $ORDER(@(%Y_"0)"))=""
DO %XY
SET ^(0)=$PIECE(@(%Y_"0)"),U,1,3)_U_DDT(0)_U_$PIECE(^(0),U,5,99)
KILL ^("ROU"),^("ROUOLD")
if DIK="^DIBT("
KILL ^DIBT(V,1)
QUIT
+1 QUIT
%XY ;
+1 SET %Z=0
SET %A=""
SET %C(-1)=0
SET %E=""
S SET %B=-1
N SET @("%B=$O("_%X_%A_"%B))")
if %B=""
SET %B=-1
SET %C(%Z)=%C(%Z-1)
SET %D=$SELECT($DATA(L(%B)):L(%B),1:%B)
+1 IF %B=-1
if '%Z
QUIT
SET @("%B="_$PIECE(%A,",",%Z+%C(%Z-2),%Z+%C(%Z-1)))
SET %Z=%Z-1
SET %A=$PIECE(%A,",",1,%Z+%C(%Z-1))_$EXTRACT(",",%Z>0)
SET %E=$PIECE(%E,",",1,%Z+%C(%Z-1))_$EXTRACT(",",%Z>0)
GOTO N
+2 IF $DATA(@(%X_%A_"%B)"))#2
SET W=^(%B)
XECUTE A
DO Y^DIT1
XECUTE E
SET @(%Y_%E_"%D)=W")
IF %A="""DCL"","
SET ^(%B#1+DHIT_U_$PIECE(%B,U,2))=^(%B)
KILL ^(%B)
GOTO N
+3 IF @("$D("_%X_%A_"%B))<9")
GOTO N
+4 if +%B'=%B
SET %B=""""_%B_""""
if +%D'=%D
SET %D=""""_%D_""""
+5 SET %A=%A_%B_","
SET %Z=%Z+1
SET %E=%E_%D_","
GOTO S
+6 ;
DCL ;S ^(%B#1+DHIT_U_$P(%B,U,2))=^(%B) K ^(%B) G N
+1 ;
