- DDWH ;SFISC/MKO-SCREEN EDITOR HELP ;08:38 AM 23 Nov 1994
- ;;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.
- ;
- HLP ;
- N DX,DY,DDWI
- ;
- D HLP^DDGLIBH(9211,9214,"DDWH",IOBM+2)
- D BOX^DDW1
- ;
- S DY=IOTM-1,DX=0 X IOXY
- F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
- ;
- D:$D(DDWMARK) IND^DDW7(1)
- Q
- ;
- LINE(DDWI,DDWMARK) ;
- N DDWX
- S DDWX=$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
- Q:$G(DDWMARK)="" DDWX
- ;
- N DDWR1,DDWC1,DDWR2,DDWC2
- S DDWR1=$P(DDWMARK,U,1),DDWC1=$P(DDWMARK,U,2)
- S DDWR2=$P(DDWMARK,U,3),DDWC2=$P(DDWMARK,U,4)
- ;
- I DDWI'<(DDWR1-DDWA),DDWI'>(DDWR2-DDWA) D
- . N DDWX1,DDWX2
- . S DDWX1=$S(DDWI=(DDWR1-DDWA):DDWC1,1:1)
- . S DDWX2=$S(DDWI=(DDWR2-DDWA):DDWC2,1:999)
- . S DDWX=$E(DDWL(DDWI),1+DDWOFS,DDWX1-1)_$P(DDGLVID,DDGLDEL,6)_$E(DDWL(DDWI),$$MAX(DDWX1,1+DDWOFS),$$MIN(DDWX2,IOM+DDWOFS))_$P(DDGLVID,DDGLDEL,10)_$E(DDWL(DDWI),$$MAX(DDWX2+1,1+DDWOFS),IOM+DDWOFS)
- Q DDWX
- ;
- MIN(X,Y) ;
- Q $S(X<Y:X,1:Y)
- ;
- MAX(X,Y) ;
- Q $S(X>Y:X,1:Y)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDWH 1274 printed Mar 13, 2025@21:48:49 Page 2
- DDWH ;SFISC/MKO-SCREEN EDITOR HELP ;08:38 AM 23 Nov 1994
- +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 ;
- HLP ;
- +1 NEW DX,DY,DDWI
- +2 ;
- +3 DO HLP^DDGLIBH(9211,9214,"DDWH",IOBM+2)
- +4 DO BOX^DDW1
- +5 ;
- +6 SET DY=IOTM-1
- SET DX=0
- XECUTE IOXY
- +7 FOR DDWI=1:1:DDWMR
- WRITE $PIECE(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$GET(DDWMARK))_$SELECT(DDWI<DDWMR:$CHAR(13,10),1:"")
- +8 ;
- +9 if $DATA(DDWMARK)
- DO IND^DDW7(1)
- +10 QUIT
- +11 ;
- LINE(DDWI,DDWMARK) ;
- +1 NEW DDWX
- +2 SET DDWX=$EXTRACT(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
- +3 if $GET(DDWMARK)=""
- QUIT DDWX
- +4 ;
- +5 NEW DDWR1,DDWC1,DDWR2,DDWC2
- +6 SET DDWR1=$PIECE(DDWMARK,U,1)
- SET DDWC1=$PIECE(DDWMARK,U,2)
- +7 SET DDWR2=$PIECE(DDWMARK,U,3)
- SET DDWC2=$PIECE(DDWMARK,U,4)
- +8 ;
- +9 IF DDWI'<(DDWR1-DDWA)
- IF DDWI'>(DDWR2-DDWA)
- Begin DoDot:1
- +10 NEW DDWX1,DDWX2
- +11 SET DDWX1=$SELECT(DDWI=(DDWR1-DDWA):DDWC1,1:1)
- +12 SET DDWX2=$SELECT(DDWI=(DDWR2-DDWA):DDWC2,1:999)
- +13 SET DDWX=$EXTRACT(DDWL(DDWI),1+DDWOFS,DDWX1-1)_$PIECE(DDGLVID,DDGLDEL,6)_$EXTRACT(DDWL(DDWI),$$MAX(DDWX1,1+DDWOFS),$$MIN(DDWX2,IOM+DDWOFS))_$PIECE(DDGLVID,DDGLDEL,10)_$EXTRACT(DDWL(DDWI),$$MAX(DDWX2+1,1+DDWOFS),IOM+DDWOFS)
- End DoDot:1
- +14 QUIT DDWX
- +15 ;
- MIN(X,Y) ;
- +1 QUIT $SELECT(X<Y:X,1:Y)
- +2 ;
- MAX(X,Y) ;
- +1 QUIT $SELECT(X>Y:X,1:Y)