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

SDUL1.m

Go to the documentation of this file.
  1. SDUL1 ;ALB/MJK - Screen Malipulation Utilities ; 12/1/91
  1. ;;5.3;Scheduling;**140**;Aug 13, 1993
  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,ENTRY) ; -- update entry and field on screen
  1. ; STR := string to insert
  1. ; FLD := col name
  1. ; ENTRY := entry # in list
  1. ;
  1. D INSTR(.STR,+$P(SDULDDF(FLD),U,2),ENTRY-SDULBG+SDUL("TM"),$P(SDULDDF(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^SDUL1(STR,VAR,+$P(SDULDDF(FLD),U,2),+$P(SDULDDF(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^SDUL0
  1. I IOSTBM]"" S IOTM=1,IOBM=IOSL W IOSC W @IOSTBM W IORC
  1. Q
  1. ;
  1. CLEAR ; -- clear screen
  1. D FULL,ERASE W @IOF
  1. Q
  1. ;
  1. ERASE ;
  1. F X="IOUOFF","IOINORM" W $G(@X)
  1. Q
  1. ;
  1. FDATE(Y) ; -- return formatted date
  1. ; input: Y := field name
  1. ; output: [returned] := formatted date only
  1. Q $TR($$FMTE^XLFDT(Y,"5DF")," ","0")
  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 SDY
  1. S SDY=$TR($$FMTE^XLFDT(Y,"5DF")," ","0")
  1. D DD^%DT
  1. Q SDY_$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. ; input: ^TMP("SDUL DATA",$J SDULEVL,"DAYS") := number of days allowed
  1. ; SDB := default beginning date {optional}
  1. ;
  1. I $D(SDB) S Y=SDB D DD^%DT S:Y]"" %DT("B")=Y
  1. W ! S:$D(SDMIN) %DT(0)=SDMIN S %DT="AEX",%DT("A")="Select Beginning Date: " D ^%DT K %DT
  1. G RANGEQ:Y<0 S (X1,SDX)=Y,X2=+$G(^TMP("SDUL DATA",$J,SDULEVL,"DAYS")) D C^%DTC S SDX1=X,X=""
  1. I SDX'>DT,SDX1>DT S X="TODAY"
  1. I X="" S Y=SDX D DD^%DT S X=Y
  1. S DIR("B")=X
  1. S DIR(0)="DA"_U_SDX_":"_SDX1_":EX",DIR("A")="Select Ending Date: "
  1. S DIR("?",1)="Date range can be a maximum of "_+$G(^TMP("SDUL DATA",$J,SDULEVL,"DAYS"))_" days long.",DIR("?",2)=" "
  1. S DIR("?",3)="Enter a date between "_$$FDATE(SDX)_" and "_$$FDATE(SDX1)_".",DIR("?")=" "
  1. D ^DIR K DIR G RANGEQ:Y'>0 S SDEND=Y,SDBEG=SDX
  1. RANGEQ K SDX,SDX1 Q
  1. ;
  1. PAUSE ;
  1. W ! S DIR(0)="E" D ^DIR K DIR W !
  1. Q
  1. ;
  1. PRT ; -- prt screen (PS)
  1. N SDESC
  1. S SDULBCK=$S(SDULCC:"",1:"R")
  1. S %ZIS="Q" D ^%ZIS G PRTQ:POP
  1. I '$D(IO("Q")),IO=IO(0) S SDULBCK="R" D CLEAR
  1. I '$D(IO("Q")) G PRTS
  1. S ZTRTN="PRTS^SDUL1",ZTIO=ION,ZTDESC="Print Screen -- List Manager Action"
  1. D SAVE,^%ZTLOAD G PRTQ
  1. ;
  1. PRTS ;
  1. N SDULCC,SDULCAP
  1. S SDULCC=0,SDULCAP=$$CAPTION^SDUL
  1. U IO D HDR^SDUL,LIST^SDUL,FTR
  1. PRTQ D:'$D(ZTQUEUED) ^%ZISC D TERM^SDUL0
  1. Q
  1. ;
  1. SAVE ; -- save to queue
  1. F X="SDULPGE","SDULWD","SDULCNT","SDULBG","SDULDDF(","SDULHDR(","SDUL(","SDULAR",$E(SDULAR,1,$L(SDULAR)-1)_$S($E(SDULAR,$L(SDULAR))=")":",",1:"(") S ZTSAVE(X)=""
  1. Q
  1. ;
  1. FTR ; -- footer to print
  1. S SDESC=""
  1. I $E(IOST,1,2)="C-" D PAUSE S SDESC='Y
  1. Q
  1. ;
  1. PRTL ; -- prt list (PL)
  1. N SDESC
  1. S SDULBCK=$S(SDULCC:"",1:"R")
  1. S %ZIS="Q" D ^%ZIS G PRTQ:POP
  1. I '$D(IO("Q")),IO=IO(0) S SDULBCK="R" D CLEAR
  1. I '$D(IO("Q")) G PRTLS
  1. S ZTRTN="PRTLS^SDUL1",ZTIO=ION,ZTDESC="Print List -- List Manager Action"
  1. D SAVE,^%ZTLOAD G PRTLQ
  1. ;
  1. PRTLS ;
  1. N SDULPGE,SDESC,SDULCC,SDI,SDLINES,SDULCAP
  1. S SDLINES=SDUL("LINES")
  1. S SDUL("LINES")=IOSL-5,SDULCC=0,SDULPGE=1,SDULCAP=$$CAPTION^SDUL
  1. U IO D HDR^SDUL
  1. F SDI=1:1:SDULCNT S X=$G(@SDULAR@($$GET^SDUL4(SDI),0)) W !,X I IOSL<($Y+6) D FTR G PRTLQ:SDESC S SDULPGE=SDULPGE+1 D HDR^SDUL
  1. D FTR
  1. PRTLQ D:'$D(ZTQUEUED) ^%ZISC D TERM^SDUL0
  1. S:$D(SDLINES) SDUL("LINES")=SDLINES
  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=" ",",","/" F I=2:1 S Z=$P(Y,C,I,999) Q:Z="" S Y=$P(Y,C,1,I-1)_C_$TR($E(Z),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(Z,2,999)
  1. Q Y
  1. ;