DDSMSG ;SFISC/MKO - PRINT MESSAGES ;12APR2016
;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
;;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.
;;GFT;**75,1055**
;
ERR ;Print "DIERR" messages in help box
N DDSE,DDSL,DDSLMT,DDSN
K DDH,DDQ
S DDSLMT=$G(DDC,15),DDSE=0
;
W $C(7)
S DDSN=0
F S DDSN=$O(^TMP("DIERR",$J,DDSN)) Q:'DDSN!DDSE D
. S DDSL=0
. F S DDSL=$O(^TMP("DIERR",$J,DDSN,"TEXT",DDSL)) Q:'DDSL!DDSE D
.. D LD($G(^TMP("DIERR",$J,DDSN,"TEXT",DDSL)),"!")
.. I DDH'<DDSLMT D SC^DDSU S:$D(DTOUT)!($D(DUOUT)) DDSE=1
;
I $G(DDH) S:$G(DDH(1,"T"))?1.C DDH(1,"T")="" D SC^DDSU
S DDSKM=1
K DIERR,^TMP("DIERR",$J)
Q
;
HLP(DDSG) ;Print messages from @DDSG in help area
N DDSE,DDSL,DDSLMT,DDSNXTF,DDST
S:$G(DDSG)="" DDSG=$NA(@DDSREFT@("HLP"))
;
K DDH
I $G(DDQ)-1=DDSHBX,'$X K DDQ
D:$G(DDQ)>DDSHBX SETDDH
S DDSLMT=$G(DDC,15),(DDSE,DDSL)=0
;
F S DDSL=$O(@DDSG@(DDSL)) Q:'DDSL!DDSE D
. S DDST=$G(@DDSG@(DDSL))
. I DDST="$$EOP" S DDH=$G(DDH)+1,DDH(DDH,"E")=""
. E D LD(DDST,$G(@DDSG@(DDSL,"F"),"!"))
. S DDSNXTF=$G(@DDSG@(DDSL+1,"F"),"!")
. I DDH'<DDSLMT,DDSNXTF["!"!(DDSNXTF'["?") D SC^DDSU S:$D(DTOUT)!($D(DUOUT)) DDSE=1
;
I $G(DDH) S:$G(DDH(1,"T"))?1.C DDH(1,"T")="" D SC^DDSU
K:DDSG=$NA(@DDSREFT@("HLP")) @DDSG
S:'$D(DDSID) DDSKM=1
Q
;
WP(DDSR) ;Print the contents of a wp field @DDSR in help area
N DDSE,DDSL,DDSLMT,DDSNXTF
;
K DDH
I $G(DDQ)-1=DDSHBX,'$X K DDQ
D:$G(DDQ)>DDSHBX SETDDH
S DDSLMT=$G(DDC,15),(DDSE,DDSL)=0
;
F S DDSL=$O(@DDSR@(DDSL)) Q:'DDSL!DDSE D
. D LD($G(@DDSR@(DDSL,0)),$G(@DDSR@(DDSL,"F"),"!"))
. S DDSNXTF=$G(@DDSR@(DDSL+1,"F"),"!")
. I DDH'<DDSLMT,DDSNXTF["!"!(DDSNXTF'["?") D SC^DDSU S:$D(DTOUT)!($D(DUOUT)) DDSE=1
;
I $G(DDH) S:$G(DDH(1,"T"))?1.C DDH(1,"T")="" D SC^DDSU
S:'$D(DDSID) DDSKM=1
Q
;
MSG(DDSMSG,DDSFLG,DDSFMT) ;Print local var or array DDSMSG in help area
;DDSFLG [ 1 : Write bell
;DDSFMT : Format if one line is sent
N DDSL
K DDH
I $G(DDQ)-1=DDSHBX,'$X K DDQ
D:$G(DDQ)>DDSHBX SETDDH
;
I $D(DDSMSG)=1 D
. D LD(DDSMSG,$S($G(DDSFMT)]"":DDSFMT,1:"!"))
;
E S DDSL=0 F S DDSL=$O(DDSMSG(DDSL)) Q:'DDSL D
. D LD($G(DDSMSG(DDSL)),$G(DDSMSG(DDSL,"F"),"!"))
Q:'$G(DDH)
;
I $G(DDH) D
. S:$G(DDH(1,"T"))?1.C DDH(1,"T")=""
. S:$G(DDSFLG)[1 DDH(1,"T")=$C(7)_$G(DDH(1,"T"))
. D SC^DDSU
S:'$D(DDSID) DDSKM=1
Q
;
SETDDH ;Setup DDH and DDQ for identifiers and executable help
;that called EN^DDIOL
S:$X>IOM $X=IOM
S DDH=1
S DDH(1,"T")=$TR($J("",$X)," ",$C(0))
S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)-1_U_$X
Q
;
LD(S,F) ;Load string S with format F into DDH array
N A,C,J,L
S DDH=+$G(DDH)
F J=1:1:$L(F,"!")-1 S DDH=DDH+1,DDH(DDH,"T")=""
S:'DDH DDH=1
S:F["?" @("C="_+$P(F,"?",2))
S L=$G(DDH(DDH,"T"))
S S=L_$J("",$G(C)-$L(L))_S
;
D WRAP(S,.A,IOM-1)
S DDH=DDH-1
F A=1:1:A S DDH=$G(DDH)+1,DDH(DDH,"T")=A(A)
Q
;
WRAP(L,A,M) ;Wrap line at word boundaries
; L = Line of text
; M = Margin width
;Return:
; A = Number of lines
; A(n) = Array of text
;
S:'$G(M) M=$S($G(IOM):IOM-5,1:75)
N I,N
S N=0
F I=$L(L," "):-1:1 D Q:L=""
. I I=1 S N=N+1,A(N)=$E(L,1,M),L=$E(L,M+1,999) Q
. I $L($P(L," ",1,I))'>M D
.. S N=N+1,A(N)=$P(L," ",1,I),L=$P(L," ",I+1,999)
S A=N
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSMSG 3524 printed Dec 13, 2024@02:43:24 Page 2
DDSMSG ;SFISC/MKO - PRINT MESSAGES ;12APR2016
+1 ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
+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 ;;GFT;**75,1055**
+7 ;
ERR ;Print "DIERR" messages in help box
+1 NEW DDSE,DDSL,DDSLMT,DDSN
+2 KILL DDH,DDQ
+3 SET DDSLMT=$GET(DDC,15)
SET DDSE=0
+4 ;
+5 WRITE $CHAR(7)
+6 SET DDSN=0
+7 FOR
SET DDSN=$ORDER(^TMP("DIERR",$JOB,DDSN))
if 'DDSN!DDSE
QUIT
Begin DoDot:1
+8 SET DDSL=0
+9 FOR
SET DDSL=$ORDER(^TMP("DIERR",$JOB,DDSN,"TEXT",DDSL))
if 'DDSL!DDSE
QUIT
Begin DoDot:2
+10 DO LD($GET(^TMP("DIERR",$JOB,DDSN,"TEXT",DDSL)),"!")
+11 IF DDH'<DDSLMT
DO SC^DDSU
if $DATA(DTOUT)!($DATA(DUOUT))
SET DDSE=1
End DoDot:2
End DoDot:1
+12 ;
+13 IF $GET(DDH)
if $GET(DDH(1,"T"))?1.C
SET DDH(1,"T")=""
DO SC^DDSU
+14 SET DDSKM=1
+15 KILL DIERR,^TMP("DIERR",$JOB)
+16 QUIT
+17 ;
HLP(DDSG) ;Print messages from @DDSG in help area
+1 NEW DDSE,DDSL,DDSLMT,DDSNXTF,DDST
+2 if $GET(DDSG)=""
SET DDSG=$NAME(@DDSREFT@("HLP"))
+3 ;
+4 KILL DDH
+5 IF $GET(DDQ)-1=DDSHBX
IF '$X
KILL DDQ
+6 if $GET(DDQ)>DDSHBX
DO SETDDH
+7 SET DDSLMT=$GET(DDC,15)
SET (DDSE,DDSL)=0
+8 ;
+9 FOR
SET DDSL=$ORDER(@DDSG@(DDSL))
if 'DDSL!DDSE
QUIT
Begin DoDot:1
+10 SET DDST=$GET(@DDSG@(DDSL))
+11 IF DDST="$$EOP"
SET DDH=$GET(DDH)+1
SET DDH(DDH,"E")=""
+12 IF '$TEST
DO LD(DDST,$GET(@DDSG@(DDSL,"F"),"!"))
+13 SET DDSNXTF=$GET(@DDSG@(DDSL+1,"F"),"!")
+14 IF DDH'<DDSLMT
IF DDSNXTF["!"!(DDSNXTF'["?")
DO SC^DDSU
if $DATA(DTOUT)!($DATA(DUOUT))
SET DDSE=1
End DoDot:1
+15 ;
+16 IF $GET(DDH)
if $GET(DDH(1,"T"))?1.C
SET DDH(1,"T")=""
DO SC^DDSU
+17 if DDSG=$NAME(@DDSREFT@("HLP"))
KILL @DDSG
+18 if '$DATA(DDSID)
SET DDSKM=1
+19 QUIT
+20 ;
WP(DDSR) ;Print the contents of a wp field @DDSR in help area
+1 NEW DDSE,DDSL,DDSLMT,DDSNXTF
+2 ;
+3 KILL DDH
+4 IF $GET(DDQ)-1=DDSHBX
IF '$X
KILL DDQ
+5 if $GET(DDQ)>DDSHBX
DO SETDDH
+6 SET DDSLMT=$GET(DDC,15)
SET (DDSE,DDSL)=0
+7 ;
+8 FOR
SET DDSL=$ORDER(@DDSR@(DDSL))
if 'DDSL!DDSE
QUIT
Begin DoDot:1
+9 DO LD($GET(@DDSR@(DDSL,0)),$GET(@DDSR@(DDSL,"F"),"!"))
+10 SET DDSNXTF=$GET(@DDSR@(DDSL+1,"F"),"!")
+11 IF DDH'<DDSLMT
IF DDSNXTF["!"!(DDSNXTF'["?")
DO SC^DDSU
if $DATA(DTOUT)!($DATA(DUOUT))
SET DDSE=1
End DoDot:1
+12 ;
+13 IF $GET(DDH)
if $GET(DDH(1,"T"))?1.C
SET DDH(1,"T")=""
DO SC^DDSU
+14 if '$DATA(DDSID)
SET DDSKM=1
+15 QUIT
+16 ;
MSG(DDSMSG,DDSFLG,DDSFMT) ;Print local var or array DDSMSG in help area
+1 ;DDSFLG [ 1 : Write bell
+2 ;DDSFMT : Format if one line is sent
+3 NEW DDSL
+4 KILL DDH
+5 IF $GET(DDQ)-1=DDSHBX
IF '$X
KILL DDQ
+6 if $GET(DDQ)>DDSHBX
DO SETDDH
+7 ;
+8 IF $DATA(DDSMSG)=1
Begin DoDot:1
+9 DO LD(DDSMSG,$SELECT($GET(DDSFMT)]"":DDSFMT,1:"!"))
End DoDot:1
+10 ;
+11 IF '$TEST
SET DDSL=0
FOR
SET DDSL=$ORDER(DDSMSG(DDSL))
if 'DDSL
QUIT
Begin DoDot:1
+12 DO LD($GET(DDSMSG(DDSL)),$GET(DDSMSG(DDSL,"F"),"!"))
End DoDot:1
+13 if '$GET(DDH)
QUIT
+14 ;
+15 IF $GET(DDH)
Begin DoDot:1
+16 if $GET(DDH(1,"T"))?1.C
SET DDH(1,"T")=""
+17 if $GET(DDSFLG)[1
SET DDH(1,"T")=$CHAR(7)_$GET(DDH(1,"T"))
+18 DO SC^DDSU
End DoDot:1
+19 if '$DATA(DDSID)
SET DDSKM=1
+20 QUIT
+21 ;
SETDDH ;Setup DDH and DDQ for identifiers and executable help
+1 ;that called EN^DDIOL
+2 if $X>IOM
SET $X=IOM
+3 SET DDH=1
+4 SET DDH(1,"T")=$TRANSLATE($JUSTIFY("",$X)," ",$CHAR(0))
+5 SET DDQ=$SELECT(DY>(IOSL-1):IOSL-1,1:DY)-1_U_$X
+6 QUIT
+7 ;
LD(S,F) ;Load string S with format F into DDH array
+1 NEW A,C,J,L
+2 SET DDH=+$GET(DDH)
+3 FOR J=1:1:$LENGTH(F,"!")-1
SET DDH=DDH+1
SET DDH(DDH,"T")=""
+4 if 'DDH
SET DDH=1
+5 if F["?"
SET @("C="_+$PIECE(F,"?",2))
+6 SET L=$GET(DDH(DDH,"T"))
+7 SET S=L_$JUSTIFY("",$GET(C)-$LENGTH(L))_S
+8 ;
+9 DO WRAP(S,.A,IOM-1)
+10 SET DDH=DDH-1
+11 FOR A=1:1:A
SET DDH=$GET(DDH)+1
SET DDH(DDH,"T")=A(A)
+12 QUIT
+13 ;
WRAP(L,A,M) ;Wrap line at word boundaries
+1 ; L = Line of text
+2 ; M = Margin width
+3 ;Return:
+4 ; A = Number of lines
+5 ; A(n) = Array of text
+6 ;
+7 if '$GET(M)
SET M=$SELECT($GET(IOM):IOM-5,1:75)
+8 NEW I,N
+9 SET N=0
+10 FOR I=$LENGTH(L," "):-1:1
Begin DoDot:1
+11 IF I=1
SET N=N+1
SET A(N)=$EXTRACT(L,1,M)
SET L=$EXTRACT(L,M+1,999)
QUIT
+12 IF $LENGTH($PIECE(L," ",1,I))'>M
Begin DoDot:2
+13 SET N=N+1
SET A(N)=$PIECE(L," ",1,I)
SET L=$PIECE(L," ",I+1,999)
End DoDot:2
End DoDot:1
if L=""
QUIT
+14 SET A=N
+15 QUIT
