source: IHS-VA_UTILITIES-XB/trunk/XBGSAVE.m@ 1119

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

Modified directory structure; moved routines.
File size: 3.4 KB
RevLine 
[641]1XBGSAVE ; IHS/ADC/GTH - GENERIC GLOBAL SAVE FOR TRANSMISSION GLOBALS ; [ 07/21/2005 4:13 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ;
5 ; XBGL = name of global (mandatory, all others optional)
6 ;
7 ; XBCON= if defined, stops if first-level subscript is non-cannonic
8 ; XBDT = date of save, in FM format, default NOW
9 ; XBE = ending first-level numeric subscript
10 ; XBFLT= 1, saves as flat file
11 ; XBFN = output file name, default "<ns><asufac>.<JulianDate>"
12 ; XBF = beginning first-level numeric subscript, seed for $ORDER
13 ; XBIO = output device number
14 ; XBMED= media to which to save global (user asked, if not exist)
15 ; XBNAR= description displayed to user, if user asks for help
16 ; XBPAR= CR parameter (DSM only)
17 ; XBQ = Y/N, to place file in uucp q, default "Y"
18 ; XBQTO= 'sendto' destination, default AO sysid in RPMS SITE file
19 ; XBTLE= comment for dump header (facility name is concatenated)
20 ; XBUF = directory, default no longer provided - will kick out error
21 ; if XBUF undefined and no directory found in files
22 ; 9999999.39 or 8989.3
23 ; XBS1 = zish send paramaters file entry
24 ;
25SETUP ;
26 I '$D(^%ZOSF("OS")) S XBFLG(1)="The ^%ZOSF(""OS"") node does not exist",XBFLG=-1 G EOJ
27 ; I '(^%ZOSF("OS")["MSM"),'(^%ZOSF("OS")["DSM") S XBFLG(1)="Operating system is not 'MSM' or 'DSM'",XBFLG=-1 G EOJ ; IHS/SET/GTH XB*3*9 10/29/2002
28 I '(^%ZOSF("OS")["MSM"),'(^%ZOSF("OS")["OpenM") S XBFLG(1)="Operating system is not 'MSM' or 'Cache'",XBFLG=-1 G EOJ ; IHS/SET/GTH XB*3*9 10/29/2002
29 I '$G(DUZ(2)) S XBFLG(1)="Facility Number 'DUZ(2)' is not defined",XBFLG=-1 G EOJ
30 I '$D(XBGL) S XBFLG(1)="The variable 'XBGL' must contain the name of the global you wish to save." S XBFLG=-1 G EOJ
31 KILL XBFLG,XBGLL
32 S:'$D(DTIME) DTIME=300
33CHECK ;
34 S X=XBGL
35 I $L(X,"(")>1,$P(X,"(",2)="" S X=$P(X,"(")
36 S:$E(X,$L(X))="," X=$E(X,1,($L(X)-1))
37 I $L(XBGL,"(")>1,$E(XBGL,$L(XBGL))'="," S XBGL=XBGL_","
38 I $L(X,"(")>1,$E(X,$L(X))'=")" S X=X_")"
39 S:$L(X,"(")=1 XBGL=X_"("
40 S XBGLL=U_X
41CKGLOB ;
42 I '$D(@XBGLL) S XBFLG(1)="Transaction File does not exist",XBFLG=-1 G EOJ
43 ;S:'$D(XBUF) XBUF="/usr/spool/uucppublic"
44 I $G(XBUF)="" S XBUF=$P($G(^AUTTSITE(1,1)),"^",2)
45 I XBUF="" S XBUF=$P($G(^XTV(8989.3,1,"DEV")),"^",1)
46 I XBUF="" D G EOJ
47 .S XBFLG(1)="Export Directory NOT Specified"
48 .S XBFLG=-1
49 I "/\"[$E(XBUF,$L(XBUF)) D
50 .S XBUF=$E(XBUF,1,($L(XBUF)-1))
51 I '$D(DT) D DT^DICRW
52 S X2=$E(DT,1,3)_"0101",X1=DT
53 D ^%DTC
54 S XBCARTNO=X+1,XBDT=$S($D(XBDT):$$FMTE^XLFDT(XBDT),1:$$HTE^XLFDT($H))
55 S:$E(XBGL)'=U XBGL=U_XBGL
56 S XBNAR=$G(XBNAR),XBTLE=$G(XBTLE)_" "_$P(^DIC(4,DUZ(2),0),U)
57 I $D(XBMED) S XBMED=$$UP^XLFSTR($E(XBMED))
58 S XBQ=$E($G(XBQ)_"Y")
59 I XBQ="Y" S XBQTO=$G(XBQTO) I XBQTO="" S XBQTO=$P(^AUTTSITE(1,0),U,14) I XBQTO="" S XBQ="N"
60 S XBF=$G(XBF),XBE=$G(XBE)
61 I XBF="" S XBF=""""""
62 I ^%ZOSF("OS")["DSM" G SETUPDSM
63SETUPMSM ;
64 S:'$D(XBIO) XBIO=51
65 I $D(XBMED),'("CDFT"[XBMED) S XBFLG(1)="Media Type '"_XBMED_"' is incorrect",XBFLG=-1 G EOJ
66 D ^ZIBGSVEM
67 I $G(XBS1)'="" D
68 .S XBFLG=$$SENDTO1^ZISHMSMU(XBS1,XBPAFN)
69 .S XBFLG(1)=$P(XBFLG,"^",2)
70 .S XBFLG=+XBFLG
71 .Q:$D(ZTQUEUED)
72 .W:XBFLG=0 !!,"File was sent successfully"
73 .W:'(XBFLG=0) !!,"File was **NOT** sent successfully"
74 G EOJ
75 ;
76SETUPDSM ;
77 I '$D(XBIO) S XBIO=47
78 I $D(XBMED),'("CT"[XBMED) S XBFLG(1)="Media Type '"_XBMED_"' is incorrect",XBFLG=-1 G EOJ
79 D ^ZIBGSVED
80EOJ ;
81 S:'$D(XBFLG) XBFLG=0
82 KILL %DT,X,XBCON,XBFN,XBGL,XBGLL,XBCARTNO,X1,X2,XBNAR,XBTLE,XBIO,XBPAR,XBDT,XBE,XBF,XBMED,XBUF,XBQ,XBQTO,XBFLT,XBSUFAC,Y
83 Q
84 ;
Note: See TracBrowser for help on using the repository browser.