- DIALOG ;SFISC/TKW - BUILD FILEMAN DIALOGUE ;2014-12-19 12:39 PM
- V ;;22.2;VA FileMan;**7,8**;Jan 05, 2016;Build 19
- ;;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.
- ;
- G GO
- ;
- EN(DIANUM,DIPI) ;
- GO N DIERR,DIMSG,DIHELP,DIT Q:'$D(^DI(.84,DIANUM,0)) S DIT=$P(^(0),U,2)
- K ^TMP($S(DIT=1:"DIERR",DIT=2:"DIMSG",1:"DIHELP"),$J)
- S IOM=$G(IOM,80)
- D BLD(DIANUM,.DIPI),MSG("W"_$E("EMH",DIT),,IOM,1)
- Q
- ;
- BLD(D0,DIPI,DIPE,DIALOGO,DIFLAG) ;BUILD FILEMAN DIALOG
- ;1)DIALOG file IEN, 2)Internal params, 3)External params, 4)Output array name, 5)S=Suppress blank line between messages, F=Format output like ^TMP
- ;N DINAKED S DINAKED=$NA(^(0))
- N DINAKED S DINAKED=$$LGR^%ZOSV ;p7
- I $G(^DI(.84,+$G(D0),0))="" G Q1
- N E,I,J,K,L,M,N,P,R,S,X,O,DILANG S DILANG=+$G(DUZ("LANG")),DIFLAG=$G(DIFLAG)
- I $G(DIPE)]"",$O(DIPE(""))="" S DIPE(1)=DIPE
- I '$O(^DI(.84,D0,4,DILANG,1,0))!('DILANG) S DILANG=1
- S P=$P(^DI(.84,+D0,0),U,3)["y",R=$P(^(0),U,2) S:'R R=1
- S O=$G(DIALOGO) S:O="" O="^TMP(",DIFLAG=DIFLAG_"F" D S DIALOGO=O
- . S I=$E(O,$L(O)) I $E(O,1,4)="DIR(" S DIFLAG=$TR(DIFLAG,"F","")
- . I DIFLAG'["F" S O=$E(O,1,($L(O)-1))_$S(I="(":"",I=",":")",1:I) Q
- . S O=$P(O,")",1)_$S("(,"[I:"",O'["(":"(",1:",")_""""_$P("DIERR^DIMSG^DIHELP",U,R)_""""_$P(","""_$J_"""",U,O["^TMP(")_")" ;WORRIED THAT $J WOULD NOT BE NUMERIC
- . Q
- S N=$O(@DIALOGO@(":"),-1)
- S N=N+1,(I,J,M)=0 S:R>1!(DIFLAG'["F") J=N-1
- I R=1,DIFLAG["F" S O=$P(O,")",1)_","_N_",""TEXT"")"
- I DILANG>1 F S I=$O(^DI(.84,D0,4,DILANG,1,I)) Q:'I S M=M+1,K(M)=$G(^(I,0)) I P S L=0 D PARAM
- I DILANG'>1 F S I=$O(^DI(.84,D0,2,I)) Q:'I S M=M+1,K(M)=$G(^(I,0)) I P S L=0 D PARAM
- G:'M Q2 D
- . N X S X=M
- . I N>1,DIFLAG'["S" I DIFLAG'["F"!(R>1) S J=J+1,@O@(J)=" ",X=X+1
- . I DIALOGO'["DIR" S:R=1 DIERR=($P($G(DIERR),U)+1)_U_($P($G(DIERR),U,2)+X) S:R=2 DIMSG=$G(DIMSG)+X S:R=3 DIHELP=$G(DIHELP)+X
- . D BTXT Q
- I (DIALOGO["DIR")!(R'=1)!(DIFLAG'["F") G Q2
- S @DIALOGO@(N)=D0
- S I="",J=0 F S I=$O(DIPE(I)) Q:I="" I $G(DIPE(I))]"" S @DIALOGO@(N,"PARAM",I)=DIPE(I),J=J+1
- I J S @DIALOGO@(N,"PARAM",0)=J
- S @DIALOGO@("E",D0,N)=""
- ;
- Q2 I $G(^DI(.84,D0,6))]"" X ^(6)
- Q1 I DINAKED]"" S DINAKED=$S(DINAKED["""""":$O(@DINAKED),1:$D(@DINAKED)) ;p8
- Q
- ;
- PARAM S S=$F(K(M),"|",L) G:'S QP S E=$F(K(M),"|",S) G:'E QP
- S X=$E(K(M),S,E-2) G:X="" PARAM
- S DIPI(X)=$S($G(DIPI(X))]"":DIPI(X),1:$G(DIPI)),L=S+$L(DIPI(X))-$L(X)
- I ($L(K(M))+$L(DIPI(X)))<245 S K(M)=$E(K(M),1,S-2)_DIPI(X)_$E(K(M),E,9999) G:K(M)]"" PARAM K K(M) S M=M-1 G QP
- I $L($E(K(M),1,S-2))+$L(DIPI(X))<245 S K(M+1)=$E(K(M),E,9999),K(M)=$E(K(M),1,S-2)_DIPI(X),M=M+1,L=0 G PARAM
- I $L(DIPI(X))+$L($E(K(M),E,9999))<245 S K(M+1)=DIPI(X)_$E(K(M),E,9999),K(M)=$E(K(M),1,S-2),M=M+1,L=0 G PARAM
- S K(M+1)=DIPI(X),K(M+2)=$E(K(M),E,9999),K(M)=$E(K(M),1,S-2),M=M+2,L=0
- G PARAM
- QP Q
- ;
- BTXT N M
- F M=0:0 S M=$O(K(M)) Q:'M S J=J+1 D
- .I DIALOGO'["DIR" S @O@(J)=K(M) Q
- .I '$O(K(M)),'$O(^DI(.84,D0,2,I)) S @DIALOGO=K(M) Q
- .S @DIALOGO@(J)=K(M) Q
- Q
- ;
- EZBLD(D0,DIPI) ;RETURN SINGLE LINE OF TEXT FROM DIALOG FILE.
- ;D0 = DIALOG file IEN, DIPI = Input Params
- ;N DINAKED S DINAKED=$NA(^(0)) I $G(^DI(.84,+$G(D0),0))="" D Q1 Q "" ;p7
- N DINAKED S DINAKED=$$LGR^%ZOSV I $G(^DI(.84,+$G(D0),0))="" D Q1 Q ""
- N DILANG S DILANG=+$G(DUZ("LANG"))
- N X I DILANG>1 S X=$O(^DI(.84,+D0,4,DILANG,1,0)) S:X X=$G(^(X,0))
- I $G(X)']"" S X=$O(^DI(.84,+D0,2,0)) S:X X=$G(^(X,0))
- I ($P(^DI(.84,+D0,0),"^",3)'["y"!($G(X)="")) S X=$G(X) G QEZ
- N K,S,L,M,I,E S M=1,L=0,K(M)=X
- I $G(DIPI)]"",$O(DIPI(""))="" S DIPI(1)=DIPI
- D PARAM S X=$G(K(1))
- QEZ D Q X
- . N X D Q2 Q
- ;
- ;
- MSG(DIFLGS,DIOUT,DIMARGIN,DICOLUMN,DIINNAME) ;WRITE MESSAGES OR MOVE THEM TO SIMPLE ARRAY.
- ;1)Flags, 2)Output array name, 3)Margin width of text, 4)Starting column no., 5)Input array name.
- ;N Z,%,X,Y,I,J,K,N,DITYP,DIWIDTH,DITMP,DIIN,DINAKED S DINAKED=$NA(^(0))
- N Z,%,X,Y,I,J,K,N,DITYP,DIWIDTH,DITMP,DIIN,DINAKED S DINAKED=$$LGR^%ZOSV ;p7
- S:$G(DIFLGS)="" DIFLGS="W" D
- . S DITMP=0 I $G(DIINNAME)="" S DIINNAME="^TMP(",DITMP=1 Q
- . N % S %=DIINNAME I %'["(" S DIINNAME=DIINNAME_"(" Q
- . Q:$E(%,$L(%))=","
- . I $E(%,$L(%))=")" S DIINNAME=$P(%,")",1)_"," Q
- . S DIINNAME=%_"," Q
- S DITYP="",%=0 D
- . F Z="E","H","M" S %=%+1 I DIFLGS[Z,$D(@(DIINNAME_""""_$P("DIERR^DIHELP^DIMSG",U,%)_""""_$P(","""_$J_"""",U,(DITMP>0))_")")) S $P(DITYP,U,%)=$P("DIERR^DIHELP^DIMSG",U,%)
- . I DITYP="",$D(@(DIINNAME_"""DIERR"""_$P(","""_$J_"""",U,(DITMP>0))_")")) S DITYP="DIERR"
- . Q
- S DIWIDTH=$S($G(DIMARGIN):DIMARGIN,$G(IOM):(IOM-5),1:75),DICOLUMN=+$G(DICOLUMN)
- K:DIFLGS["A" DIOUT S (K,Z)=0
- AWS S K=K+1 I K>3 G Q1
- G:$P(DITYP,U,K)="" AWS
- S DIIN=DIINNAME_""""_$P(DITYP,U,K)_"""" S:DITMP DIIN=DIIN_","""_$J_""""
- S (I,N)=0
- F S N=$O(@(DIIN_")")@(N)) Q:'N S:K>1 X=$G(@(DIIN_","_N_")")) D:K>1 I K=1 D:I&(DIFLGS'["B") LN S I=1,J=0 F S J=$O(@(DIIN_")")@(N,"TEXT",J)) Q:'J S X=$G(@(DIIN_","_N_",""TEXT"","_J_")")) D
- . I DIFLGS["A",'$G(DIMARGIN) S Z=Z+1,DIOUT(Z)=X
- . I DIFLGS'["W",'$G(DIMARGIN) Q
- . S Y=X D:X="" F Q:X="" F %=$L(X," "):-1:1 S:%=1&($L($P(X," ",1,%))>DIWIDTH) X=$E(X,1,(DIWIDTH-1))_" "_$E(X,DIWIDTH,$L(X)),%=%+1 I $L($P(X," ",1,%))'>DIWIDTH S Y=$P(X," ",1,%) D S X=$P(X," ",%+1,$L(X," ")) Q
- .. W:DIFLGS["W" !?DICOLUMN,Y S:DIFLGS["A"&$G(DIMARGIN) Z=Z+1,DIOUT(Z)=Y
- .. Q
- . Q
- F I=K:1:2 I $P(DITYP,U,I+1)]"" D LN Q
- I DIFLGS["A",DIFLGS["T" S DIOUT=Z
- I DIFLGS'["S" K @(DIIN_")"),@($P(DITYP,U,K))
- G AWS
- ;
- LN W:DIFLGS["W" ! S:(DIFLGS["A")&Z Z=Z+1,DIOUT(Z)="" Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIALOG 5716 printed Mar 13, 2025@21:49:28 Page 2
- DIALOG ;SFISC/TKW - BUILD FILEMAN DIALOGUE ;2014-12-19 12:39 PM
- V ;;22.2;VA FileMan;**7,8**;Jan 05, 2016;Build 19
- +1 ;;Per VA Directive 6402, this routine should not be modified.
- +2 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +3 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +4 ;;Licensed under the terms of the Apache License, Version 2.0.
- +5 ;
- +6 GOTO GO
- +7 ;
- EN(DIANUM,DIPI) ;
- GO NEW DIERR,DIMSG,DIHELP,DIT
- if '$DATA(^DI(.84,DIANUM,0))
- QUIT
- SET DIT=$PIECE(^(0),U,2)
- +1 KILL ^TMP($SELECT(DIT=1:"DIERR",DIT=2:"DIMSG",1:"DIHELP"),$JOB)
- +2 SET IOM=$GET(IOM,80)
- +3 DO BLD(DIANUM,.DIPI)
- DO MSG("W"_$EXTRACT("EMH",DIT),,IOM,1)
- +4 QUIT
- +5 ;
- BLD(D0,DIPI,DIPE,DIALOGO,DIFLAG) ;BUILD FILEMAN DIALOG
- +1 ;1)DIALOG file IEN, 2)Internal params, 3)External params, 4)Output array name, 5)S=Suppress blank line between messages, F=Format output like ^TMP
- +2 ;N DINAKED S DINAKED=$NA(^(0))
- +3 ;p7
- NEW DINAKED
- SET DINAKED=$$LGR^%ZOSV
- +4 IF $GET(^DI(.84,+$GET(D0),0))=""
- GOTO Q1
- +5 NEW E,I,J,K,L,M,N,P,R,S,X,O,DILANG
- SET DILANG=+$GET(DUZ("LANG"))
- SET DIFLAG=$GET(DIFLAG)
- +6 IF $GET(DIPE)]""
- IF $ORDER(DIPE(""))=""
- SET DIPE(1)=DIPE
- +7 IF '$ORDER(^DI(.84,D0,4,DILANG,1,0))!('DILANG)
- SET DILANG=1
- +8 SET P=$PIECE(^DI(.84,+D0,0),U,3)["y"
- SET R=$PIECE(^(0),U,2)
- if 'R
- SET R=1
- +9 SET O=$GET(DIALOGO)
- if O=""
- SET O="^TMP("
- SET DIFLAG=DIFLAG_"F"
- Begin DoDot:1
- +10 SET I=$EXTRACT(O,$LENGTH(O))
- IF $EXTRACT(O,1,4)="DIR("
- SET DIFLAG=$TRANSLATE(DIFLAG,"F","")
- +11 IF DIFLAG'["F"
- SET O=$EXTRACT(O,1,($LENGTH(O)-1))_$SELECT(I="(":"",I=",":")",1:I)
- QUIT
- +12 ;WORRIED THAT $J WOULD NOT BE NUMERIC
- SET O=$PIECE(O,")",1)_$SELECT("(,"[I:"",O'["(":"(",1:",")_""""_$PIECE("DIERR^DIMSG^DIHELP",U,R)_""""_$PIECE(","""_$JOB_"""",U,O["^TMP(")_")"
- +13 QUIT
- End DoDot:1
- SET DIALOGO=O
- +14 SET N=$ORDER(@DIALOGO@(":"),-1)
- +15 SET N=N+1
- SET (I,J,M)=0
- if R>1!(DIFLAG'["F")
- SET J=N-1
- +16 IF R=1
- IF DIFLAG["F"
- SET O=$PIECE(O,")",1)_","_N_",""TEXT"")"
- +17 IF DILANG>1
- FOR
- SET I=$ORDER(^DI(.84,D0,4,DILANG,1,I))
- if 'I
- QUIT
- SET M=M+1
- SET K(M)=$GET(^(I,0))
- IF P
- SET L=0
- DO PARAM
- +18 IF DILANG'>1
- FOR
- SET I=$ORDER(^DI(.84,D0,2,I))
- if 'I
- QUIT
- SET M=M+1
- SET K(M)=$GET(^(I,0))
- IF P
- SET L=0
- DO PARAM
- +19 if 'M
- GOTO Q2
- Begin DoDot:1
- +20 NEW X
- SET X=M
- +21 IF N>1
- IF DIFLAG'["S"
- IF DIFLAG'["F"!(R>1)
- SET J=J+1
- SET @O@(J)=" "
- SET X=X+1
- +22 IF DIALOGO'["DIR"
- if R=1
- SET DIERR=($PIECE($GET(DIERR),U)+1)_U_($PIECE($GET(DIERR),U,2)+X)
- if R=2
- SET DIMSG=$GET(DIMSG)+X
- if R=3
- SET DIHELP=$GET(DIHELP)+X
- +23 DO BTXT
- QUIT
- End DoDot:1
- +24 IF (DIALOGO["DIR")!(R'=1)!(DIFLAG'["F")
- GOTO Q2
- +25 SET @DIALOGO@(N)=D0
- +26 SET I=""
- SET J=0
- FOR
- SET I=$ORDER(DIPE(I))
- if I=""
- QUIT
- IF $GET(DIPE(I))]""
- SET @DIALOGO@(N,"PARAM",I)=DIPE(I)
- SET J=J+1
- +27 IF J
- SET @DIALOGO@(N,"PARAM",0)=J
- +28 SET @DIALOGO@("E",D0,N)=""
- +29 ;
- Q2 IF $GET(^DI(.84,D0,6))]""
- XECUTE ^(6)
- Q1 ;p8
- IF DINAKED]""
- SET DINAKED=$SELECT(DINAKED["""""":$ORDER(@DINAKED),1:$DATA(@DINAKED))
- +1 QUIT
- +2 ;
- PARAM SET S=$FIND(K(M),"|",L)
- if 'S
- GOTO QP
- SET E=$FIND(K(M),"|",S)
- if 'E
- GOTO QP
- +1 SET X=$EXTRACT(K(M),S,E-2)
- if X=""
- GOTO PARAM
- +2 SET DIPI(X)=$SELECT($GET(DIPI(X))]"":DIPI(X),1:$GET(DIPI))
- SET L=S+$LENGTH(DIPI(X))-$LENGTH(X)
- +3 IF ($LENGTH(K(M))+$LENGTH(DIPI(X)))<245
- SET K(M)=$EXTRACT(K(M),1,S-2)_DIPI(X)_$EXTRACT(K(M),E,9999)
- if K(M)]""
- GOTO PARAM
- KILL K(M)
- SET M=M-1
- GOTO QP
- +4 IF $LENGTH($EXTRACT(K(M),1,S-2))+$LENGTH(DIPI(X))<245
- SET K(M+1)=$EXTRACT(K(M),E,9999)
- SET K(M)=$EXTRACT(K(M),1,S-2)_DIPI(X)
- SET M=M+1
- SET L=0
- GOTO PARAM
- +5 IF $LENGTH(DIPI(X))+$LENGTH($EXTRACT(K(M),E,9999))<245
- SET K(M+1)=DIPI(X)_$EXTRACT(K(M),E,9999)
- SET K(M)=$EXTRACT(K(M),1,S-2)
- SET M=M+1
- SET L=0
- GOTO PARAM
- +6 SET K(M+1)=DIPI(X)
- SET K(M+2)=$EXTRACT(K(M),E,9999)
- SET K(M)=$EXTRACT(K(M),1,S-2)
- SET M=M+2
- SET L=0
- +7 GOTO PARAM
- QP QUIT
- +1 ;
- BTXT NEW M
- +1 FOR M=0:0
- SET M=$ORDER(K(M))
- if 'M
- QUIT
- SET J=J+1
- Begin DoDot:1
- +2 IF DIALOGO'["DIR"
- SET @O@(J)=K(M)
- QUIT
- +3 IF '$ORDER(K(M))
- IF '$ORDER(^DI(.84,D0,2,I))
- SET @DIALOGO=K(M)
- QUIT
- +4 SET @DIALOGO@(J)=K(M)
- QUIT
- End DoDot:1
- +5 QUIT
- +6 ;
- EZBLD(D0,DIPI) ;RETURN SINGLE LINE OF TEXT FROM DIALOG FILE.
- +1 ;D0 = DIALOG file IEN, DIPI = Input Params
- +2 ;N DINAKED S DINAKED=$NA(^(0)) I $G(^DI(.84,+$G(D0),0))="" D Q1 Q "" ;p7
- +3 NEW DINAKED
- SET DINAKED=$$LGR^%ZOSV
- IF $GET(^DI(.84,+$GET(D0),0))=""
- DO Q1
- QUIT ""
- +4 NEW DILANG
- SET DILANG=+$GET(DUZ("LANG"))
- +5 NEW X
- IF DILANG>1
- SET X=$ORDER(^DI(.84,+D0,4,DILANG,1,0))
- if X
- SET X=$GET(^(X,0))
- +6 IF $GET(X)']""
- SET X=$ORDER(^DI(.84,+D0,2,0))
- if X
- SET X=$GET(^(X,0))
- +7 IF ($PIECE(^DI(.84,+D0,0),"^",3)'["y"!($GET(X)=""))
- SET X=$GET(X)
- GOTO QEZ
- +8 NEW K,S,L,M,I,E
- SET M=1
- SET L=0
- SET K(M)=X
- +9 IF $GET(DIPI)]""
- IF $ORDER(DIPI(""))=""
- SET DIPI(1)=DIPI
- +10 DO PARAM
- SET X=$GET(K(1))
- QEZ Begin DoDot:1
- +1 NEW X
- DO Q2
- QUIT
- End DoDot:1
- QUIT X
- +2 ;
- +3 ;
- MSG(DIFLGS,DIOUT,DIMARGIN,DICOLUMN,DIINNAME) ;WRITE MESSAGES OR MOVE THEM TO SIMPLE ARRAY.
- +1 ;1)Flags, 2)Output array name, 3)Margin width of text, 4)Starting column no., 5)Input array name.
- +2 ;N Z,%,X,Y,I,J,K,N,DITYP,DIWIDTH,DITMP,DIIN,DINAKED S DINAKED=$NA(^(0))
- +3 ;p7
- NEW Z,%,X,Y,I,J,K,N,DITYP,DIWIDTH,DITMP,DIIN,DINAKED
- SET DINAKED=$$LGR^%ZOSV
- +4 if $GET(DIFLGS)=""
- SET DIFLGS="W"
- Begin DoDot:1
- +5 SET DITMP=0
- IF $GET(DIINNAME)=""
- SET DIINNAME="^TMP("
- SET DITMP=1
- QUIT
- +6 NEW %
- SET %=DIINNAME
- IF %'["("
- SET DIINNAME=DIINNAME_"("
- QUIT
- +7 if $EXTRACT(%,$LENGTH(%))=","
- QUIT
- +8 IF $EXTRACT(%,$LENGTH(%))=")"
- SET DIINNAME=$PIECE(%,")",1)_","
- QUIT
- +9 SET DIINNAME=%_","
- QUIT
- End DoDot:1
- +10 SET DITYP=""
- SET %=0
- Begin DoDot:1
- +11 FOR Z="E","H","M"
- SET %=%+1
- IF DIFLGS[Z
- IF $DATA(@(DIINNAME_""""_$PIECE("DIERR^DIHELP^DIMSG",U,%)_""""_$PIECE(","""_$JOB_"""",U,(DITMP>0))_")"))
- SET $PIECE(DITYP,U,%)=$PIECE("DIERR^DIHELP^DIMSG",U,%)
- +12 IF DITYP=""
- IF $DATA(@(DIINNAME_"""DIERR"""_$PIECE(","""_$JOB_"""",U,(DITMP>0))_")"))
- SET DITYP="DIERR"
- +13 QUIT
- End DoDot:1
- +14 SET DIWIDTH=$SELECT($GET(DIMARGIN):DIMARGIN,$GET(IOM):(IOM-5),1:75)
- SET DICOLUMN=+$GET(DICOLUMN)
- +15 if DIFLGS["A"
- KILL DIOUT
- SET (K,Z)=0
- AWS SET K=K+1
- IF K>3
- GOTO Q1
- +1 if $PIECE(DITYP,U,K)=""
- GOTO AWS
- +2 SET DIIN=DIINNAME_""""_$PIECE(DITYP,U,K)_""""
- if DITMP
- SET DIIN=DIIN_","""_$JOB_""""
- +3 SET (I,N)=0
- +4 FOR
- SET N=$ORDER(@(DIIN_")")@(N))
- if 'N
- QUIT
- if K>1
- SET X=$GET(@(DIIN_","_N_")"))
- if K>1
- Begin DoDot:1
- +5 IF DIFLGS["A"
- IF '$GET(DIMARGIN)
- SET Z=Z+1
- SET DIOUT(Z)=X
- +6 IF DIFLGS'["W"
- IF '$GET(DIMARGIN)
- QUIT
- +7 SET Y=X
- if X=""
- Begin DoDot:2
- +8 if DIFLGS["W"
- WRITE !?DICOLUMN,Y
- if DIFLGS["A"&$GET(DIMARGIN)
- SET Z=Z+1
- SET DIOUT(Z)=Y
- +9 QUIT
- End DoDot:2
- FOR
- if X=""
- QUIT
- FOR %=$LENGTH(X," "):-1:1
- if %=1&($LENGTH($PIECE(X," ",1,%))>DIWIDTH)
- SET X=$EXTRACT(X,1,(DIWIDTH-1))_" "_$EXTRACT(X,DIWIDTH,$LENGTH(X))
- SET %=%+1
- IF $LENGTH($PIECE(X," ",1,%))'>DIWIDTH
- SET Y=$PIECE(X," ",1,%)
- Begin DoDot:2
- End DoDot:2
- SET X=$PIECE(X," ",%+1,$LENGTH(X," "))
- QUIT
- +10 QUIT
- End DoDot:1
- IF K=1
- if I&(DIFLGS'["B")
- DO LN
- SET I=1
- SET J=0
- FOR
- SET J=$ORDER(@(DIIN_")")@(N,"TEXT",J))
- if 'J
- QUIT
- SET X=$GET(@(DIIN_","_N_",""TEXT"","_J_")"))
- Begin DoDot:1
- End DoDot:1
- +11 FOR I=K:1:2
- IF $PIECE(DITYP,U,I+1)]""
- DO LN
- QUIT
- +12 IF DIFLGS["A"
- IF DIFLGS["T"
- SET DIOUT=Z
- +13 IF DIFLGS'["S"
- KILL @(DIIN_")"),@($PIECE(DITYP,U,K))
- +14 GOTO AWS
- +15 ;
- LN if DIFLGS["W"
- WRITE !
- if (DIFLGS["A")&Z
- SET Z=Z+1
- SET DIOUT(Z)=""
- QUIT
