source: IHS-VA_UTILITIES-XB/trunk/XBHEDD7.m@ 963

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

Modified directory structure; moved routines.

File size: 1.9 KB
Line 
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.