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

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 3.4 KB
Line 
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.