source: IHS-VA_UTILITIES-XB/XBHEDD7.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 15 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 1.9 KB
RevLine 
[641]1XBHEDD7 ;402,DJB,10/23/91,EDD - Count fields, Printing
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;;David Bolduc - Togus, ME
4 ;;This is run each time EDD is run, right after you select a File.
5 ;;It sets up multiples in ^UTILITY($J,"TMP")
6MULT ;
7 D MULTBLD K CNT,TMP Q
8MULTBLD ;
9 K ^UTILITY($J)
10 S CNT=1,^UTILITY($J,"TMP",ZNUM)=$P(^DD(ZNUM,0),U,4)_"^"_CNT,^UTILITY($J,"TOT")=$P(^DD(ZNUM,0),U,4)
11 Q:'$D(^DD(ZNUM,"SB")) S TMP(1)=ZNUM,CNT=2,TMP(CNT)=""
12 F S TMP(CNT)=$O(^DD(TMP(CNT-1),"SB",TMP(CNT))) D MULTBLD1 Q:CNT=1
13 Q
14MULTBLD1 ;
15 I TMP(CNT)="" S CNT=CNT-1 Q
16 I '$D(^DD(TMP(CNT),0)) Q
17 S ^UTILITY($J,"TMP",TMP(CNT))=$P(^DD(TMP(CNT),0),U,4)_"^"_CNT_"^"_$O(^DD(TMP(CNT-1),"SB",TMP(CNT),""))
18 S ^UTILITY($J,"TOT")=^UTILITY($J,"TOT")+$P(^DD(TMP(CNT),0),U,4)
19 I $D(^DD(TMP(CNT),"SB")) S CNT=CNT+1,TMP(CNT)=""
20 Q
21PRINTM ;Option 11 in Main Menu
22 S FLAGP1=1 ;Redraws Main Menu. See MENU+2^XBHEDD.
23PRINT ;
24 I FLAGS W *27,"[?4l" S FLAGS=0 ;Reset scroll to normal
25 S FLAGP=FLAGP=0 I FLAGP=0 W:IO'=IO(0)&('FLAGM) @IOF D ^%ZISC S SIZE=(IOSL-5) Q ;If FLAGM user hit <RETURN> at Main Menu pompt.
26 S %ZIS("A")=" DEVICE: " D ^%ZIS K %ZIS("A") I POP S FLAGP=0 Q
27 S SIZE=(IOSL-5) Q
28TXT ;
29 W @IOF Q:'FLAGP W:IO'=IO(0) !!!
30 I '$D(EDDDATE) S X="NOW",%DT="T" D ^%DT K %DT S EDDDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
31 W !,$E(ZLINE1,1,IOM),!?2,"File:---- ",ZNAM,!?2,"Global:-- ",ZGL,?(IOM-17),"Date: ",EDDDATE,!,$E(ZLINE1,1,IOM),!
32 Q
33SCROLL ;Adjust scroll rate
34 W !!?8,"SCROLLING: [N]ormal [S]mooth . . . . ","Select: N//"
35 R SCROLL:DTIME S:'$T SCROLL="^" S SCROLL=$E(SCROLL) I SCROLL="^" S FLAGQ=1 Q
36 I SCROLL="?" W !?8,"Since you're printing to your CRT and you've asked for a page",!?8,"length greater than 25, you may now adjust the scroll rate.",!?8,"For DEC VT-100 compatible devices only." G SCROLL
37 S:SCROLL="" SCROLL="N" Q:"S,s"'[SCROLL S FLAGS=1 W *27,"[?4h" Q
38INIT ;
39 I FLAGP,IO=IO(0),IOSL>25 D SCROLL Q:FLAGQ
40 I FLAGP W:IO'=IO(0) " Printing.." U IO
41 D TXT Q
Note: See TracBrowser for help on using the repository browser.