DDIOL ;SFISC/MKO-THE LOADER ;14JUN2011
;;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.
;
;
EN(A,G,FMT) ;Write the text contained in local array A or global array G
;If one string passed, use format FMT
N %,Y,DINAKED
S DINAKED=$NA(^(0))
;
S:'$D(A) A=""
I $G(A)="",$D(A)<9,$G(FMT)="",$G(G)'?1"^"1A.7AN,$G(G)'?1"^"1A.7AN1"(".E1")" Q
;
G:$D(DDS) SM
G:$D(DIQUIET) LD
;
N F,I,S
I $D(A)=1,$G(G)="" D
. S F=$S($G(FMT)]"":FMT,1:"!")
. W @F,A
;
E I $D(A)>9 S I=0 F S I=$O(A(I)) Q:I'=+$P(I,"E") D
. S F=$G(A(I,"F"),"!") S:F="" F="?0"
. W @F,$G(A(I))
;
E S I=0 F S I=$O(@G@(I)) Q:I'=+$P(I,"E") D
. S S=$G(@G@(I,0),$G(@G@(I)))
. S F=$G(@G@(I,"F"),"!") S:F="" F="?0"
. W @F,S
;
I DINAKED]"" S DINAKED=$S(DINAKED["""""":$O(@DINAKED),1:$D(@DINAKED))
Q
;
LD ;Load text into ^TMP
N I,N,T
S T=$S($G(DDIOLFLG)["H":"DIHELP",1:"DIMSG")
S N=$O(^TMP(T,$J," "),-1)
;
I $D(A)=1,$G(G)="" D
. D LD1(A,$S($G(FMT)]"":FMT,1:"!"))
;
E I $D(A)>9 S I=0 F S I=$O(A(I)) Q:I'=+$P(I,"E") D
. D LD1($G(A(I)),$G(A(I,"F"),"!"))
;
E S I=0 F S I=$O(@G@(I)) Q:I'=+$P(I,"E") D
. D LD1($G(@G@(I),$G(@G@(I,0))),$G(@G@(I,"F"),"!"))
;
K:'N @T S:N @T=N
I DINAKED]"" S DINAKED=$S(DINAKED["""""":$O(@DINAKED),1:$D(@DINAKED))
Q
;
LD1(S,F) ;Load string S, with format F
;In: N and T
N C,J,L
S:S[$C(7) S=$TR(S,$C(7),"")
F J=1:1:$L(F,"!")-1 S N=N+1,^TMP(T,$J,N)=""
S:'N N=1
S:F["?" @("C="_+$P(F,"?",2))
S L=$G(^TMP(T,$J,N))
S ^TMP(T,$J,N)=L_$J("",$G(C)-$L(L))_S
Q
;
SM ;Print text in ScreenMan's Command Area
I $D(DDSID),$D(DTOUT)!$D(DUOUT) G SMQ
N DDIOL
S DDIOL=1
;
I $D(A)=1&($G(G)="")!($D(A)>9) D
. D MSG^DDSMSG(.A,"",$G(FMT))
E I $D(@G@(+$O(@G@(0)),0))#2 D
. D WP^DDSMSG(G)
E D HLP^DDSMSG(G)
;
SMQ I DINAKED]"" S DINAKED=$S(DINAKED["""""":$O(@DINAKED),1:$D(@DINAKED))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDIOL 2130 printed Apr 09, 2024@21:52:39 Page 2
DDIOL ;SFISC/MKO-THE LOADER ;14JUN2011
+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 ;
+7 ;
EN(A,G,FMT) ;Write the text contained in local array A or global array G
+1 ;If one string passed, use format FMT
+2 NEW %,Y,DINAKED
+3 SET DINAKED=$NAME(^(0))
+4 ;
+5 if '$DATA(A)
SET A=""
+6 IF $GET(A)=""
IF $DATA(A)<9
IF $GET(FMT)=""
IF $GET(G)'?1"^"1A.7AN
IF $GET(G)'?1"^"1A.7AN1"(".E1")"
QUIT
+7 ;
+8 if $DATA(DDS)
GOTO SM
+9 if $DATA(DIQUIET)
GOTO LD
+10 ;
+11 NEW F,I,S
+12 IF $DATA(A)=1
IF $GET(G)=""
Begin DoDot:1
+13 SET F=$SELECT($GET(FMT)]"":FMT,1:"!")
+14 WRITE @F,A
End DoDot:1
+15 ;
+16 IF '$TEST
IF $DATA(A)>9
SET I=0
FOR
SET I=$ORDER(A(I))
if I'=+$PIECE(I,"E")
QUIT
Begin DoDot:1
+17 SET F=$GET(A(I,"F"),"!")
if F=""
SET F="?0"
+18 WRITE @F,$GET(A(I))
End DoDot:1
+19 ;
+20 IF '$TEST
SET I=0
FOR
SET I=$ORDER(@G@(I))
if I'=+$PIECE(I,"E")
QUIT
Begin DoDot:1
+21 SET S=$GET(@G@(I,0),$GET(@G@(I)))
+22 SET F=$GET(@G@(I,"F"),"!")
if F=""
SET F="?0"
+23 WRITE @F,S
End DoDot:1
+24 ;
+25 IF DINAKED]""
SET DINAKED=$SELECT(DINAKED["""""":$ORDER(@DINAKED),1:$DATA(@DINAKED))
+26 QUIT
+27 ;
LD ;Load text into ^TMP
+1 NEW I,N,T
+2 SET T=$SELECT($GET(DDIOLFLG)["H":"DIHELP",1:"DIMSG")
+3 SET N=$ORDER(^TMP(T,$JOB," "),-1)
+4 ;
+5 IF $DATA(A)=1
IF $GET(G)=""
Begin DoDot:1
+6 DO LD1(A,$SELECT($GET(FMT)]"":FMT,1:"!"))
End DoDot:1
+7 ;
+8 IF '$TEST
IF $DATA(A)>9
SET I=0
FOR
SET I=$ORDER(A(I))
if I'=+$PIECE(I,"E")
QUIT
Begin DoDot:1
+9 DO LD1($GET(A(I)),$GET(A(I,"F"),"!"))
End DoDot:1
+10 ;
+11 IF '$TEST
SET I=0
FOR
SET I=$ORDER(@G@(I))
if I'=+$PIECE(I,"E")
QUIT
Begin DoDot:1
+12 DO LD1($GET(@G@(I),$GET(@G@(I,0))),$GET(@G@(I,"F"),"!"))
End DoDot:1
+13 ;
+14 if 'N
KILL @T
if N
SET @T=N
+15 IF DINAKED]""
SET DINAKED=$SELECT(DINAKED["""""":$ORDER(@DINAKED),1:$DATA(@DINAKED))
+16 QUIT
+17 ;
LD1(S,F) ;Load string S, with format F
+1 ;In: N and T
+2 NEW C,J,L
+3 if S[$CHAR(7)
SET S=$TRANSLATE(S,$CHAR(7),"")
+4 FOR J=1:1:$LENGTH(F,"!")-1
SET N=N+1
SET ^TMP(T,$JOB,N)=""
+5 if 'N
SET N=1
+6 if F["?"
SET @("C="_+$PIECE(F,"?",2))
+7 SET L=$GET(^TMP(T,$JOB,N))
+8 SET ^TMP(T,$JOB,N)=L_$JUSTIFY("",$GET(C)-$LENGTH(L))_S
+9 QUIT
+10 ;
SM ;Print text in ScreenMan's Command Area
+1 IF $DATA(DDSID)
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO SMQ
+2 NEW DDIOL
+3 SET DDIOL=1
+4 ;
+5 IF $DATA(A)=1&($GET(G)="")!($DATA(A)>9)
Begin DoDot:1
+6 DO MSG^DDSMSG(.A,"",$GET(FMT))
End DoDot:1
+7 IF '$TEST
IF $DATA(@G@(+$ORDER(@G@(0)),0))#2
Begin DoDot:1
+8 DO WP^DDSMSG(G)
End DoDot:1
+9 IF '$TEST
DO HLP^DDSMSG(G)
+10 ;
SMQ IF DINAKED]""
SET DINAKED=$SELECT(DINAKED["""""":$ORDER(@DINAKED),1:$DATA(@DINAKED))
+1 QUIT
