Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VALM1

VALM1.m

Go to the documentation of this file. 
  1. VALM1 ;ALB/MJK - Screen Malipulation Utilities ;08:17 PM  6 Dec 1992 [ 09/26/2002  11:33 AM ]
  1.  ;;1;List Manager;**1002**;Aug 13, 1993
  1.  ;IHS/ANMC/LJF 7/8/98 IHS PATCH #1002
  1.  ;  -- added check for VALMWD under FULL
  1.  ;
  1. INSTR(STR,X,Y,LENGTH,ERASE) ; -- insert text
  1.  ;    STR := string to insert
  1.  ;      X := X coordinate
  1.  ;      Y := Y coordinate
  1.  ; LENGTH := clear # of characters
  1.  ;  ERASE := erase chars first
  1.  ;
  1.  W IOSC
  1.  I $G(ERASE) S DY=Y-1,DX=X-1 X IOXY W $J("",LENGTH)
  1.  S DY=Y-1,DX=X-1 X IOXY W STR
  1.  W IORC
  1.  Q
  1.  ;
  1. FLDUPD(STR,FLD,LINE,CON,COFF) ; -- update entry and field on screen
  1.  ;    STR := string to insert
  1.  ;    FLD := col name
  1.  ;  LINE := entry # in list
  1.  ;
  1.  D INSTR(.STR,+$P(VALMDDF(FLD),U,2),LINE-VALMBG+VALM("TM"),$P(VALMDDF(FLD),U,3),1)
  1.  Q
  1.  ;
  1. SETFLD(STR,VAR,FLD) ; -- set field in var
  1.  ; input: STR := string to insert
  1.  ;        VAR := destination string
  1.  ;        FLD := col name
  1.  Q $$SETSTR(STR,VAR,+$P(VALMDDF(FLD),U,2),+$P(VALMDDF(FLD),U,3))
  1.  ;
  1. SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
  1.  ;    S := string to insert
  1.  ;    V := destination string
  1.  ;    X := insert @ col X
  1.  ;    L := clear # of chars (length)
  1.  ;
  1.  Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
  1.  ;
  1. FULL ; set full scrolling region
  1.  ;I '$D(IOSTBM) D TERM^VALM0  ;IHS PATCH #1002
  1.  I '$D(IOSTBM)!('$D(VALMWD)) D TERM^VALM0  ;IHS PATCH #1002
  1.  I IOSTBM]"" S IOTM=1,IOBM=IOSL W IOSC W @IOSTBM W IORC
  1.  S X=VALMWD X ^%ZOSF("RM")
  1.  Q
  1.  ;
  1. CLEAR ; -- clear screen
  1.  D FULL,ERASE W @IOF
  1.  Q
  1.  ;
  1. ERASE ;
  1.  W $G(VALMSGR),$G(IOSGR0)
  1.  Q
  1.  ;
  1. FDATE(Y) ; -- return formatted date
  1.  ;   input:          Y := field name
  1.  ;  output: [returned] := formatted date only
  1.  Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
  1.  ;
  1. FTIME(Y) ; -- return formatted date/time
  1.  ;   input:          Y := internal date/time
  1.  ;  output: [returned] := formatted date and time
  1.  D DD^%DT
  1.  Q Y
  1.  ;
  1. FDTTM(Y) ; -- return formatted date/time
  1.  ;   input:          Y := internal date/time
  1.  ;  output: [returned] := formatted date and time
  1.  N VALMY
  1.  S VALMY=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
  1.  D DD^%DT
  1.  Q VALMY_$S($P(Y,"@",2)]"":"@"_$P(Y,"@",2),1:"")
  1.  ;
  1. NOW() ; -- return now
  1.  D NOW^%DTC
  1.  Q $$FTIME(%)
  1.  ;
  1. RANGE ; -- change date range
  1.  G RANGE^VALM11
  1.  ;
  1. PAUSE ;
  1.  W ! S DIR(0)="E" D ^DIR K DIR W !
  1.  Q
  1.  ;
  1. PRT ; -- prt screen (PS)
  1.  N VALMESC
  1.  S VALMBCK="R"
  1.  D:VALMCC FULL
  1.  S %ZIS="Q" D ^%ZIS G PRTQ:POP
  1.  I '$D(IO("Q")),IO=IO(0) D CLEAR S X=0 X ^%ZOSF("RM")
  1.  I '$D(IO("Q")) G PRTS
  1.  S ZTRTN="PRTS^VALM1",ZTIO=ION,ZTDESC="Print Screen -- List Manager Action"
  1.  D SAVE,^%ZTLOAD G PRTQ
  1.  ;
  1. PRTS ;
  1.  N VALMCC,VALMCAP
  1.  S VALMCC=0,VALMCAP=$$CAPTION^VALM
  1.  U IO D HDR^VALM,TBAR^VALM,LIST^VALM,LBAR^VALM,FTR
  1. PRTQ D:'$D(ZTQUEUED) ^%ZISC D TERM^VALM0 S X=0 X ^%ZOSF("RM")
  1.  Q
  1.  ;
  1. SAVE ; -- save to queue
  1.  F X="VALMIOXY","VALMEVL","VALMLFT","VALMPGE","VALMWD","VALMCNT","VALMBG","VALMDDF(","VALMHDR(","VALM(" S ZTSAVE(X)=""
  1.  F X="VALMAR",$S($E(VALMAR,$L(VALMAR))=")":$E(VALMAR,1,$L(VALMAR)-1)_",",1:VALMAR_"(") S ZTSAVE(X)=""
  1.  Q
  1.  ;
  1. FTR ; -- footer to print
  1.  S VALMESC=""
  1.  I $E(IOST,1,2)="C-" D PAUSE S VALMESC='Y
  1.  Q
  1.  ;
  1. PRTL ; -- prt list (PL)
  1.  I $G(VALM("PRT"))]"",$O(^ORD(101,"B",VALM("PRT"),0)) S X=$O(^(0))_";ORD(101," D EN^XQOR G PRTQ
  1.  N VALMESC
  1.  S VALMBCK="R"
  1.  D:VALMCC FULL
  1.  S %ZIS="Q" D ^%ZIS G PRTQ:POP
  1.  I '$D(IO("Q")),IO=IO(0) D CLEAR S X=0 X ^%ZOSF("RM")
  1.  I '$D(IO("Q")) G PRTLS
  1.  S ZTRTN="PRTLS^VALM1",ZTIO=ION,ZTDESC="Print List -- List Manager Action"
  1.  D SAVE,^%ZTLOAD G PRTLQ
  1.  ;
  1. PRTLS ;
  1.  N VALMPGE,VALMESC,VALMCC,VALMI,VALMLNS,VALMCAP,VALMWD
  1.  S VALMWD=IOM,VALMLNS=VALM("LINES")
  1.  S VALM("LINES")=IOSL-5,VALMCC=0,VALMPGE=1,VALMCAP=$$CAPTION^VALM
  1.  ;9/26/2002 WAR per LJF24
  1.  ;U IO D HDR^VALM,TBAR^VALM
  1.  U IO NEW VALMSAV S VALMSAV=VALM("HDR") S VALM("HDR")="" D HDR^VALM,TBAR^VALM S VALM("HDR")=VALMSAV     ;IHS/ANMC/LJF 7/29/2002 VALMHDR array already sen't recreate if queued
  1.  F VALMI=1:1:VALMCNT S X=$G(@VALMAR@($$GET^VALM4(VALMI),0)) W !,X I IOSL<($Y+6) D FTR G PRTLQ:VALMESC S VALMPGE=VALMPGE+1 D HDR^VALM,TBAR^VALM
  1.  D FTR
  1. PRTLQ D:'$D(ZTQUEUED) ^%ZISC D TERM^VALM0 S X=0 X ^%ZOSF("RM")
  1.  S:$D(VALMLNS) VALM("LINES")=VALMLNS
  1.  Q
  1.  ;
  1. UPPER(X) ; -- convert to uppercase
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;
  1. LOWER(X) ;
  1.  N Y,C,Z,I
  1.  S Y=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
  1.  F C=" ",",","/" S I=0 F  S I=$F(Y,C,I) Q:'I  S Y=$E(Y,1,I-1)_$TR($E(Y,I),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(Y,I+1,999)
  1.  Q Y
  1.  ;