source: WorldVistAEHR/trunk/r/LIST_MANAGER-VALM/VALMW4.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1VALMW4 ; ALB/MJK - Create STUB routine;04:07 PM 16 Dec 1992
2 ;;1;List Manager;;Aug 13, 1993
3 ;
4EN(VALMIFN) ; -- stub builder
5 N VALMSYS,VALMNS,VALMROU,VALMAX
6 S U="^",DTIME=600 K ^UTILITY($J)
7 I '$$DUZ^VALMW3() G ENQ
8 S VALMSYS=$$OS^VALMW3() I VALMSYS="" G ENQ
9 W !!,">>> The system will create a stub routine..."
10 S VALMROU=$$ROU^VALMW3() I VALMROU="" G ENQ
11 S VALMAX=5000 ;$$MAX^VALMW3() I 'VALMAX G ENQ
12 W !!!,">>> Building '",VALMROU,"' stub routine..."
13 D BLD,FILE(.VALMROU),TEMP
14ENQ Q
15 ;
16TEMP ; -- set defaults
17 S DIE="^SD(409.61,",DA=VALMIFN,DR="[VALM NEW ENTRY DEFAULTS]" D ^DIE
18 K DR,DA,DIE
19 Q
20 ;
21BLD ; -- build utility
22 N VALMLN,VALMNAME
23 S VALMLN=0
24 S VALMNAME=$P($G(^SD(409.61,VALMIFN,0)),U)
25 D SET("EN ; -- main entry point for "_VALMNAME)
26 D SET(" D EN^VALM("""_VALMNAME_""")")
27 D SET(" Q")
28 D SET(" ;")
29 D SET("HDR ; -- header code")
30 D SET(" S VALMHDR(1)=""This is a test header for "_VALMNAME_".""")
31 D SET(" S VALMHDR(2)=""This is the second line""")
32 D SET(" Q")
33 D SET(" ;")
34 D SET("INIT ; -- init variables and list array")
35 D SET(" F LINE=1:1:30 D SET^VALM10(LINE,LINE_"" Line number ""_LINE)")
36 D SET(" S VALMCNT=30")
37 D SET(" Q")
38 D SET(" ;")
39 D SET("HELP ; -- help code")
40 D SET(" S X=""?"" D DISP^XQORM1 W !!")
41 D SET(" Q")
42 D SET(" ;")
43 D SET("EXIT ; -- exit code")
44 D SET(" Q")
45 D SET(" ;")
46 D SET("EXPND ; -- expand code")
47 D SET(" Q")
48 D SET(" ;")
49 Q
50 ;
51SET(X) ; -- set line utility
52 S VALMLN=VALMLN+1,^UTILITY($J,VALMLN,0)=X W "."
53 Q
54 ;
55FILE(VALMROU) ; -- file routines
56 N %H,VALMDATE,VALMNUM,VALMLN
57 S %H=+$H D YX^%DTC
58 S VALMDATE=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12)
59 S VALMNUM="",VALMLN=0
60 F D SAVE(.VALMROU,.VALMNUM,.VALMLN,.VALMDATE) Q:VALMLN="" S VALMNUM=VALMNUM+1
61 Q
62 ;
63SAVE(VALMROU,VALMNUM,VALMLN,VALMDATE) ; -- save to routine
64 N LINE,SIZE
65 K ^UTILITY($J,0) S ^(0,1)=VALMROU_VALMNUM_" ; ; "_VALMDATE,^(1.1)=" ;; ;",SIZE=0
66 F LINE=2:1 S VALMLN=$O(^UTILITY($J,VALMLN)) Q:VALMLN="" S ^UTILITY($J,0,LINE)=^(VALMLN,0),SIZE=$L(^(LINE))+SIZE I $E(^(LINE),1,2)'=" .",SIZE+700>VALMAX Q
67 I VALMLN,$O(^UTILITY($J,VALMLN)) S ^UTILITY($J,0,LINE+1)=" G "_VALMROU_(VALMNUM+1)
68 S X=VALMROU_VALMNUM X ^DD("OS",VALMSYS,"ZS") W !,X_" has been filed..."
69 Q
70 ;
Note: See TracBrowser for help on using the repository browser.