source: WorldVistAEHR/trunk/r/LIST_MANAGER-VALM/VALMW3.m@ 1407

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1VALMW3 ; ALB/MJK - Create transport routines for LM;03:39 PM 16 Dec 1992
2 ;;1;List Manager;;Aug 13, 1993
3 ;
4EN ; -- exporter main entry point
5 N VALMSYS,VALMNS,VALMROU,VALMAX
6 S U="^",DTIME=600 K ^UTILITY($J)
7 D HOME^%ZIS
8 W @IOF,!?20,"*** List Template Export Utility ***"
9 I '$$DUZ() G ENQ
10 S VALMSYS=$$OS() I VALMSYS="" G ENQ
11 S VALMNS=$$NS() I VALMNS="" G ENQ
12 S VALMROU=$$ROU(.VALMNS) I VALMROU="" G ENQ
13 S VALMAX=$$MAX() I 'VALMAX G ENQ
14 W !!!,">>> Exporting LIST TEMPLATES with namespace '"_VALMNS_"'."
15 D BLD,FILE(.VALMROU)
16ENQ Q
17 ;
18 ;
19DUZ() ; -- check duz and duz(0)
20 I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) D
21 .W !,"PROGRAMMER ACCESS REQUIRED",!
22 .S Y=0
23 E S Y=1
24 Q Y
25 ;
26OS() ; -- get os #
27 I $D(^%ZOSF("OS"))#2 D
28 .S Y=+$P(^("OS"),"^",2)
29 E S Y=0
30 Q Y
31 ;
32NS() ; -- ask for namespace
33NS1 S VALMNS=""
34 W !!,">>> Enter the Name of the Package (2-4 characters): "
35 R X:$S($D(DTIME):DTIME,1:60) G NSQ:"^"[X
36 I X'?1U1.NU!($L(X)>4) D NS^VALMW5 G NS1
37 S VALMNS="",DIC="^DIC(9.4,",DIC(0)="EZ",D="C" D IX^DIC
38 I Y>0 S SDPK=+Y,VALMNS=$P(Y(0),U,2)
39 S:Y<1!(VALMNS="") VALMNS=$$ADHOC(X)
40NSQ Q VALMNS
41 ;
42ROU(VALMNS) ; -- ask for export routine name
43 N ROU,DIR,X,Q
44ROU1 S VALMROU=""
45 W ! S:$G(VALMNS)]"" DIR("B")=VALMNS_"L"
46 S DIR("A")=">>> Enter Routine Name",DIR(0)="F^2:6^" D ^DIR K DIR
47 G ROUQ:"^"[Y S VALMROU=Y
48 W !!,"I am going to create a series of '",VALMROU,"*' routines."
49 I $D(^%ZOSF("TEST"))#2 X ^("TEST") I W *7,!,"but '"_VALMROU_"' is ALREADY ON FILE!" S Q=1
50 W !,"Is that OK" D YN^DICN
51 I %<0!(%=2) S:%=2 VALMROU="" G ROUQ
52 I '% D ROU^VALMW5 G ROU1
53ROUQ Q VALMROU
54 ;
55MAX() ; -- ask for max size of routines
56 N Y
57MAX1 S Y=""
58 W !!,">>> MAXIMUM ROUTINE SIZE(BYTES): ",^DD("ROU"),"// "
59 R Y:$S($D(DTIME):DTIME,1:60) I '$T G MAXQ
60 S:Y="" Y=^DD("ROU")
61 I Y[U S Y="" G MAXQ
62 I Y\1'=Y!(Y<2000)!(Y>9999) D MAX^VALMW5 G MAX
63MAXQ Q Y
64 ;
65ADHOC(X) ; -- pick any namespace
66L W !!,"Package "_X_" not found"
67 W !,"Please enter the package namespace you wish to export: "
68 R X:300
69 I '$T!(X="")!(X'?1A.E) S X="" G LQ
70 I $L(X)>4 W !,"Namespace too long" G L
71LQ Q X
72 ;
73BLD ; -- build utility
74 N VALMLN,VALMX,VALMNAME,VALM,VALMGLB
75 S VALMLN=0,VALMX=VALMNS
76 F S VALMX=$O(^SD(409.61,"B",VALMX)) Q:VALMX=""!($E(VALMX,1,$L(VALMNS))'=VALMNS) S VALM=+$O(^(VALMX,0)) I $D(^SD(409.61,VALM,0)),$P(^(0),U,7) S VALMNAME=$P(^(0),U) D
77 .W !?5,"o ",VALMNAME
78 .D SET(" W !,""'"_VALMNAME_"' List Template...""")
79 .D SET(" S DA=$O(^SD(409.61,""B"","""_VALMNAME_""",0)),DIK=""^SD(409.61,"" D ^DIK:DA")
80 .D SET(" K DO,DD S DIC(0)=""L"",DIC=""^SD(409.61,"",X="""_VALMNAME_""" D FILE^DICN S VALM=+Y")
81 .D SET(" I VALM>0 D")
82 .;
83 .S VALMGLB="^SD(409.61,"_VALM_",",X=VALMGLB_"-1)"
84 .F S X=$Q(@X) Q:$E(X,1,$L(VALMGLB))'=VALMGLB D:X'[",""B""," SET(" .S ^SD(409.61,VALM,"_$P(X,VALMGLB,2,99)_"="""_$$QUOTE(@X)_"""")
85 .;
86 .D SET(" .S DA=VALM,DIK=""^SD(409.61,"" D IX1^DIK K DA,DIK")
87 .D SET(" .W ""Filed.""")
88 .D SET(" ;")
89 D SET(" K DIC,DIK,VALM,X,DA Q")
90Q3 Q
91 ;
92SET(X) ; -- set line utility
93 S VALMLN=VALMLN+1,^UTILITY($J,VALMLN,0)=X W "."
94 Q
95 ;
96QUOTE(X) ; -- add double quotes
97 N P,L
98 S P=1,L=$L(X)
99 F S P=$F(X,"""",P) Q:'P!(P>(L+1)) S X=$E(X,1,P-1)_""""_$E(X,P,L),L=L+1,P=P+1
100 Q X
101 ;
102FILE(VALMROU) ; -- file routines
103 N %H,VALMDATE,VALMNUM,VALMLN
104 S %H=+$H D YX^%DTC
105 S VALMDATE=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12)
106 S VALMNUM="",VALMLN=0
107 F D SAVE(.VALMROU,.VALMNUM,.VALMLN,.VALMDATE) Q:VALMLN="" S VALMNUM=VALMNUM+1
108 Q
109 ;
110SAVE(VALMROU,VALMNUM,VALMLN,VALMDATE) ; -- save to routine
111 N LINE,SIZE
112 K ^UTILITY($J,0) S ^(0,1)=VALMROU_VALMNUM_" ; List Template Exporter ; "_VALMDATE,^(1.1)=" ;; ;",SIZE=0
113 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
114 I VALMLN,$O(^UTILITY($J,VALMLN)) S ^UTILITY($J,0,LINE+1)=" G ^"_VALMROU_(VALMNUM+1)
115 S X=VALMROU_VALMNUM X ^DD("OS",VALMSYS,"ZS") W !,X_" has been filed..."
116 Q
117 ;
Note: See TracBrowser for help on using the repository browser.